diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,7 @@ -# Applicative flags +# Applicative flags [![Hackage](https://img.shields.io/hackage/v/flags-applicative.svg)](https://hackage.haskell.org/package/flags-applicative) [![Build Status](https://travis-ci.org/mtth/flags-applicative.svg?branch=master)](https://travis-ci.org/mtth/flags-applicative) Simple flags parsing, inspired by [`optparse-applicative`](http://hackage.haskell.org/package/optparse-applicative). -See the [documentation](http://hackage.haskell.org/package/flags-applicative) +See the +[documentation](http://hackage.haskell.org/package/flags-applicative/docs/Flags-Applicative.html) on Hackage for more information. diff --git a/flags-applicative.cabal b/flags-applicative.cabal --- a/flags-applicative.cabal +++ b/flags-applicative.cabal @@ -1,28 +1,30 @@ -name: flags-applicative -version: 0.0.5.0 -synopsis: Applicative flag parsing -description: https://github.com/mtth/flags-applicative -homepage: https://github.com/mtth/flags-applicative -license: BSD3 -license-file: LICENSE -author: Matthieu Monsch -maintainer: matthieu.monsch@gmail.com -copyright: 2019 Matthieu Monsch -category: Web -build-type: Simple -cabal-version: >=1.10 -extra-source-files: README.md +name: flags-applicative +version: 0.0.5.2 +synopsis: Applicative flag parsing +description: https://github.com/mtth/flags-applicative +homepage: https://github.com/mtth/flags-applicative +license: BSD3 +license-file: LICENSE +author: Matthieu Monsch +maintainer: mtth@apache.org +copyright: 2019 Matthieu Monsch +category: Web +build-type: Simple +cabal-version: >=1.10 +extra-source-files: README.md library - hs-source-dirs: src - exposed-modules: Flags.Applicative - build-depends: base >= 4.8 && < 5 - , containers >= 0.6 && < 0.7 - , mtl >= 2.2 && < 2.3 - , network >= 2.8 && < 2.9 - , text >= 1.2 && < 1.3 - default-language: Haskell2010 - ghc-options: -Wall + hs-source-dirs: src + exposed-modules: + Flags.Applicative + build-depends: + base >= 4.8 && < 5 + , containers >= 0.6 && < 0.7 + , mtl >= 2.2 && < 2.3 + , network >= 2.8 && < 2.9 + , text >= 1.2 && < 1.3 + default-language: Haskell2010 + ghc-options: -Wall test-suite flags-applicative-test type: exitcode-stdio-1.0 @@ -38,5 +40,5 @@ default-language: Haskell2010 source-repository head - type: git + type: git location: https://github.com/mtth/flags-applicative diff --git a/src/Flags/Applicative.hs b/src/Flags/Applicative.hs --- a/src/Flags/Applicative.hs +++ b/src/Flags/Applicative.hs @@ -3,7 +3,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} --- | Simple flags parsing module, inspired by @optparse-applicative@. +-- | This module implements a lightweight flags parser, inspired by @optparse-applicative@. -- -- Sample usage (note the default log level and optional context): -- @@ -30,7 +30,6 @@ -- (opts, args) <- parseSystemFlagsOrDie optionsParser -- print opts -- @ - module Flags.Applicative ( -- * Types Name, Description, FlagsParser, FlagError(..), @@ -54,15 +53,15 @@ import Data.List (isPrefixOf) import Data.List.NonEmpty (NonEmpty(..)) import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map import Data.Set (Set) +import qualified Data.Set as Set import Data.Semigroup ((<>)) import Data.Text (Text) +import qualified Data.Text as T import Network.Socket (HostName, PortNumber) import System.Exit (die) import System.Environment (getArgs) -import qualified Data.Map.Strict as Map -import qualified Data.Set as Set -import qualified Data.Text as T import Text.Read (readEither) -- The prefix used to identify all flags. @@ -214,31 +213,31 @@ -- | The possible parsing errors. data FlagError - -- | A flag was declared multiple times. = DuplicateFlag Name - -- | The parser was empty. + -- ^ A flag was declared multiple times. | EmptyParser - -- | The input included the @--help@ flag. + -- ^ The parser was empty. | Help Text - -- | At least one unary flag was specified multiple times with different values. + -- ^ The input included the @--help@ flag. | InconsistentFlagValues Name - -- | A unary flag's value failed to parse. + -- ^ At least one unary flag was specified multiple times with different values. | InvalidFlagValue Name Text String - -- | A required flag was missing; at least one of the returned flags should be set. + -- ^ A unary flag's value failed to parse. | MissingFlags (NonEmpty Name) - -- | A unary flag was missing a value. This can happen either if a value-less unary flag was the + -- ^ A required flag was missing; at least one of the returned flags should be set. + | MissingFlagValue 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@). - | MissingFlagValue Name - -- | A flag with a reserved name was declared. | ReservedFlag Name - -- | A nullary flag was given a value. + -- ^ A flag with a reserved name was declared. | UnexpectedFlagValue Name - -- | At least one flag was set but unused. This can happen when optional flags are set but their - -- branch is not selected. + -- ^ A nullary flag was given a value. | UnexpectedFlags (NonEmpty Name) - -- | An unknown flag was set. + -- ^ At least one flag was set but unused. This can happen when optional flags are set but their + -- branch is not selected. | UnknownFlag Name + -- ^ An unknown flag was set. deriving (Eq, Show) displayFlags :: Foldable f => f Name -> Text @@ -260,7 +259,7 @@ 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. +-- Marks a flag as used. This is useful to check for unexpected flags after parsing is complete. useFlag :: Name -> Action () useFlag name = modify (Set.insert name) @@ -308,7 +307,7 @@ pure (T.unpack hostname, mbPort) -- | 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. +-- since 'autoFlag' will expect its values to be double-quoted and might not work as expected. autoFlag :: Read a => Name -> Description -> FlagsParser a autoFlag = flag (readEither . T.unpack) @@ -324,8 +323,8 @@ flag $ sequenceA . fmap (readEither . T.unpack) . filter (not . T.null) . T.splitOn sep -- Tries to gather all raw flag values into a map. When @ignoreUnknown@ is true, this function will --- pass through any unknown flags into the returned argument list, otherwise it will throw a --- 'FlagError'. +-- pass through any unknown flags into the returned argument list( and pass through any @--@ value), +-- otherwise it will throw a 'FlagError'. gatherValues :: Bool -> Map Name Flag -> [String] -> Either FlagError ((Map Name Text), [String]) gatherValues ignoreUnknown flags = go where go [] = Right (Map.empty, []) @@ -333,8 +332,8 @@ then second (token:) <$> go tokens else let entry = drop 2 token :: String - in if entry == "" - then Right (Map.empty, tokens) + in if null entry + then Right (Map.empty, if ignoreUnknown then "--":tokens else tokens) else let (name, pval) = T.breakOn "=" (T.pack entry) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} -import Control.Applicative ((<|>)) +import Control.Applicative ((<|>), optional) import Data.Either (isLeft) import Data.List.NonEmpty (NonEmpty(..)) +import Test.Hspec (describe, expectationFailure, hspec, it, shouldBe) + import Flags.Applicative -import Test.Hspec -import Test.Hspec.QuickCheck main :: IO () main = hspec $ do @@ -105,3 +105,13 @@ case res of Left (MissingFlags ("foo" :| ["bar"])) -> pure () _ -> expectationFailure $ show res + it "should ignore conflicting flags after --" $ do + let + parser = switch "foo" "" <|> switch "bar" "" + res = parseFlags parser ["--foo", "--", "--bar"] + res `shouldBe` Right ((), ["--bar"]) + it "should ignore undeclared flags after --" $ do + let + parser = optional $ textFlag "foo" "" + res = parseFlags parser ["--", "--bar=2"] + res `shouldBe` Right (Nothing, ["--bar=2"])