diff options
Diffstat (limited to 'src/Sequence/Formula.hs')
-rw-r--r-- | src/Sequence/Formula.hs | 4 |
1 files changed, 4 insertions, 0 deletions
diff --git a/src/Sequence/Formula.hs b/src/Sequence/Formula.hs index ca945f8..4f2e61b 100644 --- a/src/Sequence/Formula.hs +++ b/src/Sequence/Formula.hs | |||
@@ -28,6 +28,7 @@ import Data.Bool | |||
28 | import Data.List | 28 | import Data.List |
29 | import Data.Maybe | 29 | import Data.Maybe |
30 | import Data.Either | 30 | import Data.Either |
31 | import Data.Tuple | ||
31 | 32 | ||
32 | import Data.Set (Set) | 33 | import Data.Set (Set) |
33 | import qualified Data.Set as Set | 34 | import qualified Data.Set as Set |
@@ -109,6 +110,9 @@ evalFormula = evalFormula' [] | |||
109 | Left q@(Question{..}) -> askQuestion promptPref input q >>= flip (flip evalFormula' promptPref $ bool (pure . set (ctx' . answer) $ throwError q) mempty keepResult ++ finalChanges) formula | 110 | Left q@(Question{..}) -> askQuestion promptPref input q >>= flip (flip evalFormula' promptPref $ bool (pure . set (ctx' . answer) $ throwError q) mempty keepResult ++ finalChanges) formula |
110 | Right result -> return (foldr ($) input finalChanges, result) | 111 | Right result -> return (foldr ($) input finalChanges, result) |
111 | 112 | ||
113 | evalFormula' :: (MonadIO m, sInput :<: lInput, MonadState lInput m) => String -> FormulaM sInput a -> m a | ||
114 | evalFormula' promptPref formula = uncurry (<$) . over _2 put . swap =<< flip (evalFormula promptPref) formula =<< get | ||
115 | |||
112 | val :: Integral a => Traversal' input (Formula input) -> String -> Bool -> Formula input | 116 | val :: Integral a => Traversal' input (Formula input) -> String -> Bool -> Formula input |
113 | val answer prompt keepResult = do | 117 | val answer prompt keepResult = do |
114 | gets (Set.member prompt) >>= bool (modify $ Set.insert prompt) (modify (Set.delete prompt) >> throwError Question{..}) | 118 | gets (Set.member prompt) >>= bool (modify $ Set.insert prompt) (modify (Set.delete prompt) >> throwError Question{..}) |