#! /usr/bin/env runhaskell {-# LANGUAGE OverloadedStrings, RecordWildCards, LambdaCase #-} import Argo.Stack import Argo.Utils import Argo.Args import Turtle import Prelude hiding ( FilePath ) import Data.Default import System.Environment import Options.Applicative hiding ( action ) import Data.Text as T ( pack ) 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] "tests" "Run hardware-independent CI tests" <> help "Type of test 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 = "test" ++ description (configureTest ttype) commandTest ttype = command (show ttype) $ info (action ttype) (progDesc $ descTest ttype) commandTests ttypes cmdStr descStr = command cmdStr $ info (pure $ mapM_ (doTest sa) ttypes) (progDesc descStr) data TestType = DaemonOnly | DaemonAndApp | CsvLogs | TestHello | TestListen | TestPerfwrapper | TestPower | TestAMG | TestSTREAM | RunAMG | RunSTREAM deriving (Enum,Bounded,Show) data TestSpec = TestSpec { stackArgsUpdate :: StackArgs -> StackArgs , isTest :: IsTest , description :: String } doTest :: StackArgs -> TestType -> Shell () 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 $ T.pack $ description spec fullStack (isTest spec) stackArgs printSuccess "Test Successful." configureTest :: TestType -> TestSpec configureTest = \case DaemonOnly -> TestSpec { stackArgsUpdate = \sa -> sa { daemon = daemonBehavior } , description = "Set up and launch the daemon in synchronous mode." , isTest = IsTest False } DaemonAndApp -> TestSpec { stackArgsUpdate = \sa -> sa { daemon = daemonBehavior, cmdrun = runBehavior } , description = "Set up and start daemon, run a command in a container." , isTest = IsTest False } CsvLogs -> TestSpec { stackArgsUpdate = \sa -> sa { manifestName = "perfwrap.json" , daemon = daemonBehavior , cmdrun = runBehavior , cmdlistenperformance = JustRun (StdOutLog "performance.csv") (StdErrLog "performance.log") , cmdlistenpower = JustRun (StdOutLog "power.csv") (StdErrLog "power.log") , cmdlistenprogress = JustRun (StdOutLog "progress.csv") (StdErrLog "progress.log") } , description = "Set up and start daemon, run a command in a container." , isTest = IsTest False } TestHello -> TestSpec { stackArgsUpdate = \sa -> sa { app = AppName "echo" , args = [AppArg msg] , daemon = daemonBehavior , cmdrun = SucceedTestOnMessage (TestText msg) (StdOutLog "monitored-cmdrun-out.log") (StdErrLog "monitored-cmdrun-err.log") } , description = "1: Setup stack and check that a hello world app sends \ \message back to cmd." , isTest = IsTest True } TestListen -> TestSpec { stackArgsUpdate = \sa -> sa { app = AppName "sleep" , args = [AppArg "15"] , daemon = daemonBehavior , cmdrun = runBehavior , cmdlisten = listentestBehavior (TestText ",") } , description = "2: Setup stack and check that argo-perf-wrapper sends\ \ at least one message to the daemon." , isTest = IsTest True } TestPerfwrapper -> TestSpec { stackArgsUpdate = \sa -> sa { manifestName = "perfwrap.json" , app = AppName "sleep" , args = [AppArg "15"] , daemon = daemonBehavior , cmdrun = runBehavior , cmdlisten = listentestBehavior (TestText "performance") } , description = "3: Setup stack and check that argo-perf-wrapper sends\ \ at least one *performance* message to cmd listen through the\ \ daemon." , isTest = IsTest True } TestPower -> TestSpec { stackArgsUpdate = \sa -> sa { app = AppName "sleep" , args = [AppArg "15"] , daemon = daemonBehavior , cmdrun = runBehavior , cmdlisten = listentestBehavior (TestText "power") } , description = "4: Setup stack and check that argo-perf-wrapper sends\ \ at least one *power* message to cmd listen through the\ \ daemon." , isTest = IsTest True } TestAMG -> TestSpec { stackArgsUpdate = \sa -> sa { manifestName = "parallel.json" , app = AppName "mpiexec" , args = [ AppArg "-n" , AppArg "24" , AppArg "amg" , AppArg "-problem" , AppArg "2" , AppArg "-n" , AppArg "1" , AppArg "1" , AppArg "1" , AppArg "-P" , AppArg "8" , AppArg "3" , AppArg "1" ] , daemon = daemonBehavior , cmdrun = runBehavior , cmdlistenprogress = listenprogresstestBehavior (TestText ",") } , description = "5: Setup stack, run STREAM and check that it sends\ \ at least one progress message to the daemon." , isTest = IsTest True } TestSTREAM -> TestSpec { stackArgsUpdate = \sa -> sa { app = AppName "stream_c_20" , args = [] , daemon = daemonBehavior , cmdrun = runBehavior , cmdlistenprogress = listenprogresstestBehavior (TestText ",") } , description = "6: Setup stack, run AMG and check that it sends\ \ at least one progress message to the daemon." , isTest = IsTest True } RunAMG -> runAppSpec (AppName "mpiexec") [ AppArg "-n" , AppArg "24" , AppArg "amg" , AppArg "-problem" , AppArg "2" , AppArg "-n" , AppArg "10" , AppArg "10" , AppArg "10" , AppArg "-P" , AppArg "8" , AppArg "3" , AppArg "1" ] RunSTREAM -> runAppSpec (AppName "stream_c_20000") [] where runAppSpec appName appArgs = TestSpec { stackArgsUpdate = \sa -> sa { app = appName , args = appArgs , manifestName = "parallel.json" , daemon = daemonBehavior , cmdrun = runBehavior , cmdlistenperformance = JustRun (StdOutLog "performance.csv") (StdErrLog "performance.log") , cmdlistenpower = JustRun (StdOutLog "power.csv") (StdErrLog "power.log") , cmdlistenprogress = JustRun (StdOutLog "progress.csv") (StdErrLog "progress.log") } , description = "Set up and start daemon, run app in a container." , isTest = IsTest False } msg = "someComplicatedMessage" daemonBehavior = JustRun (StdOutLog "daemon_out.log") (StdErrLog "daemon_err.log") runBehavior = JustRun (StdOutLog "cmd_run_out.log") (StdErrLog "cmd_run_err.log") listentestBehavior t = SucceedTestOnMessage t (StdOutLog "cmd_listen_out.log") (StdErrLog "cmd_listen_err.log") listenprogresstestBehavior t = SucceedTestOnMessage t (StdOutLog "cmd_listen_progress_out.log") (StdErrLog "cmd_listen_progress_err.log") newtype IsTest = IsTest Bool fullStack :: IsTest -> StackArgs -> Shell () fullStack (IsTest b) a@StackArgs {..} = runStack a >>= \case FoundMessage -> printSuccess "Found message!\n" Died stacki errorcode -> if b then printError ( repr stacki <> " died before a message could be found:" <> repr errorcode <> "\n" ) >> exit (ExitFailure 1) else exit ExitSuccess clean :: StackArgs -> Shell () clean StackArgs {..} = cleanLeftovers workingDirectory main :: IO () main = do manifests <- getEnv "MANIFESTS" let a = def { manifestDir = ManifestDir $ decodeString manifests } turtle <- execParser (info (opts a <**> helper) idm) sh turtle