Merge branch 'refactor-powerexpe'

argo/argo.cabal

@@ -12,6 +12,21 @@ library
   exposed-Modules:     Argo.Stack
                        Argo.Utils
                        Argo.Args
-  build-depends:       base >=4 && <=8, turtle, data-default, managed, ansi-terminal, unix, system-filepath, async, process, text, optparse-applicative, extra, foldl, conduit,conduit-extra, bytestring, stm, pretty-show
+  build-depends:       base >=4 && <=8, turtle, data-default, managed, ansi-terminal, unix, system-filepath, async, process, text, optparse-applicative, extra, foldl, conduit,conduit-extra, bytestring, stm, pretty-show, unliftio-core
   hs-source-dirs:      src
   default-language:    Haskell2010
+  ghc-options:
+    -Wall
+    -Wincomplete-uni-patterns
+    -Wincomplete-record-updates
+    -Wmissing-home-modules
+    -Widentities
+    -Wredundant-constraints
+    -Wcpp-undef
+    -Wmissing-export-li
+    -fwarn-tabs
+    -fwarn-unused-imports
+    -fwarn-missing-signatures
+    -fwarn-name-shadowing
+    -fwarn-incomplete-patternssts
+    -fprint-potential-instances

argo/src/Argo.hs

+{-|
+Module      : Argo
+Description : The holt core package
+Copyright   : (c) Valentin Reis, 2018
+License     : MIT
+Maintainer  : fre@freux.fr
+-}
+
 module Argo
   ( module Argo.Stack
-  ( module Argo.Args
+  , module Argo.Args
   , module Argo.Utils
   )
 where

argo/src/Argo/Args.hs

@@ -11,14 +11,12 @@ import           Data.Text                     as T
 
 import           Turtle                  hiding ( option )
 import           Prelude                 hiding ( FilePath )
-import           System.Process          hiding ( shell )
 
 
-data OutputFiles = OutputFiles FilePath FilePath
 data StackArgs = StackArgs
   { verbosity              :: Verbosity
   , app                    :: AppName
-  , args                   :: AppArgs
+  , args                   :: [AppArg]
   , containerName          :: ContainerName
   , workingDirectory       :: WorkingDirectory
   , manifestDir            :: ManifestDir
@@ -27,11 +25,13 @@ data StackArgs = StackArgs
   , cmdrun                 :: ProcessBehavior
   , cmdlisten              :: ProcessBehavior
   , cmdlistenprogress      :: ProcessBehavior
+  , cmdlistenperformance   :: ProcessBehavior
   , cmdlistenpower         :: ProcessBehavior
-  }
+  } deriving (Show)
 
+{-data OutputFiles = OutputFiles FilePath FilePath-}
 data Verbosity = Normal | Verbose deriving (Show,Read,Eq)
-newtype AppArgs = AppArgs [Text] deriving (Show, Read)
+newtype AppArg = AppArg Text deriving (IsString, Show, Read)
 newtype WorkingDirectory = WorkingDirectory FilePath deriving (IsString, Show)
 newtype AppName = AppName Text deriving (IsString, Show, Read)
 newtype ContainerName = ContainerName Text deriving (IsString, Show, Read)
@@ -56,7 +56,7 @@ instance Default StackArgs where
   def = StackArgs
     { verbosity = Normal
     , app = AppName "ls"
-    , args = AppArgs []
+    , args = []
     , containerName = ContainerName "testContainer"
     , workingDirectory = WorkingDirectory "_output"
     , manifestDir = ManifestDir "manifests"
@@ -65,83 +65,93 @@ instance Default StackArgs where
     , cmdrun = DontRun
     , cmdlisten = DontRun
     , cmdlistenprogress = DontRun
+    , cmdlistenperformance = DontRun
     , cmdlistenpower = DontRun
     }
 
 parseExtendStackArgs :: StackArgs -> Parser StackArgs
-parseExtendStackArgs StackArgs {..} = do
+parseExtendStackArgs sa = do
   verbosity <- flag
     Normal
     Verbose
     (long "verbose" <> short 'v' <> help "Enable verbose mode")
   app <- strOption
