flags-applicative 0.0.4.5 → 0.0.5.0

raw patch · 4 files changed

+58/−72 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• app/SimpleExample.hs +0/−27
• flags-applicative.cabal +1/−10
• src/Flags/Applicative.hs +50/−35
• test/Spec.hs +7/−0

@@ -1,27 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Main where--import Control.Applicative ((<|>), optional)-import Data.Text (Text, pack)-import Flags.Applicative-import System.Environment (getArgs)--data Mode = Lenient | Strict deriving (Read, Show)--data Options = Options-  { rootPath :: Text-  , logLevel :: Int-  , mode :: Mode-  , context :: Maybe (Text, [Double])-  } deriving Show--optionsParser :: FlagParser Options-optionsParser = Options-  <$> (textFlag "root" "path to the root" <|> ("HERE" <$ switch "default_root" ""))-  <*> autoFlag "log_level" "log verbosity"-  <*> (autoFlag "mode" "mode [Lenient|Strict]" <|> pure Strict)-  <*> (optional $ (,) <$> textFlag "context" "" <*> (autoListFlag "," "values" "" <|> pure []))--main :: IO ()-main = parseSystemFlagsOrDie optionsParser >>= print

@@ -1,5 +1,5 @@ name:                flags-applicative-version:             0.0.4.5+version:             0.0.5.0 synopsis:            Applicative flag parsing description:         https://github.com/mtth/flags-applicative homepage:            https://github.com/mtth/flags-applicative@@ -36,15 +36,6 @@     , hspec >=2.6 && <2.7     , flags-applicative   default-language: Haskell2010--executable simple-example-  hs-source-dirs:      app-  main-is:             SimpleExample.hs-  build-depends:-      base >=4.8 && <5-    , text >= 1.2 && < 1.3-    , flags-applicative-  default-language:    Haskell2010  source-repository head   type:     git

