Commit 1a68b0f5 authored by Valentin Reis's avatar Valentin Reis
Browse files

refactor argotk main file.

parent be62e49a
Pipeline #5474 passed with stage
in 3 minutes and 2 seconds
...@@ -24,33 +24,10 @@ import Data.Text as T ...@@ -24,33 +24,10 @@ import Data.Text as T
) )
import System.IO import System.IO
opts :: StackArgs -> Parser (Shell ())
opts sa = hsubparser
( command "clean"
(info (pure $ clean sa) (progDesc "Clean sockets, logfiles."))
<> mconcat (fmap commandTest [(minBound :: TestType) ..])
<> commandTests [TestHello, TestListen, TestPerfwrapper, TestSTREAM]
"tests"
"Run hardware-independent CI tests"
<> help
("Type of test/stack setup to run. There are extensive options under each action, "
<> "but be careful, these do not all have the same defaults. The default "
<> "values are printed when you call --help on these actions."
)
)
where
action ttype = doOverridenTest ttype
<$> parseExtendStackArgs ((stackArgsUpdate $ configureTest ttype) sa)
descTest ttype = description (configureTest ttype)
commandTest ttype = command (show ttype)
$ info (action ttype) (progDesc $ T.unpack $ descTest ttype)
commandTests ttypes cmdStr descStr = command cmdStr
$ info (pure $ mapM_ (doTest sa) ttypes) (progDesc $ T.unpack descStr)
-- test library -- test library
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
data TestType = data TestName =
DaemonOnly DaemonOnly
| DaemonAndApp | DaemonAndApp
| CsvLogs | CsvLogs
...@@ -65,7 +42,6 @@ data TestType = ...@@ -65,7 +42,6 @@ data TestType =
| RunSTREAM | RunSTREAM
| RunLAMMPS deriving (Enum,Bounded,Show) | RunLAMMPS deriving (Enum,Bounded,Show)
-- test specification datatype -- test specification datatype
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
...@@ -80,10 +56,40 @@ instance Default TestSpec where ...@@ -80,10 +56,40 @@ instance Default TestSpec where
, description = "" , description = ""
} }
-- the interesting part, test configurations
-- helpers for building test specifications
--------------------------------------------------------------------------------
mkRun :: (StackArgs -> StackArgs) -> Text -> TestSpec
mkRun stackArgsUpdate description = TestSpec
{ stackArgsUpdate = stackArgsUpdate . runAppSA
, ..
}
where
isTest = NotTest
runAppSA sa = sa { manifestName = "parallel.json"
, daemon = daemonBehavior
, cmdrun = runBehavior
, cmdlistenperformance = csvBehavior "performance"
, cmdlistenpower = csvBehavior "power"
, cmdlistenprogress = csvBehavior "progress"
}
csvBehavior identifier = JustRun (StdOutLog $identifier <> ".csv")
(StdErrLog $ identifier <> "progress.log")
daemonBehavior :: ProcessBehavior
daemonBehavior =
JustRun (StdOutLog "daemon_out.log") (StdErrLog "daemon_err.log")
runBehavior :: ProcessBehavior
runBehavior =
JustRun (StdOutLog "cmd_run_out.log") (StdErrLog "cmd_run_err.log")
-- the interesting part, mapping test name to test specification
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
configureTest :: TestType -> TestSpec configureTest :: TestName -> TestSpec
configureTest TestHello = TestSpec configureTest TestHello = TestSpec
{ description = " Setup stack and check that a hello world app sends" { description = " Setup stack and check that a hello world app sends"
<> "message back to cmd's stdout." <> "message back to cmd's stdout."
...@@ -103,6 +109,7 @@ configureTest TestHello = TestSpec ...@@ -103,6 +109,7 @@ configureTest TestHello = TestSpec
(StdOutLog "monitored-cmdrun-out.log") (StdOutLog "monitored-cmdrun-out.log")
(StdErrLog "monitored-cmdrun-err.log") (StdErrLog "monitored-cmdrun-err.log")
} }
configureTest TestListen = TestSpec configureTest TestListen = TestSpec
{ description = " Setup stack, run command and check that cmd listen receives" { description = " Setup stack, run command and check that cmd listen receives"
<> "at least the container_exit message from the daemon." <> "at least the container_exit message from the daemon."
...@@ -122,6 +129,7 @@ configureTest TestListen = TestSpec ...@@ -122,6 +129,7 @@ configureTest TestListen = TestSpec
(StdOutLog "cmd_listen_stdout.log") (StdOutLog "cmd_listen_stdout.log")
(StdErrLog "cmd_listen_stderr.log") (StdErrLog "cmd_listen_stderr.log")
} }
configureTest TestPerfwrapper = TestSpec configureTest TestPerfwrapper = TestSpec
{ description = " Setup stack and check that argo-perf-wrapper sends" { description = " Setup stack and check that argo-perf-wrapper sends"
<> "at least one *performance* message to cmd listen through the" <> "at least one *performance* message to cmd listen through the"
...@@ -143,6 +151,7 @@ configureTest TestPerfwrapper = TestSpec ...@@ -143,6 +151,7 @@ configureTest TestPerfwrapper = TestSpec
(StdOutLog "cmd_listen_performance_stdout.csv") (StdOutLog "cmd_listen_performance_stdout.csv")
(StdErrLog "cmd_listen_performance_stderr.log") (StdErrLog "cmd_listen_performance_stderr.log")
} }
configureTest TestPower = TestSpec configureTest TestPower = TestSpec
{ description = " Setup stack and check that the daemon sends" { description = " Setup stack and check that the daemon sends"
<> "at least one *power* message to cmd listen." <> "at least one *power* message to cmd listen."
...@@ -162,6 +171,7 @@ configureTest TestPower = TestSpec ...@@ -162,6 +171,7 @@ configureTest TestPower = TestSpec
(StdOutLog "power_stdout.csv") (StdOutLog "power_stdout.csv")
(StdErrLog "power_stderr.log") (StdErrLog "power_stderr.log")
} }
configureTest TestSTREAM = TestSpec configureTest TestSTREAM = TestSpec
{ description = " Setup stack, run STREAM and check that it sends" { description = " Setup stack, run STREAM and check that it sends"
<> "at least one progress message to the daemon." <> "at least one progress message to the daemon."
...@@ -182,20 +192,24 @@ configureTest TestSTREAM = TestSpec ...@@ -182,20 +192,24 @@ configureTest TestSTREAM = TestSpec
(StdOutLog "progress_stdout.csv") (StdOutLog "progress_stdout.csv")
(StdErrLog "progress_stderr.log") (StdErrLog "progress_stderr.log")
} }
configureTest DaemonOnly = TestSpec configureTest DaemonOnly = TestSpec
{ description = "Set up and launch the daemon in synchronous mode." { description = "Set up and launch the daemon in synchronous mode."
, stackArgsUpdate = updater , stackArgsUpdate = updater
, isTest = NotTest , isTest = NotTest
} }
where updater sa = sa { daemon = daemonBehavior } where updater sa = sa { daemon = daemonBehavior }
configureTest DaemonAndApp = TestSpec configureTest DaemonAndApp = TestSpec
{ description = "Set up and start daemon, run a command in a container." { description = "Set up and start daemon, run a command in a container."
, stackArgsUpdate = updater , stackArgsUpdate = updater
, isTest = NotTest , isTest = NotTest
} }
where updater sa = sa { daemon = daemonBehavior, cmdrun = runBehavior } where updater sa = sa { daemon = daemonBehavior, cmdrun = runBehavior }
configureTest CsvLogs = configureTest CsvLogs =
mkRun id "get all logs from a command running in the stack" mkRun id "get all logs from a command running in the stack"
configureTest RunOpenMC = mkRun updater "run OpenMC in the Argo stack." configureTest RunOpenMC = mkRun updater "run OpenMC in the Argo stack."
where where
updater sa = sa updater sa = sa
...@@ -204,6 +218,7 @@ configureTest RunOpenMC = mkRun updater "run OpenMC in the Argo stack." ...@@ -204,6 +218,7 @@ configureTest RunOpenMC = mkRun updater "run OpenMC in the Argo stack."
, args = let tc = coerce (hwThreadCount sa) :: Int , args = let tc = coerce (hwThreadCount sa) :: Int
in fmap AppArg ["-n", repr tc, "openmc"] in fmap AppArg ["-n", repr tc, "openmc"]
} }
configureTest RunQMCPack = mkRun updater "run QMCPack in the Argo stack." configureTest RunQMCPack = mkRun updater "run QMCPack in the Argo stack."
where where
updater sa = sa updater sa = sa
...@@ -213,6 +228,7 @@ configureTest RunQMCPack = mkRun updater "run QMCPack in the Argo stack." ...@@ -213,6 +228,7 @@ configureTest RunQMCPack = mkRun updater "run QMCPack in the Argo stack."
Right inpath = toText (dirn </> "simple-H2O.xml") Right inpath = toText (dirn </> "simple-H2O.xml")
in fmap AppArg ["-n", repr tc, "qmcpack", inpath] in fmap AppArg ["-n", repr tc, "qmcpack", inpath]
} }
configureTest RunAMG = mkRun updater "run AMG in the Argo stack." configureTest RunAMG = mkRun updater "run AMG in the Argo stack."
where where
updater sa = sa updater sa = sa
...@@ -235,6 +251,7 @@ configureTest RunAMG = mkRun updater "run AMG in the Argo stack." ...@@ -235,6 +251,7 @@ configureTest RunAMG = mkRun updater "run AMG in the Argo stack."
, "1" , "1"
] ]
} }
configureTest RunSTREAM = mkRun updater "run STREAM in the Argo stack." configureTest RunSTREAM = mkRun updater "run STREAM in the Argo stack."
where updater sa = sa { app = AppName "stream_c" } where updater sa = sa { app = AppName "stream_c" }
...@@ -255,47 +272,42 @@ configureTest RunLAMMPS = mkRun updater "run LAMMPS in the argo stack." ...@@ -255,47 +272,42 @@ configureTest RunLAMMPS = mkRun updater "run LAMMPS in the argo stack."
} }
-- helpers for test configurations -- parsing and building the shell monad
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
mkRun :: (StackArgs -> StackArgs) -> Text -> TestSpec opts :: StackArgs -> Parser (Shell ())
mkRun stackArgsUpdate description = TestSpec opts sa = hsubparser
{ stackArgsUpdate = stackArgsUpdate . runAppSA ( command "clean"
, .. (info (pure $ clean sa) (progDesc "Clean sockets, logfiles."))
} <> mconcat (fmap commandTest [(minBound :: TestName) ..])
<> commandTests [TestHello, TestListen, TestPerfwrapper, TestSTREAM]
"tests"
"Run hardware-independent CI tests"
<> help
("Type of test/stack setup to run. There are extensive options under each action, "
<> "but be careful, these do not all have the same defaults. The default "
<> "values are printed when you call --help on these actions."
)
)
where where
isTest = NotTest action ttype = doOverridenTest ttype
runAppSA sa = sa { manifestName = "parallel.json" <$> parseExtendStackArgs ((stackArgsUpdate $ configureTest ttype) sa)
, daemon = daemonBehavior descTest ttype = description (configureTest ttype)
, cmdrun = runBehavior commandTest ttype = command (show ttype)
, cmdlistenperformance = csvBehavior "performance" $ info (action ttype) (progDesc $ T.unpack $ descTest ttype)
, cmdlistenpower = csvBehavior "power" commandTests ttypes cmdStr descStr = command cmdStr
, cmdlistenprogress = csvBehavior "progress" $ info (pure $ mapM_ (doTest sa) ttypes) (progDesc $ T.unpack descStr)
}
csvBehavior identifier = JustRun (StdOutLog $identifier <> ".csv")
(StdErrLog $ identifier <> "progress.log")
daemonBehavior :: ProcessBehavior
daemonBehavior =
JustRun (StdOutLog "daemon_out.log") (StdErrLog "daemon_err.log")
runBehavior :: ProcessBehavior
runBehavior =
JustRun (StdOutLog "cmd_run_out.log") (StdErrLog "cmd_run_err.log")
-- helpers for this file doTest :: StackArgs -> TestName -> Shell ()
-------------------------------------------------------------------------------- doTest stackArgs ttype = doSpec spec
doTest :: StackArgs -> TestType -> Shell ()
doTest stackArgs ttype = doSpec spec
$ (stackArgsUpdate $ configureTest ttype) stackArgs $ (stackArgsUpdate $ configureTest ttype) stackArgs
where spec = configureTest ttype where spec = configureTest ttype
doOverridenTest :: TestType -> StackArgs -> Shell () doOverridenTest :: TestName -> StackArgs -> Shell ()
doOverridenTest ttype = doSpec spec where spec = configureTest ttype doOverridenTest ttype = doSpec spec where spec = configureTest ttype
doSpec :: TestSpec -> StackArgs -> Shell () doSpec :: TestSpec -> StackArgs -> Shell ()
doSpec spec stackArgs = do doSpec spec stackArgs = do
printTest $ description spec printTest $ description spec
fullStack (isTest spec) stackArgs fullStack (isTest spec) stackArgs
printSuccess "Test Successful.\n" printSuccess "Test Successful.\n"
...@@ -345,7 +357,8 @@ fullStack isTest a@StackArgs {..} = do ...@@ -345,7 +357,8 @@ fullStack isTest a@StackArgs {..} = do
clean :: StackArgs -> Shell () clean :: StackArgs -> Shell ()
clean StackArgs {..} = cleanLeftovers workingDirectory clean StackArgs {..} = cleanLeftovers workingDirectory
-- the entry point with dirty setup IO and env. var fuckery -- the entry point with dirty setup IO and env. var fuckery, and finally
-- executing the shell monad.
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
main :: IO () main :: IO ()
main = do main = do
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment