Args.hs 4.51 KB
Newer Older
Valentin Reis's avatar
Valentin Reis committed
1
{-# LANGUAGE OverloadedStrings, ApplicativeDo, GeneralizedNewtypeDeriving, RecordWildCards #-}
2 3 4 5

module Argo.Args where

import           Options.Applicative           as OA
Valentin Reis's avatar
Valentin Reis committed
6 7
import           Options.Applicative.Types
import           Options.Applicative.Builder    ( option )
8 9 10 11
import           Data.Default
import           Data.Text                     as T
                                         hiding ( empty )

Valentin Reis's avatar
Valentin Reis committed
12
import           Turtle                  hiding ( option )
13
import           Prelude                 hiding ( FilePath )
Valentin Reis's avatar
Valentin Reis committed
14
import           System.Process          hiding ( shell )
15 16


17
data OutputFiles = OutputFiles FilePath FilePath
18
data StackArgs = StackArgs
19 20
  { verbosity              :: Verbosity
  , app                    :: AppName
Valentin Reis's avatar
Valentin Reis committed
21 22 23 24 25 26 27 28 29 30
  , args                   :: AppArgs
  , containerName          :: ContainerName
  , workingDirectory       :: WorkingDirectory
  , manifestDir            :: ManifestDir
  , manifestName           :: ManifestName
  , daemon                 :: ProcessBehavior
  , cmdrun                 :: ProcessBehavior
  , cmdlisten              :: ProcessBehavior
  , cmdlistenprogress      :: ProcessBehavior
  , cmdlistenpower         :: ProcessBehavior
31 32
  }

33
data Verbosity = Normal | Verbose deriving (Show,Read,Eq)
Valentin Reis's avatar
Valentin Reis committed
34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54
newtype AppArgs = AppArgs [Text] deriving (Show, Read)
newtype WorkingDirectory = WorkingDirectory FilePath deriving (IsString, Show)
newtype AppName = AppName Text deriving (IsString, Show, Read)
newtype ContainerName = ContainerName Text deriving (IsString, Show, Read)
newtype ManifestDir = ManifestDir FilePath deriving (IsString, Show)
newtype ManifestName = ManifestName FilePath deriving (IsString, Show)

newtype StdOutLog = StdOutLog Text deriving (Show, Read)
newtype StdErrLog = StdErrLog Text deriving (Show, Read)
newtype TestText = TestText Text deriving (Show, Read)

data ProcessBehavior =
     SucceedTestOnMessage TestText StdOutLog StdErrLog
   | JustRun StdOutLog StdErrLog
   | DontRun deriving (Show,Read)

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

55 56
instance Default StackArgs where
  def = StackArgs
57 58
    { verbosity = Verbose
    , app = AppName "ls"
59
    , args = AppArgs []
Valentin Reis's avatar
Valentin Reis committed
60 61 62 63 64 65 66 67 68
    , containerName = ContainerName "testContainer"
    , workingDirectory = WorkingDirectory "_output"
    , manifestDir = ManifestDir "manifests"
    , manifestName = ManifestName "basic.json"
    , daemon = DontRun
    , cmdrun = DontRun
    , cmdlisten = DontRun
    , cmdlistenprogress = DontRun
    , cmdlistenpower = DontRun
69 70 71 72
    }

parseExtendStackArgs :: StackArgs -> Parser StackArgs
parseExtendStackArgs StackArgs {..} = do
73 74 75 76
  verbosity <- flag
    Normal
    Verbose
    (long "verbose" <> short 'v' <> help "Enable verbose mode")
77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
  app <- strOption
    (  long "application"
    <> metavar "APP"
    <> help "Target application executable name. PATH is inherited."
    <> showDefault
    <> value app
    )
  containerName <- strOption
    (  long "container_name"
    <> metavar "ARGO_CONTAINER_UUID"
    <> help "Container name"
    <> showDefault
    <> value containerName
    )
  workingDirectory <- strOption
92 93
    (  long "output_dir"
    <> metavar "DIR"
94 95 96 97 98 99
    <> help "Working directory."
    <> showDefault
    <> value workingDirectory
    )
  manifestDir <- strOption
    (  long "manifest_directory"
100
    <> metavar "DIR"
101 102 103 104 105 106
    <> help "Manifest lookup directory"
    <> showDefault
    <> value manifestDir
    )
  manifestName <- strOption
    (  long "manifest_name"
107 108
    <> metavar "FILENAME"
    <> help "Manifest file basename (relative to --manifest_directory)"
109 110 111
    <> showDefault
    <> value manifestName
    )
Valentin Reis's avatar
Valentin Reis committed
112 113 114 115
  daemon <- behaviorOption
    (  long "daemon"
    <> metavar "BEHAVIOR"
    <> help "`daemon` behavior"
116
    <> showDefault
Valentin Reis's avatar
Valentin Reis committed
117
    <> value daemon
118
    )
Valentin Reis's avatar
Valentin Reis committed
119 120 121 122
  cmdrun <- behaviorOption
    (  long "cmd_run"
    <> metavar "BEHAVIOR"
    <> help "`cmd run` behavior"
123
    <> showDefault
Valentin Reis's avatar
Valentin Reis committed
124
    <> value cmdrun
125
    )
Valentin Reis's avatar
Valentin Reis committed
126 127 128 129
  cmdlisten <- behaviorOption
    (  long "cmd_listen"
    <> metavar "BEHAVIOR"
    <> help "`cmd listen` behavior"
130
    <> showDefault
Valentin Reis's avatar
Valentin Reis committed
131
    <> value cmdlisten
132
    )
Valentin Reis's avatar
Valentin Reis committed
133 134 135 136
  cmdlistenprogress <- behaviorOption
    (  long "cmd_listen_progress"
    <> metavar "BEHAVIOR"
    <> help "`cmd listen --filter progress` behavior"
137
    <> showDefault
Valentin Reis's avatar
Valentin Reis committed
138
    <> value cmdlistenprogress
139
    )
Valentin Reis's avatar
Valentin Reis committed
140 141 142 143
  cmdlistenpower <- behaviorOption
    (  long "cmd_listen_power"
    <> metavar "BEHAVIOR"
    <> help "`cmd listen --filter power` behavior"
144
    <> showDefault
Valentin Reis's avatar
Valentin Reis committed
145
    <> value cmdlistenpower
146 147
    )
  pure StackArgs {..}