Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
A
argotest
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Valentin Reis
argotest
Commits
014360e9
Commit
014360e9
authored
Jan 09, 2019
by
Valentin Reis
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Refactored tests, added logging capabilities.
parent
fd233bbb
Pipeline
#4863
passed with stage
in 45 seconds
Changes
3
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
32 additions
and
6 deletions
+32
-6
argo/argo.cabal
argo/argo.cabal
+1
-1
argo/src/Argo/Args.hs
argo/src/Argo/Args.hs
+9
-2
argo/src/Argo/Stack.hs
argo/src/Argo/Stack.hs
+22
-3
No files found.
argo/argo.cabal
View file @
014360e9
...
...
@@ -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
argo/src/Argo/Args.hs
View file @
014360e9
...
...
@@ -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"
...
...
argo/src/Argo/Stack.hs
View file @
014360e9
...
...
@@ -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
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment