Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
A
argotk
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
argo
argotk
Commits
83ada183
Commit
83ada183
authored
Mar 04, 2019
by
Valentin Reis
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Refactor -> prepare for adding --powercap option
parent
16300a83
Pipeline
#5816
passed with stage
in 34 seconds
Changes
3
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
62 additions
and
30 deletions
+62
-30
src/Argo/Args.hs
src/Argo/Args.hs
+25
-2
src/Argo/Stack.hs
src/Argo/Stack.hs
+13
-10
src/Argo/Utils.hs
src/Argo/Utils.hs
+24
-18
No files found.
src/Argo/Args.hs
View file @
83ada183
{-# 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
...
...
src/Argo/Stack.hs
View file @
83ada183
{-# 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
...
...
src/Argo/Utils.hs
View file @
83ada183
{-# 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
...
...
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