Commit 83ada183 authored by Valentin Reis's avatar Valentin Reis

Refactor -> prepare for adding --powercap option

parent 16300a83
Pipeline #5816 passed with stage
in 34 seconds
{-# LANGUAGE OverloadedStrings, ApplicativeDo, GeneralizedNewtypeDeriving, RecordWildCards #-}
{-# language OverloadedStrings #-}
{-# language ApplicativeDo #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language RecordWildCards #-}
module Argo.Args where
module Argo.Args
( StdOutLog(..)
, StdErrLog(..)
, TestText(..)
, ProcessBehavior(..)
, TextBehavior(..)
, TextBehaviorStdout(..)
, TextBehaviorStderr(..)
, WorkingDirectory(..)
, Verbosity(..)
, AppName(..)
, AppArg(..)
, ContainerName(..)
, ShareDir(..)
, ManifestName(..)
, StackArgs(..)
, PreludeCommand(..)
, HwThreadCount(..)
, parseExtendStackArgs
)
where
import Options.Applicative as OA
import Options.Applicative.Types
......
{-# language TupleSections #-}
{-# language ViewPatterns #-}
{-# language LambdaCase #-}
{-# language RecordWildCards #-}
{-# language OverloadedStrings #-}
......@@ -12,7 +11,13 @@ License : MIT
Maintainer : fre@freux.fr
-}
module Argo.Stack where
module Argo.Stack
( StackOutput(..)
, cleanLeftovers
, runStack
)
where
import Argo.Args
import Data.Coerce ( coerce )
......@@ -59,11 +64,8 @@ prepareDaemon out stdErr test v = do
cleanContainers confPath' 1 2
export "ARGO_NODEOS_CONFIG" (format fp confPath')
return $ Instrumentation
(P.proc
"daemon"
( ["--nrm_log", "./nrm_log"]
++ (if (v == Verbose) then ["--verbose"] else [])
)
(P.proc "daemon"
(["--nrm_log", "./nrm_log"] ++ [ "--verbose" | v == Verbose ])
)
out
stdErr
......@@ -187,16 +189,16 @@ instance Show StackI where
Performance -> "cmd listen -f performance"
runStack :: StackArgs -> Shell StackOutput
runStack sa@StackArgs { verbosity = (==Verbose) -> verbose, ..} = do
runStack sa@StackArgs {..} = do
when verbose $ liftIO $ pPrint sa
cleanLeftovers workingDirectory
CM.mapM_ ($ (coerce workingDirectory)) [mktree, cd]
CM.mapM_ ($ coerce workingDirectory) [mktree, cd]
iDaemon <- case daemon of
DontRun -> return Nothing
JustRun stdOut stdErr ->
(\i -> Just (Daemon, i)) <$> prepareDaemon stdOut stdErr Nothing (verbosity sa)
(\i -> Just (Daemon, i)) <$> prepareDaemon stdOut stdErr Nothing verbosity
Test t stdOut stdErr ->
(\i -> Just (Daemon, i)) <$> prepareDaemon stdOut stdErr (Just t) Verbose
......@@ -250,6 +252,7 @@ runStack sa@StackArgs { verbosity = (==Verbose) -> verbose, ..} = do
cd "../"
return r
where
verbose = verbosity == Verbose
procsWithTracebacks
:: [(StackI, Instrumentation)] -> Shell [(StackI, Text, Text)]
procsWithTracebacks ilist = fmap showOutputs <$> filterM (checkI . snd) ilist
......
{-# LANGUAGE LambdaCase, OverloadedStrings, DataKinds,
FlexibleInstances, ScopedTypeVariables, TypeOperators #-}
{-# language LambdaCase #-}
{-# language OverloadedStrings #-}
{-# language DataKinds #-}
{-# language FlexibleInstances #-}
{-# language ScopedTypeVariables #-}
{-# language TypeOperators #-}
{-|
Module : Argo.Utils
......@@ -9,7 +13,23 @@ License : MIT
Maintainer : fre@freux.fr
-}
module Argo.Utils where
module Argo.Utils
( printInfo
, printWarning
, printSuccess
, printError
, printTest
, verboseShell'
, MonitoringResult(..)
, Instrumentation(..)
, TracebackScan(..)
, processBehaviorToI
, kbInstallHandler
, runI
, cleanSocket
, myWhich
)
where
import Argo.Args
import Turtle
......@@ -47,7 +67,6 @@ printError :: Text -> Shell ()
printWarning :: Text -> Shell ()
printSuccess :: Text -> Shell ()
printTest :: Text -> Shell ()
dieRed :: Text -> Shell ()
printInfo = printf ("Info: " % s % "\n")
printCommand = printf ("Running: " % s % "\n")
......@@ -55,8 +74,6 @@ 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
......@@ -64,12 +81,6 @@ myWhich str = which str >>= \case
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) str p) >> return (Just p)
Nothing -> return Nothing
sudoRemoveFile :: (Text -> Shell ()) -> Text -> FilePath -> Shell ()
sudoRemoveFile printer desc filePath = do
foundSocket <- testfile filePath
......@@ -93,16 +104,11 @@ sudoRemoveFile printer desc filePath = do
desc
go True
verboseShell :: Text -> Shell Line -> Shell ExitCode
verboseShell command i = printCommand command >> shell command i
verboseShell' :: Text -> Shell Line -> Shell (ExitCode, Text, Text)
verboseShell' command i = printCommand command >> shellStrictWithErr command i
cleanSocket :: FilePath -> Shell ()
cleanSocket = sudoRemoveFile printWarning "socket"
cleanLog :: FilePath -> Shell ()
cleanLog = sudoRemoveFile printWarning "log folder"
kbInstallHandler :: IO () -> IO Handler
kbInstallHandler h = installHandler keyboardSignal (Catch h) Nothing
......@@ -142,7 +148,7 @@ runI (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t) = try
warnOnTraceback :: Bool -> ConduitT ByteString ByteString IO TracebackScan
warnOnTraceback sawTraceback = await >>= \case
Just b | B.isInfixOf "Traceback" b -> yield b >> warnOnTraceback True
| otherwise -> yield b >> warnOnTraceback sawTraceback
| otherwise -> yield b >> warnOnTraceback sawTraceback
Nothing -> if sawTraceback then return WarningTraceback else return Clean
untilMatch :: Text -> Bool -> ConduitT ByteString ByteString IO TracebackScan
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment