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