1{-# LANGUAGE DeriveDataTypeable, RecordWildCards, TemplateHaskell, MagicHash #-}
2{-# OPTIONS_GHC -fno-warn-missing-fields -fno-warn-unused-binds #-}
3
4module System.Console.CmdArgs.Test.Implicit.Tests(test, demos) where
5
6import System.Console.CmdArgs
7import System.Console.CmdArgs.Explicit(modeHelp)
8import System.Console.CmdArgs.Test.Implicit.Util
9import System.Console.CmdArgs.Quote
10import Data.Int
11import Data.Ratio
12
13
14-- from bug #256 and #231
15data Test1
16    = Test1 {maybeInt :: Maybe Int, listDouble :: [Double], maybeStr :: Maybe String, float :: Float
17            ,bool :: Bool, maybeBool :: Maybe Bool, listBool :: [Bool], int64 :: Int64}
18      deriving (Show,Eq,Data,Typeable)
19
20def1 = Test1 def def def (def &= args) def def def def
21mode1 = cmdArgsMode def1
22
23$(cmdArgsQuote [d|
24    mode1_ = cmdArgsMode# def1_
25    def1_ = Test1 def def def (def &=# args) def def def def
26    |])
27
28test1 = do
29    let Tester{..} = testers "Test1" [mode1,mode1_]
30    [] === def1
31    ["--maybeint=12"] === def1{maybeInt = Just 12}
32    ["--maybeint=12","--maybeint=14"] === def1{maybeInt = Just 14}
33    fails ["--maybeint"]
34    fails ["--maybeint=test"]
35    ["--listdouble=1","--listdouble=3","--listdouble=2"] === def1{listDouble=[1,3,2]}
36    fails ["--maybestr"]
37    ["--maybestr="] === def1{maybeStr=Just ""}
38    ["--maybestr=test"] === def1{maybeStr=Just "test"}
39    ["12.5"] === def1{float=12.5}
40    ["12.5","18"] === def1{float=18}
41    ["--bool"] === def1{bool=True}
42    ["--maybebool"] === def1{maybeBool=Just True}
43    ["--maybebool=off"] === def1{maybeBool=Just False}
44    ["--listbool","--listbool=true","--listbool=false"] === def1{listBool=[True,True,False]}
45    ["--int64=12"] === def1{int64=12}
46    fails ["--listbool=fred"]
47    invalid $ \_ -> def1{listBool = def &= opt "yes"}
48
49
50-- from bug #230
51data Test2 = Cmd1 {bs :: [String]}
52           | Cmd2 {bar :: Int}
53             deriving (Show, Eq, Data, Typeable)
54
55mode2 = cmdArgsMode $ modes [Cmd1 [], Cmd2 42]
56
57test2 = do
58    let Tester{..} = tester "Test2" mode2
59    fails []
60    ["cmd1","-btest"] === Cmd1 ["test"]
61    ["cmd2","-b14"] === Cmd2 14
62
63
64-- various argument position
65data Test3 = Test3 {pos1_1 :: [Int], pos1_2 :: [String], pos1_rest :: [String]}
66             deriving (Show, Eq, Data, Typeable)
67
68mode3 = cmdArgsMode $ Test3 (def &= argPos 1) (def &= argPos 2 &= opt "foo") (def &= args)
69
70$(cmdArgsQuote [d| mode3_ = cmdArgsMode# $ Test3 (def &=# argPos 1) (def &=# argPos 2 &=# opt "foo") (def &=# args) |])
71
72
73test3 = do
74    let Tester{..} = testers "Test3" [mode3,mode3_]
75    fails []
76    fails ["a"]
77    ["a","1"] === Test3 [1] ["foo"] ["a"]
78    ["a","1","c"] === Test3 [1] ["c"] ["a"]
79    ["a","1","c","d"] === Test3 [1] ["c"] ["a","d"]
80    invalid $ \_ -> Test3 def def (def &= help "help" &= args)
81
82
83-- from bug #222
84data Test4 = Test4 {test_4 :: [String]}
85             deriving (Show, Eq, Data, Typeable)
86
87mode4 = cmdArgsMode $ Test4 (def &= opt "hello" &= args)
88
89test4 = do
90    let Tester{..} = tester "Test4" mode4
91    [] === Test4 ["hello"]
92    ["a"] === Test4 ["a"]
93    ["a","b"] === Test4 ["a","b"]
94
95
96-- from #292, automatic enumerations
97data ABC = Abacus | Arbitrary | B | C deriving (Eq,Show,Data,Typeable)
98data Test5 = Test5 {choice :: ABC} deriving (Eq,Show,Data,Typeable)
99
100mode5 = cmdArgsMode $ Test5 B
101
102test5 = do
103    let Tester{..} = tester "Test5" mode5
104    [] === Test5 B
105    fails ["--choice=A"]
106    ["--choice=c"] === Test5 C
107    ["--choice=C"] === Test5 C
108    ["--choice=Aba"] === Test5 Abacus
109    ["--choice=abacus"] === Test5 Abacus
110    ["--choice=c","--choice=B"] === Test5 B
111
112-- tuple support
113data Test6 = Test6 {val1 :: (Int,Bool), val2 :: [(Int,(String,Double))]} deriving (Eq,Show,Data,Typeable)
114val6 = Test6 def def
115
116mode6 = cmdArgsMode val6
117
118test6 = do
119    let Tester{..} = tester "Test6" mode6
120    [] === val6
121    ["--val1=1,True"] === val6{val1=(1,True)}
122    ["--val1=84,off"] === val6{val1=(84,False)}
123    fails ["--val1=84"]
124    fails ["--val1=84,off,1"]
125    ["--val2=1,2,3","--val2=5,6,7"] === val6{val2=[(1,("2",3)),(5,("6",7))]}
126
127-- from #333, add default fields
128data Test7 = Test71 {shared :: Int}
129           | Test72 {unique :: Int, shared :: Int}
130           | Test73 {unique :: Int, shared :: Int}
131             deriving (Eq,Show,Data,Typeable)
132
133mode7 = cmdArgsMode $ modes [Test71{shared = def &= name "rename"}, Test72{unique=def}, Test73{}]
134
135test7 = do
136    let Tester{..} = tester "Test7" mode7
137    fails []
138    ["test71","--rename=2"] === Test71 2
139    ["test72","--rename=2"] === Test72 0 2
140    ["test72","--unique=2"] === Test72 2 0
141    ["test73","--rename=2"] === Test73 0 2
142    ["test73","--unique=2"] === Test73 2 0
143
144-- from #252, grouping
145data Test8 = Test8 {test8a :: Int, test8b :: Int, test8c :: Int}
146           | Test81
147           | Test82
148             deriving (Eq,Show,Data,Typeable)
149
150mode8 = cmdArgsMode $ modes [Test8 1 (2 &= groupname "More flags") 3 &= groupname "Mode1", Test81, Test82 &= groupname "Mode2"]
151mode8_ = cmdArgsMode_ $ modes_ [record Test8{} [atom (1::Int), atom (2::Int) += groupname "More flags", atom (3::Int)] += groupname "Mode1"
152                               ,record Test81{} []
153                               ,record Test82{} [] += groupname "Mode2"]
154
155test8 = do
156    let Tester{..} = testers "Test8" [mode8,mode8_]
157    isHelp ["-?"] ["Flags:","  --test8a=INT","More flags:","  --test8b=INT"]
158    fails []
159    ["test8","--test8a=18"] === Test8 18 2 3
160
161-- bug from Sebastian Fischer, enums with multiple fields
162data XYZ = X | Y | Z deriving (Eq,Show,Data,Typeable)
163data Test9 = Test91 {foo :: XYZ}
164           | Test92 {foo :: XYZ}
165             deriving (Eq,Show,Data,Typeable)
166
167mode9 = cmdArgsMode $ modes [Test91 {foo = enum [X &= help "pick X (default)", Y &= help "pick Y"]} &= auto, Test92{}]
168mode9_ = cmdArgsMode_ $ modes_ [record Test91{} [enum_ foo [atom X += help "pick X (default)", atom Y += help "pick Y"]] += auto, record Test92{} []]
169
170test9 = do
171    let Tester{..} = testers "Test9" [mode9,mode9_]
172    [] === Test91 X
173    ["test91","-x"] === Test91 X
174    ["test91","-y"] === Test91 Y
175    fails ["test91","-z"]
176    ["test92","-x"] === Test92 X
177    ["test92","-y"] === Test92 Y
178    ["test92"] === Test92 X
179    invalid $ \_ -> modes [Test91 {foo = enum [X &= help "pick X (default)"] &= opt "X"}]
180
181-- share common fields in the help message
182data Test10 = Test101 {food :: Int}
183            | Test102 {food :: Int, bard :: Int}
184              deriving (Eq,Show,Data,Typeable)
185
186mode10 = cmdArgsMode $ modes [Test101 def, Test102 def def]
187
188test10 = do
189    let Tester{..} = tester "Test10" mode10
190    isHelp ["-?=one"] ["  -f --food=INT"]
191    isHelpNot ["-?=one"] ["  -b --bard=INT"]
192
193-- test for GHC over-optimising
194data Test11 = Test11A {test111 :: String}
195            | Test11B {test111 :: String}
196              deriving (Eq,Show,Data,Typeable)
197
198test11A = Test11A { test111 = def &= argPos 0 }
199test11B = Test11B { test111 = def &= argPos 0 }
200mode11 = cmdArgsMode $ modes [test11A, test11B]
201
202mode11_ = cmdArgsMode_ $ modes_
203    [record Test11A{} [test111 := def += argPos 0]
204    ,record Test11B{} [test111 := def += argPos 0]]
205
206test11 = do
207    let Tester{..} = testers "Test11" [mode11,mode11_]
208    fails []
209    ["test11a","test"] === Test11A "test"
210    ["test11b","test"] === Test11B "test"
211
212
213-- #351, check you can add name annotations to modes
214data Test12 = Test12A | Test12B deriving (Eq,Show,Data,Typeable)
215
216mode12 = cmdArgsMode $ modes [Test12A &= name "check", Test12B]
217mode12_ = cmdArgsMode $ modes [Test12A &= name "check" &= explicit, Test12B]
218
219test12 = do
220    let Tester{..} = tester "Test12" mode12
221    fails []
222    ["test12a"] === Test12A
223    ["check"] === Test12A
224    ["test12b"] === Test12B
225    fails ["t"]
226    let Tester{..} = tester "Test12" mode12_
227    fails []
228    fails ["test12a"]
229    ["check"] === Test12A
230    ["test12b"] === Test12B
231    ["t"] === Test12B
232
233
234-- the ignore annotation and versionArg [summary]
235data Test13 = Test13A {foo13 :: Int, bar13 :: Either Int Int}
236            | Test13B {foo13 :: Int}
237            | Test13C {foo13 :: Int}
238              deriving (Eq,Show,Data,Typeable)
239
240mode13 = cmdArgsMode $ modes [Test13A 1 (Left 1 &= ignore), Test13B 1 &= ignore, Test13C{}]
241                       &= versionArg [summary "Version text here"]
242                       &= summary "Help text here"
243
244test13 = do
245    let Tester{..} = tester "Test13" mode13
246    fails ["test13b"]
247    fails ["test13a --bar13=1"]
248    ["test13a","--foo13=13"] === Test13A 13 (Left 1)
249    ["test13c","--foo13=13"] === Test13C 13
250    isHelp ["--help"] ["Help text here"]
251    isVersion ["--version"] "Version text here"
252    fails ["--numeric-version"]
253
254-- check a list becomes modes not an enum
255data Test14 = Test14A | Test14B | Test14C deriving (Eq,Show,Data,Typeable)
256
257mode14 = cmdArgsMode $ modes [Test14A, Test14B, Test14C]
258
259test14 = do
260    let Tester{..} = tester "Test14" mode14
261    fails []
262    ["test14a"] === Test14A
263    fails ["--test14a"]
264
265-- custom help flags
266data Test15 = Test15 {test15a :: Bool} deriving (Eq,Show,Data,Typeable)
267
268mode15 = cmdArgsMode $ Test15 (False &= name "help")
269         &= helpArg [groupname "GROUP", name "h", name "nohelp", explicit, help "whatever\nstuff"] &= versionArg [ignore]
270         &= verbosityArgs [ignore] [explicit,name "silent"]
271
272$(cmdArgsQuote [d|
273    mode15_ = cmdArgsMode# $ Test15 (False &=# name "help")
274              &=# helpArg [groupname "GROUP", name "h", name "nohelp", explicit, help "whatever\nstuff"] &=# versionArg [ignore]
275              &=# verbosityArgs [ignore] [explicit,name "silent"]
276    |])
277
278test15 = do
279    let Tester{..} = testers "Test15" [mode15,mode15_]
280    invalid $ \_ -> Test15 (False &= name "help")
281    ["--help"] === Test15 True
282    ["-t"] === Test15 True
283    fails ["-?"]
284    isHelp ["--nohelp"] ["  -h --nohelp  whatever"]
285    isHelp ["-h"] []
286    isHelp ["-h"] ["GROUP:"]
287    fails ["--version"]
288    fails ["--numeric-version"]
289    fails ["--verbose"]
290    fails ["--quiet"]
291    isVerbosity ["--help","--silent"] Quiet
292
293-- check newtype support
294newtype MyInt = MyInt Int deriving (Eq,Show,Data,Typeable)
295
296data Test16 = Test16 {test16a :: MyInt, test16b :: [MyInt]} deriving (Eq,Show,Data,Typeable)
297
298mode16 = cmdArgsMode $ Test16 (MyInt 12) [] &= summary "The Glorious Glasgow Haskell Compilation System, version 7.6.3"
299
300test16 = do
301    let Tester{..} = tester "Test16" mode16
302    [] === Test16 (MyInt 12) []
303    isVersion ["--numeric-version"] "7.6.3"
304    fails ["--test16a"]
305    ["--test16a=5"] === Test16 (MyInt 5) []
306    ["--test16b=5","--test16b=82"] === Test16 (MyInt 12) [MyInt 5, MyInt 82]
307
308-- #552, @ directives not expanded after -- symbols
309-- not actually checked because this path doesn't go through processArgs
310data Test17 = Test17 {test17_ :: [String]} deriving (Eq,Show,Data,Typeable)
311
312mode17 = cmdArgsMode $ Test17 ([] &= args) &= noAtExpand &= summary "bzip2 3.5-windows version"
313
314test17 = do
315    let Tester{..} = tester "Test17" mode17
316    [] === Test17 []
317    ["test","of","this"] === Test17 ["test","of","this"]
318    ["test","--","@foo"] === Test17 ["test","@foo"]
319    isVersion ["--numeric-version"] "3.5-windows"
320
321
322data Debuggable = This | That deriving (Eq,Show,Data,Typeable)
323data Test18 = Test18 {test18_ :: [Debuggable]} deriving (Eq,Show,Data,Typeable)
324
325mode18 = cmdArgsMode $ Test18 $ enum [[] &= ignore, [This] &= name "debug-this", [That] &= name "debug-that"]
326
327test18 = do
328    let Tester{..} = tester "Test18" mode18
329    [] === Test18 []
330    ["--debug-this","--debug-that","--debug-this"] === Test18 [This,That,This]
331
332-- #610, check performance for long lists (took ~20s before)
333
334data Test19 = Test19 {test19_ :: [String]} deriving (Eq,Show,Data,Typeable)
335
336mode19 = cmdArgsMode $ Test19 ([] &= args)
337
338test19 = do
339    let Tester{..} = tester "Test19" mode19
340    let args = map show [1..1000]
341    args === Test19 args
342
343
344-- #615, newtype wrappers of lists/Maybe should accumulate properly
345
346newtype Test20A = Test20A [String] deriving (Eq,Show,Data,Typeable)
347data Test20 = Test20 {test20_ :: Test20A} deriving (Eq,Show,Data,Typeable)
348
349mode20 = cmdArgsMode $ Test20 (Test20A [] &= args)
350
351test20 = do
352    let Tester{..} = tester "Test20" mode20
353    ["a","b","c"] === Test20 (Test20A ["a","b","c"])
354
355
356-- #626, don't reverse values too much
357
358newtype Test21A = Test21A [String] deriving (Eq,Show,Data,Typeable)
359data Test21 = Test21 {test21A :: Test21A, test21B :: [String], test21C :: [Int]} deriving (Eq,Show,Data,Typeable)
360
361mode21 = cmdArgsMode $ Test21 (Test21A ["a","b","c"]) ["A","B","C"] [1,2,3]
362
363test21 = do
364    let Tester{..} = tester "Test21" mode21
365    [] === Test21 (Test21A ["a","b","c"]) ["A","B","C"] [1,2,3]
366
367-- #10, don't break elm-server
368
369data Test22 = Test22 {port :: Int, runtime :: Maybe FilePath} deriving (Data,Typeable,Show,Eq)
370
371mode22 = cmdArgsMode $ Test22
372  { port = 8000 &= help "set the port of the server"
373  , runtime = Nothing &= typFile
374              &= help "Specify a custom location for Elm's runtime system."
375  } &= help "Quickly reload Elm projects in your browser. Just refresh to recompile.\n\
376            \It serves static files and freshly recompiled Elm files."
377    &= helpArg [explicit, name "help", name "h"]
378    &= versionArg [ explicit, name "version", name "v"
379                  , summary "0.12.0.1"
380                  ]
381    &= summary "Elm Server 0.11.0.1, (c) Evan Czaplicki 2011-2014"
382
383test22 = do
384    let Tester{..} = tester "Test22" mode22
385    [] === Test22 8000 Nothing
386    isVersion ["-v"] "0.12.0.1"
387    isVersion ["--version"] "0.12.0.1"
388    isVersion ["--numeric-version"] "0.12.0.1"
389    isHelp ["--help"] ["Elm Server 0.11.0.1, (c) Evan Czaplicki 2011-2014"]
390    isHelp ["--h"] ["Elm Server 0.11.0.1, (c) Evan Czaplicki 2011-2014"]
391    fails ["-?"]
392    ["--port=20"] === Test22 20 Nothing
393    ["--runtime=20"] === Test22 8000 (Just "20")
394    fails ["bob"]
395
396-- # 24, doesn't work with Ratio
397
398data Test23 = Test23 {test23A :: Ratio Int} deriving (Show, Data, Typeable, Eq)
399
400mode23 = cmdArgsMode $ Test23 {test23A = 4 % 7 }
401
402test23 = do
403    let Tester{..} = tester "Test23" mode23
404    [] === Test23 (4 % 7)
405    ["--test23=1,6"] === Test23 (1 % 6)
406
407
408-- For some reason, these must be at the end, otherwise the Template Haskell
409-- stage restriction kicks in.
410
411test = test1 >> test2 >> test3 >> test4 >> test5 >> test6 >> test7 >> test8 >> test9 >> test10 >>
412       test11 >> test12 >> test13 >> test14 >> test15 >> test16 >> test18 >> test19 >> test20 >>
413       test21 >> test22 >> test23
414demos = zipWith f [1..]
415        [toDemo mode1, toDemo mode2, toDemo mode3, toDemo mode4, toDemo mode5, toDemo mode6
416        ,toDemo mode7, toDemo mode8, toDemo mode9, toDemo mode10, toDemo mode11, toDemo mode12
417        ,toDemo mode13, toDemo mode14, toDemo mode15, toDemo mode16, toDemo mode17, toDemo mode18
418        ,toDemo mode19, toDemo mode20, toDemo mode21, toDemo mode22, toDemo mode23]
419    where f i x = x{modeHelp = "Testing various corner cases (" ++ show i ++ ")"}
420