Fix refactor bugs

src/Argo/Args.hs

@@ -13,11 +13,16 @@ module Argo.Args
   )
 where
 
-import           Argo.Types
+import           Argo.Types                     ( ProcessBehavior
+                                                , Verbosity(..)
+                                                , StackArgs(..)
+                                                )
 import           Options.Applicative           as OA
-import           Options.Applicative.Types
 import           Options.Applicative.Builder    ( option )
-import           Turtle                  hiding ( option )
+import           Options.Applicative.Types      ( Parser
+                                                , ReadM
+                                                , readerAsk
+                                                )
 import           Prelude                 hiding ( FilePath )
 
 behavior :: ReadM ProcessBehavior

src/Argo/Stack.hs

@@ -30,9 +30,9 @@ module Argo.Stack
   )
 where
 
-import           Protolude
-import qualified Prelude                        ( show )
 import           Argo.Types
+import qualified Prelude                        ( show )
+import           Protolude
 
 import           Data.Coerce                    ( coerce )
 
@@ -41,9 +41,7 @@ import           Data.Foldable                  ( for_ )
 import           Data.Text                     as T
                                          hiding ( empty )
 import           Data.Traversable               ( for )
-{-import           System.Process                as P-}
-                                         {-hiding ( shell )-}
-import           Text.Show.Pretty
+import           System.Directory
 import           System.Process.Typed           ( readProcessStdout_
                                                 , runProcess_
                                                 , runProcess
@@ -51,7 +49,7 @@ import           System.Process.Typed           ( readProcessStdout_
                                                 , shell
                                                 , setEnv
                                                 )
-import           System.Directory
+import           Text.Show.Pretty
 
 cleanLeftovers :: WorkingDirectory -> IO ()
 cleanLeftovers (WorkingDirectory wd) = do
@@ -73,12 +71,13 @@ prepareDaemon
   -> Maybe TestText
   -> Verbosity
   -> PowerCap
+  -> [(EnvVar, Text)]
   -> IO Instrumentation
-prepareDaemon out stdErr test v powercap = do
+prepareDaemon out stdErr test v powercap vars = do
   let confPath' = "/tmp/argo_nodeos_config"
   cleanContainers confPath'
   return $ Instrumentation
-    (   setEnv [("ARGO_NODEOS_CONFIG", toS confPath')]
+    (   setEnv ((castArg <$> vars) ++ [("ARGO_NODEOS_CONFIG", toS confPath')])
     $   proc "daemon"
     $   toS
     <$> ["--nrm_log", "./nrm_log"]
@@ -89,6 +88,7 @@ prepareDaemon out stdErr test v powercap = do
     stdErr
     test
  where
+  castArg (EnvVar varname, y) = (toS varname, toS y)
   nodeOsFailure n = do
     printError $ "argo_nodeos_config failed with exit code :" <> show n
     doesFileExist ".argo_nodeos_config_exit_message" >>= \case
@@ -121,7 +121,7 @@ cmdRunI (AppName app) args (ContainerName cn) (ShareDir md) (ManifestName mn) va
   pp =
     proc "cmd"
       $   toS
-      <$> ["run", "-u", cn, md <> "manifests" <> "/" <> mn, app]
+      <$> ["run", "-u", cn, md <> "/manifests/" <> mn, app]
       ++  fmap argToText args
 
 cmdListenI
@@ -180,13 +180,12 @@ runStack sa@StackArgs {..} = do
 
   when (powercap /= None) $ do
     user <- readProcessStdout_ (proc "whoami" [])
-    for_ ([0, 1]::[Int]) $ \x ->
+    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 _ -> die $ "couldn't create " <> wd
     ExitSuccess   -> return ()
@@ -195,10 +194,10 @@ runStack sa@StackArgs {..} = do
     DontRun -> return Nothing
     JustRun stdOut stdErr ->
       (\i -> Just (Daemon, i))
-        <$> prepareDaemon stdOut stdErr Nothing verbosity powercap
+        <$> prepareDaemon stdOut stdErr Nothing verbosity powercap vars
     Test t stdOut stdErr ->
       (\i -> Just (Daemon, i))
-        <$> prepareDaemon stdOut stdErr (Just t) Verbose powercap
+        <$> prepareDaemon stdOut stdErr (Just t) Verbose powercap vars
 
   let milist :: [Maybe (StackI, Instrumentation)]
       milist =

src/Argo/Utils.hs

@@ -181,13 +181,17 @@ untilMatch msg sawTraceback = await >>= \case
   Nothing -> return Clean
 
 configureConduits
-  :: WorkingDirectory -> ProcessConfig () () ()
+  :: WorkingDirectory
+  -> ProcessConfig () () ()
   -> ProcessConfig
        ()
        (ConduitM () ByteString IO ())
        (ConduitM () ByteString IO ())
 configureConduits (WorkingDirectory wd) p =
-  setStdout createSource $ setStderr createSource $ setStdin closed $ setWorkingDir (toS wd) p
+  setStdout createSource
+    $ setStderr createSource
+    $ setStdin closed
+    $ setWorkingDir (toS wd) p
 
 withConduitSinks
   :: Text
@@ -206,19 +210,27 @@ withSinkFileNoBuffering filepath inner =
     run $ inner $ sinkHandle h
 
 runI
-  :: WorkingDirectory -> Instrumentation
+  :: WorkingDirectory
+  -> Instrumentation
   -> IO (Either MonitoringResult (ExitCode, TracebackScan, TracebackScan))
-runI workDir (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t) =
-  try $ withConduitSinks stdOut stdErr $ \outSink errSink ->
-    withProcess (configureConduits workDir crProc) $ \p ->
-      withAsyncConduitsOnProcess p outSink outTest errSink errTest waitEither
-        >>= \case
-              Left  Clean -> (, Clean, Clean) <$> waitExitCode p
-              Right Clean -> (, Clean, Clean) <$> waitExitCode p
-              Right WarningTraceback ->
-                (, Clean, WarningTraceback) <$> waitExitCode p
-              Left WarningTraceback ->
-                (, WarningTraceback, Clean) <$> waitExitCode p
+runI workDir@(WorkingDirectory wd) (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t)
+  = try
+    $ withConduitSinks (wd <> "/" <> stdOut) (wd <> "/" <> stdErr)
+    $ \outSink errSink ->
+        withProcess (configureConduits workDir crProc) $ \p ->
+          withAsyncConduitsOnProcess p
+                                     outSink
+                                     outTest
+                                     errSink
+                                     errTest
+                                     waitEither
+            >>= \case
+                  Left  Clean -> (, Clean, Clean) <$> waitExitCode p
+                  Right Clean -> (, Clean, Clean) <$> waitExitCode p
+                  Right WarningTraceback ->
+                    (, Clean, WarningTraceback) <$> waitExitCode p
+                  Left WarningTraceback ->
+                    (, WarningTraceback, Clean) <$> waitExitCode p
  where
   outTest :: Maybe TextBehavior
   errTest :: Maybe TextBehavior
@@ -227,7 +239,6 @@ runI workDir (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t) =
       (Just tOut, Just tErr)
     Nothing -> (Nothing, Nothing)
 
-
 processBehaviorToI
   :: ProcessConfig () () () -> ProcessBehavior -> Maybe Instrumentation
 processBehaviorToI crProc = \case