Commit e98124d9 authored by Valentin Reis's avatar Valentin Reis

refactor passes ghc.

parent 2a4f8320
Pipeline #6108 passed with stages
in 1 minute and 52 seconds
......@@ -36,18 +36,8 @@ import Argo.Types
import Data.Coerce ( coerce )
import Filesystem.Path ( (</>) )
import Control.Concurrent.Async
import Argo.Utils
import Control.Foldl as Fold
( length )
import Control.Monad ( mapM_
, filterM
)
import Data.Foldable ( for_ )
import Data.Maybe
import Data.Text as T
hiding ( empty )
import Data.Traversable ( for )
......@@ -124,10 +114,10 @@ cmdRunI
-> ProcessBehavior
-> Maybe (StackI, Instrumentation)
cmdRunI (AppName app) args (ContainerName cn) (ShareDir md) (ManifestName mn) vars pb
= Just (Run, ) <*> processBehaviorToI (setEnv (cast <$> vars) pp) pb
= Just (Run, ) <*> processBehaviorToI (setEnv (castArg <$> vars) pp) pb
where
argToText (AppArg a) = a
cast (EnvVar v, y) = (toS v, toS y)
castArg (EnvVar v, y) = (toS v, toS y)
pp =
proc "cmd"
$ toS
......@@ -190,16 +180,15 @@ runStack sa@StackArgs {..} = do
when (powercap /= None) $ do
user <- readProcessStdout_ (proc "whoami" [])
for_
[0, 1]
( chownPowercapFiles (toS user)
. ("/sys/devices/virtual/powercap/intel-rapl/intel-rapl:" <>)
)
for_ ([0, 1]::[Int]) $ \x ->
chownPowercapFiles (toS user)
$ "/sys/devices/virtual/powercap/intel-rapl/intel-rapl:"
<> show x
cleanLeftovers workingDirectory
runProcess (proc "mkdir" ["-p", toS wd]) >>= \case
ExitFailure n -> die $ "couldn't create " <> wd
ExitFailure _ -> die $ "couldn't create " <> wd
ExitSuccess -> return ()
iDaemon <- case daemon of
......@@ -222,11 +211,11 @@ runStack sa@StackArgs {..} = do
]
ilist = catMaybes milist
_ <- shell (coerce preludeCommand :: Text) empty >>= \case
ExitSuccess ->
when verbose $ putText ("Executed preludeCommand." <> repr preludeCommand)
ExitFailure _ ->
die ("failed to execute preludeCommand." <> repr preludeCommand)
_ <- runProcess (shell $ toS (coerce preludeCommand :: Text)) >>= \case
ExitSuccess -> when verbose $ putText
("Executed preludeCommand." <> toS (coerce preludeCommand :: Text))
ExitFailure _ -> die $ "failed to execute preludeCommand." <> toS
(coerce preludeCommand :: Text)
when verbose $ do
putText "Starting the following processes:"
......@@ -241,14 +230,14 @@ runStack sa@StackArgs {..} = do
putText
( "Processes cancelled due to termination of: "
<> repr (fst $ snd out)
<> show (fst $ snd out)
<> " with exit information: "
<> repr (snd $ snd out)
<> show (snd $ snd out)
)
tracebackList <- procsWithTracebacks ilist
r <- case snd out of
case snd out of
(_, Left (PatternMatched line)) -> case tracebackList of
[] -> return $ FoundMessage line
t -> return $ FoundTracebacks t
......@@ -258,12 +247,9 @@ runStack sa@StackArgs {..} = do
(TracebackScanOut tracebackOut)
(TracebackScanErr tracebackErr)
tracebackList
cd "../"
return r
where
chownPowercap user fn =
shell (format ("sudo chown " % s % ":" % s % " " % s) user user fn) empty
runProcess (shell $ toS ("sudo chown " <> user <> ":" <> user <> " " <> fn))
>>= \case
ExitSuccess -> printWarning $ "changed ownership on " <> fn
ExitFailure _ -> die $ "Couldn't change ownership on " <> fn
......
......@@ -38,7 +38,6 @@ import Data.ByteString as B
hiding ( empty )
import Data.Conduit
import Data.Conduit.Combinators as CC
import Prelude hiding ( Text )
import System.Console.ANSI
import System.Console.ANSI.Types ( Color )
import System.Posix.Signals ( installHandler
......@@ -76,14 +75,12 @@ colorShell color she = setC color *> she *> setC White
where setC c = liftIO $ setSGR [SetColor Foreground Dull c]
printInfo :: Text -> IO ()
printCommand :: Text -> IO ()
printError :: Text -> IO ()
printWarning :: Text -> IO ()
printSuccess :: Text -> IO ()
printTest :: Text -> IO ()
printInfo s = putText $ "info: " <> s <> "\n"
printCommand s = putText $ "running: " <> s <> "\n"
printWarning s = colorShell Yellow $ putText $ "warning: " <> s <> "\n"
printError s = colorShell Red $ putText $ "error: " <> s <> "\n"
printSuccess s = colorShell Green $ putText $ "success: " <> s <> "\n"
......@@ -211,9 +208,9 @@ withSinkFileNoBuffering filepath inner =
runI
:: WorkingDirectory -> Instrumentation
-> IO (Either MonitoringResult (ExitCode, TracebackScan, TracebackScan))
runI workingDirectory (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t) =
runI workDir (Instrumentation crProc (StdOutLog stdOut) (StdErrLog stdErr) t) =
try $ withConduitSinks stdOut stdErr $ \outSink errSink ->
withProcess (configureConduits workingDirectory crProc) $ \p ->
withProcess (configureConduits workDir crProc) $ \p ->
withAsyncConduitsOnProcess p outSink outTest errSink errTest waitEither
>>= \case
Left Clean -> (, Clean, Clean) <$> waitExitCode p
......
......@@ -18,11 +18,12 @@ import Protolude
import Data.Coerce ( coerce )
import Data.Foldable ( for_ )
import Argo.Stack
import Argo.Utils
import Argo.Types
import Argo.Args
import Turtle hiding (repr)
import Prelude hiding ( FilePath, show)
import Turtle hiding ( repr )
import Prelude hiding ( FilePath
, show
)
import Data.Default
import System.Environment
import Options.Applicative hiding ( action )
......@@ -224,8 +225,8 @@ configureTest RunQMCPack = mkRun updater "run QMCPack in the Argo stack."
{ app = AppName "mpirun"
, args = let tc = coerce (hwThreadCount sa) :: Int
(ShareDir dirn) = shareDir sa
Right inpath = toText (dirn </> "simple-H2O.xml")
in fmap AppArg ["-n", show tc, "qmcpack", inpath]
in fmap AppArg
["-n", show tc, "qmcpack", dirn <> "/simple-H2O.xml"]
}
configureTest RunAMG = mkRun updater "run AMG in the Argo stack."
......@@ -266,10 +267,17 @@ configureTest RunLAMMPS = mkRun updater "run LAMMPS in the argo stack."
where
updater sa = sa
{ app = AppName "mpirun"
, args =
let (ShareDir dirn) = shareDir sa
Right inpath = toText (dirn </> "modified.lj")
in fmap AppArg ["-n", "24", "-bind-to", "core", "lmp_mpi", "-i", inpath]
, args = let (ShareDir dirn) = shareDir sa
in fmap
AppArg
[ "-n"
, "24"
, "-bind-to"
, "core"
, "lmp_mpi"
, "-i"
, dirn <> "/modified.lj"
]
}
-- converting a run to a test.
......@@ -407,9 +415,8 @@ main = do
vars <- fmap (\(v, y) -> (EnvVar $ T.pack v, T.pack y)) <$> getEnvironment
hwlocTC <- single $ inshell "hwloc-calc machine:0 -N PU" empty
let a = def
{ shareDir = ShareDir $ decodeString argonixShare
{ shareDir = ShareDir $ toS argonixShare
, vars = vars
, hwThreadCount = HwThreadCount (read $ unpack $ lineToText hwlocTC)
}
parsed <- execParser (info (opts a <**> helper) idm)
parsed
join $ execParser (info (opts a <**> helper) idm)
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