-
-
Notifications
You must be signed in to change notification settings - Fork 22
/
Copy pathCli.hs
194 lines (174 loc) · 9.43 KB
/
Cli.hs
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
185
186
187
188
189
190
191
192
193
194
module Test.Iris.Cli (cliSpec, cliSpecParserConflicts) where
import Options.Applicative (getParseResult)
import Test.Hspec (Expectation, Spec, describe, expectationFailure, it, shouldBe, shouldReturn)
import Iris (CliEnvSettings (..))
import Iris.Cli (VersionSettings (versionSettingsMkDesc))
import Iris.Cli.Colour (ColourOption (..))
import Iris.Cli.Interactive (InteractiveMode (..), handleInteractiveMode)
import Iris.Cli.Internal
import Iris.Cli.ParserInfo (cmdParserInfo)
import Iris.Cli.Version (defaultVersionSettings)
import Iris.Settings (defaultCliEnvSettings)
import Test.Iris.Common (checkCI)
import qualified Options.Applicative as Opt
import qualified Paths_iris as Autogen
expectedHelpText :: String
expectedHelpText =
"Simple CLI program\n\
\\n\
\Usage: <iris-test> [--no-input] [--colour | --no-colour]\n\
\\n\
\ CLI tool build with iris - a Haskell CLI framework\n\
\\n\
\Available options:\n\
\ -h,--help Show this help text\n\
\ --no-input Enter the terminal in non-interactive mode\n\
\ --colour Always output colours\n\
\ --no-colour Never output colours"
expectedHelpTextWithVersion :: String
expectedHelpTextWithVersion =
"Simple CLI program\n\
\\n\
\Usage: <iris-test> [--version] [--numeric-version] [--no-input] \n\
\ [--colour | --no-colour]\n\
\\n\
\ CLI tool build with iris - a Haskell CLI framework\n\
\\n\
\Available options:\n\
\ -h,--help Show this help text\n\
\ --version Show application version\n\
\ --numeric-version Show only numeric application version\n\
\ --no-input Enter the terminal in non-interactive mode\n\
\ --colour Always output colours\n\
\ --no-colour Never output colours"
expectedNumericVersion :: String
expectedNumericVersion = "0.1.0.0"
cliSpec :: Spec
cliSpec = describe "Cli Options" $ do
let parserPrefs = Opt.defaultPrefs
it "help without version environment" $ do
let parserInfo = cmdParserInfo defaultCliEnvSettings
let result = Opt.execParserPure parserPrefs parserInfo ["--help"]
parseResultHandlerFailure result expectedHelpText
it "help with version environment" $ do
let cliEnvSettings = defaultCliEnvSettings{cliEnvSettingsVersionSettings = Just (defaultVersionSettings Autogen.version)}
let parserInfo = cmdParserInfo cliEnvSettings
let result = Opt.execParserPure parserPrefs parserInfo ["--help"]
parseResultHandlerFailure result expectedHelpTextWithVersion
it "--numeric-version returns correct version" $ do
let cliEnvSettings = defaultCliEnvSettings{cliEnvSettingsVersionSettings = Just (defaultVersionSettings Autogen.version)}
let parserInfo = cmdParserInfo cliEnvSettings
let result = Opt.execParserPure parserPrefs parserInfo ["--numeric-version"]
parseResultHandlerFailure result expectedNumericVersion
it "CI interactivity check" $ do
handleInteractiveMode NonInteractive `shouldReturn` NonInteractive
isCi <- checkCI
if isCi
then handleInteractiveMode Interactive `shouldReturn` NonInteractive
else handleInteractiveMode Interactive `shouldReturn` Interactive
it "Handles colour mode" $ do
let parserInfo = cmdParserInfo defaultCliEnvSettings
let coloption args = getParseResult $ cmdColourOption <$> Opt.execParserPure parserPrefs parserInfo args
coloption ["--colour"] `shouldBe` pure Always
coloption ["--no-colour"] `shouldBe` pure Never
coloption [] `shouldBe` pure Auto
it "--version returns correct version text" $ do
let expectedVersionMkDescription = ("Version " ++)
let cliEnvSettings = defaultCliEnvSettings{cliEnvSettingsVersionSettings = Just $ (defaultVersionSettings Autogen.version){versionSettingsMkDesc = expectedVersionMkDescription}}
let parserInfo = cmdParserInfo cliEnvSettings
let expectedVersion = expectedVersionMkDescription expectedNumericVersion
let result = Opt.execParserPure parserPrefs parserInfo ["--version"]
parseResultHandlerFailure result expectedVersion
newtype UserDefinedParser a = UserDefinedParser {noInteractive :: a}
userDefinedNoInputOption :: Opt.Parser (UserDefinedParser String)
userDefinedNoInputOption =
UserDefinedParser
<$> Opt.strOption (Opt.long "no-input")
userDefinedNoInputSwitch :: Opt.Parser (UserDefinedParser Bool)
userDefinedNoInputSwitch =
UserDefinedParser
<$> Opt.switch (Opt.long "no-input")
userDefinedNoInputOnCommand :: Opt.Parser (UserDefinedParser Bool)
userDefinedNoInputOnCommand =
Opt.subparser
( Opt.command
"test-command"
(Opt.info userDefinedNoInputSwitch Opt.fullDesc)
)
customParserSettings :: Opt.Parser (UserDefinedParser a) -> CliEnvSettings (UserDefinedParser a) ()
customParserSettings parser =
CliEnvSettings
{ cliEnvSettingsCmdParser = parser
, cliEnvSettingsAppEnv = ()
, cliEnvSettingsHeaderDesc = "Simple CLI program"
, cliEnvSettingsProgDesc = "CLI tool build with iris - a Haskell CLI framework"
, cliEnvSettingsVersionSettings = Nothing
, cliEnvSettingsAppName = Nothing
}
argValue :: String
argValue = "someValue"
expectedErrorTextUserDefinedNoInputArg :: String
expectedErrorTextUserDefinedNoInputArg =
"Invalid argument `"
<> argValue
<> "'\n\
\\n\
\Usage: <iris-test> [--no-input] --no-input ARG [--colour | --no-colour]\n\
\\n\
\ CLI tool build with iris - a Haskell CLI framework"
expectedErrorTextUserDefinedNoInputNoArg :: String
expectedErrorTextUserDefinedNoInputNoArg =
"Missing: --no-input ARG\n\
\\n\
\Usage: <iris-test> [--no-input] --no-input ARG [--colour | --no-colour]\n\
\\n\
\ CLI tool build with iris - a Haskell CLI framework"
cliSpecParserConflicts :: Spec
cliSpecParserConflicts = describe "Cli Parser Conflicts" $ do
let parserPrefs = Opt.defaultPrefs
it "--no-input=someValue defined by user - arg provided" $ do
let parserInfo = cmdParserInfo $ customParserSettings userDefinedNoInputOption
let result = Opt.execParserPure parserPrefs parserInfo ["--no-input", argValue]
parseResultHandlerFailure result expectedErrorTextUserDefinedNoInputArg
it "--no-input=someValue defined by user - no arg provided" $ do
let parserInfo = cmdParserInfo $ customParserSettings userDefinedNoInputOption
let result = Opt.execParserPure parserPrefs parserInfo ["--no-input"]
parseResultHandlerFailure result expectedErrorTextUserDefinedNoInputNoArg
it "--no-input=someValue defined by user - not provided at all" $ do
let parserInfo = cmdParserInfo $ customParserSettings userDefinedNoInputOption
let result = Opt.execParserPure parserPrefs parserInfo []
parseResultHandlerFailure result expectedErrorTextUserDefinedNoInputNoArg
it "--no-input switch defined by user - provided" $ do
let parserInfo = cmdParserInfo $ customParserSettings userDefinedNoInputSwitch
let result = Opt.execParserPure parserPrefs parserInfo ["--no-input"]
parseResultHandlerSuccess result ["NonInteractive", "False"]
it "--no-input switch defined by user - not provided" $ do
let parserInfo = cmdParserInfo $ customParserSettings userDefinedNoInputSwitch
let result = Opt.execParserPure parserPrefs parserInfo []
parseResultHandlerSuccess result ["Interactive", "False"]
it "--no-input switch with command defined by user - user provided" $ do
let parserInfo = cmdParserInfo $ customParserSettings userDefinedNoInputOnCommand
let result = Opt.execParserPure parserPrefs parserInfo ["test-command", "--no-input"]
parseResultHandlerSuccess result ["Interactive", "True"]
it "--no-input switch with command defined by user - internal provided" $ do
let parserInfo = cmdParserInfo $ customParserSettings userDefinedNoInputOnCommand
let result = Opt.execParserPure parserPrefs parserInfo ["--no-input", "test-command"]
parseResultHandlerSuccess result ["NonInteractive", "False"]
parseResultHandlerSuccess :: Show b => Opt.ParserResult (Cmd (UserDefinedParser b)) -> [String] -> Expectation
parseResultHandlerSuccess parseResult expected =
case parseResult of
Opt.Failure _ -> expectationFailure "Expected 'Success' but got 'Failure' "
Opt.Success a -> do
let internalNoInput = show $ cmdInteractiveMode a
let userDefinedNoInput = show . noInteractive . cmdCmd $ a
shouldBe [internalNoInput, userDefinedNoInput] expected
Opt.CompletionInvoked completionResult -> expectationFailure $ "Expected 'Success' but got: " <> show completionResult
parseResultHandlerFailure :: Opt.ParserResult a -> String -> Expectation
parseResultHandlerFailure parseResult expected =
case parseResult of
-- The help functionality is baked into optparse-applicative and presents itself as a ParserFailure.
Opt.Failure (Opt.ParserFailure getFailure) -> do
let (helpText, _exitCode, _int) = getFailure "<iris-test>"
show helpText `shouldBe` expected
Opt.Success _ -> expectationFailure "Expected 'Failure' but got 'Success' "
Opt.CompletionInvoked completionResult -> expectationFailure $ "Expected 'Failure' but got: " <> show completionResult