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