Framework for rolling tests

1 files changed, 14 insertions, 1 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 9ea7a49..c6eee62 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -32,7 +32,9 @@ import Data.Function
 import Control.Monad.State.Strict
 
 import Sequence.Types
+import Sequence.Contact.Types
 import Sequence.Contact.Archetypes
+import Sequence.Contact.Tests
 import Sequence.Utils
 import Sequence.Formula
 
@@ -62,6 +64,7 @@ main = do
                                     , cmd "align" alignEntity "Align the focused entity to a faction – creating it, if necessary"
                                     , cmd "name" nameEntity "Name the current entity overriding previous name assignments"
                                     , cmd "spawn" spawnEntity "Create a new entity from an archetype focusing on it"
+                                    , cmd "roll" rollTest "Roll a test using the stats of the currently focused entity"
                                     ]
                   }
   void $ runShell description haskelineBackend (def :: GameState)
@@ -95,7 +98,7 @@ alignEntity = withArg $ \nFaction -> withFocus $ \ident -> gEntities %= Map.adju
 
 -- Automatic focus
 focusTip, blur :: Sh GameState ()
-focusTip = gFocus <~ use tip
+focusTip = gFocus <~ preuse tip
 blur     = gFocus .= Nothing
 
 -- Manual focus
@@ -122,3 +125,13 @@ spawnEntity = withArg $ \entity -> do
 nameEntity :: String -> Sh GameState ()
 nameEntity ('#':_) = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)"
 nameEntity name = withFocus $ \ident -> modifying gEntityNames $ Bimap.insert ident (name ^. entityName)
+
+rollTest :: Completable (FormulaM Stats Test) -> Sh GameState ()
+rollTest = withArg $ enactTest' >=> maybe (return ()) (shellPutStrLn . show)
+
+enactTest' :: (FormulaM Stats Test) -> Sh GameState (Maybe TestResult)
+enactTest' test = withFocus' $ \focus -> do
+  (newStats, result) <- evalFormula (view eStats focus) (enactTest =<< test)
+  gFocus'.eStats .= newStats
+  return result
+