refactor passes ghc.

src/Argo/Stack.hs

@@ -36,18 +36,8 @@ import           Argo.Types
 
 import           Data.Coerce                    ( coerce )
 
-import           Filesystem.Path                ( (</>) )
-
-import           Control.Concurrent.Async
-
 import           Argo.Utils
-import           Control.Foldl                 as Fold
-                                                ( length )
-import           Control.Monad                  ( mapM_
-                                                , filterM
-                                                )
 import           Data.Foldable                  ( for_ )
-import           Data.Maybe
 import           Data.Text                     as T
                                          hiding ( empty )
 import           Data.Traversable               ( for )
@@ -124,10 +114,10 @@ cmdRunI
   -> ProcessBehavior
   -> Maybe (StackI, Instrumentation)
 cmdRunI (AppName app) args (ContainerName cn) (ShareDir md) (ManifestName mn) vars pb
-  = Just (Run, ) <*> processBehaviorToI (setEnv (cast <$> vars) pp) pb
+  = Just (Run, ) <*> processBehaviorToI (setEnv (castArg <$> vars) pp) pb
  where
   argToText (AppArg a) = a
-  cast (EnvVar v, y) = (toS v, toS y)
+  castArg (EnvVar v, y) = (toS v, toS y)
   pp =
     proc "cmd"
       $   toS
@@ -190,16 +180,15 @@ runStack sa@StackArgs {..} = do
 
   when (powercap /= None) $ do
     user <- readProcessStdout_ (proc "whoami" [])
-    for_
-      [0, 1]
-      ( chownPowercapFiles (toS user)
-      . ("/sys/devices/virtual/powercap/intel-rapl/intel-rapl:" <>)
-      )
+    for_ ([0, 1]::[Int]) $ \x ->
+      chownPowercapFiles (toS user)
+        $  "/sys/devices/virtual/powercap/intel-rapl/intel-rapl:"
+        <> show x
 
   cleanLeftovers workingDirectory
 
   runProcess (proc "mkdir" ["-p", toS wd]) >>= \case
-    ExitFailure n -> die $ "couldn't create " <> wd
+    ExitFailure _ -> die $ "couldn't create " <> wd
     ExitSuccess   -> return ()
 
   iDaemon <- case daemon of
@@ -222,11 +211,11 @@ runStack sa@StackArgs {..} = do
         ]
       ilist = catMaybes milist
 
-  _ <- shell (coerce preludeCommand :: Text) empty >>= \case
-    ExitSuccess ->
-      when verbose $ putText ("Executed preludeCommand." <> repr preludeCommand)
-    ExitFailure _ ->
-      die ("failed to execute preludeCommand." <> repr preludeCommand)
+  _ <- runProcess (shell $ toS (coerce preludeCommand :: Text)) >>= \case
+    ExitSuccess -> when verbose $ putText
+      ("Executed preludeCommand." <> toS (coerce preludeCommand :: Text))
+    ExitFailure _ -> die $ "failed to execute preludeCommand." <> toS
+      (coerce preludeCommand :: Text)
 
   when verbose $ do
     putText "Starting the following processes:"
@@ -241,14 +230,14 @@ runStack sa@StackArgs {..} = do
 
   putText
     (  "Processes cancelled due to termination of: "
-    <> repr (fst $ snd out)
+    <> show (fst $ snd out)
     <> " with exit information: "
-    <> repr (snd $ snd out)
+    <> show (snd $ snd out)
     )
 
   tracebackList <- procsWithTracebacks ilist
 
-  r             <- case snd out of
+  case snd out of
     (_, Left (PatternMatched line)) -> case tracebackList of
       [] -> return $ FoundMessage line
       t  -> return $ FoundTracebacks t
@@ -258,12 +247,9 @@ runStack sa@StackArgs {..} = do
       (TracebackScanOut tracebackOut)
       (TracebackScanErr tracebackErr)
       tracebackList
-
-  cd "../"
-  return r
  where
   chownPowercap user fn =
-    shell (format ("sudo chown " % s % ":" % s % " " % s) user user fn) empty
+    runProcess (shell $ toS ("sudo chown " <> user <> ":" <> user <> " " <> fn))
       >>= \case
             ExitSuccess   -> printWarning $ "changed ownership on " <> fn
             ExitFailure _ -> die $ "Couldn't change ownership on " <> fn

