summaryrefslogtreecommitdiff
path: root/src/Sequence/Formula.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Sequence/Formula.hs')
-rw-r--r--src/Sequence/Formula.hs4
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
28import Data.List 28import Data.List
29import Data.Maybe 29import Data.Maybe
30import Data.Either 30import Data.Either
31import Data.Tuple
31 32
32import Data.Set (Set) 33import Data.Set (Set)
33import qualified Data.Set as Set 34import 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
113evalFormula' :: (MonadIO m, sInput :<: lInput, MonadState lInput m) => String -> FormulaM sInput a -> m a
114evalFormula' promptPref formula = uncurry (<$) . over _2 put . swap =<< flip (evalFormula promptPref) formula =<< get
115
112val :: Integral a => Traversal' input (Formula input) -> String -> Bool -> Formula input 116val :: Integral a => Traversal' input (Formula input) -> String -> Bool -> Formula input
113val answer prompt keepResult = do 117val 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{..})