From fb065aeac90ce0766a3f74b84c34547cd087da77 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 11 Jun 2016 01:34:07 +0200 Subject: trigger effects on taking damage --- src/Sequence/Formula.hs | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'src/Sequence/Formula.hs') 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 import Data.List import Data.Maybe import Data.Either +import Data.Tuple import Data.Set (Set) import qualified Data.Set as Set @@ -109,6 +110,9 @@ evalFormula = evalFormula' [] Left q@(Question{..}) -> askQuestion promptPref input q >>= flip (flip evalFormula' promptPref $ bool (pure . set (ctx' . answer) $ throwError q) mempty keepResult ++ finalChanges) formula Right result -> return (foldr ($) input finalChanges, result) +evalFormula' :: (MonadIO m, sInput :<: lInput, MonadState lInput m) => String -> FormulaM sInput a -> m a +evalFormula' promptPref formula = uncurry (<$) . over _2 put . swap =<< flip (evalFormula promptPref) formula =<< get + val :: Integral a => Traversal' input (Formula input) -> String -> Bool -> Formula input val answer prompt keepResult = do gets (Set.member prompt) >>= bool (modify $ Set.insert prompt) (modify (Set.delete prompt) >> throwError Question{..}) -- cgit v1.2.3