src/Argo/Utils.hs

@@ -38,7 +38,6 @@ import           Data.ByteString               as B
                                          hiding ( empty )
 import           Data.Conduit
 import           Data.Conduit.Combinators      as CC
-import           Prelude                 hiding ( Text )
 import           System.Console.ANSI
 import           System.Console.ANSI.Types      ( Color )
 import           System.Posix.Signals           ( installHandler
@@ -76,14 +75,12 @@ colorShell color she = setC color *> she *> setC White
   where setC c = liftIO $ setSGR [SetColor Foreground Dull c]
 
 printInfo :: Text -> IO ()
-printCommand :: Text -> IO ()
 printError :: Text -> IO ()
 printWarning :: Text -> IO ()
 printSuccess :: Text -> IO ()
 printTest :: Text -> IO ()
 
 printInfo s = putText $ "info: " <> s <> "\n"
-printCommand s = putText $ "running: " <> s <> "\n"
 printWarning s = colorShell Yellow $ putText $ "warning: " <> s <> "\n"
 printError s = colorShell Red $ putText $ "error: " <> s <> "\n"
 printSuccess s = colorShell Green $ putText $ "success: " <> s <> "\n"
@@ -211,9 +208,9 @@ withSinkFileNoBuffering filepath inner =
 runI
   :: WorkingDirectory -> Instrumentation
   -> IO (Either MonitoringResult (ExitCode, TracebackScan, TracebackScan))
-runI workingDirectory (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t) =
+runI workDir (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t) =
   try $ withConduitSinks stdOut stdErr $ \outSink errSink ->
-    withProcess (configureConduits workingDirectory crProc) $ \p ->
+    withProcess (configureConduits workDir crProc) $ \p ->
       withAsyncConduitsOnProcess p outSink outTest errSink errTest waitEither
         >>= \case
               Left  Clean -> (, Clean, Clean) <$> waitExitCode p

src/argotk.hs

@@ -18,11 +18,12 @@ import           Protolude
 import           Data.Coerce                    ( coerce )
 import           Data.Foldable                  ( for_ )
 import           Argo.Stack
-import           Argo.Utils
 import           Argo.Types
 import           Argo.Args
-import           Turtle hiding (repr)
-import           Prelude                 hiding ( FilePath, show)
+import           Turtle                  hiding ( repr )
+import           Prelude                 hiding ( FilePath
+                                                , show
+                                                )
 import           Data.Default
 import           System.Environment
 import           Options.Applicative     hiding ( action )
@@ -224,8 +225,8 @@ configureTest RunQMCPack = mkRun updater "run QMCPack in the Argo stack."
     { app  = AppName "mpirun"
     , args = let tc              = coerce (hwThreadCount sa) :: Int
                  (ShareDir dirn) = shareDir sa
-                 Right inpath    = toText (dirn </> "simple-H2O.xml")
-             in  fmap AppArg ["-n", show tc, "qmcpack", inpath]
+             in  fmap AppArg
+                      ["-n", show tc, "qmcpack", dirn <> "/simple-H2O.xml"]
     }
 
 configureTest RunAMG = mkRun updater "run AMG in the Argo stack."
@@ -266,10 +267,17 @@ 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", "24", "-bind-to", "core", "lmp_mpi", "-i", inpath]
+    , args = let (ShareDir dirn) = shareDir sa
+             in  fmap
+                   AppArg
+                   [ "-n"
+                   , "24"
+                   , "-bind-to"
+                   , "core"
+                   , "lmp_mpi"
+                   , "-i"
+                   , dirn <> "/modified.lj"
+                   ]
     }
 
 -- converting a run to a test.
@@ -407,9 +415,8 @@ main = do
   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
+        { shareDir      = ShareDir $ toS argonixShare
         , vars          = vars
         , hwThreadCount = HwThreadCount (read $ unpack $ lineToText hwlocTC)
         }
-  parsed <- execParser (info (opts a <**> helper) idm)
-  parsed
+  join $ execParser (info (opts a <**> helper) idm)