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