1
2module System.Console.CmdArgs.Test.Explicit(test, demo) where
3
4import System.Console.CmdArgs.Default
5import System.Console.CmdArgs.Explicit
6import System.Console.CmdArgs.Test.Util
7
8
9demo = [newDemo act dem]
10
11act xs | ("help","") `elem` xs = print $ helpText [] def dem
12       | otherwise = print xs
13
14dem :: Mode [(String,String)]
15dem = mode "explicit" [] "Explicit sample program" (flagArg (upd "file") "FILE")
16      [flagOpt "world" ["hello","h"] (upd "world") "WHO" "World argument"
17      ,flagReq ["greeting","g"] (upd "greeting") "MSG" "Greeting to give"
18      ,flagHelpSimple (("help",""):)
19      ]
20    where upd msg x v = Right $ (msg,x):v
21
22
23test :: IO ()
24test = do
25    testUnnamedOnly
26    testFlags
27    testModes
28
29testUnnamedOnly = do
30    let m = name "UnnamedOnly" $ mode "" [] "" (flagArg (upd "") "") []
31    checkFail m ["-f"]
32    checkFail m ["--test"]
33    checkGood m ["fred","bob"] ["fred","bob"]
34    checkGood m ["--","--test"] ["--test"]
35    checkGood m [] []
36    checkComp m [] (0,0) []
37    checkComp m ["--"] (0,2) []
38    checkComp m ["bob"] (0,3) []
39    checkComp m ["-"] (0,1) [CompleteValue "-"]
40
41testFlags = do
42    let m = name "Flags" $ mode "" [] "" (flagArg (upd "") "")
43                [flagNone ["test","t"] ("test":) ""
44                ,flagNone ["more","m"] ("more":) ""
45                ,flagReq ["color","colour","bobby"] (upd "color") "" ""
46                ,flagOpt "" ["bob","z"] (upd "bob") "" ""
47                ,flagBool ["x","xxx"] (upb "xxx") ""]
48    checkFail m ["-q"]
49    checkGood m ["--test"] ["test"]
50    checkGood m ["-t"] ["test"]
51    checkFail m ["-t="]
52    checkFail m ["--test=value"]
53    checkFail m ["--bo"]
54    checkGood m ["--bobb=r"] ["colorr"]
55    checkGood m ["--bob"] ["bob"]
56    checkGood m ["--bob=foo"] ["bobfoo"]
57    checkGood m ["--bob","foo"] ["bob","foo"]
58    checkGood m ["-zfoo"] ["bobfoo"]
59    checkGood m ["-z=foo"] ["bobfoo"]
60    checkGood m ["-z","foo"] ["bob","foo"]
61    checkGood m ["--mo"] ["more"]
62    checkGood m ["-tm"] ["test","more"]
63    checkGood m ["--col=red"] ["colorred"]
64    checkGood m ["--col","red","-t"] ["colorred","test"]
65    checkComp m ["--tes"] (0,5) [CompleteValue "--test"]
66    checkComp m ["--color","--tes"] (1,5) []
67    checkComp m ["--more","--tes"] (1,5) [CompleteValue "--test"]
68    checkComp m ["--moo","--tes"] (1,5) [CompleteValue "--test"]
69    checkComp m ["--col"] (0,5) [CompleteValue "--color"]
70    checkComp m ["--bob"] (0,5) [CompleteValue "--bobby",CompleteValue "--bob"]
71    checkComp m ["-"] (0,1) $ map CompleteValue $ words "--test --more --color --bob -x -"
72    checkComp m ["--"] (0,2) $ map CompleteValue $ words "--test --more --color --bob --xxx"
73
74testModes = do
75    let m = name "Modes" $ modes "" [] ""
76                [(mode "test" ["test"] "" undefined [flagNone ["bob"] ("bob":) ""]){modeArgs=([],Nothing)}
77                ,mode "dist" ["dist"] "" (flagArg (upd "") "") [flagNone ["bob"] ("bob":) "", flagReq ["bill"] (upd "bill") "" ""]]
78    checkGood m [] []
79    checkFail m ["--bob"]
80    checkFail m ["tess"]
81    checkFail m ["test","arg"]
82    checkGood m ["test","--b"] ["test","bob"]
83    checkGood m ["t","--bo"] ["test","bob"]
84    checkGood m ["dist","--bob"] ["dist","bob"]
85    checkFail m ["dist","--bill"]
86    checkGood m ["dist","--bill","foo"] ["dist","billfoo"]
87
88
89---------------------------------------------------------------------
90-- UTILITIES
91
92upd pre s x = Right $ (pre++s):x
93upb pre s x = (pre ++ show s):x
94name x y = ("Explicit " ++ x, y)
95
96checkFail :: (String,Mode [String]) -> [String] -> IO ()
97checkFail (n,m) xs = case process m xs of
98    Right a -> failure "Succeeded when should have failed" [("Name",n),("Args",show xs),("Result",show a)]
99    Left a -> length (show a) `hpc` success
100
101checkGood :: (String,Mode [String]) -> [String] -> [String] -> IO ()
102checkGood (n,m) xs ys = case process m xs of
103    Left err -> failure "Failed when should have succeeded" [("Name",n),("Args",show xs),("Error",err)]
104    Right a | reverse a /= ys -> failure "Wrong parse" [("Name",n),("Args",show xs),("Wanted",show ys),("Got",show $ reverse a)]
105    _ -> success
106
107checkComp :: (String,Mode [String]) -> [String] -> (Int,Int) -> [Complete] -> IO ()
108checkComp (n,m) xs ab want
109    | want == got = success
110    | otherwise = failure "Bad completions" [("Name",n),("Args",show xs),("Index",show ab),("Wanted",show want),("Got",show got)]
111    where got = complete m xs ab
112