optparse-applicative 0.11.0.2 → 0.12.0.0
raw patch · 9 files changed
+174/−98 lines, 9 filesdep ~ansi-wl-pprintdep ~processnew-uploader
Dependency ranges changed: ansi-wl-pprint, process
Files
- CHANGELOG.md +16/−0
- Options/Applicative/Builder.hs +11/−1
- Options/Applicative/Common.hs +108/−33
- Options/Applicative/Extra.hs +12/−9
- Options/Applicative/Help/Core.hs +9/−44
- Options/Applicative/Internal.hs +2/−2
- Options/Applicative/Types.hs +11/−6
- optparse-applicative.cabal +3/−3
- tests/nested.err.txt +2/−0
CHANGELOG.md view
@@ -1,3 +1,19 @@+## Version 0.12.0.0 (17 Sep 2015)++- Add "missing" error condition descriptions when required flags and arguments+ are not provided.++- Allow multiple short flags to be concatenated together behind a single+ hyphen, e.g. "-xcf".++- Updated dependency bounds on `process` and `ansi-wl-pprint`.++- Add `Show` and `Eq` instances to some types for easier debugging.++- Add defaultPrefs, a default preferences value++- Docs.+ ## Version 0.11.0.2 (17 Feb 2015) - Updated dependency bounds.
Options/Applicative/Builder.hs view
@@ -84,6 +84,7 @@ noBacktrack, columns, prefs,+ defaultPrefs, -- * Types Mod,@@ -135,6 +136,11 @@ long = fieldMod . name . OptLong -- | Specify a default value for an option.+--+-- /Note/: Because this modifier means the parser will never fail,+-- do not use it with combinators such as 'some' or 'many', as+-- these combinators continue until a failure occurs.+-- Careless use will thus result in a hang. value :: HasValue f => a -> Mod f a value x = Mod id (DefaultProp (Just x) Nothing) id @@ -186,7 +192,7 @@ -- | Add a bash completion action. Common actions include @file@ and -- @directory@. See--- http://www.gnu.org/software/bash/manual/html_node/Programmable-Completion-Builtins.html#Programmable-Completion-Builtins+-- <http://www.gnu.org/software/bash/manual/html_node/Programmable-Completion-Builtins.html#Programmable-Completion-Builtins> -- for a complete list. action :: HasCompleter f => String -> Mod f a action act = completer (bashCompleter act)@@ -388,3 +394,7 @@ -- | Trivial option modifier. idm :: Monoid m => m idm = mempty++-- | Default preferences.+defaultPrefs :: ParserPrefs+defaultPrefs = prefs idm
Options/Applicative/Common.hs view
@@ -47,20 +47,26 @@ -- * Low-level utilities mapParser, treeMapParser,- optionNames+ optionNames,+ optDesc,+ OptDescStyle (..) ) where import Control.Applicative (pure, (<*>), (<$>), (<|>), (<$))+import Control.Arrow (left) import Control.Monad (guard, mzero, msum, when, liftM) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State (StateT(..), get, put, runStateT)-import Data.List (isPrefixOf)-import Data.Maybe (maybeToList, isJust, isNothing)+import Data.List (isPrefixOf, sort, intersperse)+import Data.Maybe (maybeToList) import Data.Monoid (Monoid(..)) import Options.Applicative.Internal import Options.Applicative.Types +import Options.Applicative.Help.Pretty+import Options.Applicative.Help.Chunk+ showOption :: OptName -> String showOption (OptLong n) = "--" ++ n showOption (OptShort n) = '-' : [n]@@ -119,8 +125,11 @@ lift $ runReadM (withReadM (errorFor arg1) (crReader rdr)) arg' FlagReader names x -> do guard $ has_name arg1 names- guard $ isNothing val- Just $ return x+ Just $ do+ args <- get+ let val' = (\s -> '-' : s) <$> val+ put $ maybeToList val' ++ args+ return x _ -> Nothing where errorFor name msg = "option " ++ showOption name ++ ": " ++ msg@@ -149,35 +158,37 @@ parseWord _ = Nothing searchParser :: Monad m- => (forall r . Option r -> NondetT m r)+ => ParserPrefs+ -> (forall r . Option r -> NondetT m r) -> Parser a -> NondetT m (Parser a)-searchParser _ (NilP _) = mzero-searchParser f (OptP opt) = liftM pure (f opt)-searchParser f (MultP p1 p2) = foldr1 (<!>)- [ do p1' <- searchParser f p1+searchParser _ _ (NilP _) = mzero+searchParser _ f (OptP opt) = liftM pure (f opt)+searchParser pprefs f (MultP p1 p2) = foldr1 (<!>)+ [ do p1' <- searchParser pprefs f p1 return (p1' <*> p2)- , do p2' <- searchParser f p2+ , do p2' <- searchParser pprefs f p2 return (p1 <*> p2') ]-searchParser f (AltP p1 p2) = msum- [ searchParser f p1- , searchParser f p2 ]-searchParser f (BindP p k) = do- p' <- searchParser f p- x <- hoistMaybe (evalParser p')- return (k x)+searchParser pprefs f (AltP p1 p2) = msum+ [ searchParser pprefs f p1+ , searchParser pprefs f p2 ]+searchParser pprefs f (BindP p k) = do+ p' <- searchParser pprefs f p+ case (evalParser False False (optDesc pprefs missingStyle) p') of+ Left _ -> mzero+ Right aa -> pure $ k aa searchOpt :: MonadP m => ParserPrefs -> OptWord -> Parser a -> NondetT (StateT Args m) (Parser a)-searchOpt pprefs w = searchParser $ \opt -> do+searchOpt pprefs w = searchParser pprefs $ \opt -> do let disambiguate = prefDisambiguate pprefs && optVisibility opt > Internal case optMatches disambiguate (optMain opt) w of Just matcher -> lift matcher Nothing -> mzero -searchArg :: MonadP m => String -> Parser a+searchArg :: MonadP m => ParserPrefs -> String -> Parser a -> NondetT (StateT Args m) (Parser a)-searchArg arg = searchParser $ \opt -> do+searchArg pprefs arg = searchParser pprefs $ \opt -> do when (isArg (optMain opt)) cut case argMatches (optMain opt) arg of Just matcher -> lift matcher@@ -187,9 +198,9 @@ -> Parser a -> NondetT (StateT Args m) (Parser a) stepParser pprefs SkipOpts arg p = case parseWord arg of Just w -> searchOpt pprefs w p- Nothing -> searchArg arg p+ Nothing -> searchArg pprefs arg p stepParser pprefs AllowOpts arg p = msum- [ searchArg arg p+ [ searchArg pprefs arg p , do w <- hoistMaybe (parseWord arg) searchOpt pprefs w p ] @@ -199,15 +210,17 @@ runParser :: MonadP m => ArgPolicy -> Parser a -> Args -> m (a, Args) runParser SkipOpts p ("--" : argt) = runParser AllowOpts p argt runParser policy p args = case args of- [] -> exitP p result+ [] -> do+ prefs <- getPrefs+ exitP p $ MissingError `left` result prefs (arg : argt) -> do prefs <- getPrefs (mp', args') <- do_step prefs arg argt case mp' of- Nothing -> hoistMaybe result <|> parseError arg+ Nothing -> hoistEither (MissingError `left` (result prefs)) <|> parseError arg Just p' -> runParser policy p' args' where- result = (,) <$> evalParser p <*> pure args+ result (prefs') = (,) <$> evalParser False False (optDesc prefs' missingStyle) p <*> pure args do_step prefs arg argt = (`runStateT` argt) . disamb (not (prefDisambiguate prefs)) $ stepParser prefs policy arg p@@ -235,12 +248,28 @@ -- | The default value of a 'Parser'. This function returns an error if any of -- the options don't have a default value.-evalParser :: Parser a -> Maybe a-evalParser (NilP r) = r-evalParser (OptP _) = Nothing-evalParser (MultP p1 p2) = evalParser p1 <*> evalParser p2-evalParser (AltP p1 p2) = evalParser p1 <|> evalParser p2-evalParser (BindP p k) = evalParser p >>= evalParser . k+evalParser :: Bool -> Bool+ -> (forall x . OptHelpInfo -> Option x -> b)+ -> Parser a+ -> Either (OptTree b) a+evalParser _ _ _ (NilP r) = maybeToEither (MultNode []) r+evalParser m d f (OptP opt)+ | optVisibility opt > Internal+ = Left $ Leaf (f (OptHelpInfo m d) opt)+ | otherwise+ = Left $ MultNode []+evalParser m d f (MultP p1 p2) = case evalParser m d f p1 <*> evalParser m d f p2 of+ Right a -> Right a+ Left _ -> case (evalParser m d f p1, evalParser m d f p2) of+ (Left a', Left b') -> Left $ MultNode [a', b']+ (Left a', _) -> Left $ MultNode [a']+ (_, Left b') -> Left $ MultNode [b']+ _ -> Left $ MultNode []+evalParser m d f (AltP p1 p2) = case (evalParser m d f p1, evalParser m d f p2) of+ (Right a', _) -> Right a'+ (_, Right b') -> Right b'+ (Left a', Left b') -> Left $ AltNode [a', b']+evalParser _ d f (BindP p k) = evalParser True d f p >>= (evalParser True d f) . k -- | Map a polymorphic function over all the options of a parser, and collect -- the results in a list.@@ -259,7 +288,7 @@ treeMapParser g = simplify . go False False g where has_default :: Parser a -> Bool- has_default p = isJust (evalParser p)+ has_default p = either (const False) (const True) (evalParser False False g p) go :: Bool -> Bool -> (forall x . OptHelpInfo -> Option x -> b)@@ -294,3 +323,49 @@ remove_alt (AltNode ts) = ts remove_alt (MultNode []) = [] remove_alt t = [t]+++-- | Style for rendering an option.+data OptDescStyle = OptDescStyle+ { descSep :: Doc+ , descHidden :: Bool+ , descSurround :: Bool }++-- | Generate description for a single option.+optDesc :: ParserPrefs -> OptDescStyle -> OptHelpInfo -> Option a -> Chunk Doc+optDesc pprefs style info opt =+ let ns = optionNames $ optMain opt+ mv = stringChunk $ optMetaVar opt+ descs = map (string . showOption) (sort ns)+ desc' = listToChunk (intersperse (descSep style) descs) <<+>> mv+ show_opt+ | optVisibility opt == Hidden+ = descHidden style+ | otherwise+ = optVisibility opt == Visible+ suffix+ | hinfoMulti info+ = stringChunk . prefMultiSuffix $ pprefs+ | otherwise+ = mempty+ render chunk+ | not show_opt+ = mempty+ | isEmpty chunk || not (descSurround style)+ = mappend chunk suffix+ | hinfoDefault info+ = mappend (fmap brackets chunk) suffix+ | null (drop 1 descs)+ = mappend chunk suffix+ | otherwise+ = mappend (fmap parens chunk) suffix+ in render desc'++missingStyle :: OptDescStyle+missingStyle = OptDescStyle+ { descSep = string "|"+ , descHidden = False+ , descSurround = True }++maybeToEither :: b -> Maybe a -> Either b a+maybeToEither = flip maybe Right . Left
Options/Applicative/Extra.hs view
@@ -58,7 +58,7 @@ -- Parse command line arguments. Display help text and exit if any parse error -- occurs. execParser :: ParserInfo a -> IO a-execParser = customExecParser (prefs idm)+execParser = customExecParser defaultPrefs -- | Run a program description with custom preferences. customExecParser :: ParserPrefs -> ParserInfo a -> IO a@@ -102,7 +102,7 @@ -- If you need to keep track of error messages, use 'execParserPure' instead. {-# DEPRECATED execParserMaybe "Use execParserPure together with getParseResult instead" #-} execParserMaybe :: ParserInfo a -> [String] -> Maybe a-execParserMaybe = customExecParserMaybe (prefs idm)+execParserMaybe = customExecParserMaybe defaultPrefs -- | Run a program description with custom preferences in pure code. --@@ -143,9 +143,11 @@ in (h, exit_code, prefColumns pprefs) where exit_code = case msg of- ErrorMsg _ -> ExitFailure (infoFailureCode pinfo)- UnknownError -> ExitFailure (infoFailureCode pinfo)- _ -> ExitSuccess+ ErrorMsg _ -> ExitFailure (infoFailureCode pinfo)+ UnknownError -> ExitFailure (infoFailureCode pinfo)+ MissingError _ -> ExitFailure (infoFailureCode pinfo)+ ShowHelpText -> ExitSuccess+ InfoMsg _ -> ExitSuccess with_context :: Context -> ParserInfo a@@ -161,10 +163,11 @@ , fmap (indent 2) . infoProgDesc $ i ] error_help = errorHelp $ case msg of- ShowHelpText -> mempty- ErrorMsg m -> stringChunk m- InfoMsg m -> stringChunk m- UnknownError -> mempty+ ShowHelpText -> mempty+ ErrorMsg m -> stringChunk m+ InfoMsg m -> stringChunk m+ MissingError x -> stringChunk "Missing:" <<+>> fold_tree x+ UnknownError -> mempty base_help :: ParserInfo a -> ParserHelp base_help i
Options/Applicative/Help/Core.hs view
@@ -1,6 +1,7 @@ module Options.Applicative.Help.Core ( cmdDesc, briefDesc,+ fold_tree, fullDesc, ParserHelp(..), errorHelp,@@ -13,51 +14,14 @@ ) where import Control.Monad (guard)-import Data.List (intersperse, sort) import Data.Maybe (maybeToList, catMaybes)-import Data.Monoid (mempty, mappend)+import Data.Monoid (mempty) import Options.Applicative.Common import Options.Applicative.Types import Options.Applicative.Help.Pretty import Options.Applicative.Help.Chunk --- | Style for rendering an option.-data OptDescStyle = OptDescStyle- { descSep :: Doc- , descHidden :: Bool- , descSurround :: Bool }---- | Generate description for a single option.-optDesc :: ParserPrefs -> OptDescStyle -> OptHelpInfo -> Option a -> Chunk Doc-optDesc pprefs style info opt =- let ns = optionNames $ optMain opt- mv = stringChunk $ optMetaVar opt- descs = map (string . showOption) (sort ns)- desc' = listToChunk (intersperse (descSep style) descs) <<+>> mv- show_opt- | optVisibility opt == Hidden- = descHidden style- | otherwise- = optVisibility opt == Visible- suffix- | hinfoMulti info- = stringChunk . prefMultiSuffix $ pprefs- | otherwise- = mempty- render chunk- | not show_opt- = mempty- | isEmpty chunk || not (descSurround style)- = mappend chunk suffix- | hinfoDefault info- = mappend (fmap brackets chunk) suffix- | null (drop 1 descs)- = mappend chunk suffix- | otherwise- = mappend (fmap parens chunk) suffix- in render desc'- -- | Generate descriptions for commands. cmdDesc :: Parser a -> Chunk Doc cmdDesc = vcatChunks . mapParser desc@@ -79,12 +43,13 @@ , descHidden = False , descSurround = True } - fold_tree (Leaf x) = x- fold_tree (MultNode xs) = foldr ((<</>>) . fold_tree) mempty xs- fold_tree (AltNode xs) = alt_node- . filter (not . isEmpty)- . map fold_tree $ xs-+fold_tree :: OptTree (Chunk Doc) -> Chunk Doc+fold_tree (Leaf x) = x+fold_tree (MultNode xs) = foldr ((<</>>) . fold_tree) mempty xs+fold_tree (AltNode xs) = alt_node+ . filter (not . isEmpty)+ . map fold_tree $ xs+ where alt_node :: [Chunk Doc] -> Chunk Doc alt_node [n] = n alt_node ns = fmap parens
Options/Applicative/Internal.hs view
@@ -49,7 +49,7 @@ missingArgP :: ParseError -> Completer -> m a tryP :: m a -> m (Either ParseError a) errorP :: ParseError -> m a- exitP :: Parser b -> Maybe a -> m a+ exitP :: Parser b -> Either ParseError a -> m a newtype P a = P (ExceptT ParseError (WriterT Context (Reader ParserPrefs)) a) @@ -92,7 +92,7 @@ missingArgP e _ = errorP e tryP (P p) = P $ lift $ runExceptT p- exitP _ = P . hoistMaybe+ exitP _ = P . (either throwE return) errorP = P . throwE hoistMaybe :: MonadPlus m => Maybe a -> m a
Options/Applicative/Types.hs view
@@ -57,6 +57,7 @@ | InfoMsg String | ShowHelpText | UnknownError+ | MissingError (OptTree (Chunk Doc)) deriving Show instance Monoid ParseError where@@ -91,18 +92,18 @@ -- subcommand fails (default: True) , prefColumns :: Int -- ^ number of columns in the terminal, used to -- format the help page (default: 80)- }+ } deriving (Eq, Show) data OptName = OptShort !Char | OptLong !String- deriving (Eq, Ord)+ deriving (Eq, Ord, Show) -- | Visibility of an option in the help text. data OptVisibility = Internal -- ^ does not appear in the help text at all | Hidden -- ^ only visible in the full description | Visible -- ^ visible both in the full and brief descriptions- deriving (Eq, Ord)+ deriving (Eq, Ord, Show) -- | Specification for an individual parser option. data OptProperties = OptProperties@@ -110,7 +111,7 @@ , propHelp :: Chunk Doc -- ^ help text for this option , propMetaVar :: String -- ^ metavariable for this option , propShowDefault :: Maybe String -- ^ what to show in the help text as the default- }+ } deriving Show -- | A single option of a parser. data Option a = Option@@ -118,6 +119,9 @@ , optProps :: OptProperties -- ^ properties of this option } +instance Show (Option a) where+ show opt = "Option {optProps = " ++ show (optProps opt) ++ "}"+ instance Functor Option where fmap f (Option m p) = Option (fmap f m) p @@ -297,11 +301,12 @@ data ArgPolicy = SkipOpts | AllowOpts- deriving Eq+ deriving (Eq, Show) data OptHelpInfo = OptHelpInfo { hinfoMulti :: Bool- , hinfoDefault :: Bool }+ , hinfoDefault :: Bool+ } deriving (Eq, Show) data OptTree a = Leaf a
optparse-applicative.cabal view
@@ -1,5 +1,5 @@ name: optparse-applicative-version: 0.11.0.2+version: 0.12.0.0 synopsis: Utilities and combinators for parsing command line options description: Here is a simple example of an applicative option parser:@@ -112,5 +112,5 @@ build-depends: base == 4.*, transformers >= 0.2 && < 0.5, transformers-compat >= 0.3 && < 0.5,- process >= 1.0 && < 1.3,- ansi-wl-pprint >= 0.6 && < 0.7+ process >= 1.0 && < 1.4,+ ansi-wl-pprint >= 0.6.6 && < 0.7
tests/nested.err.txt view
@@ -1,1 +1,3 @@+Missing: -a A+ Usage: nested c b -a A