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 as OA
import Options.Applicative.Types import Options.Applicative.Types
......
{-# language TupleSections #-} {-# language TupleSections #-}
{-# language ViewPatterns #-}
{-# language LambdaCase #-} {-# language LambdaCase #-}
{-# language RecordWildCards #-} {-# language RecordWildCards #-}
{-# language OverloadedStrings #-} {-# language OverloadedStrings #-}
...@@ -12,7 +11,13 @@ License : MIT ...@@ -12,7 +11,13 @@ License : MIT
Maintainer : fre@freux.fr Maintainer : fre@freux.fr
-} -}
module Argo.Stack where module Argo.Stack
( StackOutput(..)
, cleanLeftovers
, runStack
)
where
import Argo.Args import Argo.Args
import Data.Coerce ( coerce ) import Data.Coerce ( coerce )
...@@ -59,11 +64,8 @@ prepareDaemon out stdErr test v = do ...@@ -59,11 +64,8 @@ prepareDaemon out stdErr test v = do
cleanContainers confPath' 1 2 cleanContainers confPath' 1 2
export "ARGO_NODEOS_CONFIG" (format fp confPath') export "ARGO_NODEOS_CONFIG" (format fp confPath')
return $ Instrumentation return $ Instrumentation
(P.proc (P.proc "daemon"
"daemon" (["--nrm_log", "./nrm_log"] ++ [ "--verbose" | v == Verbose ])
( ["--nrm_log", "./nrm_log"]
++ (if (v == Verbose) then ["--verbose"] else [])
)
) )
out out
stdErr stdErr
...@@ -187,16 +189,16 @@ instance Show StackI where ...@@ -187,16 +189,16 @@ instance Show StackI where
Performance -> "cmd listen -f performance" Performance -> "cmd listen -f performance"
runStack :: StackArgs -> Shell StackOutput runStack :: StackArgs -> Shell StackOutput
runStack sa@StackArgs { verbosity = (==Verbose) -> verbose, ..} = do runStack sa@StackArgs {..} = do
when verbose $ liftIO $ pPrint sa when verbose $ liftIO $ pPrint sa
cleanLeftovers workingDirectory cleanLeftovers workingDirectory
CM.mapM_ ($ (coerce workingDirectory)) [mktree, cd] CM.mapM_ ($ coerce workingDirectory) [mktree, cd]
iDaemon <- case daemon of iDaemon <- case daemon of
DontRun -> return Nothing DontRun -> return Nothing
JustRun stdOut stdErr -> 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 -> Test t stdOut stdErr ->
(\i -> Just (Daemon, i)) <$> prepareDaemon stdOut stdErr (Just t) Verbose (\i -> Just (Daemon, i)) <$> prepareDaemon stdOut stdErr (Just t) Verbose
...@@ -250,6 +252,7 @@ runStack sa@StackArgs { verbosity = (==Verbose) -> verbose, ..} = do ...@@ -250,6 +252,7 @@ runStack sa@StackArgs { verbosity = (==Verbose) -> verbose, ..} = do
cd "../" cd "../"
return r return r
where where
verbose = verbosity == Verbose
procsWithTracebacks procsWithTracebacks
:: [(StackI, Instrumentation)] -> Shell [(StackI, Text, Text)] :: [(StackI, Instrumentation)] -> Shell [(StackI, Text, Text)]
procsWithTracebacks ilist = fmap showOutputs <$> filterM (checkI . snd) ilist procsWithTracebacks ilist = fmap showOutputs <$> filterM (checkI . snd) ilist
......
{-# LANGUAGE LambdaCase, OverloadedStrings, DataKinds, {-# language LambdaCase #-}
FlexibleInstances, ScopedTypeVariables, TypeOperators #-} {-# language OverloadedStrings #-}
{-# language DataKinds #-}
{-# language FlexibleInstances #-}
{-# language ScopedTypeVariables #-}
{-# language TypeOperators #-}
{-| {-|
Module : Argo.Utils Module : Argo.Utils
...@@ -9,7 +13,23 @@ License : MIT ...@@ -9,7 +13,23 @@ License : MIT
Maintainer : fre@freux.fr 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 Argo.Args
import Turtle import Turtle
...@@ -47,7 +67,6 @@ printError :: Text -> Shell () ...@@ -47,7 +67,6 @@ printError :: Text -> Shell ()
printWarning :: Text -> Shell () printWarning :: Text -> Shell ()
printSuccess :: Text -> Shell () printSuccess :: Text -> Shell ()
printTest :: Text -> Shell () printTest :: Text -> Shell ()
dieRed :: Text -> Shell ()
printInfo = printf ("Info: " % s % "\n") printInfo = printf ("Info: " % s % "\n")
printCommand = printf ("Running: " % s % "\n") printCommand = printf ("Running: " % s % "\n")
...@@ -55,8 +74,6 @@ printWarning = colorShell Yellow . printf ("Warning: " % s % "\n") ...@@ -55,8 +74,6 @@ printWarning = colorShell Yellow . printf ("Warning: " % s % "\n")
printError = colorShell Red . printf ("Error: " % s % "\n") printError = colorShell Red . printf ("Error: " % s % "\n")
printSuccess = colorShell Green . printf ("Success: " % s % "\n") printSuccess = colorShell Green . printf ("Success: " % s % "\n")
printTest = colorShell Green . printf ("RUNNING TEST: " % 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 :: FilePath -> Shell FilePath
myWhich str = which str >>= \case myWhich str = which str >>= \case
...@@ -64,12 +81,6 @@ myWhich str = which str >>= \case ...@@ -64,12 +81,6 @@ myWhich str = which str >>= \case
printInfo (format ("Found " % fp % " at " % fp) str p) >> return p printInfo (format ("Found " % fp % " at " % fp) str p) >> return p
Nothing -> die $ format ("Argo `" % fp % "` not in $PATH.") str 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 :: (Text -> Shell ()) -> Text -> FilePath -> Shell ()
sudoRemoveFile printer desc filePath = do sudoRemoveFile printer desc filePath = do
foundSocket <- testfile filePath foundSocket <- testfile filePath
...@@ -93,16 +104,11 @@ sudoRemoveFile printer desc filePath = do ...@@ -93,16 +104,11 @@ sudoRemoveFile printer desc filePath = do
desc desc
go True 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' :: Text -> Shell Line -> Shell (ExitCode, Text, Text)
verboseShell' command i = printCommand command >> shellStrictWithErr command i verboseShell' command i = printCommand command >> shellStrictWithErr command i
cleanSocket :: FilePath -> Shell () cleanSocket :: FilePath -> Shell ()
cleanSocket = sudoRemoveFile printWarning "socket" cleanSocket = sudoRemoveFile printWarning "socket"
cleanLog :: FilePath -> Shell ()
cleanLog = sudoRemoveFile printWarning "log folder"
kbInstallHandler :: IO () -> IO Handler kbInstallHandler :: IO () -> IO Handler
kbInstallHandler h = installHandler keyboardSignal (Catch h) Nothing kbInstallHandler h = installHandler keyboardSignal (Catch h) Nothing
...@@ -142,7 +148,7 @@ runI (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t) = try ...@@ -142,7 +148,7 @@ runI (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t) = try
warnOnTraceback :: Bool -> ConduitT ByteString ByteString IO TracebackScan warnOnTraceback :: Bool -> ConduitT ByteString ByteString IO TracebackScan
warnOnTraceback sawTraceback = await >>= \case warnOnTraceback sawTraceback = await >>= \case
Just b | B.isInfixOf "Traceback" b -> yield b >> warnOnTraceback True 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 Nothing -> if sawTraceback then return WarningTraceback else return Clean
untilMatch :: Text -> Bool -> ConduitT ByteString ByteString IO TracebackScan 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