commander-cli-0.2.0.0: Test.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
module Main where

import qualified Data.HashSet as HashSet
import qualified Data.HashMap.Strict as HashMap
import Data.Text
import Control.Concurrent
import Options.Commander
import Control.Monad
import System.Exit

main :: IO ()
main = rawTest >> argTest >> optTest >> flagTest

rawProg :: ProgramT Raw IO Bool
rawProg = raw (pure True)

rawTest :: IO ()
rawTest = maybe exitFailure (cond exitSuccess exitFailure) =<< runCommanderT (run rawProg) (State mempty mempty mempty)

argProg :: (String -> Bool) -> ProgramT (Arg "arg" String & Raw) IO Bool
argProg prop = arg \a -> raw (pure (prop a))

cond :: x -> x -> Bool -> x
cond x y True = x
cond x y False = y

argTest :: IO ()
argTest = maybe exitFailure (cond exitSuccess exitFailure) =<< runCommanderT (run (argProg (== "hello"))) (State ["hello"] mempty mempty)

optProg :: (Maybe String -> Bool) -> ProgramT (Opt "opt" "opt" String & Raw) IO Bool
optProg prop = opt \o -> raw (pure (prop o))

optTest :: IO ()
optTest = maybe exitFailure (cond exitSuccess exitFailure) =<< runCommanderT (run (optProg (== Just "hello"))) (State mempty (HashMap.fromList [("opt", "hello")]) mempty)

flagProg :: ProgramT (Flag "flag" & Raw) IO Bool
flagProg = flag (raw . pure)

flagTest :: IO ()
flagTest = maybe exitFailure (cond exitSuccess exitFailure) =<< runCommanderT (run flagProg) (State mempty mempty (HashSet.fromList ["flag"]))