diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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: diff --git a/skeletest.cabal b/skeletest.cabal --- a/skeletest.cabal +++ b/skeletest.cabal @@ -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 diff --git a/src/Skeletest.hs b/src/Skeletest.hs --- a/src/Skeletest.hs +++ b/src/Skeletest.hs @@ -51,6 +51,7 @@ Flag (..), IsFlag (..), FlagSpec (..), + FlagType (..), getFlag, ) where diff --git a/src/Skeletest/Internal/CLI.hs b/src/Skeletest/Internal/CLI.hs --- a/src/Skeletest/Internal/CLI.hs +++ b/src/Skeletest/Internal/CLI.hs @@ -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 = ("--" <>) diff --git a/test/Skeletest/Internal/CLISpec.hs b/test/Skeletest/Internal/CLISpec.hs --- a/test/Skeletest/Internal/CLISpec.hs +++ b/test/Skeletest/Internal/CLISpec.hs @@ -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)