From a5f0062f48fba018e7de8b5a3c0799381e535572 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Tue, 20 Dec 2022 21:21:30 +0100
Subject: Move TestRun monad and related types to separate module

---
 src/Main.hs | 67 +------------------------------------------------------------
 1 file changed, 1 insertion(+), 66 deletions(-)

(limited to 'src/Main.hs')

diff --git a/src/Main.hs b/src/Main.hs
index 8864883..1c1f03c 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -9,7 +9,6 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
 
-import Data.Map (Map)
 import Data.Map qualified as M
 import Data.Maybe
 import Data.Scientific
@@ -35,74 +34,10 @@ import Network
 import Output
 import Parser
 import Process
+import Run.Monad
 import Test
 import Util
 
-data Options = Options
-    { optDefaultTool :: String
-    , optProcTools :: [(ProcName, String)]
-    , optTestDir :: FilePath
-    , optVerbose :: Bool
-    , optTimeout :: Scientific
-    , optGDB :: Bool
-    , optForce :: Bool
-    }
-
-defaultOptions :: Options
-defaultOptions = Options
-    { optDefaultTool = ""
-    , optProcTools = []
-    , optTestDir = ".test"
-    , optVerbose = False
-    , optTimeout = 1
-    , optGDB = False
-    , optForce = False
-    }
-
-data TestEnv = TestEnv
-    { teOutput :: Output
-    , teFailed :: TVar (Maybe Failed)
-    , teOptions :: Options
-    , teProcesses :: MVar [Process]
-    , teGDB :: Maybe (MVar GDB)
-    }
-
-data TestState = TestState
-    { tsNetwork :: Network
-    , tsVars :: [(VarName, SomeVarValue)]
-    , tsNodePacketLoss :: Map NodeName Scientific
-    }
-
-newtype TestRun a = TestRun { fromTestRun :: ReaderT (TestEnv, TestState) (ExceptT Failed IO) a }
-    deriving (Functor, Applicative, Monad, MonadReader (TestEnv, TestState), MonadIO)
-
-instance MonadFail TestRun where
-    fail str = do
-        outLine OutputError Nothing $ T.pack str
-        throwError Failed
-
-instance MonadError Failed TestRun where
-    throwError failed = do
-        failedVar <- asks $ teFailed . fst
-        liftIO $ atomically $ modifyTVar failedVar (`mplus` Just failed)
-
-        te <- asks fst
-        case failed of
-            ProcessCrashed _ | Just mgdb <- teGDB te -> do
-                maybe (return ()) gdbSession =<< liftIO (tryTakeMVar mgdb)
-            _ -> return ()
-
-        TestRun $ throwError failed
-
-    catchError (TestRun act) handler = TestRun $ catchError act $ fromTestRun . handler
-
-instance MonadEval TestRun where
-    lookupVar name = maybe (fail $ "variable not in scope: '" ++ unpackVarName name ++ "'") return =<< asks (lookup name . tsVars . snd)
-    rootNetwork = asks $ tsNetwork . snd
-
-instance MonadOutput TestRun where
-    getOutput = asks $ teOutput . fst
-
 withVar :: ExprType e => VarName -> e -> TestRun a -> TestRun a
 withVar name value = local (fmap $ \s -> s { tsVars = (name, SomeVarValue value) : tsVars s })
 
-- 
cgit v1.2.3