skeletest 0.3.6 → 0.3.7
raw patch · 5 files changed
+348/−130 lines, 5 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Skeletest.Internal.CLI: parseCliArgs :: [Flag] -> [String] -> CLIParseResult
- Skeletest.Internal.CLI: type CLIFlagStore = Map TypeRep Dynamic
+ Skeletest: MultiFlag :: FlagType x -> ([x] -> Either String a) -> FlagSpec a
+ Skeletest: [FlagType_Arg] :: FlagType [Char]
+ Skeletest: [FlagType_Switch] :: FlagType Bool
+ Skeletest: [parseMulti] :: FlagSpec a -> [x] -> Either String a
+ Skeletest: [type_] :: FlagSpec a -> FlagType x
+ Skeletest: data FlagType x
+ Skeletest.Internal.CLI: MultiFlag :: FlagType x -> ([x] -> Either String a) -> FlagSpec a
+ Skeletest.Internal.CLI: SomeFlagSpec :: FlagSpec a -> SomeFlagSpec
+ Skeletest.Internal.CLI: [FlagType_Arg] :: FlagType [Char]
+ Skeletest.Internal.CLI: [FlagType_Switch] :: FlagType Bool
+ Skeletest.Internal.CLI: [parseMulti] :: FlagSpec a -> [x] -> Either String a
+ Skeletest.Internal.CLI: [type_] :: FlagSpec a -> FlagType x
+ Skeletest.Internal.CLI: data FlagType x
+ Skeletest.Internal.CLI: data SomeFlagSpec
+ Skeletest.Internal.CLI: parseCliArgsWith :: FlagInfos -> [String] -> CLIParseResult
+ Skeletest.Internal.CLI: type FlagInfos = [(Text, Maybe Char, SomeFlagSpec)]
Files
- CHANGELOG.md +12/−0
- skeletest.cabal +1/−1
- src/Skeletest.hs +1/−0
- src/Skeletest/Internal/CLI.hs +159/−98
- test/Skeletest/Internal/CLISpec.hs +175/−31
CHANGELOG.md view
@@ -1,3 +1,15 @@+## v0.3.7++New features:+* Support repeated CLI flags with `MultiFlag`++Runtime changes:+* Fix `--foo=bar` to error when `--foo` is a `SwitchFlag`+ * Previously, it would silently add `bar` as a positional argument+* Allow multiple short CLI flags in one option+ * `-abc` would be parsed as `-a -b -c` if all are switch flags+ * `-abc` would be parsed as `-a -b c` if `-a` is a switch flag and `-b` is an argument flag+ ## v0.3.6 Runtime changes:
skeletest.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 name: skeletest-version: 0.3.6+version: 0.3.7 synopsis: Batteries-included, opinionated test framework description: Batteries-included, opinionated test framework. See README.md for more details. homepage: https://github.com/brandonchinn178/skeletest#readme
src/Skeletest.hs view
@@ -51,6 +51,7 @@ Flag (..), IsFlag (..), FlagSpec (..),+ FlagType (..), getFlag, ) where
src/Skeletest/Internal/CLI.hs view
@@ -1,6 +1,11 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TypeAbstractions #-} {-# LANGUAGE NoFieldSelectors #-} module Skeletest.Internal.CLI (@@ -8,29 +13,32 @@ flag, IsFlag (..), FlagSpec (..),+ FlagType (..), getFlag, loadCliArgs, -- * Internal- parseCliArgs,+ parseCliArgsWith,+ FlagInfos,+ SomeFlagSpec (..), CLIParseResult (..),- CLIFlagStore, ) where import Control.Monad (when) import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Trans.Class qualified as Trans-import Control.Monad.Trans.Except qualified as Trans-import Control.Monad.Trans.State qualified as Trans-import Data.Bifunctor (first, second)+import Data.Bifunctor (first) import Data.Dynamic (Dynamic, fromDynamic, toDyn)+import Data.Foldable (foldlM)+import Data.Foldable qualified as Seq (toList) import Data.Foldable1 qualified as Foldable1 import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.List.NonEmpty qualified as NonEmpty import Data.Map (Map) import Data.Map qualified as Map+import Data.Maybe (fromMaybe) import Data.Proxy (Proxy (..))-import Data.Set qualified as Set+import Data.Sequence (Seq)+import Data.Sequence qualified as Seq import Data.Text (Text) import Data.Text qualified as Text import Data.Text.IO qualified as Text@@ -43,6 +51,10 @@ import System.IO.Unsafe (unsafePerformIO) import UnliftIO.Exception (throwIO) +#if !MIN_VERSION_base(4, 20, 0)+import Data.Foldable (foldl')+#endif+ -- | Register a CLI flag. -- -- Usage:@@ -95,6 +107,7 @@ flagSpec :: FlagSpec a +-- TODO(breaking-change): Remove 'flag' prefix from these fields data FlagSpec a = SwitchFlag { flagFromBool :: Bool -> a@@ -106,7 +119,16 @@ { flagDefault :: a , flagParse :: String -> Either String a }+ | forall x.+ MultiFlag+ { type_ :: FlagType x+ , parseMulti :: [x] -> Either String a+ } +data FlagType x where+ FlagType_Switch :: FlagType Bool+ FlagType_Arg :: FlagType String+ getFlag :: forall a m. (MonadIO m, IsFlag a) => m a getFlag = liftIO $@@ -189,6 +211,7 @@ SwitchFlag{} -> Nothing RequiredFlag{} -> Just $ Text.pack (flagMetaVar @a) OptionalFlag{} -> Just $ Text.pack (flagMetaVar @a)+ MultiFlag{} -> Just $ Text.pack (flagMetaVar @a) ] renderSection title body =@@ -234,115 +257,153 @@ , flagStore :: CLIFlagStore } +type FlagInfos = [(Text, Maybe Char, SomeFlagSpec)]+data SomeFlagSpec = forall a. (Typeable a) => SomeFlagSpec (FlagSpec a)+ parseCliArgs :: [Flag] -> [String] -> CLIParseResult parseCliArgs flags args = either id id $ do- longFlags <- extractLongFlags- shortFlags <- extractShortFlags-- -- quick sweep for --help/-h after flag validation; skip parsing flags if so- when (any (`elem` ["--help", "-h"]) args) $ Left CLIHelpRequested+ flagInfos <- getFlagInfos flags+ pure $ parseCliArgsWith flagInfos args - (args', flagStore) <- first CLIParseFailure $ parseCliArgsWith longFlags shortFlags args- testTargets <- first CLIParseFailure $ parseTestTargets args'- flagStore' <- first CLIParseFailure $ resolveFlags flags flagStore- pure CLIParseSuccess{testTargets, flagStore = flagStore'}+getFlagInfos :: [Flag] -> Either CLIParseResult FlagInfos+getFlagInfos flags = do+ let infos = map fromFlag flags+ checkDups [renderLongFlag name | (name, _, _) <- infos]+ checkDups [renderShortFlag c | (_, Just c, _) <- infos]+ pure infos where- extractLongFlags =- toFlagMap renderLongFlag $- [ (Text.pack $ flagName @a, f)- | f@(Flag (Proxy :: Proxy a)) <- flags- ]+ fromFlag (Flag (Proxy @a)) =+ let name = Text.pack $ flagName @a+ spec = SomeFlagSpec (flagSpec @a)+ in (name, flagShort @a, spec) - extractShortFlags =- toFlagMap renderShortFlag $- [ (shortFlag, f)- | f@(Flag (Proxy :: Proxy a)) <- flags- , Just shortFlag <- pure $ flagShort @a- ]+ checkDups vals =+ case Map.keys . Map.filter (> 1) . Map.fromListWith (+) . map (,1 :: Int) $ vals of+ [] -> pure ()+ dup : _ -> Left . CLISetupFailure $ "Flag registered multiple times: " <> dup - toFlagMap :: (Ord name) => (name -> Text) -> [(name, a)] -> Either CLIParseResult (Map name a)- toFlagMap renderFlag vals =- let go seen = \case- [] -> Right $ Map.fromList vals- (name, _) : xs- | name `Set.member` seen -> Left . CLISetupFailure $ "Flag registered multiple times: " <> renderFlag name- | otherwise -> go (Set.insert name seen) xs- in go Set.empty vals+parseCliArgsWith :: FlagInfos -> [String] -> CLIParseResult+parseCliArgsWith flagInfos args = either id id $ do+ -- quick sweep for --help/-h; skip parsing flags if so+ when (any (`elem` ["--help", "-h"]) args) $ Left CLIHelpRequested -type ArgParserM = Trans.StateT ([Text], CLIFlagStore) (Trans.Except Text)+ (flagVals, args') <- collectCLIArgs flagInfos $ map Text.pack args+ testTargets <- first CLIParseFailure $ parseTestTargets args'+ flagStore <- parseCLIFlags flagInfos flagVals+ pure CLIParseSuccess{testTargets, flagStore} -parseCliArgsWith :: Map Text Flag -> Map Char Flag -> [String] -> Either Text ([Text], CLIFlagStore)-parseCliArgsWith longFlags shortFlags = Trans.runExcept . flip Trans.execStateT ([], Map.empty) . parseArgs+collectCLIArgs ::+ FlagInfos ->+ [Text] ->+ Either CLIParseResult (Map Text [Text], [Text])+collectCLIArgs flagInfos args0 = first CLIParseFailure $ do+ (flagVals, posArgs) <- go Map.empty Seq.empty args0+ pure (Map.map Seq.toList flagVals, Seq.toList posArgs) where- parseArgs = \case- [] -> pure ()- "--" : rest -> addArgs rest+ go :: Map Text (Seq Text) -> Seq Text -> [Text] -> Either Text (Map Text (Seq Text), Seq Text)+ go flagVals posArgs = \case+ [] -> Right (flagVals, posArgs)+ "--" : rest -> Right (flagVals, posArgs <> Seq.fromList rest) curr : rest- | Just longFlag <- Text.stripPrefix "--" (Text.pack curr) -> parseLongFlag longFlag rest- | Just chars <- Text.stripPrefix "-" (Text.pack curr) ->- case Text.unpack chars of- [] -> argError "Invalid flag: -"- [shortFlag] -> parseShortFlag shortFlag rest- _ -> argError $ "Invalid flag: -" <> chars- | otherwise -> addArgs [curr] >> parseArgs rest+ | Just rawFlag <- Text.stripPrefix "--" curr -> do+ (name, arg, rest') <- parseLongFlag rawFlag rest+ go (addFlag flagVals (name, arg)) posArgs rest'+ | Just rawFlag <- Text.stripPrefix "-" curr -> do+ (args, rest') <- parseShortFlags rawFlag rest+ let flagVals' = foldl' addFlag flagVals args+ go flagVals' posArgs rest'+ | otherwise -> do+ go flagVals (posArgs Seq.|> curr) rest - parseLongFlag name args =- let (name', args') =- case Text.breakOn "=" name of- (_, "") -> (name, args)- (n, post) -> (n, (drop 1 . Text.unpack) post : args)- in parseFlag renderLongFlag longFlags name' args'- parseShortFlag = parseFlag renderShortFlag shortFlags+ longFlags = Map.fromList [(name, spec) | (name, _, spec) <- flagInfos]+ parseLongFlag rawFlag rest = do+ let (name, mArg) =+ case Text.breakOn "=" rawFlag of+ (_, "") -> (rawFlag, Nothing)+ (n, post) -> (n, Just $ Text.drop 1 post)+ flagDisp = renderLongFlag name+ SomeFlagSpec spec <-+ maybe (Left $ "Unknown flag: " <> flagDisp) pure $+ Map.lookup name longFlags+ (arg, rest') <- validateArg spec flagDisp mArg rest+ pure (name, arg, rest') - parseFlag :: (Ord name) => (name -> Text) -> Map name Flag -> name -> [String] -> ArgParserM ()- parseFlag renderFlag flagMap name args = do- Flag (Proxy :: Proxy a) <-- case Map.lookup name flagMap of- Nothing -> argError $ "Unknown flag: " <> renderFlag name- Just f -> pure f- let parseFlagArg parseArg =- case args of- [] -> argError $ "Flag requires argument: " <> renderFlag name- curr : rest -> parseArg curr >>= addFlagStore >> parseArgs rest- case flagSpec @a of- SwitchFlag{flagFromBool} -> addFlagStore (flagFromBool True) >> parseArgs args- RequiredFlag{flagParse} -> parseFlagArg (Trans.lift . Trans.except . first Text.pack . flagParse)- OptionalFlag{flagParse} -> parseFlagArg (Trans.lift . Trans.except . first Text.pack . flagParse)+ shortFlags = Map.fromList [(c, (name, spec)) | (name, Just c, spec) <- flagInfos]+ parseShortFlags rawFlag rest = do+ (char, rawFlag') <-+ maybe (Left "Invalid flag: -") pure $+ Text.uncons rawFlag+ let flagDisp = renderShortFlag char+ (name, SomeFlagSpec spec) <-+ maybe (Left $ "Unknown flag: " <> flagDisp) pure $+ Map.lookup char shortFlags+ let mArg =+ if (not . Text.null) rawFlag' && expectsArg spec+ then Just rawFlag'+ else Nothing+ parseNext =+ if (not . Text.null) rawFlag' && (not . expectsArg) spec+ then parseShortFlags rawFlag'+ else \rest' -> pure ([], rest')+ (arg, rest') <- validateArg spec flagDisp mArg rest+ (args, rest'') <- parseNext rest'+ pure ((name, arg) : args, rest'') - argError = Trans.lift . Trans.throwE+ validateArg spec flagDisp mArg rest = do+ if expectsArg spec+ then case (mArg, rest) of+ (Just arg, _) -> pure (arg, rest)+ (Nothing, arg : rest') -> pure (arg, rest')+ (Nothing, []) -> Left $ "Flag '" <> flagDisp <> "' requires argument"+ else case (mArg, rest) of+ (Just arg, _) -> Left $ "Flag '" <> flagDisp <> "' does not take arguments, got: " <> arg+ _ -> pure ("", rest) - addArgs :: [String] -> ArgParserM ()- addArgs args = Trans.modify (first (<> map Text.pack args))+ expectsArg :: FlagSpec a -> Bool+ expectsArg = \case+ SwitchFlag{} -> False+ RequiredFlag{} -> True+ OptionalFlag{} -> True+ MultiFlag{type_} ->+ case type_ of+ FlagType_Switch -> False+ FlagType_Arg -> True - addFlagStore :: (Typeable a) => a -> ArgParserM ()- addFlagStore x = Trans.modify (second (insertFlagStore x))+ addFlag :: Map Text (Seq Text) -> (Text, Text) -> Map Text (Seq Text)+ addFlag flagVals (name, arg) =+ Map.alter+ (Just . (Seq.|> arg) . fromMaybe Seq.empty)+ name+ flagVals -resolveFlags :: [Flag] -> CLIFlagStore -> Either Text CLIFlagStore-resolveFlags = flip (foldlM go)+parseCLIFlags :: FlagInfos -> Map Text [Text] -> Either CLIParseResult CLIFlagStore+parseCLIFlags flagInfos flagVals = first CLIParseFailure $ foldlM go Map.empty flagInfos where- go flagStore (Flag (Proxy :: Proxy a)) = do- let rep = typeRep (Proxy @a)- case flagSpec @a of- SwitchFlag{flagFromBool} ->- pure $- if rep `Map.member` flagStore- then flagStore- else insertFlagStore (flagFromBool False) flagStore- RequiredFlag{} ->- if rep `Map.member` flagStore- then pure flagStore- else Left $ "Required flag not set: " <> renderLongFlag (Text.pack $ flagName @a)- OptionalFlag{flagDefault} ->- pure $- if rep `Map.member` flagStore- then flagStore- else insertFlagStore flagDefault flagStore+ go flagStore (name, _, SomeFlagSpec spec0) = do+ let vals = Map.findWithDefault [] name flagVals+ val <- first Text.pack . parse name spec0 . map Text.unpack $ vals+ pure $ insertFlagStore val flagStore - foldlM f z = \case- [] -> pure z- x : xs -> do- z' <- f z x- foldlM f z' xs+ parse :: Text -> FlagSpec a -> [String] -> Either String a+ parse name spec0 vals =+ case spec0 of+ spec@SwitchFlag{} -> do+ pure (spec.flagFromBool $ (not . null) vals)+ spec@RequiredFlag{} -> do+ val <- maybe (throwRequired name) pure $ getLast vals+ spec.flagParse val+ spec@OptionalFlag{} -> do+ case getLast vals of+ Nothing -> pure spec.flagDefault+ Just val -> spec.flagParse val+ MultiFlag{type_, parseMulti} -> do+ parseMulti $+ case type_ of+ FlagType_Switch -> True <$ vals+ FlagType_Arg -> vals++ throwRequired name = Left $ "Flag '" <> (Text.unpack . renderLongFlag) name <> "' is required"+ getLast = fmap NonEmpty.last . NonEmpty.nonEmpty renderLongFlag :: Text -> Text renderLongFlag = ("--" <>)
test/Skeletest/Internal/CLISpec.hs view
@@ -1,47 +1,194 @@ {-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-} module Skeletest.Internal.CLISpec (spec) where import Control.Monad ((>=>)) import Data.Dynamic (fromDynamic) import Data.Map qualified as Map-import Data.Typeable (Typeable, typeOf)+import Data.Typeable (typeOf) import Skeletest-import Skeletest.Internal.CLI (- CLIFlagStore,- CLIParseResult (..),- flag,- parseCliArgs,- )+import Skeletest.Internal.CLI import Skeletest.Predicate qualified as P import Skeletest.TestUtils.Integration -newtype FooFlag = FooFlag String- deriving (Eq)-instance IsFlag FooFlag where- flagName = "foo"- flagHelp = "test"- flagSpec =- OptionalFlag- { flagDefault = FooFlag ""- , flagParse = Right . FooFlag- }- spec :: Spec spec = do- describe "parseCliArgs" $ do- it "parses long flag" $ do- parseCliArgs [flag @FooFlag] ["--foo", "1"]- `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (FooFlag "1")}+ spec_parseCliArgsWith+ spec_getFlag - it "parses long flag with equal sign" $ do- parseCliArgs [flag @FooFlag] ["--foo=1"]- `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (FooFlag "1")}+newtype MyFlag = MyFlag String+ deriving (Eq)+newtype MyFlag2 = MyFlag2 String+ deriving (Eq) - it "parses long flag containing equal sign" $ do- parseCliArgs [flag @FooFlag] ["--foo=1=2"]- `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (FooFlag "1=2")}+spec_parseCliArgsWith :: Spec+spec_parseCliArgsWith = do+ describe "parseCliArgsWith" $ do+ longFlagSpec+ shortFlagSpec+ optFlagSpec+ reqFlagSpec+ switchFlagSpec+ multiFlagSpec+ where+ mkFlagInfos name mShort fspec = [(name, mShort, SomeFlagSpec fspec)] + longFlagSpec = do+ let flags =+ mkFlagInfos "foo" Nothing $+ RequiredFlag+ { flagParse = pure . MyFlag+ }+ describe "long flag" $ do+ it "parses" $ do+ parseCliArgsWith flags ["--foo", "1"]+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (MyFlag "1")}+ it "parses with equal sign" $ do+ parseCliArgsWith flags ["--foo=1"]+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (MyFlag "1")}+ it "parses argument containing equal sign" $ do+ parseCliArgsWith flags ["--foo=1=2"]+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (MyFlag "1=2")}+ it "errors if unknown" $ do+ parseCliArgsWith [] ["--foo"]+ `shouldSatisfy` parseFailure "Unknown flag: --foo"++ shortFlagSpec = do+ let flags =+ mkFlagInfos "foo" (Just 'f') $+ RequiredFlag+ { flagParse = pure . MyFlag+ }+ describe "short flag" $ do+ it "parses" $ do+ parseCliArgsWith flags ["-f", "123"]+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (MyFlag "123")}+ it "parses multiple switches at once" $ do+ let flags' =+ [ ("flag-a", Just 'a', SomeFlagSpec $ SwitchFlag (MyFlag . show))+ , ("flag-b", Just 'b', SomeFlagSpec $ SwitchFlag (MyFlag2 . show))+ ]+ expected =+ P.and+ [ containsFlag (MyFlag "True")+ , containsFlag (MyFlag2 "True")+ ]+ parseCliArgsWith flags' ["-ab"]+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = expected}+ it "parses short flag with arg without space" $ do+ let flags' =+ mkFlagInfos "foo" (Just 'f') $+ RequiredFlag+ { flagParse = pure . MyFlag+ }+ parseCliArgsWith flags' ["-fasdf"]+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (MyFlag "asdf")}+ it "errors if unknown" $ do+ parseCliArgsWith [] ["-x"]+ `shouldSatisfy` parseFailure "Unknown flag: -x"++ optFlagSpec = do+ let flags =+ mkFlagInfos "foo" Nothing $+ OptionalFlag+ { flagDefault = MyFlag ""+ , flagParse = pure . MyFlag+ }+ describe "OptionalFlag" $ do+ it "returns last flag" $ do+ parseCliArgsWith flags ["--foo", "1", "--foo", "2"]+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (MyFlag "2")}+ it "returns default if not set" $ do+ parseCliArgsWith flags []+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (MyFlag "")}+ it "errors if no argument" $ do+ parseCliArgsWith flags ["--foo"]+ `shouldSatisfy` parseFailure "Flag '--foo' requires argument"++ reqFlagSpec = do+ let flags =+ mkFlagInfos "foo" Nothing $+ RequiredFlag+ { flagParse = pure . MyFlag+ }+ describe "RequiredFlag" $ do+ it "returns last flag" $ do+ parseCliArgsWith flags ["--foo", "1", "--foo", "2"]+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (MyFlag "2")}+ it "errors if not set" $ do+ parseCliArgsWith flags []+ `shouldSatisfy` parseFailure "Flag '--foo' is required"+ it "errors if no argument" $ do+ parseCliArgsWith flags ["--foo"]+ `shouldSatisfy` parseFailure "Flag '--foo' requires argument"++ switchFlagSpec = do+ let flags =+ mkFlagInfos "foo" Nothing $+ SwitchFlag+ { flagFromBool = MyFlag . show+ }+ describe "SwitchFlag" $ do+ it "returns True if set" $ do+ parseCliArgsWith flags ["--foo"]+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (MyFlag "True")}+ it "returns True if set any number of times" $ do+ parseCliArgsWith flags ["--foo", "--foo", "--foo"]+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (MyFlag "True")}+ it "returns False if not set" $ do+ parseCliArgsWith flags []+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (MyFlag "False")}+ it "errors if argument is set" $ do+ parseCliArgsWith flags ["--foo=asdf"]+ `shouldSatisfy` parseFailure "Flag '--foo' does not take arguments, got: asdf"++ multiFlagSpec = do+ let mkMultiFlags :: (Show a) => FlagType a -> FlagInfos+ mkMultiFlags type_ =+ mkFlagInfos "foo" (Just 'f') $+ MultiFlag+ { type_+ , parseMulti = pure . MyFlag . show+ }+ describe "MultiFlag" $ do+ let flags = mkMultiFlags FlagType_Arg+ it "parses none" $ do+ parseCliArgsWith flags []+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (MyFlag "[]")}+ it "parses one" $ do+ parseCliArgsWith flags ["--foo", "1"]+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (MyFlag "[\"1\"]")}+ it "parses multiple" $ do+ parseCliArgsWith flags ["--foo", "1", "--foo", "2"]+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (MyFlag "[\"1\",\"2\"]")}++ describe "FlagType_Switch" $ do+ let switchFlags = mkMultiFlags FlagType_Switch+ it "parses" $ do+ parseCliArgsWith switchFlags ["--foo", "--foo"]+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (MyFlag "[True,True]")}+ it "parses multiple short flags" $ do+ parseCliArgsWith switchFlags ["-fff"]+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (MyFlag "[True,True,True]")}+ it "errors if argument provided" $ do+ parseCliArgsWith switchFlags ["--foo=asdf"]+ `shouldSatisfy` parseFailure "Flag '--foo' does not take arguments, got: asdf"++ describe "FlagType_Arg" $ do+ let argFlags = mkMultiFlags FlagType_Arg+ it "parses" $ do+ parseCliArgsWith argFlags ["--foo", "1", "--foo", "2"]+ `shouldSatisfy` P.con CLIParseSuccess{flagStore = containsFlag (MyFlag "[\"1\",\"2\"]")}+ it "errors if no argument" $ do+ parseCliArgsWith argFlags ["--foo"]+ `shouldSatisfy` parseFailure "Flag '--foo' requires argument"++ containsFlag f = (Map.lookup (typeOf f) >=> fromDynamic) P.>>> P.just (P.eq f)+ parseFailure msg = P.con (CLIParseFailure (P.eq msg))++spec_getFlag :: Spec+spec_getFlag = do describe "getFlag" $ do integration . it "reads registered flag" $ do runner <- getFixture @TestRunner@@ -89,6 +236,3 @@ (stdout, stderr) <- expectFailure runner.runTests stderr `shouldBe` "" stdout `shouldSatisfy` P.matchesSnapshot--containsFlag :: (Typeable a, Eq a) => a -> Predicate IO CLIFlagStore-containsFlag f = (Map.lookup (typeOf f) >=> fromDynamic) P.>>> P.just (P.eq f)