opt-env-conf-test-0.0.0.2: test/OptEnvConf/RunSpec.hs
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
module OptEnvConf.RunSpec (spec) where
import Autodocodec
import Control.Applicative
import Data.Aeson as JSON (Object, Value (Null), toJSON)
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
import Data.GenValidity.Aeson ()
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Text (Text)
import qualified Data.Text as T
import Data.Tuple (swap)
import GHC.Stack (HasCallStack, withFrozenCallStack)
import OptEnvConf
import OptEnvConf.Args as Args
import OptEnvConf.Args.Gen ()
import OptEnvConf.EnvMap (EnvMap (..))
import qualified OptEnvConf.EnvMap as EnvMap
import OptEnvConf.EnvMap.Gen ()
import OptEnvConf.Error
import Test.Syd
import Test.Syd.Validity
import Text.Colour
spec :: Spec
spec = do
describe "runParser" $ do
describe "pure" $ do
it "can parse a pure value from anything" $
forAllValid $ \e ->
forAllValid $ \mConf ->
forAllValid $ \expected ->
shouldParse (pure expected) Args.emptyArgs e mConf (expected :: Int)
describe "fmap" $ do
it "can parse a mapped value from anything" $
forAllValid $ \e ->
forAllValid $ \mConf ->
forAllValid $ \i -> do
let expected = succ i
shouldParse (fmap succ $ pure i) Args.emptyArgs e mConf (expected :: Int)
describe "<*>" $ do
it "can parse two values with ap" $
forAllValid $ \e ->
forAllValid $ \mConf ->
forAllValid $ \i -> do
let p = (,) <$> pure (succ i) <*> pure i
let expected = (succ i, i :: Int)
shouldParse p Args.emptyArgs e mConf expected
describe "Select" $ do
it "can use the second parser with select" $
forAllValid $ \e ->
forAllValid $ \mConf ->
forAllValid $ \i -> do
let p = select (pure (Left i :: Either Int Int)) (pure succ)
let expected = succ i
shouldParse p Args.emptyArgs e mConf expected
it "can avoid the second parser with select" $
forAllValid $ \e ->
forAllValid $ \mConf ->
forAllValid $ \i -> do
let p = select (pure (Right i :: Either Int Int)) (pure succ)
let expected = i
shouldParse p Args.emptyArgs e mConf expected
describe "Empty" $ do
it "can fail to parse an empty value" $
forAllValid $ \args ->
forAllValid $ \e ->
forAllValid $ \mConf -> do
let p = empty :: Parser Int
shouldFail p args e mConf $ \case
ParseErrorEmpty :| [] -> True
_ -> False
describe "Alt" $ do
it "can parse a Left value with Alt" $
forAllValid $ \e ->
forAllValid $ \mConf ->
forAllValid $ \i -> do
let p = (Left <$> pure i) <|> (Right <$> pure (succ i))
let expected = Left (i :: Int)
shouldParse p Args.emptyArgs e mConf expected
it "can parse a Right value with Alt" $
forAllValid $ \e ->
forAllValid $ \mConf ->
forAllValid $ \i -> do
let p = empty `ParserAlt` (Right <$> pure i)
let expected = Right (i :: Int) :: Either Int Int
shouldParse p Args.emptyArgs e mConf expected
describe "Many" $ do
it "can pass many args" $
forAllValid $ \e ->
forAllValid $ \mConf ->
forAllValid $ \ls -> do
let args = parseArgs ls
let p = many $ setting [reader str, argument]
let expected = ls
shouldParse p args e mConf expected
describe "Some" $ do
it "fails to parse zero args" $
forAllValid $ \e ->
forAllValid $ \mConf -> do
let args = emptyArgs
let p = some $ setting [reader str, argument] :: Parser [String]
shouldFail p args e mConf $ \case
ParseErrorMissingArgument _ :| [] -> True
_ -> False
it "can parse some args" $
forAllValid $ \e ->
forAllValid $ \mConf ->
forAllValid $ \ls -> do
let args = parseArgs (NE.toList ls)
let p = some $ setting [reader str, argument]
let expected = NE.toList ls
shouldParse p args e mConf expected
describe "MapIO" $ do
it "can run an IO action on the result of a parser" $
forAllValid $ \e ->
forAllValid $ \mConf ->
forAllValid $ \i -> do
let p = mapIO (pure . succ) (pure (i :: Int))
let expected = succ i
shouldParse p Args.emptyArgs e mConf expected
describe "WithConfig" $ do
it "can replace the config object" $
forAllValid $ \e ->
forAllValid $ \c1 ->
forAllValid $ \c2' ->
forAllValid $ \(key, val) -> do
let c2 = KeyMap.insert key (toJSON val) c2'
let p =
withConfig (pure (Just c2)) $
setting [conf (Key.toString key)]
let expected = val :: Text
shouldParse p Args.emptyArgs e (Just c1) expected
describe "withFirstYamlConfig" $ do
it "can parse without any arguments" $
forAllValid $ \e ->
forAllValid $ \val -> do
let p = withFirstYamlConfig (pure []) (pure val) :: Parser String
shouldParse p Args.emptyArgs e Nothing val
describe "withCombinedYamlConfig" $ do
it "can parse without any arguments" $ do
forAllValid $ \e ->
forAllValid $ \val -> do
let p = withCombinedYamlConfigs (pure []) (pure val) :: Parser String
shouldParse p Args.emptyArgs e Nothing val
describe "subArgs" $ do
it "can prefix a switch parser" $
forAllValid $ \e ->
forAllValid $ \mConf ->
forAllValid $ \prefix ->
forAllValid $ \(key, val) -> do
let prefixedKey = Args.prefixDashed prefix (DashedLong key)
let a = Args.parseArgs [Args.renderDashed prefixedKey]
let p =
subArgs prefix $
setting
[ reader str,
switch val,
long (NE.toList key)
]
let expected = val :: String
shouldParse p a e mConf expected
it "can prefix an option parser" $
forAllValid $ \e ->
forAllValid $ \mConf ->
forAllValid $ \prefix ->
forAllValid $ \(key, val) -> do
let prefixedKey = Args.prefixDashed prefix (DashedLong key)
let a = parseArgs [renderDashed prefixedKey, val]
let p =
subArgs prefix $
setting
[ reader str,
option,
long (NE.toList key)
]
let expected = val
shouldParse p a e mConf expected
describe "subEnv" $ do
it "can prefix an env var parser" $
forAllValid $ \e' ->
forAllValid $ \mConf ->
forAllValid $ \prefix ->
forAllValid $ \(key, val) -> do
let prefixedKey = prefix <> key
let e = EnvMap.insert prefixedKey val e'
let p = subEnv prefix $ setting [reader str, env key]
let expected = val
shouldParse p Args.emptyArgs e mConf expected
describe "subConfig" $ do
it "can prefix a conf val parser" $
forAllValid $ \e ->
forAllValid $ \c' ->
forAllValid $ \prefix ->
forAllValid $ \(key, val) -> do
let c = KeyMap.insert prefix (toJSON (KeyMap.singleton key (toJSON val))) c'
let p =
subConfig (Key.toString prefix) $
setting [conf (Key.toString key)]
let expected = val :: Text
shouldParse p Args.emptyArgs e (Just c) expected
describe "Setting" $ do
it "can parse a single arg" $
forAllValid $ \e ->
forAllValid $ \mConf ->
forAllValid $ \arg -> do
let args = Args.parseArgs [arg]
let p = setting [reader str, argument]
let expected = arg
shouldParse p args e mConf expected
it "can parse a single option" $
forAllValid $ \e ->
forAllValid $ \mConf ->
forAllValid $ \(l, r) -> do
let args =
parseArgs
[ Args.renderDashed (DashedLong l),
r
]
let p = setting [reader str, option, long $ NE.toList l]
let expected = r
shouldParse p args e mConf expected
it "can parse a many of the same option" $
forAllValid $ \e ->
forAllValid $ \mConf ->
forAllValid $ \(l, rs) -> do
let args = parseArgs $ concatMap (\v -> [Args.renderDashed (DashedLong l), v]) rs
let p = many $ setting [reader str, option, long $ NE.toList l]
let expected = rs :: [String]
shouldParse p args e mConf expected
it "can parse a single env var" $
forAllValid $ \e' ->
forAllValid $ \mConf ->
forAllValid $ \(key, val) -> do
let e = EnvMap.insert key val e'
let p = setting [reader str, env key]
let expected = val
shouldParse p Args.emptyArgs e mConf expected
it "can parse a single config value" $
forAllValid $ \e ->
forAllValid $ \c' ->
forAllValid $ \(key, val) -> do
let c = KeyMap.insert key (toJSON val) c'
let p = setting [conf (Key.toString key)]
let expected = val :: Text
shouldParse p Args.emptyArgs e (Just c) expected
it "parses Null as the default value" $
forAllValid $ \e ->
forAllValid $ \c' ->
forAllValid $ \key -> do
let c = KeyMap.insert key JSON.Null c'
let defaultVal = "hi" :: String
let p = setting [conf (Key.toString key), value defaultVal]
let expected = defaultVal
shouldParse p Args.emptyArgs e (Just c) expected
describe "Unit tests" $ do
argParseSpec
["--foo", "bar"]
(setting [reader str, option, long "foo"])
("bar" :: String)
argParseSpec
["--foo", "bar"]
(many $ setting [reader str, option, long "foo"])
(["bar"] :: [String])
argParseSpec
["--foo", "bar", "--foo", "quux"]
(many $ setting [reader str, option, long "foo"])
(["bar", "quux"] :: [String])
argParseSpec
["--foo", "bar", "-f", "quux"]
(many $ setting [reader str, option, short 'f', long "foo"])
(["bar", "quux"] :: [String])
argParseSpec
["-f", "bar", "--foo", "quux"]
(many $ setting [reader str, option, short 'f', long "foo"])
(["bar", "quux"] :: [String])
argParseSpec
["--", "all", "-bare", "--arguments"]
(many $ setting [reader str, argument])
-- No double-dash!
(["all", "-bare", "--arguments"] :: [String])
-- Switch before argument
argParseSpec
["--foo", "bar"]
((,) <$> setting [switch True, long "foo"] <*> setting [reader str, argument])
(True, "bar" :: String)
-- Note that this could also be parsed as (False, "--foo") with a
-- leftover argument but somehow that's not what we want.
-- (Maybe we could "just" disallow extra arguments while parsing?
-- No because then "--help" doesn't work.)
argParseSpec
["--foo", "bar"]
((,) <$> setting [switch True, long "foo", value False] <*> setting [reader str, argument])
(True, "bar" :: String)
-- Switch before argument, but defined after
argParseSpec
["--foo", "bar"]
((,) <$> setting [reader str, argument] <*> setting [switch True, long "foo"])
("bar" :: String, True)
-- Dashed as argument
-- This example shows that we can't just skip dasheds when looking for
-- arguments.
argParseSpec
["--foo", "bar"]
((,) <$> setting [reader str, argument] <*> setting [reader str, argument])
("--foo" :: String, "bar" :: String)
-- Dashed as value for an option
-- This example shows that we can't "just" treat any argument with dashed
-- as an option key or switch.
-- They could be a value.
argParseSpec
["--foo", "--bar"]
(setting [reader str, option, long "foo"])
("--bar" :: String)
-- Short dashed as a value for an option
-- This example shows that we can't "just" unfold combined short options.
-- They could be a value.
argParseSpec
["--foo", "-dfu"]
(setting [reader str, option, long "foo"])
("-dfu" :: String)
-- Arguments can be parsed as-is
argParseSpec
["delete"]
( commands
[ command "add" "add" (pure "hi"),
command "delete" "delete" (pure "ho")
]
)
("ho" :: String)
-- A command can have an argument
argParseSpec
["add", "hi"]
( commands
[ command "add" "add" $ setting [argument, reader str],
command "other" "other" (pure "ho")
]
)
("hi" :: String)
-- Here an argument has a value that looks like a command name but
-- should still be treated as an argument.
argParseSpec
["command", "arg"]
( (,)
<$> setting [reader str, argument]
<*> commands
[ command "command" "command" (pure '1'),
command "arg" "command" (pure '2')
]
)
("command" :: String, '2')
-- Same as above but with an option instead of an argument
argParseSpec
["--option", "command", "arg"]
( (,)
<$> setting [reader str, option, long "option"]
<*> commands
[ command "command" "command" (pure '1'),
command "arg" "command" (pure '2')
]
)
("command" :: String, '2')
-- Commands can have a default
argParseSpec
[]
( commands
[ command "a" "a" (pure "a"),
command "b" "b" (pure "b"),
defaultCommand "b"
]
)
("b" :: String)
-- Commands can have a default with an argument
argParseSpec
["c"]
( commands
[ command "a" "a" (pure "a"),
command "b" "b" $ setting [argument, reader str],
defaultCommand "b"
]
)
("c" :: String)
-- Unfolding switches
argParseSpecs
( length
<$> many
( setting
[ help "verbosity",
switch (),
long "verbose",
short 'v'
]
)
)
[ ([], 0),
(["-v"], 1),
(["--verbose"], 1),
(["-v", "-v"], 2),
(["-v", "--verbose"], 2),
(["-vv"], 2),
(["-vv", "--verbose"], 3),
(["-vv", "--verbose", "-v"], 4)
]
-- Unfolding short options as well
argParseSpecs
( (,)
<$> ( length
<$> many
( setting
[ help "verbosity",
switch (),
short 'v'
]
)
)
<*> setting
[ reader str,
option,
short 'f',
example ("file" :: String)
]
)
[ (["-f", "foo"], (0, "foo" :: String)),
(["-v", "-f", "foo"], (1, "foo")),
(["-vf", "foo", "-v"], (2, "foo")),
(["-vvf", "foo"], (2, "foo")),
(["-vvf", "foo", "-v"], (3, "foo"))
]
-- Unfolding short switches
argParseSpecs
( (,)
<$> many
( setting
[ reader str,
option,
long "file",
short 'f'
]
)
<*> ( length
<$> many
( setting
[ help "verbosity",
switch (),
short 'v'
]
)
)
)
[ ([], ([], 0)),
(["--file", "foo", "-v"], (["foo" :: String], 1)),
(["-vf", "foo"], (["foo"], 1))
]
-- Equals version of long option
argParseSpecs
( setting
[ option,
reader str,
long "file"
]
)
[ (["--file", "foo"], "foo" :: String),
(["--file=foo"], "foo")
]
-- Shorthand version of short option
argParseSpecs
( setting
[ option,
reader str,
short 'f'
]
)
[ (["-f", "foo"], "foo" :: String),
(["-ffoo"], "foo")
]
-- Optional Argument and optional switch
let optionalArgOptionalSwitchExamples =
[ (["foo", "-w"], (Just "foo", True)),
(["-w", "foo"], (Just "foo", True)),
(["foo", "--watch"], (Just "foo", True)),
(["--watch", "foo"], (Just "foo", True)),
(["foo"], (Just "foo", False)),
(["--bar"], (Just "--bar", False)),
(["-w"], (Nothing, True)),
(["--watch"], (Nothing, True))
]
argParseSpecs
( (,)
<$> optional (setting [reader str, argument])
<*> setting [switch True, short 'w', long "watch", value False] ::
Parser (Maybe String, Bool)
)
optionalArgOptionalSwitchExamples
argParseSpecs
( swap
<$> ( (,)
<$> setting [switch True, short 'w', long "watch", value False]
<*> optional (setting [reader str, argument])
) ::
Parser (Maybe String, Bool)
)
optionalArgOptionalSwitchExamples
let verbosityArgsExamples =
[ ([], ([], 0)),
(["-vvv"], ([], 3)),
(["--"], (["--"], 0)),
(["-v", "--"], (["--"], 1)),
(["-vv", "--"], (["--"], 2)),
(["--", "-v"], (["-v"], 0)),
(["a", "-v", "b", "-v"], (["a", "b"], 2)),
(["a", "--verbose", "-v", "b", "-v"], (["a", "b"], 3)),
(["a", "--verbose", "-v", "-v", "b", "-v"], (["a", "b"], 4)),
(["a", "--verbose", "-v", "-v", "b", "-v", "c"], (["a", "b", "c"], 4)),
(["a", "--verbose", "-v", "-vv", "b", "-v", "c"], (["a", "b", "c"], 5)),
(["a", "--verbose", "-v", "-vv", "-v", "b", "-v", "c"], (["a", "b", "c"], 6))
]
argParseSpecs
( (,)
<$> many (setting [reader str, argument])
<*> (length <$> many (setting [switch (), short 'v', long "verbose"])) ::
Parser ([String], Int)
)
verbosityArgsExamples
argParseSpecs
( swap
<$> ( (,)
<$> (length <$> many (setting [switch (), short 'v', long "verbose"]))
<*> many (setting [reader str, argument])
) ::
Parser ([String], Int)
)
verbosityArgsExamples
let optionsArgsExamples =
[ ([], ([], [])),
(["-p1"], ([], [1])),
(["-p1", "--port", "2"], ([], [1, 2])),
(["-p", "1", "-p", "2", "-p", "3"], ([], [1, 2, 3])),
(["--port=2"], ([], [2])),
(["--port=2", "-p3"], ([], [2, 3])),
(["--port", "3"], ([], [3])),
(["foo", "-p4"], (["foo"], [4])),
(["bar", "--port=5"], (["bar"], [5])),
(["quux", "--port", "6"], (["quux"], [6])),
(["-p7", "foo"], (["foo"], [7])),
(["--port=8", "bar"], (["bar"], [8])),
(["--port", "9", "quux"], (["quux"], [9])),
(["--", "-p1"], (["-p1"], [])),
(["--", "-p", "2"], (["-p", "2"], [])),
(["--", "--port=3"], (["--port=3"], [])),
(["--", "--port", "4"], (["--port", "4"], []))
]
argParseSpecs
( (,)
<$> many (setting [reader str, argument])
<*> many (setting [reader auto, option, short 'p', long "port"]) ::
Parser ([String], [Int])
)
optionsArgsExamples
argParseSpecs
( swap
<$> ( (,)
<$> many (setting [reader auto, option, short 'p', long "port"])
<*> many (setting [reader str, argument])
) ::
Parser ([String], [Int])
)
optionsArgsExamples
argParseSpecs
(enableDisableSwitch [long "example", env "EXAMPLE", conf "example", value True])
[ ([], True),
(["--enable-example"], True),
(["--disable-example"], False)
]
argParseSpecs
(enableDisableSwitch [long "example", env "EXAMPLE", conf "example", value False])
[ ([], False),
(["--enable-example"], True),
(["--disable-example"], False)
]
argParseSpecs
(optional $ enableDisableSwitch [long "example", env "EXAMPLE", conf "example"])
[ ([], Nothing),
(["--enable-example"], Just True),
(["--disable-example"], Just False)
]
envParseSpecs
(enableDisableSwitch [long "example", env "EXAMPLE", env "ALTERNATIVE", conf "example", value True])
[ ([], True),
([("EXAMPLE", "False")], False),
([("ALTERNATIVE", "False")], False),
([("EXAMPLE", "True")], True),
([("ALTERNATIVE", "True")], True)
]
envParseSpecs
(enableDisableSwitch [long "example", env "EXAMPLE", env "ALTERNATIVE", conf "example", value False])
[ ([], False),
([("EXAMPLE", "True")], True),
([("ALTERNATIVE", "True")], True),
([("EXAMPLE", "False")], False),
([("ALTERNATIVE", "False")], False)
]
argParseSpecs
(yesNoSwitch [long "example", env "EXAMPLE", conf "example", value True])
[ ([], True),
(["--example"], True),
(["--no-example"], False)
]
argParseSpecs
(yesNoSwitch [long "example", env "EXAMPLE", conf "example", value False])
[ ([], False),
(["--example"], True),
(["--no-example"], False)
]
argParseSpecs
(optional $ yesNoSwitch [long "example", env "EXAMPLE", conf "example"])
[ ([], Nothing),
(["--example"], Just True),
(["--no-example"], Just False)
]
envParseSpecs
(yesNoSwitch [long "example", env "EXAMPLE", env "ALTERNATIVE", conf "example", value True])
[ ([], True),
([("EXAMPLE", "False")], False),
([("ALTERNATIVE", "False")], False),
([("EXAMPLE", "True")], True),
([("ALTERNATIVE", "True")], True)
]
envParseSpecs
(yesNoSwitch [long "example", env "EXAMPLE", env "ALTERNATIVE", conf "example", value False])
[ ([], False),
([("EXAMPLE", "True")], True),
([("ALTERNATIVE", "True")], True),
([("EXAMPLE", "False")], False),
([("ALTERNATIVE", "False")], False)
]
argParseSpecs
( commands
[ command "one" "first" $ pure '1',
command "two" "second" $ pure '2'
]
)
[ (["one"], '1'),
(["two"], '2')
]
argParseSpecs
((Left <$> setting [switch True, long "bash-completion-script"]) <|> (Right <$> setting [reader str, argument]))
[ (["--bash-completion-script"], Left True),
(["arg"], Right ("arg" :: String))
]
argParseSpecs
((Left <$> setting [switch True, long "bash-completion-script"]) <|> (Right <$> optional (setting [reader str, argument])))
[ (["--bash-completion-script"], Left True),
(["arg"], Right (Just ("arg" :: String)))
]
argParseSpecs
( optional
( allOrNothing
( (,)
<$> setting [reader str, option, long "foo"]
<*> optional (setting [reader str, option, long "bar"])
)
) ::
Parser (Maybe (String, Maybe String))
)
[ ([], Nothing),
(["--foo", "foo"], Just ("foo", Nothing))
]
-- Default values should not count as parsed:
argParseSpecs
( choice
[ allOrNothing $
(,)
<$> setting [option, long "foo", reader auto, help "This one will exist", metavar "CHAR", value 'c']
<*> setting [option, long "bar", reader auto, help "This one will not exist", metavar "CHAR"],
pure ('a', 'b')
]
)
[ ([], ('a', 'b')),
(["--foo", "'c'", "--bar", "'d'"], ('c', 'd'))
]
argParseSpecs
( (,)
<$> setting [option, long "before", reader auto, help "before", metavar "CHAR"]
<*> optional
( allOrNothing $
(,)
<$> setting [option, long "baz", reader auto, help "This one will exist", metavar "CHAR"]
<*> setting [option, long "quux", reader auto, help "This one will not exist", metavar "CHAR"]
) ::
Parser (Char, Maybe (Char, Char))
)
[ (["--before", "'m'"], ('m', Nothing))
]
-- source location does not matter
argParseSpecs
( optional
( let foo = setting [reader str, option, long "foo"]
in (,)
<$> foo
<*> optional
( subAll
"bar"
( allOrNothing
( (,)
<$> foo
<*> setting [reader str, option, long "bar"]
)
)
)
) ::
Parser (Maybe (String, Maybe (String, String)))
)
[ ([], Nothing),
(["--foo", "foo"], Just ("foo", Nothing))
]
-- Failing after consuming args leaves the args unconsumed
argParseSpecs
( choice
[ (++)
<$> many (setting [reader str, argument])
<*> setting [switch ["ho"], long "--switch"],
many $ setting [reader str, argument]
]
)
[ (["args", "here"], ["args", "here" :: String])
]
-- Unrecognised args should be forgivable
argParseSpecs
( let fallback = setting [reader str, option, long "foo"]
withCommand = commands [command "run" "command in front" fallback]
in withCommand <|> fallback
)
[ (["run", "--foo", "bar"], "bar" :: String),
(["--foo", "bar"], "bar" :: String)
]
-- Alt-ing commands concats the commands
argParseSpecs
( let fallback = setting [reader str, option, long "foo"]
withCommand1 = commands [command "run1" "command in front" fallback]
withCommand2 = commands [command "run2" "command in front" fallback]
in withCommand1 <|> withCommand2 <|> fallback
)
[ (["run1", "--foo", "bar"], "bar" :: String),
(["run2", "--foo", "bar"], "bar" :: String),
(["--foo", "bar"], "bar" :: String)
]
-- Alt-ing commands concats the commands, even recursively
argParseSpecs
( let fallback = setting [reader str, option, long "foo"]
withCommand1 = commands [command "run1" "command in front" fallback]
withCommand2 = commands [command "run2" "command in front" fallback]
in withCommand1 <|> (withCommand2 <|> fallback)
)
[ (["run1", "--foo", "bar"], "bar" :: String),
(["run2", "--foo", "bar"], "bar" :: String),
(["--foo", "bar"], "bar" :: String)
]
-- Required config value
confParseSpecs
(setting [conf "hi"] :: Parser String)
[ (Just [("hi", "ho")], "ho")
]
-- Optional config value
confParseSpecs
(optional $ setting [conf "hi"] :: Parser (Maybe String))
[ (Nothing, Nothing),
(Just [("hi", "ho")], Just "ho")
]
-- Multiple possible codecs
confParseSpecs
( setting
[ confWith "hi" (Left <$> codec),
confWith "foo" (Right <$> codec)
]
)
[ (Just [("hi", toJSON (5 :: Int))], Left 5),
(Just [("foo", "bar")], Right "bar" :: Either Int String)
]
argParseSpecs
( withDefault
False
( setting
[ argument,
reader auto
]
)
)
[ (["True"], True),
([], False)
]
argParseSpecs :: (HasCallStack) => (Show a, Eq a) => Parser a -> [([String], a)] -> Spec
argParseSpecs p table = withFrozenCallStack $ mapM_ (\(args, result) -> argParseSpec args p result) table
argParseSpec :: (HasCallStack) => (Show a, Eq a) => [String] -> Parser a -> a -> Spec
argParseSpec args p expected = withFrozenCallStack $ do
it (unwords ["parses args", show args, "as", show expected]) $ do
let argMap = parseArgs args
errOrRes <- runParserOn Nothing p argMap EnvMap.empty Nothing
context (showParserABit p) $
case errOrRes of
Left errs ->
expectationFailure $
unlines
[ T.unpack $ renderChunksText With24BitColours $ renderErrors errs,
ppShow errs
]
Right actual -> actual `shouldBe` expected
envParseSpecs :: (HasCallStack) => (Show a, Eq a) => Parser a -> [([(String, String)], a)] -> Spec
envParseSpecs p table = withFrozenCallStack $ mapM_ (\(envs, result) -> envParseSpec envs p result) table
envParseSpec :: (HasCallStack) => (Show a, Eq a) => [(String, String)] -> Parser a -> a -> Spec
envParseSpec envVars p expected = withFrozenCallStack $ do
it (unwords ["parses environment", show envVars, "as", show expected]) $ do
let envMap = EnvMap.parse envVars
errOrRes <- runParserOn Nothing p emptyArgs envMap Nothing
case errOrRes of
Left err -> expectationFailure $ T.unpack $ renderChunksText With24BitColours $ renderErrors err
Right actual -> actual `shouldBe` expected
confParseSpecs :: (HasCallStack) => (Show a, Eq a) => Parser a -> [(Maybe JSON.Object, a)] -> Spec
confParseSpecs p table = withFrozenCallStack $ mapM_ (\(mConf, result) -> confParseSpec mConf p result) table
confParseSpec :: (HasCallStack) => (Show a, Eq a) => Maybe JSON.Object -> Parser a -> a -> Spec
confParseSpec mConf p expected = withFrozenCallStack $ do
it (unwords ["parses configuration", show mConf, "as", show expected]) $ do
errOrRes <- runParserOn Nothing p emptyArgs EnvMap.empty mConf
case errOrRes of
Left err -> expectationFailure $ T.unpack $ renderChunksText With24BitColours $ renderErrors err
Right actual -> actual `shouldBe` expected
shouldParse ::
(Show a, Eq a) =>
Parser a ->
Args ->
EnvMap ->
Maybe JSON.Object ->
a ->
IO ()
shouldParse p args e mConf expected = do
errOrRes <- runParserOn Nothing p args e mConf
context (showParserABit p) $ case errOrRes of
Left errs -> expectationFailure $ T.unpack $ renderChunksText With24BitColours $ renderErrors errs
Right actual -> actual `shouldBe` expected
shouldFail ::
(Show a) =>
Parser a ->
Args ->
EnvMap ->
Maybe JSON.Object ->
(NonEmpty ParseErrorMessage -> Bool) ->
IO ()
shouldFail p args e mConf isExpected = do
errOrRes <- runParserOn Nothing p args e mConf
case errOrRes of
Left errs -> NE.map parseErrorMessage errs `shouldSatisfy` isExpected
Right actual -> expectationFailure $ show actual