Better tests

1 files changed, 15 insertions, 8 deletions

diff --git a/src/Main.hs b/src/Main.hs
index de90b80..55c0d8b 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -257,9 +257,15 @@ spawnFaction cFaction num cEntity nameTemplate
 
 -- Dice rolls
 rollTest :: Completable (FormulaM Stats Test) -> Sh GameState ()
-rollTest = withArg $ enactTest' >=> maybe (return ()) (shellPutStrLn . ppResult)
+rollTest = withArg $ maybe (return ()) outputResult <=< enactTest'
   where
-    ppResult result = pad 3 (show $ result^.rWith) ++ ": " ++ setSGRCode (colour result) ++ name result ++ setSGRCode [] ++ " by " ++ pad 2 (show $ result^.rBy) ++ "pp"
+    outputResult :: (String, TestResult) -> Sh GameState ()
+    outputResult (test, ppResult -> result) = do
+      focusId <- use gFocus
+      case focusId of
+        Nothing -> shellPutStrLn result
+        Just id -> outputLogged id $ test ++ ": " ++ result
+    ppResult result = pad 3 (show $ result^.rWith) ++ " → " ++ setSGRCode (colour result) ++ name result ++ setSGRCode [] ++ " by " ++ pad 2 (show $ result^.rBy) ++ "pp"
     colour CritSuccess{..} = [SetColor Foreground Vivid Green, SetConsoleIntensity BoldIntensity]
     colour Success{..} = [SetColor Foreground Dull Green]
     colour Failure{..} = [SetColor Foreground Dull Red]
@@ -272,12 +278,13 @@ rollTest = withArg $ enactTest' >=> maybe (return ()) (shellPutStrLn . ppResult)
       | length str >= n = str
       | otherwise = ' ' : pad (n - 1) str
 
-enactTest' :: (FormulaM Stats Test) -> Sh GameState (Maybe TestResult)
-enactTest' test = withFocus' $ \focus -> do
-  focusName <- use gFocus >>= toName . fromJust
-  (newFocus, result) <- evalFormula [focusName] focus (enactTest =<< test)
-  gFocus' .= newFocus
-  return result
+enactTest' :: FormulaM Stats Test -> Sh GameState (Maybe (String, TestResult))
+enactTest' test = runMaybeT $ do
+  focusName <- MaybeT (use gFocus) >>= lift . toName
+  let evalF = MaybeT . focusState (gFocus' . eStats) . evalFormula' [focusName]
+  test' <- evalF test
+  result <- evalF $ enactTest test'
+  return (view (tName . to CI.original) test', result)
       
 entitySeqVal :: Sh GameState ()
 entitySeqVal = withFocus entitySeqVal'