Args.hs 4.91 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 42 43
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)]
   , grafting  :: Grafting
   , sandboxing :: Sandboxing
44
   , offline    :: Bool
Valentin Reis's avatar
Valentin Reis committed
45 46 47 48 49 50 51 52 53 54 55 56 57
  } 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
                    | Target Text deriving (Eq)
data NixCommand = NixBuild | NixShell

instance Default ArgsCommon where
  def = ArgsCommon
58 59 60 61 62 63 64
    { verbosity       = Normal,
      argopkgs        = "<argopkgs>",
      run             = Nothing,
      overrides       = [],
      grafting        = NoGraft,
      sandboxing      = NoSandbox,
      offline         = False
Valentin Reis's avatar
Valentin Reis committed
65 66 67 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
    }

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."
    )
99 100 101 102
  offline <- flag
    False
    True
    (long "offline" <> short 'o' <> help "Do not use no binary caches.")
Valentin Reis's avatar
Valentin Reis committed
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164
  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
  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
  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

isTarget :: Text -> Bool
isTarget x = Target x `elem` nixStatic

nixStatic :: [NixStaticInOut]
nixStatic = src <> both <> simpletarget <> target
 where
  src = [Src "experiments"]
  both =
    Both
      <$> [ "aml"
          , "libnrm"
165
          , "dhrun"
Valentin Reis's avatar
Valentin Reis committed
166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184
          , "numabench"
          , "repoquality"
          , "excit"
          , "nrm"
          , "containers"
          , "amg"
          , "lammps"
          , "qmcpack"
          , "stream"
          , "openmc"
          , "argonix"
          ]
  simpletarget = SimpleTarget <$> ["numabench-check", "excit-check"]
  target =
    Target
      <$> [ "powerexpe"
          , "test"
          , "report"
          , "testHello"
Valentin Reis's avatar
Valentin Reis committed
185
          , "testRun"
Valentin Reis's avatar
Valentin Reis committed
186 187 188 189 190 191 192 193 194 195 196 197 198
          , "testListen"
          , "testListen"
          , "testHello"
          , "testListen"
          , "testPerfwrapper"
          , "testPower"
          , "testSTREAM"
          , "testAMG"
          , "testOpenMC"
          , "testLAMMPS"
          , "testQMCPack"
          , "testAll"
          ]