Commit dc3d0f7f authored by Valentin Reis's avatar Valentin Reis

[refactor] split out types, apply warnings. adds --powercap option.

parent 83ada183
Pipeline #5817 failed with stage
in 2 minutes and 10 seconds
......@@ -10,9 +10,11 @@ module Argo
( module Argo.Stack
, module Argo.Args
, module Argo.Utils
, module Argo.Types
)
where
import Argo.Stack
import Argo.Utils
import Argo.Args
import Argo.Types
{-# language OverloadedStrings #-}
{-# language ApplicativeDo #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language RecordWildCards #-}
module Argo.Args
( StdOutLog(..)
, StdErrLog(..)
, TestText(..)
, ProcessBehavior(..)
, TextBehavior(..)
, TextBehaviorStdout(..)
, TextBehaviorStderr(..)
, WorkingDirectory(..)
, Verbosity(..)
, AppName(..)
, AppArg(..)
, ContainerName(..)
, ShareDir(..)
, ManifestName(..)
, StackArgs(..)
, PreludeCommand(..)
, HwThreadCount(..)
, parseExtendStackArgs
( parseExtendStackArgs
)
where
import Argo.Types
import Options.Applicative as OA
import Options.Applicative.Types
import Options.Applicative.Builder ( option )
import Data.Default
import Data.Text as T
hiding ( empty )
import Turtle hiding ( option )
import Prelude hiding ( FilePath )
{-|
Module : Argo.Args
Description : Argo stack library
......@@ -43,72 +21,11 @@ License : MIT
Maintainer : fre@freux.fr
-}
data StackArgs = StackArgs
{ verbosity :: Verbosity
, app :: AppName
, args :: [AppArg]
, containerName :: ContainerName
, workingDirectory :: WorkingDirectory
, shareDir :: ShareDir
, manifestName :: ManifestName
, preludeCommand :: PreludeCommand
, daemon
, cmdrun
, cmdlisten
, cmdlistenprogress
, cmdlistenperformance
, cmdlistenpower :: ProcessBehavior
, hwThreadCount :: HwThreadCount
} deriving (Show)
{-data OutputFiles = OutputFiles FilePath FilePath-}
data Verbosity = Normal | Verbose deriving (Show, Read, Eq)
newtype HwThreadCount = HwThreadCount Int deriving (Show, Read, Eq)
newtype AppArg = AppArg Text deriving (IsString, Show, Read)
newtype WorkingDirectory = WorkingDirectory FilePath deriving (IsString, Show)
newtype AppName = AppName Text deriving (IsString, Show, Read)
newtype ContainerName = ContainerName Text deriving (IsString, Show, Read)
newtype ShareDir = ShareDir FilePath deriving (IsString, Show)
newtype ManifestName = ManifestName FilePath deriving (IsString, Show)
newtype PreludeCommand = PreludeCommand Text deriving (IsString, Show, Read)
data ProcessBehavior =
Test TestText StdOutLog StdErrLog
| JustRun StdOutLog StdErrLog
| DontRun deriving (Show,Read)
newtype StdOutLog = StdOutLog Text deriving (Show, Read)
newtype StdErrLog = StdErrLog Text deriving (Show, Read)
data TestText = TestText TextBehaviorStdout TextBehaviorStderr deriving (Show, Read)
newtype TextBehaviorStdout = TextBehaviorStdout TextBehavior deriving (Show, Read)
newtype TextBehaviorStderr = TextBehaviorStderr TextBehavior deriving (Show, Read)
data TextBehavior =
WaitFor Text
| ExpectClean deriving (Show,Read)
behavior :: ReadM ProcessBehavior
behavior = read <$> readerAsk
behaviorOption :: Mod OptionFields ProcessBehavior -> Parser ProcessBehavior
behaviorOption = option behavior
instance Default StackArgs where
def = StackArgs
{ verbosity = Normal
, app = AppName "ls"
, args = []
, containerName = ContainerName "testContainer"
, workingDirectory = WorkingDirectory "_output"
, shareDir = ShareDir "/tmp"
, manifestName = ManifestName "basic.json"
, preludeCommand = PreludeCommand ""
, daemon = DontRun
, cmdrun = DontRun
, cmdlisten = DontRun
, cmdlistenprogress = DontRun
, cmdlistenperformance = DontRun
, cmdlistenpower = DontRun
, hwThreadCount = HwThreadCount 1
}
parseExtendStackArgs :: StackArgs -> Parser StackArgs
parseExtendStackArgs sa = do
verbosity <- flag
......@@ -207,6 +124,14 @@ parseExtendStackArgs sa = do
<> showDefault
<> value (hwThreadCount sa)
)
powercap <- option
auto
( long "powercap"
<> metavar "POWERCAP"
<> help "Powercap strategy: Fixed x | None | Adaptive"
<> showDefault
<> value (powercap sa)
)
args <- some (argument str (metavar "ARGS" <> help "Application arguments."))
<|> pure (args sa)
pure StackArgs {..}
......@@ -18,7 +18,7 @@ module Argo.Stack
)
where
import Argo.Args
import Argo.Types
import Data.Coerce ( coerce )
import Turtle
......@@ -57,15 +57,16 @@ prepareDaemon
-> StdErrLog
-> Maybe TestText
-> Verbosity
-> PowerCap
-> Shell Instrumentation
prepareDaemon out stdErr test v = do
prepareDaemon out stdErr test v powercap = do
_ <- myWhich "daemon"
let confPath' = "/tmp/argo_nodeos_config"
cleanContainers confPath' 1 2
export "ARGO_NODEOS_CONFIG" (format fp confPath')
return $ Instrumentation
(P.proc "daemon"
(["--nrm_log", "./nrm_log"] ++ [ "--verbose" | v == Verbose ])
(["--nrm_log", "./nrm_log"] ++ toOption v ++ toOption powercap)
)
out
stdErr
......@@ -105,16 +106,16 @@ prepareDaemon out stdErr test v = do
if len > 0
then do
printWarning
"the argo_nodeos_config call did not remove containers, \
\at least not fast enough. Retrying.."
$ "the argo_nodeos_config call did not remove containers, "
<> "at least not fast enough. Retrying.."
liftIO $ sleep retryTime
cleanContainers argo_nodeos_config
(retryTime * 2)
(remainingRetries - 1)
else
printInfo
"argo_nodeos_config successfully cleaned the container \
\config."
$ "argo_nodeos_config successfully cleaned the container "
<> "config."
cmdRunI
:: AppName
......@@ -198,9 +199,11 @@ runStack sa@StackArgs {..} = do
iDaemon <- case daemon of
DontRun -> return Nothing
JustRun stdOut stdErr ->
(\i -> Just (Daemon, i)) <$> prepareDaemon stdOut stdErr Nothing verbosity
(\i -> Just (Daemon, i))
<$> prepareDaemon stdOut stdErr Nothing verbosity powercap
Test t stdOut stdErr ->
(\i -> Just (Daemon, i)) <$> prepareDaemon stdOut stdErr (Just t) Verbose
(\i -> Just (Daemon, i))
<$> prepareDaemon stdOut stdErr (Just t) Verbose powercap
let milist =
[ iDaemon
......
{-# language GeneralizedNewtypeDeriving #-}
{-# language OverloadedStrings #-}
module Argo.Types
( StdOutLog(..)
, StdErrLog(..)
, TestText(..)
, ProcessBehavior(..)
, TextBehavior(..)
, TextBehaviorStdout(..)
, TextBehaviorStderr(..)
, WorkingDirectory(..)
, Verbosity(..)
, AppName(..)
, AppArg(..)
, ContainerName(..)
, ShareDir(..)
, ManifestName(..)
, StackArgs(..)
, PreludeCommand(..)
, HwThreadCount(..)
, PowerCap(..)
, toOption
)
where
import Data.Default
import Data.Text as T
hiding ( empty )
import Turtle hiding ( option )
import Prelude hiding ( FilePath )
data StackArgs = StackArgs
{ verbosity :: Verbosity
, app :: AppName
, args :: [AppArg]
, containerName :: ContainerName
, workingDirectory :: WorkingDirectory
, shareDir :: ShareDir
, manifestName :: ManifestName
, preludeCommand :: PreludeCommand
, daemon
, cmdrun
, cmdlisten
, cmdlistenprogress
, cmdlistenperformance
, cmdlistenpower :: ProcessBehavior
, hwThreadCount :: HwThreadCount
, powercap :: PowerCap
} deriving (Show)
{-data OutputFiles = OutputFiles FilePath FilePath-}
data Verbosity = Normal | Verbose deriving (Show, Read, Eq)
newtype HwThreadCount = HwThreadCount Int deriving (Show, Read, Eq)
newtype AppArg = AppArg Text deriving (IsString, Show, Read)
newtype WorkingDirectory = WorkingDirectory FilePath deriving (IsString, Show)
newtype AppName = AppName Text deriving (IsString, Show, Read)
newtype ContainerName = ContainerName Text deriving (IsString, Show, Read)
newtype ShareDir = ShareDir FilePath deriving (IsString, Show)
newtype ManifestName = ManifestName FilePath deriving (IsString, Show)
newtype PreludeCommand = PreludeCommand Text deriving (IsString, Show, Read)
data ProcessBehavior =
Test TestText StdOutLog StdErrLog
| JustRun StdOutLog StdErrLog
| DontRun deriving (Show,Read)
newtype StdOutLog = StdOutLog Text deriving (Show, Read)
newtype StdErrLog = StdErrLog Text deriving (Show, Read)
data TestText = TestText TextBehaviorStdout TextBehaviorStderr deriving (Show, Read)
newtype TextBehaviorStdout = TextBehaviorStdout TextBehavior deriving (Show, Read)
newtype TextBehaviorStderr = TextBehaviorStderr TextBehavior deriving (Show, Read)
data TextBehavior =
WaitFor Text
| ExpectClean deriving (Show,Read)
data PowerCap = Fixed Int | Adaptive | None deriving (Show, Read)
class ToDaemonOption a where
toOption :: a -> [String]
instance ToDaemonOption Verbosity where
toOption Verbose = ["--verbose"]
toOption Normal = []
instance ToDaemonOption PowerCap where
toOption (Fixed i) = ["--powercap", show i]
toOption Adaptive = []
toOption None = []
instance Default StackArgs where
def = StackArgs
{ verbosity = Normal
, app = AppName "ls"
, args = []
, containerName = ContainerName "testContainer"
, workingDirectory = WorkingDirectory "_output"
, shareDir = ShareDir "/tmp"
, manifestName = ManifestName "basic.json"
, preludeCommand = PreludeCommand ""
, daemon = DontRun
, cmdrun = DontRun
, cmdlisten = DontRun
, cmdlistenprogress = DontRun
, cmdlistenperformance = DontRun
, cmdlistenpower = DontRun
, hwThreadCount = HwThreadCount 1
, powercap = None
}
......@@ -31,7 +31,7 @@ module Argo.Utils
)
where
import Argo.Args
import Argo.Types
import Turtle
import Prelude hiding ( FilePath )
import System.Console.ANSI
......
......@@ -12,6 +12,7 @@ Maintainer : fre@freux.fr
import Data.Coerce ( coerce )
import Argo.Stack
import Argo.Utils
import Argo.Types
import Argo.Args
import Turtle
import Prelude hiding ( FilePath )
......@@ -65,10 +66,7 @@ instance Default TestSpec where
--------------------------------------------------------------------------------
mkRun :: (StackArgs -> StackArgs) -> Text -> TestSpec
mkRun updater description = TestSpec
{ stackArgsUpdate = updater . runAppSA
, ..
}
mkRun updater description = TestSpec {stackArgsUpdate = updater . runAppSA, ..}
where
isTest = NotTest
runAppSA sa = sa { manifestName = "parallel.json"
......@@ -178,8 +176,7 @@ configureTest TestPower = TestSpec
configureTest TestSTREAM =
testProgressFromRun RunSTREAM "Test STREAM progress reports."
configureTest TestAMG =
testProgressFromRun RunAMG "Test AMG progress reports."
configureTest TestAMG = testProgressFromRun RunAMG "Test AMG progress reports."
configureTest TestQMCPack =
testProgressFromRun RunQMCPack "Test QMCPack progress reports."
configureTest TestOpenMC =
......@@ -282,18 +279,18 @@ testProgressFromRun :: TestName -> Text -> TestSpec
testProgressFromRun = testFromRun updater
where
updater sa = sa
{ cmdlistenprogress = Test
(TestText
(TextBehaviorStdout (WaitFor "progress"))
(TextBehaviorStderr ExpectClean)
)
(StdOutLog "progress_stdout.csv")
(StdErrLog "progress_stderr.log")
, cmdlistenpower = DontRun
, cmdlisten = DontRun
{ cmdlistenprogress = Test
(TestText
(TextBehaviorStdout (WaitFor "progress"))
(TextBehaviorStderr ExpectClean)
)
(StdOutLog "progress_stdout.csv")
(StdErrLog "progress_stderr.log")
, cmdlistenpower = DontRun
, cmdlisten = DontRun
, cmdlistenperformance = DontRun
, manifestName = "basic.json"
, hwThreadCount = HwThreadCount 2
, manifestName = "basic.json"
, hwThreadCount = HwThreadCount 2
}
-- parsing and building the shell monad
......
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