Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
argo
argotk
Commits
dc3d0f7f
Commit
dc3d0f7f
authored
Mar 04, 2019
by
Valentin Reis
Browse files
[refactor] split out types, apply warnings. adds --powercap option.
parent
83ada183
Pipeline
#5817
failed with stage
in 2 minutes and 10 seconds
Changes
6
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
src/Argo.hs
View file @
dc3d0f7f
...
...
@@ -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
src/Argo/Args.hs
View file @
dc3d0f7f
{-# 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
{
..
}
src/Argo/Stack.hs
View file @
dc3d0f7f
...
...
@@ -18,7 +18,7 @@ module Argo.Stack
)
where
import
Argo.
Arg
s
import
Argo.
Type
s
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
...
...
src/Argo/Types.hs
0 → 100644
View file @
dc3d0f7f
{-# 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
}
src/Argo/Utils.hs
View file @
dc3d0f7f
...
...
@@ -31,7 +31,7 @@ module Argo.Utils
)
where
import
Argo.
Arg
s
import
Argo.
Type
s
import
Turtle
import
Prelude
hiding
(
FilePath
)
import
System.Console.ANSI
...
...
src/argotk.hs
View file @
dc3d0f7f
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment