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