-    (  long "application"
+    (  long "app"
     <> metavar "APP"
     <> help "Target application executable name. PATH is inherited."
     <> showDefault
-    <> value app
+    <> value (app sa)
     )
   containerName <- strOption
     (  long "container_name"
     <> metavar "ARGO_CONTAINER_UUID"
     <> help "Container name"
     <> showDefault
-    <> value containerName
+    <> value (containerName sa)
     )
   workingDirectory <- strOption
     (  long "output_dir"
     <> metavar "DIR"
     <> help "Working directory."
     <> showDefault
-    <> value workingDirectory
+    <> value (workingDirectory sa)
     )
   manifestDir <- strOption
     (  long "manifest_directory"
     <> metavar "DIR"
     <> help "Manifest lookup directory"
     <> showDefault
-    <> value manifestDir
+    <> value (manifestDir sa)
     )
   manifestName <- strOption
     (  long "manifest_name"
     <> metavar "FILENAME"
     <> help "Manifest file basename (relative to --manifest_directory)"
     <> showDefault
-    <> value manifestName
+    <> value (manifestName sa)
     )
   daemon <- behaviorOption
     (  long "daemon"
     <> metavar "BEHAVIOR"
     <> help "`daemon` behavior"
     <> showDefault
-    <> value daemon
+    <> value (daemon sa)
     )
   cmdrun <- behaviorOption
     (  long "cmd_run"
     <> metavar "BEHAVIOR"
     <> help "`cmd run` behavior"
     <> showDefault
-    <> value cmdrun
+    <> value (cmdrun sa)
     )
   cmdlisten <- behaviorOption
     (  long "cmd_listen"
     <> metavar "BEHAVIOR"
     <> help "`cmd listen` behavior"
     <> showDefault
-    <> value cmdlisten
+    <> value (cmdlisten sa)
+    )
+  cmdlistenperformance <- behaviorOption
+    (  long "cmd_listen_performance"
+    <> metavar "BEHAVIOR"
+    <> help "`cmd listen --filter performance` behavior"
+    <> showDefault
+    <> value (cmdlistenperformance sa)
     )
   cmdlistenprogress <- behaviorOption
     (  long "cmd_listen_progress"
     <> metavar "BEHAVIOR"
     <> help "`cmd listen --filter progress` behavior"
     <> showDefault
-    <> value cmdlistenprogress
+    <> value (cmdlistenprogress sa)
     )
   cmdlistenpower <- behaviorOption
     (  long "cmd_listen_power"
     <> metavar "BEHAVIOR"
     <> help "`cmd listen --filter power` behavior"
     <> showDefault
-    <> value cmdlistenpower
+    <> value (cmdlistenpower sa)
     )
+  args <- some (argument str (metavar "ARGS" <> help "Application arguments."))
+    <|> pure (args sa)
   pure StackArgs {..}

argo/src/Argo/Stack.hs

@@ -16,49 +16,33 @@ import           Turtle
 import           Turtle.Shell
 import           Prelude                 hiding ( FilePath )
 
-import           System.IO                      ( withFile )
-import           Debug.Trace
 import           Filesystem.Path                ( (</>) )
 
 import           Control.Concurrent.Async
-import           Control.Monad.STM              ( atomically
-                                                , orElse
-                                                )
 
-import           System.Console.ANSI
-import           System.Console.ANSI.Types      ( Color )
 import           Data.Text                     as T
                                          hiding ( empty )
-import           Data.Text.IO                  as Text
 import           Argo.Utils
 import           System.Process                as P
                                          hiding ( shell )
-import           Options.Applicative           as OA
-import           Control.Monad.Extra           as E
 import           Control.Monad                 as CM
-import           Control.Foldl                 as F
-import           Data.Conduit
-import           Data.Conduit.Process
-import           Data.ByteString.Char8         as C8
-                                         hiding ( empty )
-import           Control.Exception.Base
 import           Data.Maybe
 import           Control.Foldl                 as Fold
 import           Text.Show.Pretty
 
 cleanLeftovers :: WorkingDirectory -> Shell ()
 cleanLeftovers (WorkingDirectory wd) = do
-  printInfo "Cleaning working(output) directory.\n"
+  printInfo "Cleaning working(output) directory."
   cleanLog wd
-  printInfo "Cleaning sockets.\n"
+  printInfo "Cleaning sockets."
   CM.mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in"]
 
 checkFsAttributes :: FilePath -> Shell ()
 checkFsAttributes workingDirectory = do
-  let x = case toText workingDirectory of
-        Left  x -> x
-        Right x -> x
-  let findmnt = inproc "findmnt" ["-T", x, "-o", "OPTIONS"] empty
+  let dir = case toText workingDirectory of
+        Left  di -> di
+        Right di -> di
+  let findmnt = inproc "findmnt" ["-T", dir, "-o", "OPTIONS"] empty
   b <- liftIO $ Turtle.Shell.fold (grep (has "nosuid") findmnt) Fold.length
   when (b > 0) $ dieRed $ format
     ("The output directory, " % fp % ", must not mounted with \"nosuid\"")
@@ -66,63 +50,57 @@ checkFsAttributes workingDirectory = do
 
 prepareDaemon
   :: StdOutLog -> StdErrLog -> Maybe TestText -> Shell Instrumentation
-prepareDaemon (StdOutLog out) (StdErrLog err) test = do
-  myWhich "daemon"
+prepareDaemon out stdErr test = do
+  _ <- myWhich "daemon"
   confPath <- myWhich "argo_nodeos_config"
   let confPath' = "./argo_nodeos_config"
   cp confPath confPath'
-  printInfo $ format ("Copied the configurator to " % fp % "\n") confPath'
-  printInfo $ format "Trying to sudo chown and chmod argo_nodeos_config\n"
+  printInfo $ format ("Copied the configurator to " % fp ) confPath'
+  printInfo $ format "Trying to sudo chown and chmod argo_nodeos_config"
   verboseShell (format ("sudo chown root:root " % fp) confPath') empty >>= \case
-    ExitSuccess -> printInfo "Chowned argo_nodeos_config to root:root.\n"
+    ExitSuccess -> printInfo "Chowned argo_nodeos_config to root:root."
     ExitFailure n ->
       die ("Failed to set argo_nodeos_config permissions " <> repr n)
   verboseShell (format ("sudo chmod u+sw " % fp) confPath') empty >>= \case
-    ExitSuccess   -> printInfo "Set the suid bit.\n"
+    ExitSuccess   -> printInfo "Set the suid bit."
     ExitFailure n -> die ("Setting suid bit failed with exit code " <> repr n)
   cleanContainers confPath' 1 2
   export "ARGO_NODEOS_CONFIG" (format fp confPath')
-  return $ Instrumentation (P.proc "daemon" [])
-                           (StdOutLog out)
-                           (StdErrLog err)
-                           test
+  return $ Instrumentation (P.proc "daemon" []) out stdErr test
  where
-  nodeOsFailure (ExitFailure n, _, _) = do
-    printError ("argo_nodeos_config failed with exit code :" <> repr n <> "\n")
+  nodeOsFailure n = do
+    printError ("argo_nodeos_config failed with exit code :" <> repr n )
     testfile ".argo_nodeos_config_exit_message" >>= \case
       True -> do
-        printInfo "Contents of .argo_nodeos_config_exit_message: \n"
+        printInfo "Contents of .argo_nodeos_config_exit_message: "
         view $ input ".argo_nodeos_config_exit_message"
       False -> die ("argo_nodeos_config failed with exit code " <> repr n)
+  cleanContainers :: FilePath -> NominalDiffTime -> Integer ->  Shell ()
   cleanContainers argo_nodeos_config retryTime remainingRetries = do
     let
       showConfig =
         inshell (format (fp % " --show_config") argo_nodeos_config) empty
-      (isClean :: IO Bool) =
-        liftIO
-            (Turtle.Shell.fold (grep (has "CONTAINER") showConfig) Fold.length)
-          >>= (\x -> return $ x > 5)
     verboseShell'
         (format (fp % " --clean_config=kill_content:true") argo_nodeos_config)
         empty
       >>= \case
-            e@(ExitFailure n, out, err) -> do
-              when (remainingRetries == 0) $ nodeOsFailure e
+            (ExitFailure n, _, _) -> do
+              when (remainingRetries == 0) $ nodeOsFailure n
               printWarning
                 (  "the argo_nodeos_config call failed with exit code "
                 <> repr n
-                <> ". Retrying..\n"
+                <> ". Retrying.."
                 )
               liftIO $ sleep (retryTime * 2)
               cleanContainers argo_nodeos_config
                               (retryTime * 2)
                               (remainingRetries - 1)
             (ExitSuccess, _, _) -> do
-              printInfo "Cleaned the argo config.\n"
-              l <- liftIO $ Turtle.Shell.fold
+              printInfo "Cleaned the argo config."
+              len <- liftIO $ Turtle.Shell.fold
                 (grep (has "CONTAINER") showConfig)
                 Fold.length
-              if l > 0
+              if len > 0
                 then do
                   printWarning
                     "the argo_nodeos_config call did not remove containers, \
@@ -134,24 +112,25 @@ prepareDaemon (StdOutLog out) (StdErrLog err) test = do
                 else
                   printInfo
                     "argo_nodeos_config successfully cleaned the container \
-                \config.\n"
+                    \config."
 
 cmdRunI
   :: AppName
-  -> AppArgs
+  -> [AppArg]
   -> ContainerName
   -> ManifestDir
   -> ManifestName
   -> ProcessBehavior
   -> Maybe (StackI, Instrumentation)
-cmdRunI (AppName app) (AppArgs args) (ContainerName cn) (ManifestDir md) (ManifestName mn) pb
+cmdRunI (AppName app) args (ContainerName cn) (ManifestDir md) (ManifestName mn) pb
   = Just (Run, )
     <*> processBehaviorToI
           (  P.proc "cmd"
           $  ["run", "-u", T.unpack cn, encodeString $ md </> mn, T.unpack app]
-          ++ fmap T.unpack args
+          ++ fmap (T.unpack . argToText) args
           )
           pb
+  where argToText (AppArg a) = a
 
 cmdListenI
   :: ContainerName -> ProcessBehavior -> Maybe (StackI, Instrumentation)
@@ -167,6 +146,15 @@ cmdListenProgressI (ContainerName cn) pb =
           (P.proc "cmd" ["listen", "-u", T.unpack cn, "--filter", "progress"])
           pb
 
+cmdListenPerformanceI
+  :: ContainerName -> ProcessBehavior -> Maybe (StackI, Instrumentation)
+cmdListenPerformanceI (ContainerName cn) pb =
+  Just (Performance, )
+    <*> processBehaviorToI
+          (P.proc "cmd" ["listen", "-u", T.unpack cn, "--filter", "performance"]
+          )
+          pb
+
 cmdListenPowerI
   :: ContainerName -> ProcessBehavior -> Maybe (StackI, Instrumentation)
 cmdListenPowerI (ContainerName cn) pb =
@@ -179,28 +167,36 @@ data StackOutput =
     FoundMessage
   | Died StackI ExitCode
 
-data StackI = Daemon | Run | Listen | Progress | Power deriving (Show)
+data StackI = Daemon | Run | Listen | Progress | Power | Performance deriving (Show)
 
 runStack :: StackArgs -> Shell StackOutput
-runStack a@StackArgs {..} = do
-  CM.mapM_ cleanSocket ["/tmp/nrm-downstream-in", "/tmp/nrm-upstream-in", "/tmp/nrm-upstream-event"]
+runStack sa@StackArgs {..} = do
+  when (verbosity == Verbose) $ liftIO $ pPrint sa
+
+  CM.mapM_
+    cleanSocket
+    [ "/tmp/nrm-downstream-in"
+    , "/tmp/nrm-upstream-in"
+    , "/tmp/nrm-upstream-event"
+    ]
   let (WorkingDirectory wd) = workingDirectory
-  Turtle.shell (format ("rm -rf " % fp) wd) Turtle.empty
+  _ <- Turtle.shell (format ("rm -rf " % fp) wd) Turtle.empty
   mktree wd
   checkFsAttributes wd
   cd wd
 
   iDaemon <- case daemon of
     DontRun -> return Nothing
-    JustRun out err ->
-      (\x -> Just (Daemon, x)) <$> prepareDaemon out err Nothing
-    SucceedTestOnMessage t out err ->
-      (\x -> Just (Daemon, x)) <$> prepareDaemon out err (Just t)
+    JustRun stdOut stdErr ->
+      (\i -> Just (Daemon, i)) <$> prepareDaemon stdOut stdErr Nothing
+    SucceedTestOnMessage t stdOut stdErr ->
+      (\i -> Just (Daemon, i)) <$> prepareDaemon stdOut stdErr (Just t)
 
   let milist =
         [ iDaemon
         , cmdRunI app args containerName manifestDir manifestName cmdrun
         , cmdListenI containerName cmdlisten
+        , cmdListenPerformanceI containerName cmdlistenperformance
         , cmdListenProgressI containerName cmdlistenprogress
         , cmdListenPowerI containerName cmdlistenpower
         ]
@@ -208,14 +204,14 @@ runStack a@StackArgs {..} = do
 
   if verbosity == Verbose
     then do
-      printInfo "Starting the following processes:\n"
+      printInfo "Starting the following processes:"
       liftIO $ pPrint ilist
     else liftIO $ pPrint (fmap fst ilist)
 
   asyncs <- liftIO $ mapM tupleToAsync ilist
-  liftIO $ kbInstallHandler $ CM.mapM_ cancel asyncs
+  _ <- liftIO $ kbInstallHandler $ CM.mapM_ cancel asyncs
 
-  when (verbosity == Verbose) $ printInfo "Processes started.\n"
+  when (verbosity == Verbose) $ printInfo "Processes started."
 
   out <- liftIO $ waitAnyCancel asyncs
 
@@ -224,14 +220,13 @@ runStack a@StackArgs {..} = do
     <> repr (fst $ snd out)
     <> " with exit information: "
     <> repr (snd $ snd out)
-    <> "\n"
     )
 
   cd "../"
 
   return $ case snd out of
     (_     , Left PatternMatched) -> FoundMessage
-    (stacki, Right (e, _, _)    ) -> Died stacki e
+    (stacki, Right (errmsg, _, _)    ) -> Died stacki errmsg
  where
   tupleToAsync
     :: (StackI, Instrumentation)

argo/src/Argo/Utils.hs

 {-# LANGUAGE LambdaCase, OverloadedStrings, DataKinds,
-  FlexibleInstances, TypeOperators, RecordWildCards #-}
+  FlexibleInstances, ScopedTypeVariables, TypeOperators #-}
 
 module Argo.Utils where
 
@@ -14,15 +14,24 @@ import           Data.Conduit
 import           Data.Conduit.Process    hiding ( shell )
 import           Data.ByteString               as B
                                          hiding ( empty )
+
+import           System.IO                      ( BufferMode(NoBuffering)
+                                                , hSetBuffering
+                                                )
+import           Control.Monad.IO.Unlift        ( MonadIO(..)
+                                                , MonadUnliftIO
+                                                , withRunInIO
+                                                )
 import           Data.Text.Encoding            as TE
 import           Data.Conduit.Combinators      as CC
 import           Control.Exception.Base
 import           Data.Typeable
 import           Data.Text                     as T
+import qualified System.IO                     as IO
 
 -- | Miscellaneous printing utilities
 colorShell :: Color -> Shell () -> Shell ()
-colorShell color s = setC color *> s *> setC White
+colorShell color she = setC color *> she *> setC White
   where setC c = liftIO $ setSGR [SetColor Foreground Dull c]
 
 printInfo :: Text -> Shell ()
@@ -33,22 +42,24 @@ printSuccess :: Text -> Shell ()
 printTest :: Text -> Shell ()
 dieRed :: Text -> Shell ()
 
-printInfo = printf ("Info: " % s)
+printInfo = printf ("Info: " % s% "\n")
 printCommand = printf ("Running: " % s % "\n")
-printWarning = colorShell Yellow . printf ("Warning: " % s)
-printError = colorShell Red . printf ("Error: " % s)
-printSuccess = colorShell Green . printf ("Success: " % s)
+printWarning = colorShell Yellow . printf ("Warning: " % s% "\n")
+printError = colorShell Red . printf ("Error: " % s% "\n")
+printSuccess = colorShell Green . printf ("Success: " % s% "\n")
 printTest = colorShell Green . printf ("RUNNING TEST: " % s % "\n")
 dieRed str =
   colorShell Red (printf ("Failure: " % s) str) >> exit (ExitFailure 1)
 
+myWhich :: FilePath -> Shell FilePath
 myWhich str = which str >>= \case
   (Just p) ->
-    printInfo (format ("Found " % fp % " at " % fp % "\n") str p) >> return p
+    printInfo (format ("Found " % fp % " at " % fp) str p) >> return p
   Nothing -> die $ format ("Argo `" % fp % "` not in $PATH.") str
 
+myWhichMaybe :: FilePath -> Shell (Maybe FilePath)
 myWhichMaybe str = which str >>= \case
-  (Just p) -> printInfo (format ("Found " % fp % " at " % fp % "\n") str p)
+  (Just p) -> printInfo (format ("Found " % fp % " at " % fp) str p)
     >> return (Just p)
   Nothing -> return Nothing
 
@@ -56,7 +67,7 @@ sudoRemoveFile :: (Text -> Shell ()) -> Text -> FilePath -> Shell ()
 sudoRemoveFile printer desc filePath = do
   foundSocket <- testfile filePath
   when foundSocket $ go False
-  printInfo $ format ("OK: " % s % " " % fp % "\n") desc filePath
+  printInfo $ format ("OK: " % s % " " % fp) desc filePath
  where
   go useSudo = do
     printer $ format ("found stale " % s % " at " % fp % ".. ") desc filePath
@@ -65,7 +76,7 @@ sudoRemoveFile printer desc filePath = do
         Turtle.empty
       >>= \case
             ExitSuccess -> colorShell Green $ printf " Successfully removed.\n"
-            ExitFailure n -> if useSudo
+            ExitFailure _ -> if useSudo
               then printer $ format
                 ("Failed to remove stale " % s % ", even with sudo.")
                 desc
@@ -76,13 +87,14 @@ sudoRemoveFile printer desc filePath = do
                 go True
 
 verboseShell :: Text -> Shell Line -> Shell ExitCode
-verboseShell command input = printCommand command >> shell command input
+verboseShell command i = printCommand command >> shell command i
 
 verboseShell' :: Text -> Shell Line -> Shell (ExitCode, Text, Text)
-verboseShell' command input =
-  printCommand command >> shellStrictWithErr command input
+verboseShell' command i = printCommand command >> shellStrictWithErr command i
 
+cleanSocket :: FilePath -> Shell ()
 cleanSocket = sudoRemoveFile printError "socket"
+cleanLog :: FilePath -> Shell ()
 cleanLog = sudoRemoveFile printWarning "log folder"
 
 kbInstallHandler :: IO () -> IO Handler
@@ -99,17 +111,16 @@ data Instrumentation = Instrumentation
   deriving (Show)
 
 runI :: Instrumentation -> IO (Either PatternMatched (ExitCode, (), ()))
-runI (Instrumentation cp outlog@(StdOutLog out) errlog@(StdErrLog err) t) = try
-  (reroutedDaemon cp)
+runI (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t) = try
+  (reroutedDaemon crProc)
  where
   reroutedDaemon process =
-    withSinkFile (T.unpack out)
-      $ \outSink ->
-          withSinkFile (T.unpack err) $ \errSink -> sourceProcessWithStreams
-            process
-            mempty
-            (makeMatcher t .| outSink)
-            (makeMatcher t .| errSink)
+    withSinkFileNoBuffering (T.unpack stdOut) $ \outSink ->
+      withSinkFile (T.unpack stdErr) $ \errSink -> sourceProcessWithStreams
+        process
+        mempty
+        (makeMatcher t .| outSink)
+        (makeMatcher t .| errSink)
   makeMatcher maybeMessage = case maybeMessage of
     Just (TestText msg) -> untilMatch msg
     Nothing             -> awaitForever yield
@@ -124,8 +135,19 @@ runI (Instrumentation cp outlog@(StdOutLog out) errlog@(StdErrLog err) t) = try
           untilMatch message
       _ -> return ()
 
+  withSinkFileNoBuffering
+    :: (MonadUnliftIO m, MonadIO n)
+    => IO.FilePath
+    -> (ConduitM ByteString o n () -> m a)
+    -> m a
+  withSinkFileNoBuffering filepath inner =
+    withRunInIO $ \run -> IO.withBinaryFile filepath IO.WriteMode $ \h -> do
+      hSetBuffering h NoBuffering
+      run $ inner $ sinkHandle h
+
 processBehaviorToI :: CreateProcess -> ProcessBehavior -> Maybe Instrumentation
-processBehaviorToI cp = \case
-  DontRun                        -> Nothing
-  JustRun out err                -> Just $ Instrumentation cp out err Nothing
-  SucceedTestOnMessage t out err -> Just $ Instrumentation cp out err (Just t)
+processBehaviorToI crProc = \case
+  DontRun               -> Nothing
+  JustRun stdOut stdErr -> Just $ Instrumentation crProc stdOut stdErr Nothing
+  SucceedTestOnMessage t stdOut stdErr ->
+    Just $ Instrumentation crProc stdOut stdErr (Just t)

argotk/argotk.cabal

@@ -19,4 +19,18 @@ executable argotk
   build-depends:       base, shake, argo, turtle, data-default, async, unix, text, optparse-applicative, foldl, ansi-terminal
   --hs-source-dirs:      src
   default-language:    Haskell2010
-  GHC-Options: -Wall
+  ghc-options:
+    -Wall
+    -Wincomplete-uni-patterns
+    -Wincomplete-record-updates
+    -Wmissing-home-modules
+    -Widentities
+    -Wredundant-constraints
+    -Wcpp-undef
+    -Wmissing-export-li
+    -fwarn-tabs
+    -fwarn-unused-imports
+    -fwarn-missing-signatures
+    -fwarn-name-shadowing