File: Tests.hs

package info (click to toggle)
haskell-cmdargs 0.10.22-3
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 352 kB
  • sloc: haskell: 2,972; makefile: 3
file content (419 lines) | stat: -rw-r--r-- 14,881 bytes parent folder | download | duplicates (3)
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
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
{-# LANGUAGE DeriveDataTypeable, RecordWildCards, TemplateHaskell, MagicHash #-}
{-# OPTIONS_GHC -fno-warn-missing-fields -fno-warn-unused-binds -fno-cse #-}

module System.Console.CmdArgs.Test.Implicit.Tests(test, demos) where

import System.Console.CmdArgs
import System.Console.CmdArgs.Explicit(modeHelp)
import System.Console.CmdArgs.Test.Implicit.Util
import System.Console.CmdArgs.Quote
import Data.Int
import Data.Ratio


-- from bug #256 and #231
data Test1
    = Test1 {maybeInt :: Maybe Int, listDouble :: [Double], maybeStr :: Maybe String, float :: Float
            ,bool :: Bool, maybeBool :: Maybe Bool, listBool :: [Bool], int64 :: Int64}
      deriving (Show,Eq,Data,Typeable)

def1 = Test1 def def def (def &= args) def def def def
mode1 = cmdArgsMode def1

$(cmdArgsQuote [d|
    mode1_ = cmdArgsMode# def1_
    def1_ = Test1 def def def (def &=# args) def def def def
    |])

test1 = do
    let Tester{..} = testers "Test1" [mode1,mode1_]
    [] === def1
    ["--maybeint=12"] === def1{maybeInt = Just 12}
    ["--maybeint=12","--maybeint=14"] === def1{maybeInt = Just 14}
    fails ["--maybeint"]
    fails ["--maybeint=test"]
    ["--listdouble=1","--listdouble=3","--listdouble=2"] === def1{listDouble=[1,3,2]}
    fails ["--maybestr"]
    ["--maybestr="] === def1{maybeStr=Just ""}
    ["--maybestr=test"] === def1{maybeStr=Just "test"}
    ["12.5"] === def1{float=12.5}
    ["12.5","18"] === def1{float=18}
    ["--bool"] === def1{bool=True}
    ["--maybebool"] === def1{maybeBool=Just True}
    ["--maybebool=off"] === def1{maybeBool=Just False}
    ["--listbool","--listbool=true","--listbool=false"] === def1{listBool=[True,True,False]}
    ["--int64=12"] === def1{int64=12}
    fails ["--listbool=fred"]
    invalid $ const def1{listBool = def &= opt "yes"}


-- from bug #230
data Test2 = Cmd1 {bs :: [String]}
           | Cmd2 {bar :: Int}
             deriving (Show, Eq, Data, Typeable)

mode2 = cmdArgsMode $ modes [Cmd1 [], Cmd2 42]

test2 = do
    let Tester{..} = tester "Test2" mode2
    fails []
    ["cmd1","-btest"] === Cmd1 ["test"]
    ["cmd2","-b14"] === Cmd2 14


-- various argument position
data Test3 = Test3 {pos1_1 :: [Int], pos1_2 :: [String], pos1_rest :: [String]}
             deriving (Show, Eq, Data, Typeable)

mode3 = cmdArgsMode $ Test3 (def &= argPos 1) (def &= argPos 2 &= opt "foo") (def &= args)

$(cmdArgsQuote [d| mode3_ = cmdArgsMode# $ Test3 (def &=# argPos 1) (def &=# argPos 2 &=# opt "foo") (def &=# args) |])


test3 = do
    let Tester{..} = testers "Test3" [mode3,mode3_]
    fails []
    fails ["a"]
    ["a","1"] === Test3 [1] ["foo"] ["a"]
    ["a","1","c"] === Test3 [1] ["c"] ["a"]
    ["a","1","c","d"] === Test3 [1] ["c"] ["a","d"]
    invalid $ \_ -> Test3 def def (def &= help "help" &= args)


-- from bug #222
data Test4 = Test4 {test_4 :: [String]}
             deriving (Show, Eq, Data, Typeable)

mode4 = cmdArgsMode $ Test4 (def &= opt "hello" &= args)

test4 = do
    let Tester{..} = tester "Test4" mode4
    [] === Test4 ["hello"]
    ["a"] === Test4 ["a"]
    ["a","b"] === Test4 ["a","b"]


-- from #292, automatic enumerations
data ABC = Abacus | Arbitrary | B | C deriving (Eq,Show,Data,Typeable)
data Test5 = Test5 {choice :: ABC} deriving (Eq,Show,Data,Typeable)

mode5 = cmdArgsMode $ Test5 B

test5 = do
    let Tester{..} = tester "Test5" mode5
    [] === Test5 B
    fails ["--choice=A"]
    ["--choice=c"] === Test5 C
    ["--choice=C"] === Test5 C
    ["--choice=Aba"] === Test5 Abacus
    ["--choice=abacus"] === Test5 Abacus
    ["--choice=c","--choice=B"] === Test5 B

-- tuple support
data Test6 = Test6 {val1 :: (Int,Bool), val2 :: [(Int,(String,Double))]} deriving (Eq,Show,Data,Typeable)
val6 = Test6 def def

mode6 = cmdArgsMode val6

test6 = do
    let Tester{..} = tester "Test6" mode6
    [] === val6
    ["--val1=1,True"] === val6{val1=(1,True)}
    ["--val1=84,off"] === val6{val1=(84,False)}
    fails ["--val1=84"]
    fails ["--val1=84,off,1"]
    ["--val2=1,2,3","--val2=5,6,7"] === val6{val2=[(1,("2",3)),(5,("6",7))]}

-- from #333, add default fields
data Test7 = Test71 {shared :: Int}
           | Test72 {unique :: Int, shared :: Int}
           | Test73 {unique :: Int, shared :: Int}
             deriving (Eq,Show,Data,Typeable)

mode7 = cmdArgsMode $ modes [Test71{shared = def &= name "rename"}, Test72{unique=def}, Test73{}]

test7 = do
    let Tester{..} = tester "Test7" mode7
    fails []
    ["test71","--rename=2"] === Test71 2
    ["test72","--rename=2"] === Test72 0 2
    ["test72","--unique=2"] === Test72 2 0
    ["test73","--rename=2"] === Test73 0 2
    ["test73","--unique=2"] === Test73 2 0

-- from #252, grouping
data Test8 = Test8 {test8a :: Int, test8b :: Int, test8c :: Int}
           | Test81
           | Test82
             deriving (Eq,Show,Data,Typeable)

mode8 = cmdArgsMode $ modes [Test8 1 (2 &= groupname "More flags") 3 &= groupname "Mode1", Test81, Test82 &= groupname "Mode2"]
mode8_ = cmdArgsMode_ $ modes_ [record Test8{} [atom (1::Int), atom (2::Int) += groupname "More flags", atom (3::Int)] += groupname "Mode1"
                               ,record Test81{} []
                               ,record Test82{} [] += groupname "Mode2"]

test8 = do
    let Tester{..} = testers "Test8" [mode8,mode8_]
    isHelp ["-?"] ["Flags:","  --test8a=INT","More flags:","  --test8b=INT"]
    fails []
    ["test8","--test8a=18"] === Test8 18 2 3

-- bug from Sebastian Fischer, enums with multiple fields
data XYZ = X | Y | Z deriving (Eq,Show,Data,Typeable)
data Test9 = Test91 {foo :: XYZ}
           | Test92 {foo :: XYZ}
             deriving (Eq,Show,Data,Typeable)

mode9 = cmdArgsMode $ modes [Test91 {foo = enum [X &= help "pick X (default)", Y &= help "pick Y"]} &= auto, Test92{}]
mode9_ = cmdArgsMode_ $ modes_ [record Test91{} [enum_ foo [atom X += help "pick X (default)", atom Y += help "pick Y"]] += auto, record Test92{} []]

test9 = do
    let Tester{..} = testers "Test9" [mode9,mode9_]
    [] === Test91 X
    ["test91","-x"] === Test91 X
    ["test91","-y"] === Test91 Y
    fails ["test91","-z"]
    ["test92","-x"] === Test92 X
    ["test92","-y"] === Test92 Y
    ["test92"] === Test92 X
    invalid $ \_ -> modes [Test91 {foo = enum [X &= help "pick X (default)"] &= opt "X"}]

-- share common fields in the help message
data Test10 = Test101 {food :: Int}
            | Test102 {food :: Int, bard :: Int}
              deriving (Eq,Show,Data,Typeable)

mode10 = cmdArgsMode $ modes [Test101 def, Test102 def def]

test10 = do
    let Tester{..} = tester "Test10" mode10
    isHelp ["-?=one"] ["  -f --food=INT"]
    isHelpNot ["-?=one"] ["  -b --bard=INT"]

-- test for GHC over-optimising
data Test11 = Test11A {test111 :: String}
            | Test11B {test111 :: String}
              deriving (Eq,Show,Data,Typeable)

test11A = Test11A { test111 = def &= argPos 0 }
test11B = Test11B { test111 = def &= argPos 0 }
mode11 = cmdArgsMode $ modes [test11A, test11B]

mode11_ = cmdArgsMode_ $ modes_
    [record Test11A{} [test111 := def += argPos 0]
    ,record Test11B{} [test111 := def += argPos 0]]

test11 = do
    let Tester{..} = testers "Test11" [mode11,mode11_]
    fails []
    ["test11a","test"] === Test11A "test"
    ["test11b","test"] === Test11B "test"


-- #351, check you can add name annotations to modes
data Test12 = Test12A | Test12B deriving (Eq,Show,Data,Typeable)

mode12 = cmdArgsMode $ modes [Test12A &= name "check", Test12B]
mode12_ = cmdArgsMode $ modes [Test12A &= name "check" &= explicit, Test12B]

test12 = do
    let Tester{..} = tester "Test12" mode12
    fails []
    ["test12a"] === Test12A
    ["check"] === Test12A
    ["test12b"] === Test12B
    fails ["t"]
    let Tester{..} = tester "Test12" mode12_
    fails []
    fails ["test12a"]
    ["check"] === Test12A
    ["test12b"] === Test12B
    ["t"] === Test12B


-- the ignore annotation and versionArg [summary]
data Test13 = Test13A {foo13 :: Int, bar13 :: Either Int Int}
            | Test13B {foo13 :: Int}
            | Test13C {foo13 :: Int}
              deriving (Eq,Show,Data,Typeable)

mode13 = cmdArgsMode $ modes [Test13A 1 (Left 1 &= ignore), Test13B 1 &= ignore, Test13C{}]
                       &= versionArg [summary "Version text here"]
                       &= summary "Help text here"

test13 = do
    let Tester{..} = tester "Test13" mode13
    fails ["test13b"]
    fails ["test13a --bar13=1"]
    ["test13a","--foo13=13"] === Test13A 13 (Left 1)
    ["test13c","--foo13=13"] === Test13C 13
    isHelp ["--help"] ["Help text here"]
    isVersion ["--version"] "Version text here"
    fails ["--numeric-version"]

-- check a list becomes modes not an enum
data Test14 = Test14A | Test14B | Test14C deriving (Eq,Show,Data,Typeable)

mode14 = cmdArgsMode $ modes [Test14A, Test14B, Test14C]

test14 = do
    let Tester{..} = tester "Test14" mode14
    fails []
    ["test14a"] === Test14A
    fails ["--test14a"]

-- custom help flags
data Test15 = Test15 {test15a :: Bool} deriving (Eq,Show,Data,Typeable)

mode15 = cmdArgsMode $ Test15 (False &= name "help")
         &= helpArg [groupname "GROUP", name "h", name "nohelp", explicit, help "whatever\nstuff"] &= versionArg [ignore]
         &= verbosityArgs [ignore] [explicit,name "silent"]

$(cmdArgsQuote [d|
    mode15_ = cmdArgsMode# $ Test15 (False &=# name "help")
              &=# helpArg [groupname "GROUP", name "h", name "nohelp", explicit, help "whatever\nstuff"] &=# versionArg [ignore]
              &=# verbosityArgs [ignore] [explicit,name "silent"]
    |])

test15 = do
    let Tester{..} = testers "Test15" [mode15,mode15_]
    invalid $ \_ -> Test15 (False &= name "help")
    ["--help"] === Test15 True
    ["-t"] === Test15 True
    fails ["-?"]
    isHelp ["--nohelp"] ["  -h --nohelp  whatever"]
    isHelp ["-h"] []
    isHelp ["-h"] ["GROUP:"]
    fails ["--version"]
    fails ["--numeric-version"]
    fails ["--verbose"]
    fails ["--quiet"]
    isVerbosity ["--help","--silent"] Quiet

-- check newtype support
newtype MyInt = MyInt Int deriving (Eq,Show,Data,Typeable)

data Test16 = Test16 {test16a :: MyInt, test16b :: [MyInt]} deriving (Eq,Show,Data,Typeable)

mode16 = cmdArgsMode $ Test16 (MyInt 12) [] &= summary "The Glorious Glasgow Haskell Compilation System, version 7.6.3"

test16 = do
    let Tester{..} = tester "Test16" mode16
    [] === Test16 (MyInt 12) []
    isVersion ["--numeric-version"] "7.6.3"
    fails ["--test16a"]
    ["--test16a=5"] === Test16 (MyInt 5) []
    ["--test16b=5","--test16b=82"] === Test16 (MyInt 12) [MyInt 5, MyInt 82]

-- #552, @ directives not expanded after -- symbols
-- not actually checked because this path doesn't go through processArgs
data Test17 = Test17 {test17_ :: [String]} deriving (Eq,Show,Data,Typeable)

mode17 = cmdArgsMode $ Test17 ([] &= args) &= noAtExpand &= summary "bzip2 3.5-windows version"

test17 = do
    let Tester{..} = tester "Test17" mode17
    [] === Test17 []
    ["test","of","this"] === Test17 ["test","of","this"]
    ["test","--","@foo"] === Test17 ["test","@foo"]
    isVersion ["--numeric-version"] "3.5-windows"


data Debuggable = This | That deriving (Eq,Show,Data,Typeable)
data Test18 = Test18 {test18_ :: [Debuggable]} deriving (Eq,Show,Data,Typeable)

mode18 = cmdArgsMode $ Test18 $ enum [[] &= ignore, [This] &= name "debug-this", [That] &= name "debug-that"]

test18 = do
    let Tester{..} = tester "Test18" mode18
    [] === Test18 []
    ["--debug-this","--debug-that","--debug-this"] === Test18 [This,That,This]

-- #610, check performance for long lists (took ~20s before)

data Test19 = Test19 {test19_ :: [String]} deriving (Eq,Show,Data,Typeable)

mode19 = cmdArgsMode $ Test19 ([] &= args)

test19 = do
    let Tester{..} = tester "Test19" mode19
    let args = map show [1..1000]
    args === Test19 args


-- #615, newtype wrappers of lists/Maybe should accumulate properly

newtype Test20A = Test20A [String] deriving (Eq,Show,Data,Typeable)
data Test20 = Test20 {test20_ :: Test20A} deriving (Eq,Show,Data,Typeable)

mode20 = cmdArgsMode $ Test20 (Test20A [] &= args)

test20 = do
    let Tester{..} = tester "Test20" mode20
    ["a","b","c"] === Test20 (Test20A ["a","b","c"])


-- #626, don't reverse values too much

newtype Test21A = Test21A [String] deriving (Eq,Show,Data,Typeable)
data Test21 = Test21 {test21A :: Test21A, test21B :: [String], test21C :: [Int]} deriving (Eq,Show,Data,Typeable)

mode21 = cmdArgsMode $ Test21 (Test21A ["a","b","c"]) ["A","B","C"] [1,2,3]

test21 = do
    let Tester{..} = tester "Test21" mode21
    [] === Test21 (Test21A ["a","b","c"]) ["A","B","C"] [1,2,3]

-- #10, don't break elm-server

data Test22 = Test22 {port :: Int, runtime :: Maybe FilePath} deriving (Data,Typeable,Show,Eq)

mode22 = cmdArgsMode $ Test22
  { port = 8000 &= help "set the port of the server"
  , runtime = Nothing &= typFile
              &= help "Specify a custom location for Elm's runtime system."
  } &= help "Quickly reload Elm projects in your browser. Just refresh to recompile.\n\
            \It serves static files and freshly recompiled Elm files."
    &= helpArg [explicit, name "help", name "h"]
    &= versionArg [ explicit, name "version", name "v"
                  , summary "0.12.0.1"
                  ]
    &= summary "Elm Server 0.11.0.1, (c) Evan Czaplicki 2011-2014"

test22 = do
    let Tester{..} = tester "Test22" mode22
    [] === Test22 8000 Nothing
    isVersion ["-v"] "0.12.0.1"
    isVersion ["--version"] "0.12.0.1"
    isVersion ["--numeric-version"] "0.12.0.1"
    isHelp ["--help"] ["Elm Server 0.11.0.1, (c) Evan Czaplicki 2011-2014"]
    isHelp ["--h"] ["Elm Server 0.11.0.1, (c) Evan Czaplicki 2011-2014"]
    fails ["-?"]
    ["--port=20"] === Test22 20 Nothing
    ["--runtime=20"] === Test22 8000 (Just "20")
    fails ["bob"]

-- # 24, doesn't work with Ratio

data Test23 = Test23 {test23A :: Ratio Int} deriving (Show, Data, Typeable, Eq)

mode23 = cmdArgsMode $ Test23 {test23A = 4 % 7 }

test23 = do
    let Tester{..} = tester "Test23" mode23
    [] === Test23 (4 % 7)
    ["--test23=1,6"] === Test23 (1 % 6)


-- For some reason, these must be at the end, otherwise the Template Haskell
-- stage restriction kicks in.

test = test1 >> test2 >> test3 >> test4 >> test5 >> test6 >> test7 >> test8 >> test9 >> test10 >>
       test11 >> test12 >> test13 >> test14 >> test15 >> test16 >> test18 >> test19 >> test20 >>
       test21 >> test22 >> test23
demos = zipWith f [1..]
        [toDemo mode1, toDemo mode2, toDemo mode3, toDemo mode4, toDemo mode5, toDemo mode6
        ,toDemo mode7, toDemo mode8, toDemo mode9, toDemo mode10, toDemo mode11, toDemo mode12
        ,toDemo mode13, toDemo mode14, toDemo mode15, toDemo mode16, toDemo mode17, toDemo mode18
        ,toDemo mode19, toDemo mode20, toDemo mode21, toDemo mode22, toDemo mode23]
    where f i x = x{modeHelp = "Testing various corner cases (" ++ show i ++ ")"}