Args.hs 4.89 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
185
186
187
188
189
190
191
192
193
194
195
196
197
          , "numabench"
          , "repoquality"
          , "excit"
          , "nrm"
          , "containers"
          , "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"
          ]