Args.hs 4.36 KB
Newer Older
1
{-# language OverloadedStrings #-}
Valentin Reis's avatar
Valentin Reis committed
2 3 4 5 6 7 8 9

{-|
Module      : Argo.Args
Description : Argo stack library
Copyright   : (c) Valentin Reis, 2018
License     : MIT
Maintainer  : fre@freux.fr
-}
Valentin Reis's avatar
Valentin Reis committed
10

11
module Argo.Args
12
  ( parseExtendStackArgs
13 14
  )
where
Valentin Reis's avatar
Valentin Reis committed
15

Valentin Reis's avatar
Valentin Reis committed
16 17 18 19
import           Argo.Types                     ( ProcessBehavior
                                                , Verbosity(..)
                                                , StackArgs(..)
                                                )
Valentin Reis's avatar
Valentin Reis committed
20 21
import           Options.Applicative           as OA
import           Options.Applicative.Builder    ( option )
Valentin Reis's avatar
Valentin Reis committed
22 23 24 25
import           Options.Applicative.Types      ( Parser
                                                , ReadM
                                                , readerAsk
                                                )
Valentin Reis's avatar
Valentin Reis committed
26 27 28 29 30 31 32 33
import           Prelude                 hiding ( FilePath )

behavior :: ReadM ProcessBehavior
behavior = read <$> readerAsk
behaviorOption :: Mod OptionFields ProcessBehavior -> Parser ProcessBehavior
behaviorOption = option behavior

parseExtendStackArgs :: StackArgs -> Parser StackArgs
34
parseExtendStackArgs sa =
Valentin Reis's avatar
Valentin Reis committed
35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52
  StackArgs
    <$> pverbosity
    <*> papp
    <*> pvars
    <*> pargs
    <*> pcontainerName
    <*> pworkingDirectory
    <*> pshareDir
    <*> pmanifestName
    <*> ppreludeCommand
    <*> pdaemon
    <*> pcmdrun
    <*> pcmdlisten
    <*> pcmdlistenprogress
    <*> pcmdlistenperformance
    <*> pcmdlistenpower
    <*> phwThreadCount
    <*> ppowercap
53 54
 where
  pverbosity = flag
Valentin Reis's avatar
Valentin Reis committed
55 56 57
    Normal
    Verbose
    (long "verbose" <> short 'v' <> help "Enable verbose mode")
58
  papp = strOption
Valentin Reis's avatar
Valentin Reis committed
59 60 61 62 63 64
    (  long "app"
    <> metavar "APP"
    <> help "Target application executable name. PATH is inherited."
    <> showDefault
    <> value (app sa)
    )
65
  pcontainerName = strOption
Valentin Reis's avatar
Valentin Reis committed
66 67 68 69 70 71
    (  long "container_name"
    <> metavar "ARGO_CONTAINER_UUID"
    <> help "Container name"
    <> showDefault
    <> value (containerName sa)
    )
72
  pworkingDirectory = strOption
Valentin Reis's avatar
Valentin Reis committed
73 74 75 76 77 78
    (  long "output_dir"
    <> metavar "DIR"
    <> help "Working directory."
    <> showDefault
    <> value (workingDirectory sa)
    )
79
  pshareDir = strOption
Valentin Reis's avatar
Valentin Reis committed
80 81 82 83
    (  long "manifest_directory"
    <> metavar "DIR"
    <> help "Manifest lookup directory"
    <> showDefault
Valentin Reis's avatar
adding  
Valentin Reis committed
84
    <> value (shareDir sa)
Valentin Reis's avatar
Valentin Reis committed
85
    )
86
  pmanifestName = strOption
Valentin Reis's avatar
Valentin Reis committed
87 88 89 90 91 92
    (  long "manifest_name"
    <> metavar "FILENAME"
    <> help "Manifest file basename (relative to --manifest_directory)"
    <> showDefault
    <> value (manifestName sa)
    )
93
  ppreludeCommand = strOption
Valentin Reis's avatar
Valentin Reis committed
94 95 96 97 98 99
    (  long "prelude_command"
    <> metavar "COMMAND"
    <> help "Command to run before executing the stack (after stack setup)"
    <> showDefault
    <> value (preludeCommand sa)
    )
100
  pdaemon = behaviorOption
Valentin Reis's avatar
Valentin Reis committed
101 102 103 104 105 106
    (  long "daemon"
    <> metavar "BEHAVIOR"
    <> help "`daemon` behavior"
    <> showDefault
    <> value (daemon sa)
    )
107
  pcmdrun = behaviorOption
Valentin Reis's avatar
Valentin Reis committed
108 109 110 111 112 113
    (  long "cmd_run"
    <> metavar "BEHAVIOR"
    <> help "`cmd run` behavior"
    <> showDefault
    <> value (cmdrun sa)
    )
114
  pcmdlisten = behaviorOption
Valentin Reis's avatar
Valentin Reis committed
115 116 117 118 119 120
    (  long "cmd_listen"
    <> metavar "BEHAVIOR"
    <> help "`cmd listen` behavior"
    <> showDefault
    <> value (cmdlisten sa)
    )
121
  pcmdlistenperformance = behaviorOption
Valentin Reis's avatar
Valentin Reis committed
122 123 124 125 126 127
    (  long "cmd_listen_performance"
    <> metavar "BEHAVIOR"
    <> help "`cmd listen --filter performance` behavior"
    <> showDefault
    <> value (cmdlistenperformance sa)
    )
128
  pcmdlistenprogress = behaviorOption
Valentin Reis's avatar
Valentin Reis committed
129 130 131 132 133 134
    (  long "cmd_listen_progress"
    <> metavar "BEHAVIOR"
    <> help "`cmd listen --filter progress` behavior"
    <> showDefault
    <> value (cmdlistenprogress sa)
    )
135
  pcmdlistenpower = behaviorOption
Valentin Reis's avatar
Valentin Reis committed
136 137 138 139 140 141
    (  long "cmd_listen_power"
    <> metavar "BEHAVIOR"
    <> help "`cmd listen --filter power` behavior"
    <> showDefault
    <> value (cmdlistenpower sa)
    )
142
  phwThreadCount = option
Valentin Reis's avatar
Style  
Valentin Reis committed
143
    auto
144 145 146 147 148 149
    (  long "threadCount"
    <> metavar "THREADS"
    <> help "Number of threads to use when running the stack."
    <> showDefault
    <> value (hwThreadCount sa)
    )
150
  ppowercap = option
151 152 153 154 155 156 157
    auto
    (  long "powercap"
    <> metavar "POWERCAP"
    <> help "Powercap strategy: Fixed x | None | Adaptive"
    <> showDefault
    <> value (powercap sa)
    )
158
  pargs = some (argument str (metavar "ARGS" <> help "Application arguments."))
Valentin Reis's avatar
Valentin Reis committed
159
    <|> pure (args sa)
160 161 162
  pvars =
    some (argument auto (metavar "ENVvar" <> help "Env.Vars. for running app."))
      <|> pure (vars sa)