packages feed

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 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)