Commit b6d54c38 authored by Valentin Reis's avatar Valentin Reis

Adds environment variable overloading.

parent 1fd5b1a9
Pipeline #5981 passed with stages
in 40 seconds
......@@ -7,6 +7,7 @@ result
*/build
*/new-build
*/dist
dist*
*/new-dist
*/result
_output
......
......@@ -4,7 +4,7 @@ ghcid-lib:
sh -c "while true; do \
nix-shell \
--run 'ghcid \
--command \"cabal new-repl argotk\" \
--command \"cabal repl --ghc-options=-fno-code --ghc-options=-fno-break-on-exception --ghc-options=-fno-break-on-error --ghc-options=-v1 --ghc-options=-ferror-spans --ghc-options=-j\" \
--restart=argotk.cabal \
--restart=default.nix\
--restart=shell.nix'\
......
......@@ -134,4 +134,6 @@ parseExtendStackArgs sa = do
)
args <- some (argument str (metavar "ARGS" <> help "Application arguments."))
<|> pure (args sa)
vars <- some (argument auto (metavar "ENVvar" <> help "Env.Vars. for running app."))
<|> pure (vars sa)
pure StackArgs {..}
......@@ -101,22 +101,24 @@ cmdRunI
-> ContainerName
-> ShareDir
-> ManifestName
-> [(EnvVar, Text)]
-> ProcessBehavior
-> Maybe (StackI, Instrumentation)
cmdRunI (AppName app) args (ContainerName cn) (ShareDir md) (ManifestName mn) pb
= Just (Run, )
<*> processBehaviorToI
( P.proc "cmd"
$ [ "run"
, "-u"
, T.unpack cn
, encodeString $ md <> "manifests" </> mn
, T.unpack app
]
++ fmap (T.unpack . argToText) args
)
pb
where argToText (AppArg a) = a
cmdRunI (AppName app) args (ContainerName cn) (ShareDir md) (ManifestName mn) vars pb
= Just (Run, ) <*> processBehaviorToI (pp { P.env = Just $ cast <$> vars }) pb
where
argToText (AppArg a) = a
cast :: (EnvVar, Text) -> (String, String)
cast (EnvVar v, y) = (T.unpack v, T.unpack y)
pp =
P.proc "cmd"
$ [ "run"
, "-u"
, T.unpack cn
, encodeString $ md <> "manifests" </> mn
, T.unpack app
]
++ fmap (T.unpack . argToText) args
cmdListenI
:: ContainerName -> ProcessBehavior -> Maybe (StackI, Instrumentation)
......@@ -192,7 +194,7 @@ runStack sa@StackArgs {..} = do
let milist =
[ iDaemon
, cmdRunI app args containerName shareDir manifestName cmdrun
, cmdRunI app args containerName shareDir manifestName vars cmdrun
, cmdListenI containerName cmdlisten
, cmdListenPerformanceI containerName cmdlistenperformance
, cmdListenProgressI containerName cmdlistenprogress
......
......@@ -21,6 +21,7 @@ module Argo.Types
, Verbosity(..)
, AppName(..)
, AppArg(..)
, EnvVar(..)
, ContainerName(..)
, ShareDir(..)
, ManifestName(..)
......@@ -41,6 +42,7 @@ import Prelude hiding ( FilePath )
data StackArgs = StackArgs
{ verbosity :: Verbosity
, app :: AppName
, vars :: [(EnvVar,Text)]
, args :: [AppArg]
, containerName :: ContainerName
, workingDirectory :: WorkingDirectory
......@@ -59,6 +61,7 @@ data StackArgs = StackArgs
{-data OutputFiles = OutputFiles FilePath FilePath-}
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 FilePath deriving (IsString, Show)
......@@ -97,6 +100,7 @@ instance Default StackArgs where
def = StackArgs
{ verbosity = Normal
, app = AppName "ls"
, vars = []
, args = []
, containerName = ContainerName "testContainer"
, workingDirectory = WorkingDirectory "_output"
......
......@@ -26,6 +26,7 @@ import System.Environment
import Options.Applicative hiding ( action )
import Data.Text as T
( unpack
, pack
, Text
)
import System.IO
......@@ -229,6 +230,7 @@ configureTest RunAMG = mkRun updater "run AMG in the Argo stack."
where
updater sa = sa
{ app = AppName "mpiexec"
, vars = vars sa ++ [(EnvVar "OMP_NUM_THREADS", "1")]
, args = let tc = coerce (hwThreadCount sa) :: Int
in fmap
AppArg
......@@ -238,9 +240,9 @@ configureTest RunAMG = mkRun updater "run AMG in the Argo stack."
, "-problem"
, "2"
, "-n"
, "3"
, "3"
, "3"
, "90"
, "90"
, "90"
, "-P"
, "2"
, repr $ quot tc 2
......@@ -390,9 +392,11 @@ main :: IO ()
main = do
hSetBuffering System.IO.stdout NoBuffering
argonixShare <- getEnv "ARGOTK_SHARE"
hwlocTC <- single $ inshell "hwloc-calc machine:0 -N PU" empty
vars <- fmap (\(v, y) -> (EnvVar $ T.pack v, T.pack y)) <$> getEnvironment
hwlocTC <- single $ inshell "hwloc-calc machine:0 -N PU" empty
let a = def
{ shareDir = ShareDir $ decodeString argonixShare
, vars = vars
, hwThreadCount = HwThreadCount (read $ unpack $ lineToText hwlocTC)
}
turtle <- 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