Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add arguments1 builder.

Also make the `argument` builder skip arguments starting with '-', and
provide an alternative lower-level builder `argument'` which behaves
like `argument` used to.
  • Loading branch information...
commit 700e07b0751d02fec938af67d1f917e60974a601 1 parent 240e42e
Paolo Capriotti authored
2  Options/Applicative/Builder.hs
View
@@ -19,7 +19,9 @@ module Options.Applicative.Builder (
-- creates a parser for an option called \"output\".
subparser,
argument,
+ argument',
arguments,
+ arguments1,
flag,
flag',
switch,
44 Options/Applicative/Builder/Arguments.hs
View
@@ -1,6 +1,8 @@
module Options.Applicative.Builder.Arguments
( argument
+ , argument'
, arguments
+ , arguments1
) where
import Control.Applicative
@@ -11,13 +13,21 @@ import Options.Applicative.Builder.Internal
import Options.Applicative.Common
import Options.Applicative.Types
+skipOpts :: (String -> Maybe a) -> String -> Maybe a
+skipOpts _ ('-':_) = Nothing
+skipOpts rdr s = rdr s
+
-- | Builder for an argument parser.
-argument :: (String -> Maybe a) -> Mod ArgumentFields a -> Parser a
-argument p (Mod f d g) = mkParser d g (ArgReader rdr)
+argument' :: (String -> Maybe a) -> Mod ArgumentFields a -> Parser a
+argument' p (Mod f d g) = mkParser d g (ArgReader rdr)
where
ArgumentFields compl = f (ArgumentFields mempty)
rdr = CReader compl p
+-- | Builder for an argument parser ignoring arguments starting with '-'.
+argument :: (String -> Maybe a) -> Mod ArgumentFields a -> Parser a
+argument p = argument' (skipOpts p)
+
-- | Builder for an argument list parser. All arguments are collected and
-- returned as a list.
--
@@ -27,17 +37,35 @@ argument p (Mod f d g) = mkParser d g (ArgReader rdr)
-- command line, all following arguments are included in the result, even if
-- they start with @'-'@.
arguments :: (String -> Maybe a) -> Mod ArgumentFields [a] -> Parser [a]
-arguments p m = set_default <$> fromM args
+arguments = arguments_ True
+
+-- | Like `arguments`, but require at least one argument.
+arguments1 :: (String -> Maybe a) -> Mod ArgumentFields [a] -> Parser [a]
+arguments1 = arguments_ False
+
+-- | Builder for an argument list parser. All arguments are collected and
+-- returned as a list.
+--
+-- Note that arguments starting with @'-'@ are ignored.
+--
+-- This parser accepts a special argument: @--@. When a @--@ is found on the
+-- command line, all following arguments are included in the result, even if
+-- they start with @'-'@.
+arguments_ :: Bool -> (String -> Maybe a) -> Mod ArgumentFields [a] -> Parser [a]
+arguments_ allow_empty p m = set_default <$> fromM args1
where
Mod f (DefaultProp def sdef) g = m
show_def = sdef <*> def
- p' ('-':_) = Nothing
- p' s = p s
-
props = mkProps mempty g
props' = (mkProps mempty g) { propShowDefault = show_def }
+ args1 | allow_empty = args
+ | otherwise = do
+ mx <- oneM arg_or_ddash
+ case mx of
+ Nothing -> someM arg
+ Just x -> (x:) <$> args
args = do
mx <- oneM $ optional arg_or_ddash
case mx of
@@ -49,8 +77,8 @@ arguments p m = set_default <$> fromM args
set_default xs = xs
arg = liftOpt (Option (ArgReader (CReader compl p)) props)
- arg' = liftOpt (Option (ArgReader (CReader compl p')) props')
+ arg' = liftOpt (Option (ArgReader (CReader compl (skipOpts p))) props')
- ddash = argument (guard . (== "--")) internal
+ ddash = argument' (guard . (== "--")) internal
ArgumentFields compl = f (ArgumentFields mempty)
4 Options/Applicative/Types.hs
View
@@ -19,6 +19,7 @@ module Options.Applicative.Types (
fromM,
oneM,
manyM,
+ someM,
optVisibility,
optMetaVar,
@@ -132,6 +133,9 @@ manyM p = do
Nothing -> return []
Just x -> (x:) <$> manyM p
+someM :: Parser a -> ParserM [a]
+someM p = (:) <$> oneM p <*> manyM p
+
instance Alternative Parser where
empty = NilP Nothing
(<|>) = AltP
16 tests/Tests.hs
View
@@ -203,5 +203,21 @@ case_issue_19 = do
Left _ -> assertFailure "unexpected parse error"
Right r -> Just "foo" @=? r
+case_arguments1_none :: Assertion
+case_arguments1_none = do
+ let p = arguments1 str idm
+ i = info (p <**> helper) idm
+ result = run i []
+ assertLeft result $ \(ParserFailure _ _) -> return ()
+
+case_arguments1_some :: Assertion
+case_arguments1_some = do
+ let p = arguments1 str idm
+ i = info (p <**> helper) idm
+ result = run i ["foo", "--", "bar", "baz"]
+ case result of
+ Left _ -> assertFailure "unexpected parse error"
+ Right r -> ["foo", "bar", "baz"] @=? r
+
main :: IO ()
main = $(defaultMainGenerator)
Please sign in to comment.
Something went wrong with that request. Please try again.