Args.hs 4.57 KB
Newer Older
Valentin Reis's avatar
Valentin Reis committed
1 2 3 4 5 6 7 8 9 10 11 12 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 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 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 99 100 101 102 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 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184
{-# language ApplicativeDo #-}
{-# language OverloadedStrings #-}
{-# language RecordWildCards #-}

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
  } 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
    { verbosity  = Normal,
      argopkgs   = "<argopkgs>",
      run        = Nothing,
      overrides  = [],
      grafting   = NoGraft,
      sandboxing = NoSandbox
    }

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."
    )
  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"
          , "numabench"
          , "repoquality"
          , "excit"
          , "nrm"
          , "containers"
          , "argotk"
          , "amg"
          , "lammps"
          , "qmcpack"
          , "stream"
          , "openmc"
          , "argonix"
          ]
  simpletarget = SimpleTarget <$> ["numabench-check", "excit-check"]
  target =
    Target
      <$> [ "powerexpe"
          , "test"
          , "report"
          , "testHello"
          , "testListen"
          , "testListen"
          , "testHello"
          , "testListen"
          , "testPerfwrapper"
          , "testPower"
          , "testSTREAM"
          , "testAMG"
          , "testOpenMC"
          , "testLAMMPS"
          , "testQMCPack"
          , "testAll"
          ]