Adds environment variable overloading.

.gitignore

@@ -7,6 +7,7 @@ result
 */build
 */new-build
 */dist
+dist*
 */new-dist
 */result
 _output

Makefile

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

src/Argo/Args.hs

@@ -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 {..}

src/Argo/Stack.hs

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

src/Argo/Types.hs

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

src/argotk.hs

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