Tests.hs

{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-missing-fields -fno-warn-unused-binds #-}

module System.Console.CmdArgs.Test.Implicit.Tests where

import System.Console.CmdArgs
import System.Console.CmdArgs.Explicit(modeHelp)
import System.Console.CmdArgs.Test.Implicit.Util


test = test1 >> test2 >> test3 >> test4 >> test5 >> test6 >> test7 >> test8 >> test9 >> test10 >>
       test11 >> test12 >> test13 >> test14 >> test15
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]
    where f i x = x{modeHelp = "Testing various corner cases (" ++ show i ++ ")"}


-- 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]}
      deriving (Show,Eq,Data,Typeable)

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

test1 = do
    let Tester{..} = tester "Test1" 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]}
    fails ["--listbool=fred"]
    invalid $ \_ -> 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)

test3 = do
    let Tester{..} = tester "Test3" 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
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{}]

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

-- 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 [name "h", name "nohelp", explicit, help "whatever"] &= versionArg [ignore]
         &= verbosityArgs [ignore] [explicit,name "silent"]

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