support for tests applying effects

1 files changed, 15 insertions, 2 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 2d9f876..3b7b3f5 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -274,10 +274,10 @@ spawnFaction cFaction num cEntity nameTemplate
 
 -- Dice rolls
 rollTest :: Completable (FormulaM Stats Test) -> Sh GameState ()
-rollTest = withArg $ maybe (return ()) outputResult <=< enactTest'
+rollTest = withArg $ maybe (return ()) ((>>) <$> outputResult <*> applyEffect) <=< enactTest'
   where
     outputResult :: (String, TestResult) -> Sh GameState ()
-    outputResult (test, ppResult -> result) = do
+    outputResult (test, view (rRoll . to ppResult) -> result) = do
       focusId <- use gFocus
       case focusId of
         Nothing -> shellPutStrLn result
@@ -295,6 +295,19 @@ rollTest = withArg $ maybe (return ()) outputResult <=< enactTest'
       | length str >= n = str
       | otherwise = ' ' : pad (n - 1) str
 
+
+    applyEffect :: (String, TestResult) -> Sh GameState ()
+    applyEffect (test, view rResult -> (Effect (CI.original -> effectDesc) effect)) = void . runMaybeT $ do
+      focusId <- MaybeT $ use gFocus
+      name <- toName focusId
+      let
+        lStats :: Traversal' GameState Stats
+        lStats = gEntities . ix focusId . eStats
+        evalF = MaybeT . focusState lStats . evalFormula' [name]
+      guard =<< askBool ("Apply effects (" ++ effectDesc ++ ")?") True
+      lStats <~ (MaybeT . fmap join . runMaybeT $ evalF effect)
+      lift . outputLogged focusId $ test ++ " effects: " ++ effectDesc
+
 enactTest' :: FormulaM Stats Test -> Sh GameState (Maybe (String, TestResult))
 enactTest' test = runMaybeT $ do
   focusName <- MaybeT (use gFocus) >>= lift . toName