{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
import Control.Applicative ((<|>), optional)
import Data.Either (isLeft)
import Data.Foldable (asum)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import Test.Hspec (describe, expectationFailure, hspec, it, shouldBe)
import Flags.Applicative
data Mode = Flexible | Strict deriving (Bounded, Enum, Eq, Show)
main :: IO ()
main = hspec $ do
describe "parse" $ do
it "should parse a single flag" $ do
let
parser = flag textVal "foo" ""
res = parseFlags parser ["--foo=abc", "hi"]
res `shouldBe` Right ("abc", ["hi"])
it "should fail on duplicate flag" $ do
let
parser = (,) <$> flag textVal "foo" "" <*> flag textVal "foo" ""
res = parseFlags parser []
res `shouldBe` Left (DuplicateFlag "foo")
it "should support help" $ do
let
parser = flag textVal "foo" ""
res = parseFlags parser ["--foo=abc", "hi", "--help"]
isLeft res `shouldBe` True
it "should fail on unknown flags" $ do
let
parser = flag textVal "foo" ""
res = parseFlags parser ["hi", "--bar"]
res `shouldBe` Left (UnknownFlag "bar")
it "should detect unexpected flags" $ do
let
parser = switch "bar" "" <|> switch "foo" ""
res = parseFlags parser ["--bar", "--foo"]
res `shouldBe` Left (UnexpectedFlags ("foo" :| []))
it "should branch correctly with unary flags" $ do
let
parser = asum
[ Right <$> flag (autoVal @String) "ok" ""
, Left <$> flag (autoVal @String) "fail" "" ]
res = parseFlags parser ["--ok", "\"yes\"", "no"]
res `shouldBe` Right (Right "yes", ["no"])
it "should branch correctly with nullary flags" $ do
let
parser = (True <$ switch "true" "") <|> (False <$ switch "false" "")
res = parseFlags parser ["--true", "b", "a"]
res `shouldBe` Right (True, ["b", "a"])
it "should fail on inconsistent flag values" $ do
let
parser = flag textVal "foo" ""
res = parseFlags parser ["--foo=1", "--foo=2"]
res `shouldBe` Left (InconsistentFlagValues "foo")
it "should support the same flag value multiple times" $ do
let
parser = flag (autoVal @Int) "foo" ""
res = parseFlags parser ["--foo=1", "--foo=1"]
res `shouldBe` Right (1, [])
it "should support strings" $ do
let
parser = flag stringVal "bar" ""
res = parseFlags parser ["--bar", "abc0"]
res `shouldBe` Right ("abc0", [])
it "should support text lists" $ do
let
parser = flag (listOf textVal) "bar" ""
res = parseFlags parser ["--bar=a,b,c", "def"]
res `shouldBe` Right (["a", "b", "c"], ["def"])
it "should support maps" $ do
let
parser = flag (mapOf textVal fracVal) "bar" "" :: FlagsParser (Map Text Double)
res = parseFlags parser ["--bar=a:1,b:0,c:2.5"]
res `shouldBe` Right (Map.fromList [("a", 1), ("b", 0), ("c", 2.5)], [])
it "should swallow switches" $ do
let
parser = boolFlag "foo" ""
res = parseFlags parser ["--foo", "--bar", "--swallowed_switches=bar"]
res `shouldBe` Right (True, [])
it "should fail when a switch is set as a flag" $ do
let
parser = boolFlag "foo" ""
res = parseFlags parser ["--foo=3"]
res `shouldBe` Left (UnexpectedFlagValue "foo")
it "should swallow flags" $ do
let
parser = boolFlag "foo" ""
res = parseFlags parser ["--bar=2", "--swallowed_flags=bar"]
res `shouldBe` Right (False, [])
it "should fail when a flag is swallowed as a switch" $ do
let
parser = boolFlag "foo" ""
res = parseFlags parser ["--foo", "--bar=1", "--swallowed_switches=bar"]
res `shouldBe` Left (UnexpectedFlagValue "bar")
it "should parse a hostname" $ do
let
parser = flag hostVal "host" ""
res = parseFlags parser ["--host=foo.com"]
res `shouldBe` Right (("foo.com", Nothing), [])
it "should parse a hostname and a port" $ do
let
parser = flag hostVal "host" ""
res = parseFlags parser ["--host=localhost:1234"]
res `shouldBe` Right (("localhost", Just 1234), [])
it "should fail when given an invalid port" $ do
let
parser = flag hostVal "host" ""
res = parseFlags parser ["--host=localhost:1a2"]
case res of
Left (InvalidFlagValue "host" _ _) -> pure ()
_ -> expectationFailure $ show res
it "should report all missing required flags" $ do
let
parser = switch "foo" "" <|> switch "bar" ""
res = parseFlags parser []
case res of
Left (MissingFlags ("foo" :| ["bar"])) -> pure ()
_ -> expectationFailure $ show res
it "should ignore conflicting flags after --" $ do
let
parser = switch "foo" "" <|> switch "bar" ""
res = parseFlags parser ["--foo", "--", "--bar"]
res `shouldBe` Right ((), ["--bar"])
it "should ignore undeclared flags after --" $ do
let
parser = optional $ flag textVal "foo" ""
res = parseFlags parser ["--", "--bar=2"]
res `shouldBe` Right (Nothing, ["--bar=2"])
it "should parse integral flags" $ do
let parser = flag intVal "int" "" :: FlagsParser Int
parseFlags parser ["--int=12"] `shouldBe` Right (12, [])
parseFlags parser ["--int=-1"] `shouldBe` Right (-1, [])
parseFlags parser ["--int", "0"] `shouldBe` Right (0, [])
case parseFlags parser ["--int", "0.1"] of
Left (InvalidFlagValue "int" "0.1" _) -> pure ()
r -> expectationFailure $ show r
case parseFlags parser ["--int", ""] of
Left (InvalidFlagValue "int" "" _) -> pure ()
r -> expectationFailure $ show r
it "should parse fractional flags" $ do
let parser = flag fracVal "double" "" :: FlagsParser Double
parseFlags parser ["--double=12.1"] `shouldBe` Right (12.1, [])
parseFlags parser ["--double=-1"] `shouldBe` Right (-1, [])
parseFlags parser ["--double", "0"] `shouldBe` Right (0, [])
case parseFlags parser ["--double", "0."] of
Left (InvalidFlagValue "double" "0." _) -> pure ()
r -> expectationFailure $ show r
it "should parse enum flags" $ do
let parser = flag enumVal "mode" "" :: FlagsParser Mode
parseFlags parser ["--mode", "FLEXIBLE"] `shouldBe` Right (Flexible, [])
parseFlags parser ["--mode=STRICT"] `shouldBe` Right (Strict, [])
case parseFlags parser ["--mode", "NONE"] of
Left (InvalidFlagValue "mode" "NONE" _) -> pure ()
r -> expectationFailure $ show r