Adds JSON+Dhall type conversions.

argotk.cabal

@@ -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

@@ -14,7 +14,7 @@
       {
         "name": "argo/container",
         "value": {
-          "cpus": "48",
+          "cpus": "24",
           "mems": "2"
         }
       },

src/Argo/Stack.hs

@@ -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

 {-# 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

@@ -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)