[refactor] split out types, apply warnings. adds --powercap option.

src/Argo.hs

@@ -10,9 +10,11 @@ module Argo
   ( module Argo.Stack
   , module Argo.Args
   , module Argo.Utils
+  , module Argo.Types
   )
 where
 
 import           Argo.Stack
 import           Argo.Utils
 import           Argo.Args
+import           Argo.Types

src/Argo/Args.hs

 {-# language OverloadedStrings #-}
 {-# language ApplicativeDo #-}
-{-# language GeneralizedNewtypeDeriving #-}
 {-# language RecordWildCards #-}
 
 module Argo.Args
-  ( StdOutLog(..)
-  , StdErrLog(..)
-  , TestText(..)
-  , ProcessBehavior(..)
-  , TextBehavior(..)
-  , TextBehaviorStdout(..)
-  , TextBehaviorStderr(..)
-  , WorkingDirectory(..)
-  , Verbosity(..)
-  , AppName(..)
-  , AppArg(..)
-  , ContainerName(..)
-  , ShareDir(..)
-  , ManifestName(..)
-  , StackArgs(..)
-  , PreludeCommand(..)
-  , HwThreadCount(..)
-  , parseExtendStackArgs
+  ( parseExtendStackArgs
   )
 where
 
+import           Argo.Types
 import           Options.Applicative           as OA
 import           Options.Applicative.Types
 import           Options.Applicative.Builder    ( option )
-import           Data.Default
-import           Data.Text                     as T
-                                         hiding ( empty )
-
 import           Turtle                  hiding ( option )
 import           Prelude                 hiding ( FilePath )
-
 {-|
 Module      : Argo.Args
 Description : Argo stack library
@@ -43,72 +21,11 @@ License     : MIT
 Maintainer  : fre@freux.fr
 -}
 
-data StackArgs = StackArgs
-  { verbosity              :: Verbosity
-  , app                    :: AppName
-  , args                   :: [AppArg]
-  , containerName          :: ContainerName
-  , workingDirectory       :: WorkingDirectory
-  , shareDir               :: ShareDir
-  , manifestName           :: ManifestName
-  , preludeCommand         :: PreludeCommand
-  , daemon
-  , cmdrun
-  , cmdlisten
-  , cmdlistenprogress
-  , cmdlistenperformance
-  , cmdlistenpower         :: ProcessBehavior
-  , hwThreadCount          :: HwThreadCount
-  } deriving (Show)
-
-{-data OutputFiles = OutputFiles FilePath FilePath-}
-data Verbosity = Normal | Verbose deriving (Show, Read, Eq)
-newtype HwThreadCount = HwThreadCount Int deriving (Show, Read, Eq)
-newtype AppArg = AppArg Text deriving (IsString, Show, Read)
-newtype WorkingDirectory = WorkingDirectory FilePath deriving (IsString, Show)
-newtype AppName = AppName Text deriving (IsString, Show, Read)
-newtype ContainerName = ContainerName Text deriving (IsString, Show, Read)
-newtype ShareDir = ShareDir FilePath deriving (IsString, Show)
-newtype ManifestName = ManifestName FilePath deriving (IsString, Show)
-newtype PreludeCommand = PreludeCommand Text deriving (IsString, Show, Read)
-data ProcessBehavior =
-     Test TestText StdOutLog StdErrLog
-   | JustRun StdOutLog StdErrLog
-   | DontRun deriving (Show,Read)
-
-newtype StdOutLog = StdOutLog Text deriving (Show, Read)
-newtype StdErrLog = StdErrLog Text deriving (Show, Read)
-data TestText = TestText TextBehaviorStdout TextBehaviorStderr deriving (Show, Read)
-newtype TextBehaviorStdout = TextBehaviorStdout TextBehavior deriving (Show, Read)
-newtype TextBehaviorStderr = TextBehaviorStderr TextBehavior deriving (Show, Read)
-data TextBehavior =
-    WaitFor Text
-  | ExpectClean deriving (Show,Read)
-
 behavior :: ReadM ProcessBehavior
 behavior = read <$> readerAsk
 behaviorOption :: Mod OptionFields ProcessBehavior -> Parser ProcessBehavior
 behaviorOption = option behavior
 
-instance Default StackArgs where
-  def = StackArgs
-    { verbosity = Normal
-    , app = AppName "ls"
-    , args = []
-    , containerName = ContainerName "testContainer"
-    , workingDirectory = WorkingDirectory "_output"
-    , shareDir = ShareDir "/tmp"
-    , manifestName = ManifestName "basic.json"
-    , preludeCommand = PreludeCommand ""
-    , daemon = DontRun
-    , cmdrun = DontRun
-    , cmdlisten = DontRun
-    , cmdlistenprogress = DontRun
-    , cmdlistenperformance = DontRun
-    , cmdlistenpower = DontRun
-    , hwThreadCount = HwThreadCount 1
-    }
-
 parseExtendStackArgs :: StackArgs -> Parser StackArgs
 parseExtendStackArgs sa = do
   verbosity <- flag
@@ -207,6 +124,14 @@ parseExtendStackArgs sa = do
     <> showDefault
     <> value (hwThreadCount sa)
     )
+  powercap <- option
+    auto
+    (  long "powercap"
+    <> metavar "POWERCAP"
+    <> help "Powercap strategy: Fixed x | None | Adaptive"
+    <> showDefault
+    <> value (powercap sa)
+    )
   args <- some (argument str (metavar "ARGS" <> help "Application arguments."))
     <|> pure (args sa)
   pure StackArgs {..}

src/Argo/Stack.hs

@@ -18,7 +18,7 @@ module Argo.Stack
   )
 where
 
-import           Argo.Args
+import           Argo.Types
 
 import           Data.Coerce                    ( coerce )
 import           Turtle
@@ -57,15 +57,16 @@ prepareDaemon
   -> StdErrLog
   -> Maybe TestText
   -> Verbosity
+  -> PowerCap
   -> Shell Instrumentation
-prepareDaemon out stdErr test v = do
+prepareDaemon out stdErr test v powercap = do
   _ <- myWhich "daemon"
   let confPath' = "/tmp/argo_nodeos_config"
   cleanContainers confPath' 1 2
   export "ARGO_NODEOS_CONFIG" (format fp confPath')
   return $ Instrumentation
     (P.proc "daemon"
-            (["--nrm_log", "./nrm_log"] ++ [ "--verbose" | v == Verbose ])
+            (["--nrm_log", "./nrm_log"] ++ toOption v ++ toOption powercap)
     )
     out
     stdErr
@@ -105,16 +106,16 @@ prepareDaemon out stdErr test v = do
               if len > 0
                 then do
                   printWarning
-                    "the argo_nodeos_config call did not remove containers, \
-                    \at least not fast enough. Retrying.."
+                    $  "the argo_nodeos_config call did not remove containers, "
+                    <> "at least not fast enough. Retrying.."
                   liftIO $ sleep retryTime
                   cleanContainers argo_nodeos_config
                                   (retryTime * 2)
                                   (remainingRetries - 1)
                 else
                   printInfo
-                    "argo_nodeos_config successfully cleaned the container \
-                    \config."
+                  $  "argo_nodeos_config successfully cleaned the container "
+                  <> "config."
 
 cmdRunI
   :: AppName
@@ -198,9 +199,11 @@ runStack sa@StackArgs {..} = do
   iDaemon <- case daemon of
     DontRun -> return Nothing
     JustRun stdOut stdErr ->
-      (\i -> Just (Daemon, i)) <$> prepareDaemon stdOut stdErr Nothing verbosity
+      (\i -> Just (Daemon, i))
+        <$> prepareDaemon stdOut stdErr Nothing verbosity powercap
     Test t stdOut stdErr ->
-      (\i -> Just (Daemon, i)) <$> prepareDaemon stdOut stdErr (Just t) Verbose
+      (\i -> Just (Daemon, i))
+        <$> prepareDaemon stdOut stdErr (Just t) Verbose powercap
 
   let milist =
         [ iDaemon

src/Argo/Types.hs

+{-# language GeneralizedNewtypeDeriving #-}
+{-# language OverloadedStrings #-}
+
+module Argo.Types
+  ( StdOutLog(..)
+  , StdErrLog(..)
+  , TestText(..)
+  , ProcessBehavior(..)
+  , TextBehavior(..)
+  , TextBehaviorStdout(..)
+  , TextBehaviorStderr(..)
+  , WorkingDirectory(..)
+  , Verbosity(..)
+  , AppName(..)
+  , AppArg(..)
+  , ContainerName(..)
+  , ShareDir(..)
+  , ManifestName(..)
+  , StackArgs(..)
+  , PreludeCommand(..)
+  , HwThreadCount(..)
+  , PowerCap(..)
+  , toOption
+  )
+where
+
+import           Data.Default
+import           Data.Text                     as T
+                                         hiding ( empty )
+import           Turtle                  hiding ( option )
+import           Prelude                 hiding ( FilePath )
+
+data StackArgs = StackArgs
+  { verbosity              :: Verbosity
+  , app                    :: AppName
+  , args                   :: [AppArg]
+  , containerName          :: ContainerName
+  , workingDirectory       :: WorkingDirectory
+  , shareDir               :: ShareDir
+  , manifestName           :: ManifestName
+  , preludeCommand         :: PreludeCommand
+  , daemon
+  , cmdrun
+  , cmdlisten
+  , cmdlistenprogress
+  , cmdlistenperformance
+  , cmdlistenpower         :: ProcessBehavior
+  , hwThreadCount          :: HwThreadCount
+  , powercap               :: PowerCap
+  } deriving (Show)
+
+{-data OutputFiles = OutputFiles FilePath FilePath-}
+data Verbosity = Normal | Verbose deriving (Show, Read, Eq)
+newtype HwThreadCount = HwThreadCount Int deriving (Show, Read, Eq)
+newtype AppArg = AppArg Text deriving (IsString, Show, Read)
+newtype WorkingDirectory = WorkingDirectory FilePath deriving (IsString, Show)
+newtype AppName = AppName Text deriving (IsString, Show, Read)
+newtype ContainerName = ContainerName Text deriving (IsString, Show, Read)
+newtype ShareDir = ShareDir FilePath deriving (IsString, Show)
+newtype ManifestName = ManifestName FilePath deriving (IsString, Show)
+newtype PreludeCommand = PreludeCommand Text deriving (IsString, Show, Read)
+data ProcessBehavior =
+     Test TestText StdOutLog StdErrLog
+   | JustRun StdOutLog StdErrLog
+   | DontRun deriving (Show,Read)
+newtype StdOutLog = StdOutLog Text deriving (Show, Read)
+newtype StdErrLog = StdErrLog Text deriving (Show, Read)
+data TestText = TestText TextBehaviorStdout TextBehaviorStderr deriving (Show, Read)
+newtype TextBehaviorStdout = TextBehaviorStdout TextBehavior deriving (Show, Read)
+newtype TextBehaviorStderr = TextBehaviorStderr TextBehavior deriving (Show, Read)
+data TextBehavior =
+    WaitFor Text
+  | ExpectClean deriving (Show,Read)
+data PowerCap = Fixed Int | Adaptive | None deriving (Show, Read)
+
+class ToDaemonOption a where
+  toOption :: a -> [String]
+
+instance ToDaemonOption Verbosity where
+  toOption Verbose = ["--verbose"]
+  toOption Normal = []
+
+instance ToDaemonOption PowerCap where
+  toOption (Fixed i) = ["--powercap", show i]
+  toOption Adaptive = []
+  toOption None = []
+
+instance Default StackArgs where
+  def = StackArgs
+    { verbosity = Normal
+    , app = AppName "ls"
+    , args = []
+    , containerName = ContainerName "testContainer"
+    , workingDirectory = WorkingDirectory "_output"
+    , shareDir = ShareDir "/tmp"
+    , manifestName = ManifestName "basic.json"
+    , preludeCommand = PreludeCommand ""
+    , daemon = DontRun
+    , cmdrun = DontRun
+    , cmdlisten = DontRun
+    , cmdlistenprogress = DontRun
+    , cmdlistenperformance = DontRun
+    , cmdlistenpower = DontRun
+    , hwThreadCount = HwThreadCount 1
+    , powercap = None
+    }
+

src/Argo/Utils.hs

@@ -31,7 +31,7 @@ module Argo.Utils
   )
 where
 
-import           Argo.Args
+import           Argo.Types
 import           Turtle
 import           Prelude                 hiding ( FilePath )
 import           System.Console.ANSI

src/argotk.hs

@@ -12,6 +12,7 @@ Maintainer  : fre@freux.fr
 import           Data.Coerce                    ( coerce )
 import           Argo.Stack
 import           Argo.Utils
+import           Argo.Types
 import           Argo.Args
 import           Turtle
 import           Prelude                 hiding ( FilePath )
@@ -65,10 +66,7 @@ instance Default TestSpec where
 --------------------------------------------------------------------------------
 
 mkRun :: (StackArgs -> StackArgs) -> Text -> TestSpec
-mkRun updater description = TestSpec
-  { stackArgsUpdate = updater . runAppSA
-  , ..
-  }
+mkRun updater description = TestSpec {stackArgsUpdate = updater . runAppSA, ..}
  where
   isTest = NotTest
   runAppSA sa = sa { manifestName         = "parallel.json"
@@ -178,8 +176,7 @@ configureTest TestPower = TestSpec
 
 configureTest TestSTREAM =
   testProgressFromRun RunSTREAM "Test STREAM progress reports."
-configureTest TestAMG =
-  testProgressFromRun RunAMG "Test AMG progress reports."
+configureTest TestAMG = testProgressFromRun RunAMG "Test AMG progress reports."
 configureTest TestQMCPack =
   testProgressFromRun RunQMCPack "Test QMCPack progress reports."
 configureTest TestOpenMC =
@@ -282,18 +279,18 @@ testProgressFromRun :: TestName -> Text -> TestSpec
 testProgressFromRun = testFromRun updater
  where
   updater sa = sa
-    { cmdlistenprogress = Test
-                            (TestText
-                              (TextBehaviorStdout (WaitFor "progress"))
-                              (TextBehaviorStderr ExpectClean)
-                            )
-                            (StdOutLog "progress_stdout.csv")
-                            (StdErrLog "progress_stderr.log")
-    , cmdlistenpower = DontRun
-    , cmdlisten = DontRun
+    { cmdlistenprogress    = Test
+                               (TestText
+                                 (TextBehaviorStdout (WaitFor "progress"))
+                                 (TextBehaviorStderr ExpectClean)
+                               )
+                               (StdOutLog "progress_stdout.csv")
+                               (StdErrLog "progress_stderr.log")
+    , cmdlistenpower       = DontRun
+    , cmdlisten            = DontRun
     , cmdlistenperformance = DontRun
-    , manifestName = "basic.json"
-    , hwThreadCount = HwThreadCount 2
+    , manifestName         = "basic.json"
+    , hwThreadCount        = HwThreadCount 2
     }
 
 -- parsing and building the shell monad