Skip to content

GitLab

Commit 88ee00a9 authored by Valentin Reis's avatar Valentin Reis
Browse files

Adds JSON+Dhall type conversions.

parent 9bc62d49
Pipeline #6209 failed with stages
in 1 minute and 34 seconds
Hide whitespace changes
Inline Side-by-side
Showing with 98 additions and 52 deletions
argotk.cabal
View file @ 88ee00a9
......@@ -19,6 +19,7 @@ executable argotk
build-depends:
base,
protolude,
dhall,
shake,
directory,
typed-process,
......@@ -37,6 +38,8 @@ executable argotk
bytestring,
system-filepath,
pretty-show,
yaml,
aeson,
neat-interpolation
hs-source-dirs: src
default-language: Haskell2010
......
share/manifests/parallel.json
View file @ 88ee00a9
......@@ -14,7 +14,7 @@
{
"name": "argo/container",
"value": {
"cpus": "48",
"cpus": "24",
"mems": "2"
}
},
......
src/Argo/Stack.hs
View file @ 88ee00a9
......@@ -185,7 +185,7 @@ runStack sa@StackArgs {..} = do
when (powercap /= None) $ do
user <- readProcessStdout_ (proc "whoami" [])
for_ ([0, 1] :: [Int]) $ \x ->
chownPowercapFiles (toS user)
chownPowercapFiles (T.filter (/= '\n') (toS user))
$ "/sys/devices/virtual/powercap/intel-rapl/intel-rapl:"
<> show x
......@@ -251,11 +251,13 @@ runStack sa@StackArgs {..} = do
(TracebackScanErr tracebackErr)
tracebackList
where
chownPowercap user fn =
runProcess (shell $ toS ("sudo chown " <> user <> ":" <> user <> " " <> fn))
chownPowercap user fn = do
putText shellLine
runProcess (shell $ toS shellLine)
>>= \case
ExitSuccess -> printWarning $ "changed ownership on " <> fn
ExitFailure _ -> die $ "Couldn't change ownership on " <> fn
where shellLine = "sudo chown " <> user <> ":" <> user <> " " <> fn
chownPowercapFiles :: Text -> Text -> IO ()
chownPowercapFiles user p =
......
src/Argo/Types.hs
View file @ 88ee00a9
{-# language GeneralizedNewtypeDeriving #-}
{-# language DeriveAnyClass #-}
{-# language DerivingStrategies #-}
{-# language DeriveGeneric #-}
{-# language OverloadedStrings #-}
{-# language NoImplicitPrelude #-}
......@@ -38,6 +41,8 @@ import Data.Default
import Data.Text as T
hiding ( empty )
import Protolude
import Data.Yaml
import Dhall
data StackArgs = StackArgs
{ verbosity :: Verbosity
......@@ -57,32 +62,72 @@ data StackArgs = StackArgs
, cmdlistenpower :: ProcessBehavior
, hwThreadCount :: HwThreadCount
, powercap :: PowerCap
} deriving (Show)
} deriving (Show, Generic, ToJSON, FromJSON, Interpret)
{-data OutputFiles = OutputFiles Text Text-}
data Verbosity = Normal | Verbose deriving (Show, Read, Eq)
newtype EnvVar = EnvVar Text deriving (Show, Read)
newtype HwThreadCount = HwThreadCount Int deriving (Show, Read, Eq)
newtype AppArg = AppArg Text deriving (IsString, Show, Read)
newtype WorkingDirectory = WorkingDirectory Text deriving (IsString, Show)
newtype AppName = AppName Text deriving (IsString, Show, Read)
newtype ContainerName = ContainerName Text deriving (IsString, Show, Read)
newtype ShareDir = ShareDir Text deriving (IsString, Show)
newtype ManifestName = ManifestName Text deriving (IsString, Show)
newtype PreludeCommand = PreludeCommand Text deriving (IsString, Show, Read)
data Verbosity = Normal | Verbose
deriving (Show, Read, Eq, Generic, FromJSON, ToJSON, Interpret)
newtype EnvVar = EnvVar Text
deriving stock (Show, Read, Generic)
deriving newtype (IsString)
deriving anyclass (FromJSON, ToJSON, Interpret)
newtype HwThreadCount = HwThreadCount Integer
deriving stock (Show, Read, Generic)
deriving anyclass (FromJSON, ToJSON, Interpret)
newtype AppArg = AppArg Text
deriving stock (Show, Read, Generic)
deriving newtype (IsString)
deriving anyclass (FromJSON, ToJSON, Interpret)
newtype WorkingDirectory = WorkingDirectory Text
deriving stock (Show, Read, Generic)
deriving newtype (IsString)
deriving anyclass (FromJSON, ToJSON, Interpret)
newtype AppName = AppName Text
deriving stock (Show, Read, Generic)
deriving newtype (IsString)
deriving anyclass (FromJSON, ToJSON, Interpret)
newtype ContainerName = ContainerName Text
deriving stock (Show, Read, Generic)
deriving newtype (IsString)
deriving anyclass (FromJSON, ToJSON, Interpret)
newtype ShareDir = ShareDir Text
deriving stock (Show, Read, Generic)
deriving newtype (IsString)
deriving anyclass (FromJSON, ToJSON, Interpret)
newtype ManifestName = ManifestName Text
deriving stock (Show, Read, Generic)
deriving newtype (IsString)
deriving anyclass (FromJSON, ToJSON, Interpret)
newtype PreludeCommand = PreludeCommand Text
deriving stock (Show, Read, Generic)
deriving newtype (IsString)
deriving anyclass (FromJSON, ToJSON, Interpret)
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)
| DontRun
deriving (Show,Read, Generic, FromJSON, ToJSON, Interpret)
newtype StdOutLog = StdOutLog Text
deriving stock (Show, Read, Generic)
deriving newtype (IsString)
deriving anyclass (FromJSON, ToJSON, Interpret)
newtype StdErrLog = StdErrLog Text
deriving stock (Show, Read, Generic)
deriving newtype (IsString)
deriving anyclass (FromJSON, ToJSON, Interpret)
data TestText = TestText TextBehaviorStdout TextBehaviorStderr
deriving stock (Show, Read, Generic)
deriving anyclass (FromJSON, ToJSON, Interpret)
newtype TextBehaviorStdout = TextBehaviorStdout TextBehavior
deriving stock (Show, Read, Generic)
deriving anyclass (FromJSON, ToJSON, Interpret)
newtype TextBehaviorStderr = TextBehaviorStderr TextBehavior
deriving stock (Show, Read, Generic)
deriving anyclass (FromJSON, ToJSON, Interpret)
data TextBehavior =
WaitFor Text
| ExpectClean deriving (Show,Read)
data PowerCap = Fixed Int | Adaptive | None deriving (Show, Read, Eq)
| ExpectClean deriving (Show,Read, Generic, FromJSON, ToJSON, Interpret)
data PowerCap = Fixed Integer | Adaptive | None deriving (Show, Read, Eq, Generic, FromJSON, ToJSON, Interpret)
class ToDaemonOption a where
toOption :: a -> [Text]
......
src/argotk.hs
View file @ 88ee00a9
......@@ -15,7 +15,6 @@ Maintainer : fre@freux.fr
-}
import Protolude
import Data.Coerce ( coerce )
import Data.Foldable ( for_ )
import Argo.Stack
import Argo.Types
......@@ -70,7 +69,6 @@ instance Default TestSpec where
, description = ""
}
-- helpers for building test specifications
--------------------------------------------------------------------------------
......@@ -215,8 +213,7 @@ configureTest RunOpenMC = mkRun updater "run OpenMC in the Argo stack."
updater sa = sa
{ preludeCommand = PreludeCommand $ "cp -r $OPENMC_PWD/* " <> wd
, app = AppName "mpiexec"
, args = let tc = coerce (hwThreadCount sa) :: Int
in fmap AppArg ["-n", show tc, "openmc"]
, args = fmap AppArg ["-n", "24", "openmc"]
}
where (WorkingDirectory wd) = workingDirectory sa
......@@ -224,10 +221,8 @@ configureTest RunQMCPack = mkRun updater "run QMCPack in the Argo stack."
where
updater sa = sa
{ app = AppName "mpirun"
, args = let tc = coerce (hwThreadCount sa) :: Int
(ShareDir dirn) = shareDir sa
in fmap AppArg
["-n", show tc, "qmcpack", dirn <> "/simple-H2O.xml"]
, args = let (ShareDir dirn) = shareDir sa
in fmap AppArg ["-n", "24", "qmcpack", dirn <> "/simple-H2O.xml"]
}
configureTest RunAMG = mkRun updater "run AMG in the Argo stack."
......@@ -235,23 +230,22 @@ configureTest RunAMG = mkRun updater "run AMG in the Argo stack."
updater sa = sa
{ app = AppName "mpiexec"
, vars = vars sa ++ [(EnvVar "OMP_NUM_THREADS", "1")]
, args = let tc = coerce (hwThreadCount sa) :: Int
in fmap
AppArg
[ "-n"
, show tc
, "amg"
, "-problem"
, "2"
, "-n"
, "90"
, "90"
, "90"
, "-P"
, "2"
, show $ quot tc 2
, "1"
]
, args = fmap
AppArg
[ "-n"
, "24"
, "amg"
, "-problem"
, "2"
, "-n"
, "90"
, "90"
, "90"
, "-P"
, "2"
, "24"
, "1"
]
}
configureTest RunSTREAM = mkRun updater "run STREAM in the Argo stack."
......@@ -413,11 +407,13 @@ main :: IO ()
main = do
hSetBuffering System.IO.stdout NoBuffering
argonixShare <- getEnv "ARGOTK_SHARE"
outputDir <- getEnv "ARGOTK_BASEWD"
vars <- fmap (\(v, y) -> (EnvVar $ T.pack v, T.pack y)) <$> getEnvironment
hwlocTC <- single $ inshell "hwloc-calc machine:0 -N PU" empty
hwlocTC <- single $ inshell "hwloc-calc machine:0 -N PU" empty
let a = def
{ shareDir = ShareDir $ toS argonixShare
, vars = vars
, hwThreadCount = HwThreadCount (read $ unpack $ lineToText hwlocTC)
{ shareDir = ShareDir $ toS argonixShare
, vars = vars
, workingDirectory = WorkingDirectory $ toS outputDir
, hwThreadCount = HwThreadCount (read $ unpack $ lineToText hwlocTC)
}
join $ execParser (info (opts a <**> helper) idm)
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