chore(primer): add interpreter test to actions tests

This test change is a separate commit to the parent commit because it
requires a change to `EditAppM`, namely adding a `MonadIO` instance to
it. Prior to this change, no action tests required `IO`.

Signed-off-by: Drew Hess <src@drewhess.com>

primer/src/Primer/App.hs

@@ -1477,7 +1477,7 @@ type MonadQueryApp m e = (Monad m, MonadReader App m, MonadError e m)
 -- state. This is important to ensure that we can reliably replay the
 -- log without having ID mismatches.
 newtype EditAppM m e a = EditAppM (StateT App (ExceptT e m) a)
-  deriving newtype (Functor, Applicative, Monad, MonadState App, MonadError e, MonadLog l)
+  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadState App, MonadError e, MonadLog l)
 
 -- | Run an 'EditAppM' action, returning a result and an updated
 -- 'App'.

primer/test/Tests/Action/Available.hs

@@ -54,6 +54,7 @@ import Primer.App (
   DefSelection (..),
   EditAppM,
   Editable (..),
+  EvalBoundedInterpReq (EvalBoundedInterpReq),
   EvalFullReq (EvalFullReq),
   EvalReq (EvalReq),
   Level (Beginner, Expert, Intermediate),
@@ -79,6 +80,7 @@ import Primer.App (
   checkAppWellFormed,
   checkProgWellFormed,
   handleEditRequest,
+  handleEvalBoundedInterpRequest,
   handleEvalFullRequest,
   handleEvalRequest,
   handleMutationRequest,
@@ -155,6 +157,9 @@ import Primer.Def (
   defAST,
  )
 import Primer.Eval (EvalError (NotRedex), NormalOrderOptions (StopAtBinders, UnderBinders))
+import Primer.EvalFullInterp (
+  Timeout (MicroSec),
+ )
 import Primer.EvalFullStep (Dir (Chk))
 import Primer.Examples (comprehensiveWellTyped)
 import Primer.Gen.App (genApp)
@@ -167,9 +172,15 @@ import Primer.Gen.Core.Typed (
   genSyn,
   genWTKind,
   genWTType,
+  isolateWT,
   propertyWT,
  )
-import Primer.Log (PureLog, runPureLog)
+import Primer.Log (
+  PureLog,
+  PureLogT,
+  runPureLog,
+  runPureLogT,
+ )
 import Primer.Module (
   Module (Module, moduleDefs),
   builtinModule,
@@ -345,6 +356,7 @@ tasty_multiple_requests_accepted = withTests 500
               , Just (1, Eval1)
               , if null $ appDefs a' then Nothing else Just (1, EvalFull)
               , Just (1, Question)
+              , if null $ appDefs a' then Nothing else Just (1, EvalBoundedInterp)
               , if undoLogEmpty $ appProg a' then Nothing else Just (2, Undo)
               , if redoLogEmpty $ appProg a' then Nothing else Just (2, Redo)
               , Just (1, RenameModule)
@@ -375,6 +387,10 @@ tasty_multiple_requests_accepted = withTests 500
             steps <- forAllT $ Gen.integral $ Range.linear 0 100
             optsN <- forAllT $ Gen.element @[] [StopAtBinders, UnderBinders]
             actionSucceeds (readerToState $ handleEvalFullRequest $ EvalFullReq tld Chk steps optsN) appN
+          EvalBoundedInterp -> do
+            g <- forAllT $ Gen.element $ appDefs appN
+            tld <- gvar g
+            actionSucceedsIO (readerToState $ handleEvalBoundedInterpRequest $ EvalBoundedInterpReq tld Chk (MicroSec 100)) appN
           Question -> do
             -- Obtain a non-exhaustive case warning if we add a new question
             let _w :: Question q -> ()
@@ -441,14 +457,31 @@ data Act
   | AddTy
   | Eval1
   | EvalFull
+  | EvalBoundedInterp
   | Question
   | Undo
   | Redo
   | RenameModule
   | AvailAct
   deriving stock (Show)
 
--- Helper for tasty_available_actions_accepted and tasty_chained_actions_undo_accepted
+-- Helpers for tasty_available_actions_accepted and tasty_chained_actions_undo_accepted
+
+runEditAppMLogsIO ::
+  (HasCallStack) =>
+  EditAppM (PureLogT (WithSeverity ()) WT) ProgError a ->
+  App ->
+  PropertyT WT (Either ProgError a, App)
+runEditAppMLogsIO m a = do
+  (r, logs) <- lift $ isolateWT $ runPureLogT $ runEditAppM m a
+  testNoSevereLogs logs >> pure r
+
+actionSucceedsIO :: HasCallStack => EditAppM (PureLogT (WithSeverity ()) WT) ProgError a -> App -> PropertyT WT App
+actionSucceedsIO m a =
+  runEditAppMLogsIO m a >>= \case
+    (Left err, _) -> annotateShow err >> failure
+    (Right _, a') -> ensureSHNormal a' $> a'
+
 runEditAppMLogs ::
   HasCallStack =>
   EditAppM (PureLog (WithSeverity ())) ProgError a ->
@@ -457,7 +490,6 @@ runEditAppMLogs ::
 runEditAppMLogs m a = case runPureLog $ runEditAppM m a of
   (r, logs) -> testNoSevereLogs logs >> pure r
 
--- Helper for tasty_available_actions_accepted and tasty_chained_actions_undo_accepted
 actionSucceeds :: HasCallStack => EditAppM (PureLog (WithSeverity ())) ProgError a -> App -> PropertyT WT App
 actionSucceeds m a =
   runEditAppMLogs m a >>= \case