summaryrefslogtreecommitdiff
path: root/src/Run/Monad.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Run/Monad.hs')
-rw-r--r--src/Run/Monad.hs17
1 files changed, 13 insertions, 4 deletions
diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs
index abef32d..aeab7e4 100644
--- a/src/Run/Monad.hs
+++ b/src/Run/Monad.hs
@@ -15,6 +15,7 @@ import Control.Concurrent.STM
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader
+import Control.Monad.Writer
import Data.Map (Map)
import Data.Scientific
@@ -26,15 +27,22 @@ import Network.Ip
import Output
import {-# SOURCE #-} Process
import Script.Expr
+import Script.Object
-newtype TestRun a = TestRun { fromTestRun :: ReaderT (TestEnv, TestState) (ExceptT Failed IO) a }
- deriving (Functor, Applicative, Monad, MonadReader (TestEnv, TestState), MonadIO)
+newtype TestRun a = TestRun { fromTestRun :: ReaderT (TestEnv, TestState) (ExceptT Failed (WriterT [ SomeObject TestRun ] IO)) a }
+ deriving
+ ( Functor, Applicative, Monad
+ , MonadReader ( TestEnv, TestState )
+ , MonadWriter [ SomeObject TestRun ]
+ , MonadIO
+ )
data TestEnv = TestEnv
{ teOutput :: Output
, teFailed :: TVar (Maybe Failed)
, teOptions :: TestOptions
- , teProcesses :: MVar [Process]
+ , teNextObjId :: MVar Int
+ , teProcesses :: MVar [ Process ]
, teGDB :: Maybe (MVar GDB)
}
@@ -117,6 +125,7 @@ forkTestUsing :: (IO () -> IO ThreadId) -> TestRun () -> TestRun ThreadId
forkTestUsing fork act = do
tenv <- ask
liftIO $ fork $ do
- runExceptT (flip runReaderT tenv $ fromTestRun act) >>= \case
+ ( res, [] ) <- runWriterT (runExceptT $ flip runReaderT tenv $ fromTestRun act)
+ case res of
Left e -> atomically $ writeTVar (teFailed $ fst tenv) (Just e)
Right () -> return ()