cli-0.1.1: tests/Cli.hs

{-# LANGUAGE FlexibleContexts #-}
module Main (main) where

import           Control.Applicative
import           Control.Monad

import           Test.Tasty
import           Test.Tasty.QuickCheck
import           Test.QuickCheck.Monadic

import           System.Directory
import           Data.List
import           Data.Monoid
import           Data.Functor.Identity

import           Console.Options hiding (defaultMain)

flagA = flagParam (FlagShort 'a' <> FlagLong "aaa") (FlagRequired Right)
flagB = flagParam (FlagShort 'b' <> FlagLong "bbb") (FlagRequired Right)

commandFoo = command "foo" $ do
    action $ \toParam -> return True

--commandBar :: Monad m => OptionDesc (m Bool) ()
commandBar :: OptionDesc (Identity Bool) ()
commandBar = command "bar" $ do
    a  <- flagA
    a2 <- argument "arg1" Right
    action $ \toParam -> do
        return True

testParseHelp name f = testProperty name $ runIdentity $ do
    case snd f of
        OptionHelp -> return True
        _          -> return False

testParseSuccess name values f =
    testProperty name $
        let (_,r) = f
         in case r of
                OptionSuccess p act -> runIdentity $ return (sort values == sort (paramsFlags p))
                OptionHelp          -> error $ "got help expected success"
                OptionError s       -> error $ "got error " ++ show s ++ " expected success"
                OptionInvalid s     -> error $ "got invalid " ++ show s ++ " expected success"

main = defaultMain $ testGroup "options"
    [ testGroup "help"
        [ testParseHelp "1" $ parseOptions (commandBar) ["options", "argument", "--help", "a"]
        , testParseHelp "2" $ parseOptions (commandBar) ["options", "argument", "-h", "a"]
        ]
    , testGroup "success"
        [ testParseSuccess "1" [] $ parseOptions (commandBar >> commandFoo) ["bar", "arg1"]
        , testParseSuccess "2" [] $ parseOptions (commandBar >> commandFoo) ["foo", "a"]
        ]
    ]