Commit fffaf1dc authored by Valentin Reis's avatar Valentin Reis

Refactoring Power experiments.

parent 859dcbcd
Pipeline #4955 failed with stage
in 13 seconds
......@@ -12,7 +12,7 @@ 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, pretty-show
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, unliftio-core
hs-source-dirs: src
default-language: Haskell2010
ghc-options:
......
......@@ -27,7 +27,7 @@ data StackArgs = StackArgs
, cmdlistenprogress :: ProcessBehavior
, cmdlistenperformance :: ProcessBehavior
, cmdlistenpower :: ProcessBehavior
}
} deriving (Show)
{-data OutputFiles = OutputFiles FilePath FilePath-}
data Verbosity = Normal | Verbose deriving (Show,Read,Eq)
......@@ -82,10 +82,6 @@ parseExtendStackArgs sa = do
<> showDefault
<> value (app sa)
)
args <- many ( argument auto
( metavar "ARGS"
<> help "Application arguments."
))
containerName <- strOption
( long "container_name"
<> metavar "ARGO_CONTAINER_UUID"
......@@ -156,4 +152,6 @@ parseExtendStackArgs sa = do
<> showDefault
<> value (cmdlistenpower sa)
)
args <- some (argument str (metavar "ARGS" <> help "Application arguments."))
<|> pure (args sa)
pure StackArgs {..}
......@@ -170,7 +170,9 @@ data StackOutput =
data StackI = Daemon | Run | Listen | Progress | Power | Performance deriving (Show)
runStack :: StackArgs -> Shell StackOutput
runStack StackArgs {..} = do
runStack sa@StackArgs {..} = do
when (verbosity == Verbose) $ liftIO $ pPrint sa
CM.mapM_
cleanSocket
[ "/tmp/nrm-downstream-in"
......
{-# LANGUAGE LambdaCase, OverloadedStrings, DataKinds,
FlexibleInstances, TypeOperators #-}
FlexibleInstances, ScopedTypeVariables, TypeOperators #-}
module Argo.Utils where
......@@ -14,11 +14,20 @@ import Data.Conduit
import Data.Conduit.Process hiding ( shell )
import Data.ByteString as B
hiding ( empty )
import System.IO ( BufferMode(NoBuffering)
, hSetBuffering
)
import Control.Monad.IO.Unlift ( MonadIO(..)
, MonadUnliftIO
, withRunInIO
)
import Data.Text.Encoding as TE
import Data.Conduit.Combinators as CC
import Control.Exception.Base
import Data.Typeable
import Data.Text as T
import qualified System.IO as IO
-- | Miscellaneous printing utilities
colorShell :: Color -> Shell () -> Shell ()
......@@ -81,8 +90,7 @@ 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
verboseShell' command i = printCommand command >> shellStrictWithErr command i
cleanSocket :: FilePath -> Shell ()
cleanSocket = sudoRemoveFile printError "socket"
......@@ -107,13 +115,12 @@ runI (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t) = try
(reroutedDaemon crProc)
where
reroutedDaemon process =
withSinkFile (T.unpack stdOut)
$ \outSink ->
withSinkFile (T.unpack stdErr) $ \errSink -> sourceProcessWithStreams
process
mempty
(makeMatcher t .| outSink)
(makeMatcher t .| errSink)
withSinkFileNoBuffering (T.unpack stdOut) $ \outSink ->
withSinkFile (T.unpack stdErr) $ \errSink -> sourceProcessWithStreams
process
mempty
(makeMatcher t .| outSink)
(makeMatcher t .| errSink)
makeMatcher maybeMessage = case maybeMessage of
Just (TestText msg) -> untilMatch msg
Nothing -> awaitForever yield
......@@ -128,8 +135,19 @@ runI (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t) = try
untilMatch message
_ -> return ()
withSinkFileNoBuffering
:: (MonadUnliftIO m, MonadIO n)
=> IO.FilePath
-> (ConduitM ByteString o n () -> m a)
-> m a
withSinkFileNoBuffering filepath inner =
withRunInIO $ \run -> IO.withBinaryFile filepath IO.WriteMode $ \h -> do
hSetBuffering h NoBuffering
run $ inner $ sinkHandle h
processBehaviorToI :: CreateProcess -> ProcessBehavior -> Maybe Instrumentation
processBehaviorToI crProc = \case
DontRun -> Nothing
JustRun stdOut stdErr -> Just $ Instrumentation crProc stdOut stdErr Nothing
SucceedTestOnMessage t stdOut stdErr -> Just $ Instrumentation crProc stdOut stdErr (Just t)
DontRun -> Nothing
JustRun stdOut stdErr -> Just $ Instrumentation crProc stdOut stdErr Nothing
SucceedTestOnMessage t stdOut stdErr ->
Just $ Instrumentation crProc stdOut stdErr (Just t)
#! /usr/bin/env runhaskell
{-# LANGUAGE OverloadedStrings, RecordWildCards, LambdaCase #-}
import Argo.Stack
......@@ -17,7 +16,7 @@ opts :: StackArgs -> Parser (Shell ())
opts sa = hsubparser
( command "clean"
(info (pure $ clean sa) (progDesc "Clean sockets, logfiles."))
<> (mconcat $ fmap commandTest [(minBound :: TestType) ..])
<> mconcat (fmap commandTest [(minBound :: TestType) ..])
<> commandTests [TestHello, TestListen, TestPerfwrapper]
"tests"
"Run hardware-independent CI tests"
......@@ -42,7 +41,8 @@ data TestType =
| TestHello
| TestListen
| TestPerfwrapper
| TestPower deriving (Enum,Bounded,Show)
| TestPower
| TestAMG deriving (Enum,Bounded,Show)
data TestSpec = TestSpec
{ stackArgsUpdate :: StackArgs -> StackArgs
......@@ -78,12 +78,14 @@ configureTest = \case
}
CsvLogs -> TestSpec
{ stackArgsUpdate = \sa -> sa
{ manifestName = "perfwrap.json"
, daemon = daemonBehavior
, cmdrun = runBehavior
{ manifestName = "perfwrap.json"
, daemon = daemonBehavior
, cmdrun = runBehavior
, cmdlistenperformance = JustRun (StdOutLog "performance.csv")
(StdErrLog "performance.log")
, cmdlistenpower = JustRun (StdOutLog "power.csv") (StdErrLog "power.log")
, cmdlistenprogress = JustRun (StdOutLog "progress.csv")
(StdErrLog "progress.log")
}
, description = "Set up and start daemon, run a command in a container."
, isTest = IsTest False
......@@ -140,6 +142,34 @@ configureTest = \case
\ daemon."
, isTest = IsTest True
}
TestAMG -> TestSpec
{ stackArgsUpdate = \sa -> sa
{ app = AppName "mpiexec"
, args = [ AppArg "-n"
, AppArg "24"
, AppArg "-problem"
, AppArg "2"
, AppArg "-n"
, AppArg "1"
, AppArg "1"
, AppArg "1"
, AppArg "-P"
, AppArg "8"
, AppArg "3"
, AppArg "1"
]
, manifestName = "perfwrap.json"
, daemon = daemonBehavior
, cmdrun = runBehavior
, cmdlistenperformance = JustRun (StdOutLog "performance.csv")
(StdErrLog "performance.log")
, cmdlistenpower = JustRun (StdOutLog "power.csv") (StdErrLog "power.log")
, cmdlistenprogress = JustRun (StdOutLog "progress.csv")
(StdErrLog "progress.log")
}
, description = "Set up and start daemon, run a command in a container."
, isTest = IsTest False
}
where
msg = "someComplicatedMessage"
daemonBehavior =
......@@ -165,7 +195,7 @@ fullStack (IsTest b) a@StackArgs {..} = runStack a >>= \case
<> "\n"
)
>> exit (ExitFailure 1)
else exit (ExitSuccess)
else exit ExitSuccess
clean :: StackArgs -> Shell ()
clean StackArgs {..} = cleanLeftovers workingDirectory
......
{
argopkgs-src ? ../argopkgs,
#let
#hostPkgs = import <nixpkgs> {};
#pinnedVersion = hostPkgs.lib.importJSON ./pin.json;
#in
#hostPkgs.fetchgit {
#inherit (pinnedVersion) url rev sha256;
#},
argopkgs-src ?
let
hostPkgs = import <nixpkgs> {};
pinnedVersion = hostPkgs.lib.importJSON ./pin.json;
in
hostPkgs.fetchgit {
inherit (pinnedVersion) url rev sha256;
},
pkgs ? import argopkgs-src {},
nrm-src ? pkgs.nodelevel.nrm.src,
containers-src ? pkgs.nodelevel.containers.src,
libnrm-src ? pkgs.nodelevel.libnrm.src
libnrm-src ? pkgs.nodelevel.libnrm.src,
amg-src ? pkgs.applications.nrm.amg.src
}:
let
filterHdevTools = builtins.filterSource (path: type: baseNameOf path != ".hdevtools.sock");
......@@ -72,7 +73,7 @@ in rec
nrm = (pkgs.nodelevel.nrm.overrideAttrs (old: { src = nrm-src; })).override{};
libnrm = pkgs.nodelevel.libnrm.overrideAttrs (old: { src = libnrm-src; });
containers = pkgs.nodelevel.containers.overrideAttrs (old: { src = containers-src; });
amg = pkgs.applications.nrm.amg.override {libnrm=libnrm;};
amg = (pkgs.applications.nrm.amg.overrideAttrs (old: {src = amg-src;})).override {libnrm=libnrm;};
inherit(hpkgs) argo argotk;
......
......@@ -41,6 +41,7 @@ nrm.build:
- _output/nrm.log
- _output/.argo_nodeos_config_exit_message
expire_in: 1 week
when: always
except:
- /^wip\/.*/
- /^WIP\/.*/
......
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