Commit 014360e9 authored by Valentin Reis's avatar Valentin Reis

Refactored tests, added logging capabilities.

parent fd233bbb
Pipeline #4863 passed with stage
in 45 seconds
......@@ -12,6 +12,6 @@ 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
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
hs-source-dirs: src
default-language: Haskell2010
......@@ -16,7 +16,8 @@ import System.Process hiding ( shell )
data OutputFiles = OutputFiles FilePath FilePath
data StackArgs = StackArgs
{ app :: AppName
{ verbosity :: Verbosity
, app :: AppName
, args :: AppArgs
, containerName :: ContainerName
, workingDirectory :: WorkingDirectory
......@@ -29,6 +30,7 @@ data StackArgs = StackArgs
, cmdlistenpower :: ProcessBehavior
}
data Verbosity = Normal | Verbose deriving (Show,Read,Eq)
newtype AppArgs = AppArgs [Text] deriving (Show, Read)
newtype WorkingDirectory = WorkingDirectory FilePath deriving (IsString, Show)
newtype AppName = AppName Text deriving (IsString, Show, Read)
......@@ -52,7 +54,8 @@ behaviorOption = option behavior
instance Default StackArgs where
def = StackArgs
{ app = AppName "ls"
{ verbosity = Verbose
, app = AppName "ls"
, args = AppArgs []
, containerName = ContainerName "testContainer"
, workingDirectory = WorkingDirectory "_output"
......@@ -67,6 +70,10 @@ instance Default StackArgs where
parseExtendStackArgs :: StackArgs -> Parser StackArgs
parseExtendStackArgs StackArgs {..} = do
verbosity <- flag
Normal
Verbose
(long "verbose" <> short 'v' <> help "Enable verbose mode")
app <- strOption
( long "application"
<> metavar "APP"
......
......@@ -44,6 +44,7 @@ import Data.ByteString.Char8 as C8
import Control.Exception.Base
import Data.Maybe
import Control.Foldl as Fold
import Text.Show.Pretty
cleanLeftovers :: WorkingDirectory -> Shell ()
cleanLeftovers (WorkingDirectory wd) = do
......@@ -133,7 +134,7 @@ prepareDaemon (StdOutLog out) (StdErrLog err) test = do
else
printInfo
"argo_nodeos_config successfully cleaned the container \
\config."
\config.\n"
cmdRunI
:: AppName
......@@ -205,12 +206,30 @@ runStack a@StackArgs {..} = do
]
ilist = catMaybes milist
if verbosity == Verbose
then do
printInfo "Starting the following processes:\n"
liftIO $ pPrint ilist
else liftIO $ pPrint (fmap fst ilist)
asyncs <- liftIO $ mapM tupleToAsync ilist
liftIO $ kbInstallHandler $ CM.mapM_ cancel asyncs
when (verbosity == Verbose) $ printInfo "Processes started.\n"
out <- liftIO $ waitAnyCancel asyncs
printInfo
( "Processes cancelled due to termination of: "
<> repr (fst $ snd out)
<> " with exit information: "
<> repr (snd $ snd out)
<> "\n"
)
return $ case snd out of
(_ , Left PatternMatched ) -> FoundMessage
(stacki, Right (e, _, _) ) -> Died stacki e
(_ , Left PatternMatched) -> FoundMessage
(stacki, Right (e, _, _) ) -> Died stacki e
where
tupleToAsync
:: (StackI, Instrumentation)
......
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