refactoring to protolude.

argotk.cabal

@@ -18,7 +18,10 @@ executable argotk
   -- other-extensions:
   build-depends:
     base,
+    protolude,
     shake,
+    directory,
+    typed-process,
     turtle,
     data-default,
     async,

share/manifests/parallel.json

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

src/Argo/Types.hs

 {-# language GeneralizedNewtypeDeriving #-}
 {-# language OverloadedStrings #-}
+{-# language NoImplicitPrelude #-}
 
 {-|
 Module      : Argo.Types
@@ -36,8 +37,7 @@ where
 import           Data.Default
 import           Data.Text                     as T
                                          hiding ( empty )
-import           Turtle                  hiding ( option )
-import           Prelude                 hiding ( FilePath )
+import           Protolude
 
 data StackArgs = StackArgs
   { verbosity              :: Verbosity
@@ -59,16 +59,16 @@ data StackArgs = StackArgs
   , powercap               :: PowerCap
   } deriving (Show)
 
-{-data OutputFiles = OutputFiles FilePath FilePath-}
+{-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 FilePath deriving (IsString, Show)
+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 FilePath deriving (IsString, Show)
-newtype ManifestName = ManifestName FilePath deriving (IsString, Show)
+newtype ShareDir = ShareDir Text deriving (IsString, Show)
+newtype ManifestName = ManifestName Text deriving (IsString, Show)
 newtype PreludeCommand = PreludeCommand Text deriving (IsString, Show, Read)
 data ProcessBehavior =
      Test TestText StdOutLog StdErrLog
@@ -85,7 +85,7 @@ data TextBehavior =
 data PowerCap = Fixed Int | Adaptive | None deriving (Show, Read, Eq)
 
 class ToDaemonOption a where
-  toOption :: a -> [String]
+  toOption :: a -> [Text]
 
 instance ToDaemonOption Verbosity where
   toOption Verbose = ["--verbose"]

src/argotk.hs

 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 
 module Main
   ( main
@@ -13,14 +14,15 @@ License     : MIT
 Maintainer  : fre@freux.fr
 -}
 
+import           Protolude
 import           Data.Coerce                    ( coerce )
 import           Data.Foldable                  ( for_ )
 import           Argo.Stack
 import           Argo.Utils
 import           Argo.Types
 import           Argo.Args
-import           Turtle
-import           Prelude                 hiding ( FilePath )
+import           Turtle hiding (repr)
+import           Prelude                 hiding ( FilePath, show)
 import           Data.Default
 import           System.Environment
 import           Options.Applicative     hiding ( action )
@@ -213,7 +215,7 @@ configureTest RunOpenMC = mkRun updater "run OpenMC in the Argo stack."
     { preludeCommand = PreludeCommand "cp -r $OPENMC_PWD/* ."
     , app            = AppName "mpiexec"
     , args           = let tc = coerce (hwThreadCount sa) :: Int
-                       in  fmap AppArg ["-n", repr tc, "openmc"]
+                       in  fmap AppArg ["-n", show tc, "openmc"]
     }
 
 configureTest RunQMCPack = mkRun updater "run QMCPack in the Argo stack."
@@ -223,7 +225,7 @@ configureTest RunQMCPack = mkRun updater "run QMCPack in the Argo stack."
     , args = let tc              = coerce (hwThreadCount sa) :: Int
                  (ShareDir dirn) = shareDir sa
                  Right inpath    = toText (dirn </> "simple-H2O.xml")
-             in  fmap AppArg ["-n", repr tc, "qmcpack", inpath]
+             in  fmap AppArg ["-n", show tc, "qmcpack", inpath]
     }
 
 configureTest RunAMG = mkRun updater "run AMG in the Argo stack."
@@ -235,7 +237,7 @@ configureTest RunAMG = mkRun updater "run AMG in the Argo stack."
              in  fmap
                    AppArg
                    [ "-n"
-                   , repr tc
+                   , show tc
                    , "amg"
                    , "-problem"
                    , "2"
@@ -245,31 +247,31 @@ configureTest RunAMG = mkRun updater "run AMG in the Argo stack."
                    , "90"
                    , "-P"
                    , "2"
-                   , repr $ quot tc 2
+                   , show $ quot tc 2
                    , "1"
                    ]
     }
 
 configureTest RunSTREAM = mkRun updater "run STREAM in the Argo stack."
-  where updater sa = sa { app = AppName "stream_c" }
+ where
+  updater sa = sa
+    { app  = AppName "stream_c"
+    , vars = vars sa
+               ++ [ (EnvVar "OMP_NUM_THREADS", "24")
+                  , (EnvVar "OMP_PLACES"     , "cores")
+                  ]
+    }
 
 configureTest RunLAMMPS = mkRun updater "run LAMMPS in the argo stack."
  where
   updater sa = sa
     { app  = AppName "mpirun"
-    , args = let (ShareDir dirn) = shareDir sa
-                 Right inpath    = toText (dirn </> "modified.lj")
-             in  fmap
-                   AppArg
-                   [ "-n"
-                   , repr (coerce (hwThreadCount sa) :: Int)
-                   , "lmp_mpi"
-                   , "-i"
-                   , inpath
-                   ]
+    , args =
+      let (ShareDir dirn) = shareDir sa
+          Right inpath    = toText (dirn </> "modified.lj")
+      in  fmap AppArg ["-n", "24", "-bind-to", "core", "lmp_mpi", "-i", inpath]
     }
 
-
 -- converting a run to a test.
 --------------------------------------------------------------------------------
 
@@ -303,15 +305,17 @@ testProgressFromRun = testFromRun updater
 -- parsing and building the shell monad
 --------------------------------------------------------------------------------
 
-opts :: StackArgs -> Parser (Shell ())
+opts :: StackArgs -> Parser (IO ())
 opts sa = hsubparser
   (  command "clean"
              (info (pure $ clean sa) (progDesc "Clean sockets, logfiles."))
-  <> mconcat (fmap commandTest [(minBound :: TestName) ..])
-  <> commandTests [TestQMCPack, TestLAMMPS, TestOpenMC, TestAMG, TestSTREAM]
+  <> mconcat (fmap (commandTest sa) [(minBound :: TestName) ..])
+  <> commandTests sa
+                  [TestQMCPack, TestLAMMPS, TestOpenMC, TestAMG, TestSTREAM]
                   "testApplications"
                   "Run application CI tests"
-  <> commandTests [TestHello, TestListen]
+  <> commandTests sa
+                  [TestHello, TestListen]
                   "tests"
                   "Run hardware-independent CI tests"
   <> help
@@ -320,69 +324,77 @@ opts sa = hsubparser
        <> "values are printed when you call --help on these actions."
        )
   )
- where
-  action ttype = doOverridenTest ttype
-    <$> parseExtendStackArgs ((stackArgsUpdate $ configureTest ttype) sa)
-  descTest ttype = description (configureTest ttype)
-  commandTest ttype = command (show ttype)
-    $ info (action ttype) (progDesc $ T.unpack $ descTest ttype)
-  commandTests ttypes cmdStr descStr = command cmdStr
-    $ info (pure $ for_ ttypes (doTest sa)) (progDesc $ T.unpack descStr)
-
-  doTest :: StackArgs -> TestName -> Shell ()
-  doTest stackArgs ttype = doSpec spec
-    $ (stackArgsUpdate $ configureTest ttype) stackArgs
-    where spec = configureTest ttype
-
-  doOverridenTest :: TestName -> StackArgs -> Shell ()
-  doOverridenTest ttype = doSpec spec where spec = configureTest ttype
-
-  doSpec :: TestSpec -> StackArgs -> Shell ()
-  doSpec spec stackArgs = do
-    printTest $ description spec
-    fullStack (isTest spec) stackArgs
-    printSuccess "Test Successful.\n"
+
+action :: StackArgs -> TestName -> Parser (IO ())
+action sa testName = doOverridenTest testName
+  <$> parseExtendStackArgs ((stackArgsUpdate $ configureTest testName) sa)
+
+commandTests
+  :: StackArgs -> [TestName] -> String -> Text -> Mod CommandFields (IO ())
+commandTests sa testNames cmdStr descStr = command cmdStr
+  $ info (pure $ for_ testNames (doTest sa)) (progDesc $ T.unpack descStr)
+
+commandTest :: StackArgs -> TestName -> Mod CommandFields (IO ())
+commandTest sa testName = command (show testName)
+  $ info (action sa testName) (progDesc $ T.unpack $ descTest testName)
+
+descTest :: TestName -> Text
+descTest testName = description (configureTest testName)
+
+doTest :: StackArgs -> TestName -> IO ()
+doTest stackArgs testName = doSpec spec
+  $ (stackArgsUpdate $ configureTest testName) stackArgs
+  where spec = configureTest testName
+
+doOverridenTest :: TestName -> StackArgs -> IO ()
+doOverridenTest testName = doSpec spec where spec = configureTest testName
+
+doSpec :: TestSpec -> StackArgs -> IO ()
+doSpec spec stackArgs = do
+  putText $ description spec
+  fullStack (isTest spec) stackArgs
+  putText "Test Successful.\n"
 
 -- executors
 --------------------------------------------------------------------------------
 
-fullStack :: IsTest -> StackArgs -> Shell ()
+fullStack :: IsTest -> StackArgs -> IO ()
 fullStack isTest a@StackArgs {..} = do
   stackOutput <- runStack a
   case stackOutput of
-    FoundMessage    msg -> printSuccess $ "Found string in message:" <> repr msg
+    FoundMessage    msg -> putText $ "Found string in message:" <> toS msg
     FoundTracebacks tsl -> do
       for_ tsl $ \(stacki, fout, ferr) ->
-        printError
+        putText
           $  "Found Python Traceback when executing "
-          <> repr stacki
+          <> show stacki
           <> ". Files for this command: "
-          <> repr fout
+          <> toS fout
           <> " "
-          <> repr ferr
+          <> toS ferr
       exit (ExitFailure 1)
     Died stacki errorcode _ _ tsl -> case isTest of
       IsTest -> do
-        printError
-          (  repr stacki
+        putText
+          (  show stacki
           <> " died before a message could be found with error code "
-          <> repr errorcode
+          <> show errorcode
           )
         for_
           tsl
           (\(stacki', fout, ferr) ->
-            printError
+            putText
               $  "Found Python Traceback when executing "
-              <> repr stacki'
+              <> show stacki'
               <> ". Files for this command: "
-              <> repr fout
+              <> toS fout
               <> " "
-              <> repr ferr
+              <> toS ferr
           )
         exit (ExitFailure 1)
       NotTest -> exit ExitSuccess
 
-clean :: StackArgs -> Shell ()
+clean :: StackArgs -> IO ()
 clean StackArgs {..} = cleanLeftovers workingDirectory
 
 -- the entry point with dirty setup IO and env. var fuckery, and finally
@@ -399,5 +411,5 @@ main = do
         , vars          = vars
         , hwThreadCount = HwThreadCount (read $ unpack $ lineToText hwlocTC)
         }
-  turtle <- execParser (info (opts a <**> helper) idm)
-  sh turtle
+  parsed <- execParser (info (opts a <**> helper) idm)
+  parsed