@@ -20,7 +20,7 @@ --   , context :: Maybe Text --   } deriving Show ----- optionsParser :: FlagParser Options+-- optionsParser :: FlagsParser Options -- optionsParser = Options \<$\> textFlag "root" "path to the root" --                         \<*\> (autoFlag "log_level" "" \<|\> pure 0) --                         \<*\> (optional $ textFlag "context" "")@@ -31,13 +31,17 @@ --   print opts -- @ -module Flags.Applicative-  ( Name, Description, FlagParser, FlagError(..)+module Flags.Applicative (+  -- * Types+  Name, Description, FlagsParser, FlagError(..),   -- * Running parsers-  , parseFlags, parseSystemFlagsOrDie-  -- * Defining flags-  , switch, boolFlag, flag, textFlag, hostFlag, autoFlag, textListFlag, autoListFlag-  ) where+  parseFlags, parseSystemFlagsOrDie,+  -- * Declaring flags+  -- ** Nullary flags+  switch, boolFlag,+  -- ** Unary flags+  flag, textFlag, hostFlag, autoFlag, textListFlag, autoListFlag+) where  import Control.Applicative ((<|>), Alternative, empty) import Control.Monad (when)@@ -92,9 +96,12 @@  -- The errors which can happen during flag parsing. data ValueError-  = MissingValue Name-  | InvalidValue Name Text String+  = InvalidValue Name Text String+  | MissingValues (NonEmpty Name) +missingValue :: Name -> ValueError+missingValue name = MissingValues $ name :| []+ type Action a = RWST   (Map Name Text) -- Flag values (or empty for nullary flags).   () -- Unused.@@ -155,7 +162,7 @@ -- form is accepted. -- -- You can run a parser using 'parseFlags' or 'parseSystemFlagsOrDie'.-data FlagParser a+data FlagsParser a   = Actionable (Action a) (Map Name Flag) Usage   | Invalid ParserError   deriving Functor@@ -167,7 +174,7 @@   Just ((name, _), _) -> Left name   Nothing -> Right $ flags1 `Map.union` flags2 -instance Applicative FlagParser where+instance Applicative FlagsParser where   pure res = Actionable (pure res) Map.empty emptyUsage    Invalid err <*> _ = Invalid err@@ -177,7 +184,7 @@       Left name -> Invalid $ Duplicate name       Right flags -> Actionable (action1 <*> action2) flags (usage1 `andAlso` usage2) -instance Alternative FlagParser where+instance Alternative FlagsParser where   empty = Invalid Empty    Invalid Empty <|> parser = parser@@ -188,14 +195,18 @@     case mergeFlags flags1 flags2 of       Left name -> Invalid $ Duplicate name       Right flags -> Actionable action flags (usage1 `orElse` usage2) where-        wrap a = catchError (Just <$> a) $ \case-          (MissingValue _) -> pure Nothing+        wrap a = catchError (Right <$> a) $ \case+          (MissingValues names) -> pure $ Left names           err -> throwError err         action = do           used <- get           wrap action1 >>= \case-            Nothing -> put used >> action2-            Just res -> do+            Left names -> do+              put used+              wrap action2 >>= \case+                Left names' -> throwError $ MissingValues $ names <> names'+                Right res -> pure res+            Right res -> do               used' <- get               _ <- wrap action2               put used'@@ -213,8 +224,8 @@   | InconsistentFlagValues Name   -- | A unary flag's value failed to parse.   | InvalidFlagValue Name Text String-  -- | A required flag was missing.-  | MissingFlag Name+  -- | A required flag was missing; at least one of the returned flags should be set.+  | MissingFlags (NonEmpty Name)   -- | A unary flag was missing a value. This can happen either if a value-less unary flag was the   -- last token or was followed by a value which is also a flag name (in which case you should use   -- the single-token form: @--flag=--value@).@@ -230,6 +241,9 @@   | UnknownFlag Name   deriving (Eq, Show) +displayFlags :: Foldable f => f Name -> Text+displayFlags = T.intercalate " " . fmap qualify . toList+ -- Pretty-print a 'FlagError'. displayFlagError :: FlagError -> Text displayFlagError (DuplicateFlag name) = qualify name <> " was declared multiple times"@@ -238,12 +252,12 @@ displayFlagError (InconsistentFlagValues name) = "inconsistent values for " <> qualify name displayFlagError (InvalidFlagValue name val msg) =   "invalid value \"" <> val <> "\" for " <> qualify name <> " (" <> T.pack msg <> ")"-displayFlagError (MissingFlag name) = qualify name <> " is required but was not set"+displayFlagError (MissingFlags names) =+  "at least one of the following required flags must be set: " <> displayFlags names displayFlagError (MissingFlagValue name) = "missing value for " <> qualify name displayFlagError (ReservedFlag name) = qualify name <> " was declared but is reserved" displayFlagError (UnexpectedFlagValue name) = "unexpected value for " <> qualify name-displayFlagError (UnexpectedFlags names) =-  "unexpected " <> (T.intercalate " " $ fmap qualify $ toList $ names)+displayFlagError (UnexpectedFlags names) = "unexpected " <> displayFlags names displayFlagError (UnknownFlag name) = "undeclared " <> qualify name  -- Mark a flag as used. This is useful to check for unexpected flags after parsing is complete.@@ -253,27 +267,27 @@ -- | Returns a parser with the given name and description for a flag with no value, failing if the -- flag is not present. See also 'boolFlag' for a variant which doesn't fail when the flag is -- missing.-switch :: Name -> Description -> FlagParser ()+switch :: Name -> Description -> FlagsParser () switch name desc = Actionable action flags usage where   action = asks (Map.member name) >>= \case     True -> useFlag name-    False -> throwError $ MissingValue name+    False -> throwError $ missingValue name   flags = Map.singleton name (Flag Nullary desc)   usage = Exactly name  -- | Returns a parser with the given name and description for a flag with no value, returning -- whether the flag was present.-boolFlag :: Name -> Description -> FlagParser Bool+boolFlag :: Name -> Description -> FlagsParser Bool boolFlag name desc = (True <$ switch name desc) <|> pure False  -- | Returns a parser using the given parsing function, name, and description for a flag with an -- associated value.-flag :: (Text -> Either String a) -> Name -> Description -> FlagParser a+flag :: (Text -> Either String a) -> Name -> Description -> FlagsParser a flag convert name desc = Actionable action flags usage where   action = do     useFlag name     asks (Map.lookup name) >>= \case-      Nothing -> throwError $ MissingValue name+      Nothing -> throwError $ missingValue name       Just val -> case convert val of         Left err -> throwError $ InvalidValue name val err         Right res -> pure res@@ -281,10 +295,11 @@   usage = Exactly name  -- | Returns a parser for a single text value.-textFlag :: Name -> Description -> FlagParser Text+textFlag :: Name -> Description -> FlagsParser Text textFlag = flag Right -hostFlag :: Name -> Description -> FlagParser (HostName, Maybe PortNumber)+-- | Returns a parser for network hosts of the form @hostname:port@. The port part is optional.+hostFlag :: Name -> Description -> FlagsParser (HostName, Maybe PortNumber) hostFlag = flag $ \txt -> do   let (hostname, suffix) = T.breakOn ":" txt   mbPort <- case T.stripPrefix ":" suffix of@@ -294,17 +309,17 @@  -- | Returns a parser for any value with a 'Read' instance. Prefer 'textFlag' for textual values -- since 'flag'  will expect its values to be double-quoted and might not work as expected.-autoFlag :: Read a => Name -> Description -> FlagParser a+autoFlag :: Read a => Name -> Description -> FlagsParser a autoFlag = flag (readEither . T.unpack)  -- | Returns a parser for a single flag with multiple text values.-textListFlag :: Text -> Name -> Description -> FlagParser [Text]+textListFlag :: Text -> Name -> Description -> FlagsParser [Text] textListFlag sep =  flag $ Right . T.splitOn sep  -- | Returns a parser for a single flag with multiple values having a 'Read' instance, with a -- configurable separator. Empty values are always ignored, so it's possible to declare an empty -- list as @--list=@ and trailing commas are supported.-autoListFlag :: Read a => Text -> Name -> Description -> FlagParser [a]+autoListFlag :: Read a => Text -> Name -> Description -> FlagsParser [a] autoListFlag sep =   flag $ sequenceA . fmap (readEither . T.unpack) . filter (not . T.null) . T.splitOn sep @@ -354,11 +369,11 @@     Right (rv, usedNames, _) ->       let unused = Set.difference (Map.keysSet values) usedNames       in Right (rv, unused, args)-    Left (MissingValue name) -> Left $ MissingFlag name+    Left (MissingValues names) -> Left $ MissingFlags names     Left (InvalidValue name val msg) -> Left $ InvalidFlagValue name val msg  -- Preprocessing parser.-reservedParser :: FlagParser (Bool, Set Name, Set Name)+reservedParser :: FlagsParser (Bool, Set Name, Set Name) reservedParser =   let textSetFlag name = Set.fromList <$> (flag (Right . T.splitOn ",") name "" <|> pure [])   in (,,)@@ -369,7 +384,7 @@ -- | Runs a parser on a list of tokens, returning the parsed flags alongside other non-flag -- arguments (i.e. which don't start with @--@). If the special @--@ token is found, all following -- tokens will be considered arguments even if they look like flags.-parseFlags :: FlagParser a -> [String] -> Either FlagError (a, [String])+parseFlags :: FlagsParser a -> [String] -> Either FlagError (a, [String]) parseFlags parser tokens = case reservedParser of   Invalid _ -> error "unreachable"   Actionable action0 flags0 _ -> do@@ -393,7 +408,7 @@  -- | Runs a parser on the system's arguments, or exits with code 1 and prints the relevant error -- message in case of failure.-parseSystemFlagsOrDie :: FlagParser a -> IO (a, [String])+parseSystemFlagsOrDie :: FlagsParser a -> IO (a, [String]) parseSystemFlagsOrDie parser = parseFlags parser <$> getArgs >>= \case   Left err -> die $ T.unpack $ displayFlagError err   Right res -> pure res

@@ -98,3 +98,10 @@       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