flags-applicative 0.0.5.2 → 0.1.0.0

raw patch · 3 files changed

+176/−62 lines, 3 filesdep +casingdep ~containersdep ~hspecdep ~mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: casing

Dependency ranges changed: containers, hspec, mtl, network, text

API changes (from Hackage documentation)

Files

• flags-applicative.cabal +9/−7
• src/Flags/Applicative.hs +93/−43
• test/Spec.hs +74/−12

@@ -1,5 +1,5 @@ name: flags-applicative-version: 0.0.5.2+version: 0.1.0.0 synopsis: Applicative flag parsing description: https://github.com/mtth/flags-applicative homepage: https://github.com/mtth/flags-applicative@@ -19,10 +19,11 @@     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+    , casing >= 0.1.4+    , containers >= 0.6+    , mtl >= 2.2+    , network >= 2.8+    , text >= 1.2   default-language: Haskell2010   ghc-options: -Wall @@ -34,8 +35,9 @@   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:       base >=4.8 && <5-    , text >= 1.2 && < 1.3-    , hspec >=2.6 && <2.7+    , containers >= 0.6+    , text >= 1.2+    , hspec >=2.6     , flags-applicative   default-language: Haskell2010 

@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}  -- | This module implements a lightweight flags parser, inspired by @optparse-applicative@. --@@ -14,32 +15,37 @@ -- import Data.Text (Text) -- import Flags.Applicative ----- data Options = Options+-- data Flags = Flags --   { rootPath :: Text --   , logLevel :: Int --   , context :: Maybe Text --   } deriving Show ----- optionsParser :: FlagsParser Options--- optionsParser = Options \<$\> textFlag "root" "path to the root"---                         \<*\> (autoFlag "log_level" "" \<|\> pure 0)---                         \<*\> (optional $ textFlag "context" "")+-- flagsParser :: FlagsParser Flags+-- flagsParser = Flags+--   \<$\> flag textVal "root" "path to the root"+--   \<*\> (flag autoVal "log_level" "" \<|\> pure 0)+--   \<*\> (optional $ flag textVal "context" "") -- -- main :: IO () -- main = do---   (opts, args) <- parseSystemFlagsOrDie optionsParser---   print opts+--   (flags, args) <- parseSystemFlagsOrDie optionsParser+--   print flags -- @ module Flags.Applicative (-  -- * Types-  Name, Description, FlagsParser, FlagError(..),-  -- * Running parsers-  parseFlags, parseSystemFlagsOrDie,   -- * Declaring flags+  Name, Description,   -- ** Nullary flags   switch, boolFlag,   -- ** Unary flags-  flag, textFlag, hostFlag, autoFlag, textListFlag, autoListFlag+  flag, Reader,+  -- *** Common readers+  autoVal, textVal, fracVal, intVal, enumVal, hostVal,+  -- *** Reader combinators+  listOf, mapOf,+  -- * Running parsers+  FlagsParser, FlagsError(..),+  parseFlags, parseSystemFlagsOrDie ) where  import Control.Applicative ((<|>), Alternative, empty)@@ -59,9 +65,11 @@ import Data.Semigroup ((<>)) import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.Read as T import Network.Socket (HostName, PortNumber) import System.Exit (die) import System.Environment (getArgs)+import Text.Casing (fromHumps, toScreamingSnake) import Text.Read (readEither)  -- The prefix used to identify all flags.@@ -155,10 +163,9 @@ -- There are two types of flags: -- -- * Nullary flags created with 'switch' and 'boolFlag', which do not accept a value.--- * Unary flags created with 'flag' and its convenience variants (e.g. 'textFlag', 'autoFlag',--- 'autoListFlag'). These expect a value to be passed in either after an equal sign (@--foo=value@)--- or as the following input value (@--foo value@). If the value starts with @--@, only the first--- form is accepted.+-- * Unary flags created with 'flag'. These expect a value to be passed in either after an equal+-- sign (@--foo=value@) or as the following input value (@--foo value@). If the value starts with+-- @--@, only the first form is accepted. -- -- You can run a parser using 'parseFlags' or 'parseSystemFlagsOrDie'. data FlagsParser a@@ -212,7 +219,7 @@               pure res  -- | The possible parsing errors.-data FlagError+data FlagsError   = DuplicateFlag Name   -- ^ A flag was declared multiple times.   | EmptyParser@@ -244,7 +251,7 @@ displayFlags = T.intercalate " " . fmap qualify . toList  -- Pretty-print a 'FlagError'.-displayFlagError :: FlagError -> Text+displayFlagError :: FlagsError -> Text displayFlagError (DuplicateFlag name) = qualify name <> " was declared multiple times" displayFlagError EmptyParser = "empty parser" displayFlagError (Help usage) = usage@@ -279,9 +286,12 @@ 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+-- | The type used to read flag values.+type Reader a = Text -> Either String a++-- | Returns a parser using the given value reader, name, and description for a flag with an -- associated value.-flag :: (Text -> Either String a) -> Name -> Description -> FlagsParser a+flag :: Reader a -> Name -> Description -> FlagsParser a flag convert name desc = Actionable action flags usage where   action = do     useFlag name@@ -293,39 +303,79 @@   flags = Map.singleton name (Flag Unary desc)   usage = Exactly name --- | Returns a parser for a single text value.-textFlag :: Name -> Description -> FlagsParser Text-textFlag = flag Right+-- | Returns a reader for any value with a 'Read' instance. Prefer 'textVal' for textual values+-- since 'autoVal'  will expect its values to be double-quoted and might not work as expected.+autoVal :: Read a => Reader a+autoVal = readEither . T.unpack --- | 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+-- | Returns a reader for a single text value.+textVal :: Reader Text+textVal = Right++-- Fully executes a reader. This function is useful for interacting with "Data.Text.Read".+readingFully :: (Text -> Either String (a, Text)) -> Reader a+readingFully f t = case f t of+  Left e -> Left e+  Right (v, t') -> if T.null t' then Right v else Left $ T.unpack $ "trailing chars: " <> t'++-- | Returns a reader for any number with a 'Fractional' instance (e.g. 'Double', 'Float').+fracVal :: Fractional a => Reader a+fracVal = readingFully T.rational++-- | Returns a reader for any number with an 'Integral instance (e.g. 'Int', 'Integer').+intVal :: Integral a => Reader a+intVal = readingFully $ T.signed T.decimal++-- | Returns a reader for 'Enum' instances. This reader assumes that enum (Haskell) constructors are+-- written in PascalCase and expects UPPER_SNAKE_CASE as command-line flag values. For example:+--+-- > data Mode = Flexible | Strict deriving (Bounded, Enum, Show)+-- > modeFlag = flag enumVal "mode" "the mode" :: FlagsParser Mode+--+-- The above flag will accept values @--mode=FLEXIBLE@ and @--mode=STRICT@.+enumVal :: (Bounded a, Enum a, Show a) => Reader a+enumVal = parse where+  write = T.pack . toScreamingSnake . fromHumps . show -- Serializes an enum value.+  m = Map.fromList $ fmap (\v -> (write v, v)) [minBound .. maxBound]+  parse t = case Map.lookup t m of+    Nothing ->+      let e = t <> " is not in " <> T.intercalate "," (Map.keys m)+      in Left $ T.unpack e+    Just v -> Right v++-- | Returns a reader for network hosts of the form @hostname:port@. The port part is optional.+hostVal :: Reader (HostName, Maybe PortNumber)+hostVal txt = do   let (hostname, suffix) = T.breakOn ":" txt   mbPort <- case T.stripPrefix ":" suffix of       Nothing -> Right Nothing       Just portStr -> Just <$> readEither (T.unpack portStr)   pure (T.unpack hostname, mbPort) --- | Returns a parser for any value with a 'Read' instance. Prefer 'textFlag' for textual values--- 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)---- | Returns a parser for a single flag with multiple text values.-textListFlag :: Text -> Name -> Description -> FlagsParser [Text]-textListFlag sep =  flag $ Right . T.splitOn sep+-- | Transforms a single-valued unary flag into one which accepts multiple comma-separated values.+-- For example, to parse a comma-separated list of integers:+--+-- > countsFlag = flag (listOf intVal) "counts" "the counts"+--+-- Empty text values are ignored, which means both that trailing commas are supported and that an+-- empty list can be specified simply by specifying an empty value on the command line. Note that+-- escapes are not supported, so values should not contain any commas.+listOf :: Reader a -> Reader [a]+listOf f = traverse f . filter (not . T.null) . T.splitOn "," --- | 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 -> FlagsParser [a]-autoListFlag sep =-  flag $ sequenceA . fmap (readEither . T.unpack) . filter (not . T.null) . T.splitOn sep+-- | Transforms a single-valued unary flag into one which accepts a comma-separated list of+-- colon-delimited key-value pairs. The syntax is @key:value[,key:value...]@. Note that escapes are+-- not supported, so neither keys not values should contain colons or commas.+mapOf :: Ord a => Reader a -> Reader b -> Reader (Map a b)+mapOf f g = fmap Map.fromList <$> listOf (h . T.breakOn ":") where+  h (k, v) = case T.uncons v of+    Nothing -> Left $ T.unpack $ "empty value for key " <> k+    Just (_, v') -> (,) <$> f k <*> g v'  -- 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( and pass through any @--@ value), -- otherwise it will throw a 'FlagError'.-gatherValues :: Bool -> Map Name Flag -> [String] -> Either FlagError ((Map Name Text), [String])+gatherValues :: Bool -> Map Name Flag -> [String] -> Either FlagsError ((Map Name Text), [String]) gatherValues ignoreUnknown flags = go where   go [] = Right (Map.empty, [])   go (token:tokens) = if not (prefix `isPrefixOf` token)@@ -361,7 +411,7 @@               Just (_, val) -> insert val tokens  -- Runs a single parsing pass.-runAction :: Bool -> Action a -> Map Name Flag -> [String] -> Either FlagError (a, Set Name, [String])+runAction :: Bool -> Action a -> Map Name Flag -> [String] -> Either FlagsError (a, Set Name, [String]) runAction ignoreUnknown action flags tokens = case gatherValues ignoreUnknown flags tokens of   Left err -> Left err   Right (values, args) -> case runExcept $ runRWST action values Set.empty of@@ -383,7 +433,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 :: FlagsParser a -> [String] -> Either FlagError (a, [String])+parseFlags :: FlagsParser a -> [String] -> Either FlagsError (a, [String]) parseFlags parser tokens = case reservedParser of   Invalid _ -> error "unreachable"   Actionable action0 flags0 _ -> do

@@ -3,101 +3,132 @@  import Control.Applicative ((<|>), optional) import Data.Either (isLeft)+import Data.Foldable (asum) import Data.List.NonEmpty (NonEmpty(..))+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Text (Text) import Test.Hspec (describe, expectationFailure, hspec, it, shouldBe)  import Flags.Applicative +data Mode = Flexible | Strict deriving (Bounded, Enum, Eq, Show)+ main :: IO () main = hspec $ do   describe "parse" $ do     it "should parse a single flag" $ do       let-        parser = textFlag "foo" ""+        parser = flag textVal "foo" ""         res = parseFlags parser ["--foo=abc", "hi"]       res `shouldBe` Right ("abc", ["hi"])+     it "should fail on duplicate flag" $ do       let-        parser = (,) <$> textFlag "foo" "" <*> textFlag "foo" ""+        parser = (,) <$> flag textVal "foo" "" <*> flag textVal "foo" ""         res = parseFlags parser []       res `shouldBe` Left (DuplicateFlag "foo")+     it "should support help" $ do       let-        parser = textFlag "foo" ""+        parser = flag textVal "foo" ""         res = parseFlags parser ["--foo=abc", "hi", "--help"]       isLeft res `shouldBe` True+     it "should fail on unknown flags" $ do       let-        parser = textFlag "foo" ""+        parser = flag textVal "foo" ""         res = parseFlags parser ["hi", "--bar"]       res `shouldBe` Left (UnknownFlag "bar")+     it "should detect unexpected flags" $ do       let         parser = switch "bar" "" <|> switch "foo" ""         res = parseFlags parser ["--bar", "--foo"]       res `shouldBe` Left (UnexpectedFlags ("foo" :| []))+     it "should branch correctly with unary flags" $ do       let-        parser = (Right <$> autoFlag @String "ok" "") <|> (Left <$> autoFlag @String "fail" "")+        parser = asum+          [ Right <$> flag (autoVal @String) "ok" ""+          , Left <$> flag (autoVal @String) "fail" "" ]         res = parseFlags parser ["--ok", "\"yes\"", "no"]       res `shouldBe` Right (Right "yes", ["no"])+     it "should branch correctly with nullary flags" $ do       let         parser = (True <$ switch "true" "") <|> (False <$ switch "false" "")         res = parseFlags parser ["--true", "b", "a"]       res `shouldBe` Right (True, ["b", "a"])+     it "should fail on inconsistent flag values" $ do       let-        parser = textFlag "foo" ""+        parser = flag textVal "foo" ""         res = parseFlags parser ["--foo=1", "--foo=2"]       res `shouldBe` Left (InconsistentFlagValues "foo")+     it "should support the same flag value multiple times" $ do       let-        parser = autoFlag @Int "foo" ""+        parser = flag (autoVal @Int) "foo" ""         res = parseFlags parser ["--foo=1", "--foo=1"]       res `shouldBe` Right (1, [])+     it "should support text lists" $ do       let-        parser = textListFlag "," "bar" ""+        parser = flag (listOf textVal) "bar" ""         res = parseFlags parser ["--bar=a,b,c", "def"]       res `shouldBe` Right (["a", "b", "c"], ["def"])++    it "should support maps" $ do+      let+        parser = flag (mapOf textVal fracVal) "bar" "" :: FlagsParser (Map Text Double)+        res = parseFlags parser ["--bar=a:1,b:0,c:2.5"]+      res `shouldBe` Right (Map.fromList [("a", 1), ("b", 0), ("c", 2.5)], [])+     it "should swallow switches" $ do       let         parser = boolFlag "foo" ""         res = parseFlags parser ["--foo", "--bar", "--swallowed_switches=bar"]       res `shouldBe` Right (True, [])+     it "should fail when a switch is set as a flag" $ do       let         parser = boolFlag "foo" ""         res = parseFlags parser ["--foo=3"]       res `shouldBe` Left (UnexpectedFlagValue "foo")+     it "should swallow flags" $ do       let         parser = boolFlag "foo" ""         res = parseFlags parser ["--bar=2", "--swallowed_flags=bar"]       res `shouldBe` Right (False, [])+     it "should fail when a flag is swallowed as a switch" $ do       let         parser = boolFlag "foo" ""         res = parseFlags parser ["--foo", "--bar=1", "--swallowed_switches=bar"]       res `shouldBe` Left (UnexpectedFlagValue "bar")+     it "should parse a hostname" $ do       let-        parser = hostFlag "host" ""+        parser = flag hostVal "host" ""         res = parseFlags parser ["--host=foo.com"]       res `shouldBe` Right (("foo.com", Nothing), [])+     it "should parse a hostname and a port" $ do       let-        parser = hostFlag "host" ""+        parser = flag hostVal "host" ""         res = parseFlags parser ["--host=localhost:1234"]       res `shouldBe` Right (("localhost", Just 1234), [])+     it "should fail when given an invalid port" $ do       let-        parser = hostFlag "host" ""+        parser = flag hostVal "host" ""         res = parseFlags parser ["--host=localhost:1a2"]       case res of         Left (InvalidFlagValue "host" _ _) -> pure ()         _ -> expectationFailure $ show res+     it "should report all missing required flags" $ do       let         parser = switch "foo" "" <|> switch "bar" ""@@ -105,13 +136,44 @@       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" ""+        parser = optional $ flag textVal "foo" ""         res = parseFlags parser ["--", "--bar=2"]       res `shouldBe` Right (Nothing, ["--bar=2"])++    it "should parse integral flags" $ do+      let parser = flag intVal "int" "" :: FlagsParser Int+      parseFlags parser ["--int=12"] `shouldBe` Right (12, [])+      parseFlags parser ["--int=-1"] `shouldBe` Right (-1, [])+      parseFlags parser ["--int", "0"] `shouldBe` Right (0, [])+      case parseFlags parser ["--int", "0.1"] of+        Left (InvalidFlagValue "int" "0.1" _) -> pure ()+        r -> expectationFailure $ show r+      case parseFlags parser ["--int", ""] of+        Left (InvalidFlagValue "int" "" _) -> pure ()+        r -> expectationFailure $ show r++    it "should parse fractional flags" $ do+      let parser = flag fracVal "double" "" :: FlagsParser Double+      parseFlags parser ["--double=12.1"] `shouldBe` Right (12.1, [])+      parseFlags parser ["--double=-1"] `shouldBe` Right (-1, [])+      parseFlags parser ["--double", "0"] `shouldBe` Right (0, [])+      case parseFlags parser ["--double", "0."] of+        Left (InvalidFlagValue "double" "0." _) -> pure ()+        r -> expectationFailure $ show r++    it "should parse enum flags" $ do+      let parser = flag enumVal "mode" "" :: FlagsParser Mode+      parseFlags parser ["--mode", "FLEXIBLE"] `shouldBe` Right (Flexible, [])+      parseFlags parser ["--mode=STRICT"] `shouldBe` Right (Strict, [])+      case parseFlags parser ["--mode", "NONE"] of+        Left (InvalidFlagValue "mode" "NONE" _) -> pure ()+        r -> expectationFailure $ show r