From 1a5670d0fc6ee4640fc84b5abc01bf5efd85f5ce Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Mon, 2 Jan 2023 22:57:25 +0100
Subject: Split command line and test options

---
 src/Main.hs      | 46 ++++++++++++++++++++++++++++++----------------
 src/Run/Monad.hs | 12 +++++-------
 2 files changed, 35 insertions(+), 23 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index 1c1f03c..98fa9f1 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -271,7 +271,7 @@ evalSteps = mapM_ $ \case
         void $ liftIO $ getLine
         outClearPrompt
 
-runTest :: Output -> Options -> Test -> IO Bool
+runTest :: Output -> TestOptions -> Test -> IO Bool
 runTest out opts test = do
     let testDir = optTestDir opts
     when (optForce opts) $ removeDirectoryRecursive testDir `catchIOError` \e ->
@@ -335,30 +335,42 @@ runTest out opts test = do
             return True
         _ -> return False
 
+data CmdlineOptions = CmdlineOptions
+    { optTest :: TestOptions
+    , optVerbose :: Bool
+    }
 
-options :: [OptDescr (Options -> Options)]
+defaultCmdlineOptions :: CmdlineOptions
+defaultCmdlineOptions = CmdlineOptions
+    { optTest = defaultTestOptions
+    , optVerbose = False
+    }
+
+options :: [OptDescr (CmdlineOptions -> CmdlineOptions)]
 options =
     [ Option ['T'] ["tool"]
-        (ReqArg (\str opts -> case break (==':') str of
-                                   (path, []) -> opts { optDefaultTool = path }
-                                   (pname, (_:path)) -> opts { optProcTools = (ProcName (T.pack pname), path) : optProcTools opts }
+        (ReqArg (\str -> to $ \opts -> case break (==':') str of
+                                            (path, []) -> opts { optDefaultTool = path }
+                                            (pname, (_:path)) -> opts { optProcTools = (ProcName (T.pack pname), path) : optProcTools opts }
                 ) "PATH")
         "test tool to be used"
     , Option ['v'] ["verbose"]
         (NoArg (\opts -> opts { optVerbose = True }))
         "show output of processes and successful tests"
     , Option ['t'] ["timeout"]
-        (ReqArg (\str opts -> case readMaybe str of
-                                   Just timeout -> opts { optTimeout = timeout }
-                                   Nothing -> error "timeout must be a number") "SECONDS")
+        (ReqArg (\str -> to $ \opts -> case readMaybe str of
+                                            Just timeout -> opts { optTimeout = timeout }
+                                            Nothing -> error "timeout must be a number") "SECONDS")
         "default timeout in seconds with microsecond precision"
     , Option ['g'] ["gdb"]
-        (NoArg (\opts -> opts { optGDB = True }))
+        (NoArg $ to $ \opts -> opts { optGDB = True })
         "run GDB and attach spawned processes"
     , Option ['f'] ["force"]
-        (NoArg (\opts -> opts { optForce = True }))
+        (NoArg $ to $ \opts -> opts { optForce = True })
         "remove test directory if it exists instead of stopping"
     ]
+  where
+    to f opts = opts { optTest = f (optTest opts) }
 
 main :: IO ()
 main = do
@@ -369,9 +381,11 @@ main = do
     envtool <- lookupEnv "EREBOS_TEST_TOOL" >>= \mbtool ->
         return $ fromMaybe (error "No test tool defined") $ mbtool `mplus` (return . (baseDir </>) =<< configTool =<< config)
 
-    let initOpts = defaultOptions
-            { optDefaultTool = envtool
-            , optTestDir = normalise $ baseDir </> optTestDir defaultOptions
+    let initOpts = defaultCmdlineOptions
+            { optTest = defaultTestOptions
+                { optDefaultTool = envtool
+                , optTestDir = normalise $ baseDir </> optTestDir defaultTestOptions
+                }
             }
 
     args <- getArgs
@@ -380,9 +394,9 @@ main = do
         (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
             where header = "Usage: erebos-tester [OPTION...]"
 
-    getPermissions (head $ words $ optDefaultTool opts) >>= \perms -> do
+    getPermissions (head $ words $ optDefaultTool $ optTest opts) >>= \perms -> do
         when (not $ executable perms) $ do
-            fail $ optDefaultTool opts <> " is not executable"
+            fail $ optDefaultTool (optTest opts) <> " is not executable"
 
     files <- if not (null ofiles)
         then return ofiles
@@ -390,5 +404,5 @@ main = do
     when (null files) $ fail $ "No test files"
 
     out <- startOutput $ optVerbose opts
-    ok <- allM (runTest out opts) . concat =<< mapM parseTestFile files
+    ok <- allM (runTest out $ optTest opts) . concat =<< mapM parseTestFile files
     when (not ok) exitFailure
diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs
index 77e47ea..220ac46 100644
--- a/src/Run/Monad.hs
+++ b/src/Run/Monad.hs
@@ -2,7 +2,7 @@ module Run.Monad (
     TestRun(..),
     TestEnv(..),
     TestState(..),
-    Options(..), defaultOptions,
+    TestOptions(..), defaultTestOptions,
     Failed(..),
 ) where
 
@@ -28,7 +28,7 @@ newtype TestRun a = TestRun { fromTestRun :: ReaderT (TestEnv, TestState) (Excep
 data TestEnv = TestEnv
     { teOutput :: Output
     , teFailed :: TVar (Maybe Failed)
-    , teOptions :: Options
+    , teOptions :: TestOptions
     , teProcesses :: MVar [Process]
     , teGDB :: Maybe (MVar GDB)
     }
@@ -39,22 +39,20 @@ data TestState = TestState
     , tsNodePacketLoss :: Map NodeName Scientific
     }
 
-data Options = Options
+data TestOptions = TestOptions
     { optDefaultTool :: String
     , optProcTools :: [(ProcName, String)]
     , optTestDir :: FilePath
-    , optVerbose :: Bool
     , optTimeout :: Scientific
     , optGDB :: Bool
     , optForce :: Bool
     }
 
-defaultOptions :: Options
-defaultOptions = Options
+defaultTestOptions :: TestOptions
+defaultTestOptions = TestOptions
     { optDefaultTool = ""
     , optProcTools = []
     , optTestDir = ".test"
-    , optVerbose = False
     , optTimeout = 1
     , optGDB = False
     , optForce = False
-- 
cgit v1.2.3