Commit be62e49a authored by Valentin Reis's avatar Valentin Reis
Browse files

style refactor

parent 5c40f695
Pipeline #5473 passed with stage
in 28 seconds
...@@ -6,7 +6,8 @@ Module : argotk.hs ...@@ -6,7 +6,8 @@ Module : argotk.hs
Description : argo provisioner/executor Description : argo provisioner/executor
Copyright : (c) Valentin Reis, 2018 Copyright : (c) Valentin Reis, 2018
License : MIT License : MIT
Maintainer : fre@freux.fr -} Maintainer : fre@freux.fr
-}
import Data.Coerce ( coerce ) import Data.Coerce ( coerce )
import Argo.Stack import Argo.Stack
...@@ -32,7 +33,7 @@ opts sa = hsubparser ...@@ -32,7 +33,7 @@ opts sa = hsubparser
"tests" "tests"
"Run hardware-independent CI tests" "Run hardware-independent CI tests"
<> help <> help
("Type of test to run. There are extensive options under each action, " ("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 " <> "but be careful, these do not all have the same defaults. The default "
<> "values are printed when you call --help on these actions." <> "values are printed when you call --help on these actions."
) )
...@@ -46,6 +47,9 @@ opts sa = hsubparser ...@@ -46,6 +47,9 @@ opts sa = hsubparser
commandTests ttypes cmdStr descStr = command cmdStr commandTests ttypes cmdStr descStr = command cmdStr
$ info (pure $ mapM_ (doTest sa) ttypes) (progDesc $ T.unpack descStr) $ info (pure $ mapM_ (doTest sa) ttypes) (progDesc $ T.unpack descStr)
-- test library
--------------------------------------------------------------------------------
data TestType = data TestType =
DaemonOnly DaemonOnly
| DaemonAndApp | DaemonAndApp
...@@ -61,36 +65,29 @@ data TestType = ...@@ -61,36 +65,29 @@ data TestType =
| RunSTREAM | RunSTREAM
| RunLAMMPS deriving (Enum,Bounded,Show) | RunLAMMPS deriving (Enum,Bounded,Show)
-- test specification datatype
--------------------------------------------------------------------------------
data TestSpec = TestSpec data TestSpec = TestSpec
{ stackArgsUpdate :: StackArgs -> StackArgs { stackArgsUpdate :: StackArgs -> StackArgs
, isTest :: IsTest , isTest :: IsTest
, description :: Text } , description :: Text }
data IsTest = IsTest | NotTest
instance Default TestSpec where instance Default TestSpec where
def = TestSpec { stackArgsUpdate = id def = TestSpec { stackArgsUpdate = id
, isTest = NotTest , isTest = NotTest
, description = "" , description = ""
} }
doTest :: StackArgs -> TestType -> Shell () -- the interesting part, test configurations
doTest stackArgs ttype = doSpec spec --------------------------------------------------------------------------------
$ (stackArgsUpdate $ configureTest ttype) stackArgs
where spec = configureTest ttype
doOverridenTest :: TestType -> StackArgs -> Shell ()
doOverridenTest ttype = doSpec spec where spec = configureTest ttype
doSpec :: TestSpec -> StackArgs -> Shell ()
doSpec spec stackArgs = do
printTest $ description spec
fullStack (isTest spec) stackArgs
printSuccess "Test Successful.\n"
configureTest :: TestType -> TestSpec configureTest :: TestType -> TestSpec
configureTest TestHello = TestSpec configureTest TestHello = TestSpec
{ stackArgsUpdate = updater { 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."
, stackArgsUpdate = updater
, isTest = IsTest , isTest = IsTest
} }
where where
...@@ -107,9 +104,9 @@ configureTest TestHello = TestSpec ...@@ -107,9 +104,9 @@ configureTest TestHello = TestSpec
(StdErrLog "monitored-cmdrun-err.log") (StdErrLog "monitored-cmdrun-err.log")
} }
configureTest TestListen = TestSpec configureTest TestListen = TestSpec
{ stackArgsUpdate = updater { 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."
, stackArgsUpdate = updater
, isTest = IsTest , isTest = IsTest
} }
where where
...@@ -118,15 +115,17 @@ configureTest TestListen = TestSpec ...@@ -118,15 +115,17 @@ configureTest TestListen = TestSpec
, args = [AppArg "1"] , args = [AppArg "1"]
, daemon = daemonBehavior , daemon = daemonBehavior
, cmdrun = runBehavior , cmdrun = runBehavior
, cmdlisten = listentestBehavior , cmdlisten = Test
(TestText (TextBehaviorStdout (WaitFor "container_exit")) (TestText (TextBehaviorStdout (WaitFor "container_exit"))
(TextBehaviorStderr ExpectClean) (TextBehaviorStderr ExpectClean)
) )
(StdOutLog "cmd_listen_stdout.log")
(StdErrLog "cmd_listen_stderr.log")
} }
configureTest TestPerfwrapper = TestSpec configureTest TestPerfwrapper = TestSpec
{ stackArgsUpdate = updater { 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"
, stackArgsUpdate = updater
, isTest = IsTest , isTest = IsTest
} }
where where
...@@ -136,16 +135,18 @@ configureTest TestPerfwrapper = TestSpec ...@@ -136,16 +135,18 @@ configureTest TestPerfwrapper = TestSpec
, args = [AppArg "15"] , args = [AppArg "15"]
, daemon = daemonBehavior , daemon = daemonBehavior
, cmdrun = runBehavior , cmdrun = runBehavior
, cmdlistenperformance = listenperformancetestBehavior , cmdlistenperformance = Test
(TestText (TestText
(TextBehaviorStdout (WaitFor "performance")) (TextBehaviorStdout (WaitFor "performance"))
(TextBehaviorStderr ExpectClean) (TextBehaviorStderr ExpectClean)
) )
(StdOutLog "cmd_listen_performance_stdout.csv")
(StdErrLog "cmd_listen_performance_stderr.log")
} }
configureTest TestPower = TestSpec configureTest TestPower = TestSpec
{ stackArgsUpdate = updater { 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."
, stackArgsUpdate = updater
, isTest = IsTest , isTest = IsTest
} }
where where
...@@ -154,15 +155,17 @@ configureTest TestPower = TestSpec ...@@ -154,15 +155,17 @@ configureTest TestPower = TestSpec
, args = [AppArg "15"] , args = [AppArg "15"]
, daemon = daemonBehavior , daemon = daemonBehavior
, cmdrun = runBehavior , cmdrun = runBehavior
, cmdlistenpower = listenpowertestBehavior , cmdlistenpower = Test
(TestText (TextBehaviorStdout (WaitFor "power")) (TestText (TextBehaviorStdout (WaitFor "power"))
(TextBehaviorStderr ExpectClean) (TextBehaviorStderr ExpectClean)
) )
(StdOutLog "power_stdout.csv")
(StdErrLog "power_stderr.log")
} }
configureTest TestSTREAM = TestSpec configureTest TestSTREAM = TestSpec
{ stackArgsUpdate = updater { 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."
, stackArgsUpdate = updater
, isTest = IsTest , isTest = IsTest
} }
where where
...@@ -171,21 +174,23 @@ configureTest TestSTREAM = TestSpec ...@@ -171,21 +174,23 @@ configureTest TestSTREAM = TestSpec
, args = [] , args = []
, daemon = daemonBehavior , daemon = daemonBehavior
, cmdrun = runBehavior , cmdrun = runBehavior
, cmdlistenprogress = listenprogresstestBehavior , cmdlistenprogress = Test
(TestText (TestText
(TextBehaviorStdout (WaitFor "progress")) (TextBehaviorStdout (WaitFor "progress"))
(TextBehaviorStderr ExpectClean) (TextBehaviorStderr ExpectClean)
) )
(StdOutLog "progress_stdout.csv")
(StdErrLog "progress_stderr.log")
} }
configureTest DaemonOnly = TestSpec configureTest DaemonOnly = TestSpec
{ stackArgsUpdate = updater { description = "Set up and launch the daemon in synchronous mode."
, description = "Set up and launch the daemon in synchronous mode." , stackArgsUpdate = updater
, isTest = NotTest , isTest = NotTest
} }
where updater sa = sa { daemon = daemonBehavior } where updater sa = sa { daemon = daemonBehavior }
configureTest DaemonAndApp = TestSpec configureTest DaemonAndApp = TestSpec
{ stackArgsUpdate = updater { 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
, isTest = NotTest , isTest = NotTest
} }
where updater sa = sa { daemon = daemonBehavior, cmdrun = runBehavior } where updater sa = sa { daemon = daemonBehavior, cmdrun = runBehavior }
...@@ -249,6 +254,10 @@ configureTest RunLAMMPS = mkRun updater "run LAMMPS in the argo stack." ...@@ -249,6 +254,10 @@ configureTest RunLAMMPS = mkRun updater "run LAMMPS in the argo stack."
] ]
} }
-- helpers for test configurations
--------------------------------------------------------------------------------
mkRun :: (StackArgs -> StackArgs) -> Text -> TestSpec mkRun :: (StackArgs -> StackArgs) -> Text -> TestSpec
mkRun stackArgsUpdate description = TestSpec mkRun stackArgsUpdate description = TestSpec
{ stackArgsUpdate = stackArgsUpdate . runAppSA { stackArgsUpdate = stackArgsUpdate . runAppSA
...@@ -263,10 +272,8 @@ mkRun stackArgsUpdate description = TestSpec ...@@ -263,10 +272,8 @@ mkRun stackArgsUpdate description = TestSpec
, cmdlistenpower = csvBehavior "power" , cmdlistenpower = csvBehavior "power"
, cmdlistenprogress = csvBehavior "progress" , cmdlistenprogress = csvBehavior "progress"
} }
csvBehavior identifier = JustRun (StdOutLog $identifier <> ".csv")
csvBehavior :: Text -> ProcessBehavior (StdErrLog $ identifier <> "progress.log")
csvBehavior identifier = JustRun (StdOutLog $identifier <> ".csv")
(StdErrLog $ identifier <> "progress.log")
daemonBehavior :: ProcessBehavior daemonBehavior :: ProcessBehavior
daemonBehavior = daemonBehavior =
...@@ -276,25 +283,25 @@ runBehavior :: ProcessBehavior ...@@ -276,25 +283,25 @@ runBehavior :: ProcessBehavior
runBehavior = runBehavior =
JustRun (StdOutLog "cmd_run_out.log") (StdErrLog "cmd_run_err.log") JustRun (StdOutLog "cmd_run_out.log") (StdErrLog "cmd_run_err.log")
listentestBehavior :: TestText -> ProcessBehavior
listentestBehavior t =
Test t (StdOutLog "cmd_listen_stdout.log") (StdErrLog "cmd_listen_stderr.log")
listenprogresstestBehavior :: TestText -> ProcessBehavior
listenprogresstestBehavior t =
Test t (StdOutLog "progress_stdout.csv") (StdErrLog "progress_stderr.log")
listenperformancetestBehavior :: TestText -> ProcessBehavior -- helpers for this file
listenperformancetestBehavior t = Test t --------------------------------------------------------------------------------
(StdOutLog "performance_stdout.csv") doTest :: StackArgs -> TestType -> Shell ()
(StdErrLog "performance_stderr.log") doTest stackArgs ttype = doSpec spec
$ (stackArgsUpdate $ configureTest ttype) stackArgs
where spec = configureTest ttype
listenpowertestBehavior :: TestText -> ProcessBehavior doOverridenTest :: TestType -> StackArgs -> Shell ()
doOverridenTest ttype = doSpec spec where spec = configureTest ttype
listenpowertestBehavior t = doSpec :: TestSpec -> StackArgs -> Shell ()
Test t (StdOutLog "power_stdout.csv") (StdErrLog "power_stderr.log") doSpec spec stackArgs = do
printTest $ description spec
fullStack (isTest spec) stackArgs
printSuccess "Test Successful.\n"
data IsTest = IsTest | NotTest -- executors
--------------------------------------------------------------------------------
fullStack :: IsTest -> StackArgs -> Shell () fullStack :: IsTest -> StackArgs -> Shell ()
fullStack isTest a@StackArgs {..} = do fullStack isTest a@StackArgs {..} = do
...@@ -338,6 +345,8 @@ fullStack isTest a@StackArgs {..} = do ...@@ -338,6 +345,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
--------------------------------------------------------------------------------
main :: IO () main :: IO ()
main = do main = do
hSetBuffering System.IO.stdout NoBuffering hSetBuffering System.IO.stdout NoBuffering
......
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