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