Args.hs 5.58 KB
Newer Older
Valentin Reis's avatar
Valentin Reis committed
1 2 3 4
{-# language ApplicativeDo #-}
{-# language OverloadedStrings #-}
{-# language RecordWildCards #-}

Valentin Reis's avatar
Valentin Reis committed
5 6 7 8 9 10 11 12
{-|
Module      : Argonix
Description : argonix
Copyright   : (c) Valentin Reis, 2018
License     : MIT
Maintainer  : fre@freux.fr
-}

Valentin Reis's avatar
Valentin Reis committed
13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41
module Args
  ( ArgsCommon(..)
  , ArgsRemote(..)
  , Verbosity(..)
  , NixCommand(..)
  , Grafting(..)
  , Sandboxing(..)
  , commonParser
  , remoteParser
  , targets
  , isTarget
  )
where

import           Data.Default
import           Protolude
import           Options.Applicative


data ArgsRemote = ArgsRemote
  {  targetMachine
   , retreive
   , retreiveAs    :: Maybe Text
  } deriving (Show)
data ArgsCommon = ArgsCommon
  { argopkgs   :: Text
   , verbosity :: Verbosity
   , run       :: Maybe Text
   , overrides :: [(Text, Text)]
Valentin Reis's avatar
Valentin Reis committed
42
   , overrideAs :: [(Text, Text)]
Valentin Reis's avatar
Valentin Reis committed
43 44
   , grafting  :: Grafting
   , sandboxing :: Sandboxing
45
   , offline    :: Bool
Valentin Reis's avatar
Valentin Reis committed
46 47 48 49 50 51 52 53
  } deriving (Show)
data Verbosity = Verbose | Normal deriving (Show, Eq)
data Sandboxing = Sandbox | NoSandbox deriving (Show, Eq)
data Grafting = Libnrm | NoGraft deriving (Show, Eq)

data NixStaticInOut = Both Text
                    | Src Text
                    | SimpleTarget Text
Valentin Reis's avatar
Valentin Reis committed
54
                    | StringArg Text
Valentin Reis's avatar
Valentin Reis committed
55
                    | Target Text deriving (Eq)
56
data NixCommand = NixBuild | NixShell | NixTest deriving (Eq)
Valentin Reis's avatar
Valentin Reis committed
57 58 59

instance Default ArgsCommon where
  def = ArgsCommon
60 61 62 63
    { verbosity       = Normal,
      argopkgs        = "<argopkgs>",
      run             = Nothing,
      overrides       = [],
Valentin Reis's avatar
Valentin Reis committed
64
      overrideAs       = [],
65 66 67
      grafting        = NoGraft,
      sandboxing      = NoSandbox,
      offline         = False
Valentin Reis's avatar
Valentin Reis committed
68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
    }

instance Default ArgsRemote where
  def = ArgsRemote
    { targetMachine = Nothing,
      retreive      = Nothing,
      retreiveAs    = Nothing
    }

remoteParser :: Parser ArgsRemote
remoteParser = do
  retreive <- optional $ strOption
    (long "retreive" <> metavar "RELATIVE_PATH" <> help
      "File/Folder to retreive from the remote machine."
    )
  retreiveAs <- optional $ strOption
    (long "retreiveAs" <> metavar "LOCAL_PATH" <> help
      "File/Folder to save retreived data as (locally)."
    )
  targetMachine <- optional $ strOption
    (long "target_machine" <> metavar "USER@HOST" <> help
      "Target machine. defaults to localhost via forking."
    )
  pure ArgsRemote {..}

commonParser :: Parser ArgsCommon
commonParser = do
  argopkgs <- strOption
    (  long "argopkgs"
    <> metavar "ARGOPKGS"
    <> showDefault
    <> value (argopkgs def)
    <> help "Nix expression that produces the argopkgs source path."
    )
102 103 104 105
  offline <- flag
    False
    True
    (long "offline" <> short 'o' <> help "Do not use no binary caches.")
Valentin Reis's avatar
Valentin Reis committed
106 107 108 109 110 111 112 113 114 115 116 117 118 119 120
  verbosity <- flag
    Normal
    Verbose
    (long "verbose" <> short 'v' <> help "Enable verbose mode")
  sandboxing <- flag
    NoSandbox
    Sandbox
    (long "sandboxing" <> short 's' <> help "Enable nix sandboxing.")
  grafting <- flag
    NoGraft
    Libnrm
    (long "grafting" <> short 'g' <> help
      "Enable libnrm grafting to avoid rebuilding applications."
    )
  overrides <- catMaybes <$> ts
Valentin Reis's avatar
Valentin Reis committed
121
  overrideAs <- catMaybes <$> tsA
Valentin Reis's avatar
Valentin Reis committed
122 123 124 125 126 127 128 129 130 131 132 133 134 135 136
  run       <- optional $ strOption
    (long "run" <> metavar "COMMAND" <> help
      "Command to run the environment instead of an interactive shell"
    )
  pure ArgsCommon {..}
 where
  ts :: Parser [Maybe (Text, Text)]
  ts = traverse optSrc sources
  optSrc :: Text -> Parser (Maybe (Text, Text))
  optSrc longform = do
    parsed <- optional $ strOption
      (long (toS longform) <> metavar "PATH" <> help
        (toS longform <> " source folder override.")
      )
    pure $ mapT longform parsed
Valentin Reis's avatar
Valentin Reis committed
137 138 139 140 141 142 143 144 145 146 147 148

  tsA :: Parser [Maybe (Text, Text)]
  tsA = traverse optSrcA stringArgs
  optSrcA :: Text -> Parser (Maybe (Text, Text))
  optSrcA longform = do
    parsed <- optional $ strOption
      (long (toS longform) <> metavar "PATH" <> help
        (toS longform <> " string argument.")
      )
    pure $ mapT longform parsed


Valentin Reis's avatar
Valentin Reis committed
149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169
  mapT :: Text -> Maybe Text -> Maybe (Text, Text)
  mapT longform thePath = case thePath of
    Nothing -> Nothing
    Just p  -> Just (longform, p)


targets :: [Text]
targets = mapMaybe toTarget nixStatic
 where
  toTarget (Target       t) = Just t
  toTarget (SimpleTarget t) = Just t
  toTarget (Both         t) = Just t
  toTarget _                = Nothing

sources :: [Text]
sources = mapMaybe toSrc nixStatic
 where
  toSrc (Src  t) = Just t
  toSrc (Both t) = Just t
  toSrc _        = Nothing

Valentin Reis's avatar
Valentin Reis committed
170 171 172 173 174 175
stringArgs :: [Text]
stringArgs = mapMaybe toSrc nixStatic
 where
  toSrc (StringArg t) = Just t
  toSrc _        = Nothing

Valentin Reis's avatar
Valentin Reis committed
176 177 178 179
isTarget :: Text -> Bool
isTarget x = Target x `elem` nixStatic

nixStatic :: [NixStaticInOut]
Valentin Reis's avatar
Valentin Reis committed
180
nixStatic = src <> both <> simpletarget <> target <> stringA
Valentin Reis's avatar
Valentin Reis committed
181 182 183 184 185 186
 where
  src = [Src "experiments"]
  both =
    Both
      <$> [ "aml"
          , "libnrm"
187
          , "dhrun"
Valentin Reis's avatar
Valentin Reis committed
188 189 190 191 192 193 194 195 196 197 198 199 200
          , "numabench"
          , "repoquality"
          , "excit"
          , "nrm"
          , "containers"
          , "amg"
          , "lammps"
          , "qmcpack"
          , "stream"
          , "openmc"
          , "argonix"
          ]
  simpletarget = SimpleTarget <$> ["numabench-check", "excit-check"]
Valentin Reis's avatar
Valentin Reis committed
201
  stringA = StringArg <$> ["genericTestName"]
Valentin Reis's avatar
Valentin Reis committed
202 203 204 205 206 207
  target =
    Target
      <$> [ "powerexpe"
          , "test"
          , "report"
          , "testHello"
Valentin Reis's avatar
Valentin Reis committed
208
          , "testRun"
Valentin Reis's avatar
Valentin Reis committed
209 210 211 212 213 214 215 216 217 218 219 220
          , "testListen"
          , "testListen"
          , "testHello"
          , "testListen"
          , "testPerfwrapper"
          , "testPower"
          , "testSTREAM"
          , "testAMG"
          , "testOpenMC"
          , "testLAMMPS"
          , "testQMCPack"
          , "testAll"
Valentin Reis's avatar
Valentin Reis committed
221
          , "testGeneric"
Valentin Reis's avatar
Valentin Reis committed
222
          ]