Hello community,
here is the log from the commit of package ghc-optparse-applicative for
openSUSE:Factory checked in at 2020-08-28 21:35:39
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-optparse-applicative (Old)
and /work/SRC/openSUSE:Factory/.ghc-optparse-applicative.new.3399 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-optparse-applicative"
Fri Aug 28 21:35:39 2020 rev:17 rq:829368 version:0.16.0.0
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-optparse-applicative/ghc-optparse-applicative.changes
2020-06-19 17:16:19.130698933 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-optparse-applicative.new.3399/ghc-optparse-applicative.changes
2020-08-28 21:35:41.788732853 +0200
@@ -1,0 +2,52 @@
+Tue Aug 18 10:45:37 UTC 2020 - Peter Simons <[email protected]>
+
+- Replace %setup -q with the more modern %autosetup macro.
+
+-------------------------------------------------------------------
+Thu Aug 13 15:56:41 UTC 2020 - [email protected]
+
+- Update optparse-applicative to version 0.16.0.0.
+ ## Version 0.16.0.0 (14 Aug 2020)
+
+ - Add `Options.Applicative.NonEmpty.some1` function, which
+ parses options the same as `some1` from base, but doesn't
+ cause duplicates in the usage texts.
+
+ - Further improve help text generation in the presence
+ of optional values when nesting is involved, and many and
+ some when displayed with a suffix.
+
+ - Add "global" options to the usage texts for subcommands.
+ When using subcommands, a "global options" section can
+ now appear below the options and commands sections.
+
+ Global options are *off* by default, to enable them, use
+ the `helpShowGlobals` modifier.
+
+ The `noGlobal` builder will suppress a single option being
+ displayed in the global options list.
+
+ Fixes issues:
+ * \# 175 - List detailed subparser documentation with `--help`
+ * \# 294 - Displaying global options when listing options for a command.
+ * \# 359 - Subcommand help text lacks required parent command arguments
+
+ - Allow the `--help` option to take the name of a command.
+ Usage without any arguments is the same, but now, when an
+ argument is given, if it is the name of a currently
+ reachable command, the help text for that command will
+ be show.
+
+ Fixes issues:
+ * \# 379 - cmd --help subcmd is not the same as cmd subcmd --help
+
+ - Updated dependency bounds.
+
+ - Add builder for the all positional parser policy.
+
+ - Remove deprecated functions
+ * nullOption
+ * execParserMaybe
+ * customExecParserMaybe
+
+-------------------------------------------------------------------
Old:
----
optparse-applicative-0.15.1.0.tar.gz
optparse-applicative.cabal
New:
----
optparse-applicative-0.16.0.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-optparse-applicative.spec ++++++
--- /var/tmp/diff_new_pack.hzz9As/_old 2020-08-28 21:35:42.832733347 +0200
+++ /var/tmp/diff_new_pack.hzz9As/_new 2020-08-28 21:35:42.836733349 +0200
@@ -19,13 +19,12 @@
%global pkg_name optparse-applicative
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.15.1.0
+Version: 0.16.0.0
Release: 0
Summary: Utilities and combinators for parsing command line options
License: BSD-3-Clause
URL: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
-Source1:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-ansi-wl-pprint-devel
BuildRequires: ghc-process-devel
@@ -39,11 +38,12 @@
%description
Optparse-applicative is a haskell library for parsing options on the command
-line, providing a powerful applicative interface for composing these options.
+line, and providing a powerful applicative interface for composing them.
optparse-applicative takes care of reading and validating the arguments passed
to the command line, handling and reporting errors, generating a usage line, a
-comprehensive help screen, and enabling context-sensitive bash completions.
+comprehensive help screen, and enabling context-sensitive bash, zsh, and fish
+completions.
See the included README for detailed instructions and examples, which is also
available on github <https://github.com/pcapriotti/optparse-applicative>.
@@ -60,8 +60,7 @@
files.
%prep
-%setup -q -n %{pkg_name}-%{version}
-cp -p %{SOURCE1} %{pkg_name}.cabal
+%autosetup -n %{pkg_name}-%{version}
%build
%ghc_lib_build
++++++ optparse-applicative-0.15.1.0.tar.gz ->
optparse-applicative-0.16.0.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/optparse-applicative-0.15.1.0/CHANGELOG.md
new/optparse-applicative-0.16.0.0/CHANGELOG.md
--- old/optparse-applicative-0.15.1.0/CHANGELOG.md 2019-09-12
13:53:27.000000000 +0200
+++ new/optparse-applicative-0.16.0.0/CHANGELOG.md 2001-09-09
03:46:40.000000000 +0200
@@ -1,3 +1,46 @@
+## Version 0.16.0.0 (14 Aug 2020)
+
+- Add `Options.Applicative.NonEmpty.some1` function, which
+ parses options the same as `some1` from base, but doesn't
+ cause duplicates in the usage texts.
+
+- Further improve help text generation in the presence
+ of optional values when nesting is involved, and many and
+ some when displayed with a suffix.
+
+- Add "global" options to the usage texts for subcommands.
+ When using subcommands, a "global options" section can
+ now appear below the options and commands sections.
+
+ Global options are *off* by default, to enable them, use
+ the `helpShowGlobals` modifier.
+
+ The `noGlobal` builder will suppress a single option being
+ displayed in the global options list.
+
+ Fixes issues:
+ * \# 175 - List detailed subparser documentation with `--help`
+ * \# 294 - Displaying global options when listing options for a command.
+ * \# 359 - Subcommand help text lacks required parent command arguments
+
+- Allow the `--help` option to take the name of a command.
+ Usage without any arguments is the same, but now, when an
+ argument is given, if it is the name of a currently
+ reachable command, the help text for that command will
+ be show.
+
+ Fixes issues:
+ * \# 379 - cmd --help subcmd is not the same as cmd subcmd --help
+
+- Updated dependency bounds.
+
+- Add builder for the all positional parser policy.
+
+- Remove deprecated functions
+ * nullOption
+ * execParserMaybe
+ * customExecParserMaybe
+
## Version 0.15.1.0 (12 Sep 2019)
- Improve printing of brief descriptions for parsers.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/optparse-applicative-0.15.1.0/README.md
new/optparse-applicative-0.16.0.0/README.md
--- old/optparse-applicative-0.15.1.0/README.md 2019-09-12 13:53:27.000000000
+0200
+++ new/optparse-applicative-0.16.0.0/README.md 2001-09-09 03:46:40.000000000
+0200
@@ -1,9 +1,11 @@
# optparse-applicative
[![Continuous Integration status][status-png]][status]
+[![Hackage matrix][hackage-matrix-png]][hackage-matrix]
[![Hackage page (downloads and API reference)][hackage-png]][hackage]
[![Hackage-Deps][hackage-deps-png]][hackage-deps]
+
optparse-applicative is a haskell library for parsing options on
the command line, and providing a powerful [applicative] interface
for composing them.
@@ -1011,6 +1013,8 @@
[blog]: http://paolocapriotti.com/blog/2012/04/27/applicative-option-parser/
[hackage]: http://hackage.haskell.org/package/optparse-applicative
[hackage-png]: http://img.shields.io/hackage/v/optparse-applicative.svg
+ [hackage-matrix]:
https://matrix.hackage.haskell.org/package/optparse-applicative
+ [hackage-matrix-png]:
https://matrix.hackage.haskell.org/api/v2/packages/optparse-applicative/badge
[hackage-deps]: http://packdeps.haskellers.com/reverse/optparse-applicative
[hackage-deps-png]:
https://img.shields.io/hackage-deps/v/optparse-applicative.svg
[monoid]: http://hackage.haskell.org/package/base/docs/Data-Monoid.html
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/optparse-applicative-0.15.1.0/optparse-applicative.cabal
new/optparse-applicative-0.16.0.0/optparse-applicative.cabal
--- old/optparse-applicative-0.15.1.0/optparse-applicative.cabal
2019-09-12 13:53:27.000000000 +0200
+++ new/optparse-applicative-0.16.0.0/optparse-applicative.cabal
2001-09-09 03:46:40.000000000 +0200
@@ -1,15 +1,15 @@
name: optparse-applicative
-version: 0.15.1.0
+version: 0.16.0.0
synopsis: Utilities and combinators for parsing command line options
description:
optparse-applicative is a haskell library for parsing options
- on the command line, providing a powerful applicative interface
- for composing these options.
+ on the command line, and providing a powerful applicative
+ interface for composing them.
.
optparse-applicative takes care of reading and validating the
arguments passed to the command line, handling and reporting
errors, generating a usage line, a comprehensive help screen,
- and enabling context-sensitive bash completions.
+ and enabling context-sensitive bash, zsh, and fish completions.
.
See the included README for detailed instructions and examples,
which is also available on github
@@ -21,7 +21,7 @@
copyright: (c) 2012-2017 Paolo Capriotti <[email protected]>
category: System, CLI, Options, Parsing
build-type: Simple
-cabal-version: >= 1.8
+cabal-version: >= 1.10
extra-source-files: CHANGELOG.md
README.md
tests/alt.err.txt
@@ -63,6 +63,7 @@
library
hs-source-dirs: src
ghc-options: -Wall
+ default-language: Haskell98
-- See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0#base-4.9.0.0
if impl(ghc >= 8.0)
@@ -84,6 +85,7 @@
, Options.Applicative.Help.Levenshtein
, Options.Applicative.Help.Pretty
, Options.Applicative.Help.Types
+ , Options.Applicative.NonEmpty
, Options.Applicative.Types
, Options.Applicative.Internal
@@ -104,8 +106,9 @@
ghc-options: -Wall -threaded -O2 -funbox-strict-fields
- hs-source-dirs:
- tests
+ hs-source-dirs: tests
+
+ default-language: Haskell98
other-modules: Examples.Alternatives
, Examples.Cabal
@@ -116,7 +119,7 @@
build-depends: base
, bytestring >= 0.9 && < 0.11
, optparse-applicative
- , QuickCheck >= 2.8 && < 2.14
+ , QuickCheck >= 2.8 && < 2.15
if !impl(ghc >= 8)
build-depends: semigroups
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/optparse-applicative-0.15.1.0/src/Options/Applicative/BashCompletion.hs
new/optparse-applicative-0.16.0.0/src/Options/Applicative/BashCompletion.hs
--- old/optparse-applicative-0.15.1.0/src/Options/Applicative/BashCompletion.hs
2019-09-12 13:53:27.000000000 +0200
+++ new/optparse-applicative-0.16.0.0/src/Options/Applicative/BashCompletion.hs
2001-09-09 03:46:40.000000000 +0200
@@ -91,7 +91,7 @@
--
-- For options and flags, ensure that the user
-- hasn't disabled them with `--`.
- opt_completions argPolicy hinfo opt = case optMain opt of
+ opt_completions argPolicy reachability opt = case optMain opt of
OptReader ns _ _
| argPolicy /= AllPositionals
-> return . add_opt_help opt $ show_names ns
@@ -103,12 +103,12 @@
| otherwise
-> return []
ArgReader rdr
- | hinfoUnreachableArgs hinfo
+ | argumentIsUnreachable reachability
-> return []
| otherwise
-> run_completer (crCompleter rdr)
CmdReader _ ns p
- | hinfoUnreachableArgs hinfo
+ | argumentIsUnreachable reachability
-> return []
| otherwise
-> return . add_cmd_help p $ filter_names ns
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/optparse-applicative-0.15.1.0/src/Options/Applicative/Builder/Internal.hs
new/optparse-applicative-0.16.0.0/src/Options/Applicative/Builder/Internal.hs
---
old/optparse-applicative-0.15.1.0/src/Options/Applicative/Builder/Internal.hs
2019-09-12 13:53:27.000000000 +0200
+++
new/optparse-applicative-0.16.0.0/src/Options/Applicative/Builder/Internal.hs
2001-09-09 03:46:40.000000000 +0200
@@ -20,7 +20,8 @@
mkOption,
mkProps,
- internal
+ internal,
+ noGlobal
) where
import Control.Applicative
@@ -148,6 +149,7 @@
, propHelp = mempty
, propShowDefault = Nothing
, propDescMod = Nothing
+ , propShowGlobal = True
}
mkCommand :: Mod CommandFields a -> (Maybe String, [String], String -> Maybe
(ParserInfo a))
@@ -180,6 +182,13 @@
props = (g baseProps)
{ propShowDefault = sdef <*> def }
--- | Hide this option from the help text
+-- | Hide this option completely from the help text
+--
+-- Use 'hidden' if the option should remain visible in the full description.
internal :: Mod f a
internal = optionMod $ \p -> p { propVisibility = Internal }
+
+
+-- | Suppress this option from appearing in global options
+noGlobal :: Mod f a
+noGlobal = optionMod $ \pp -> pp { propShowGlobal = False }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/optparse-applicative-0.15.1.0/src/Options/Applicative/Builder.hs
new/optparse-applicative-0.16.0.0/src/Options/Applicative/Builder.hs
--- old/optparse-applicative-0.15.1.0/src/Options/Applicative/Builder.hs
2019-09-12 13:53:27.000000000 +0200
+++ new/optparse-applicative-0.16.0.0/src/Options/Applicative/Builder.hs
2001-09-09 03:46:40.000000000 +0200
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
module Options.Applicative.Builder (
-- * Parser builders
--
@@ -26,7 +28,6 @@
infoOption,
strOption,
option,
- nullOption,
-- * Modifiers
short,
@@ -74,6 +75,7 @@
failureCode,
noIntersperse,
forwardOptions,
+ allPositional,
info,
-- * Builder for 'ParserPrefs'
@@ -86,6 +88,7 @@
subparserInline,
columns,
helpLongEquals,
+ helpShowGlobals,
prefs,
defaultPrefs,
@@ -104,7 +107,9 @@
) where
import Control.Applicative
+#if __GLASGOW_HASKELL__ <= 802
import Data.Semigroup hiding (option)
+#endif
import Data.String (fromString, IsString)
import Options.Applicative.Builder.Completer
@@ -201,6 +206,8 @@
metavar var = optionMod $ \p -> p { propMetaVar = var }
-- | Hide this option from the brief description.
+--
+-- Use 'internal' to hide the option from the help text too.
hidden :: Mod f a
hidden = optionMod $ \p ->
p { propVisibility = min Hidden (propVisibility p) }
@@ -275,8 +282,9 @@
-- | Builder for an argument parser.
argument :: ReadM a -> Mod ArgumentFields a -> Parser a
-argument p (Mod f d g) = mkParser d g (ArgReader rdr)
+argument p m = mkParser d g (ArgReader rdr)
where
+ (Mod f d g) = noGlobal `mappend` m
ArgumentFields compl = f (ArgumentFields mempty)
rdr = CReader compl p
@@ -351,11 +359,6 @@
strOption :: IsString s => Mod OptionFields s -> Parser s
strOption = option str
--- | Same as 'option'.
-{-# DEPRECATED nullOption "Use 'option' instead" #-}
-nullOption :: ReadM a -> Mod OptionFields a -> Parser a
-nullOption = option
-
-- | Builder for an option using the given reader.
--
-- This is a regular option, and should always have either a @long@ or
@@ -438,6 +441,14 @@
forwardOptions :: InfoMod a
forwardOptions = InfoMod $ \p -> p { infoPolicy = ForwardOptions }
+-- | Disable parsing of regular options completely. All options and arguments
+-- will be treated as a positional arguments. Obviously not recommended in
+-- general as options will be unreachable.
+-- This is the same behaviour one sees after the "--" pseudo-argument.
+allPositional :: InfoMod a
+allPositional = InfoMod $ \p -> p { infoPolicy = AllPositionals }
+
+
-- | Create a 'ParserInfo' given a 'Parser' and a modifier.
info :: Parser a -> InfoMod a -> ParserInfo a
info parser m = applyInfoMod m base
@@ -506,6 +517,11 @@
helpLongEquals :: PrefsMod
helpLongEquals = PrefsMod $ \p -> p { prefHelpLongEquals = True }
+-- | Show global help information in subparser usage
+helpShowGlobals :: PrefsMod
+helpShowGlobals = PrefsMod $ \p -> p { prefHelpShowGlobal = True}
+
+
-- | Create a `ParserPrefs` given a modifier
prefs :: PrefsMod -> ParserPrefs
prefs m = applyPrefsMod m base
@@ -517,7 +533,8 @@
, prefShowHelpOnEmpty = False
, prefBacktrack = Backtrack
, prefColumns = 80
- , prefHelpLongEquals = False }
+ , prefHelpLongEquals = False
+ , prefHelpShowGlobal = False }
-- Convenience shortcuts
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/optparse-applicative-0.15.1.0/src/Options/Applicative/Common.hs
new/optparse-applicative-0.16.0.0/src/Options/Applicative/Common.hs
--- old/optparse-applicative-0.15.1.0/src/Options/Applicative/Common.hs
2019-09-12 13:53:27.000000000 +0200
+++ new/optparse-applicative-0.16.0.0/src/Options/Applicative/Common.hs
2001-09-09 03:46:40.000000000 +0200
@@ -41,6 +41,7 @@
-- * Running parsers
runParserInfo,
runParserFully,
+ runParserStep,
runParser,
evalParser,
@@ -161,26 +162,27 @@
searchArg :: MonadP m => ParserPrefs -> String -> Parser a
-> NondetT (StateT Args m) (Parser a)
-searchArg prefs arg = searchParser $ \opt -> do
- when (isArg (optMain opt)) cut
- case optMain opt of
- CmdReader _ _ f ->
- case (f arg, prefBacktrack prefs) of
- (Just subp, NoBacktrack) -> lift $ do
- args <- get <* put []
- fmap pure . lift $ enterContext arg subp *> runParserInfo subp args
<* exitContext
-
- (Just subp, Backtrack) -> fmap pure . lift . StateT $ \args ->
- enterContext arg subp *> runParser (infoPolicy subp) CmdStart
(infoParser subp) args <* exitContext
-
- (Just subp, SubparserInline) -> lift $ do
- lift $ enterContext arg subp
- return $ infoParser subp
-
- (Nothing, _) -> mzero
- ArgReader rdr ->
- fmap pure . lift . lift $ runReadM (crReader rdr) arg
- _ -> mzero
+searchArg prefs arg =
+ searchParser $ \opt -> do
+ when (isArg (optMain opt)) cut
+ case optMain opt of
+ CmdReader _ _ f ->
+ case (f arg, prefBacktrack prefs) of
+ (Just subp, NoBacktrack) -> lift $ do
+ args <- get <* put []
+ fmap pure . lift $ enterContext arg subp *> runParserInfo subp
args <* exitContext
+
+ (Just subp, Backtrack) -> fmap pure . lift . StateT $ \args ->
+ enterContext arg subp *> runParser (infoPolicy subp) CmdStart
(infoParser subp) args <* exitContext
+
+ (Just subp, SubparserInline) -> lift $ do
+ lift $ enterContext arg subp
+ return $ infoParser subp
+
+ (Nothing, _) -> mzero
+ ArgReader rdr ->
+ fmap pure . lift . lift $ runReadM (crReader rdr) arg
+ _ -> mzero
stepParser :: MonadP m => ParserPrefs -> ArgPolicy -> String
-> Parser a -> NondetT (StateT Args m) (Parser a)
@@ -203,21 +205,27 @@
runParser policy isCmdStart p args = case args of
[] -> exitP isCmdStart policy p result
(arg : argt) -> do
- prefs <- getPrefs
- (mp', args') <- do_step prefs arg argt
+ (mp', args') <- do_step arg argt
case mp' of
Nothing -> hoistMaybe result <|> parseError arg p
Just p' -> runParser (newPolicy arg) CmdCont p' args'
where
- result = (,) <$> evalParser p <*> pure args
- do_step prefs arg argt = (`runStateT` argt)
- . disamb (not (prefDisambiguate prefs))
- $ stepParser prefs policy arg p
+ result =
+ (,) <$> evalParser p <*> pure args
+ do_step =
+ runParserStep policy p
newPolicy a = case policy of
NoIntersperse -> if isJust (parseWord a) then NoIntersperse else
AllPositionals
x -> x
+runParserStep :: MonadP m => ArgPolicy -> Parser a -> String -> Args -> m
(Maybe (Parser a), Args)
+runParserStep policy p arg args = do
+ prefs <- getPrefs
+ flip runStateT args
+ $ disamb (not (prefDisambiguate prefs))
+ $ stepParser prefs policy arg p
+
parseError :: MonadP m => String -> Parser x -> m a
parseError arg = errorP . UnexpectedError arg . SomeParser
@@ -242,39 +250,39 @@
-- | Map a polymorphic function over all the options of a parser, and collect
-- the results in a list.
-mapParser :: (forall x. OptHelpInfo -> Option x -> b)
+mapParser :: (forall x. ArgumentReachability -> Option x -> b)
-> Parser a -> [b]
mapParser f = flatten . treeMapParser f
where
flatten (Leaf x) = [x]
flatten (MultNode xs) = xs >>= flatten
flatten (AltNode _ xs) = xs >>= flatten
+ flatten (BindNode x) = flatten x
-- | Like 'mapParser', but collect the results in a tree structure.
-treeMapParser :: (forall x . OptHelpInfo -> Option x -> b)
+treeMapParser :: (forall x. ArgumentReachability -> Option x -> b)
-> Parser a
-> OptTree b
-treeMapParser g = simplify . go False False g
+treeMapParser g = simplify . go False g
where
has_default :: Parser a -> Bool
has_default p = isJust (evalParser p)
go :: Bool
- -> Bool
- -> (forall x . OptHelpInfo -> Option x -> b)
+ -> (forall x. ArgumentReachability -> Option x -> b)
-> Parser a
-> OptTree b
- go _ _ _ (NilP _) = MultNode []
- go m r f (OptP opt)
+ go _ _ (NilP _) = MultNode []
+ go r f (OptP opt)
| optVisibility opt > Internal
- = Leaf (f (OptHelpInfo m r) opt)
+ = Leaf (f (ArgumentReachability r) opt)
| otherwise
= MultNode []
- go m r f (MultP p1 p2) =
- MultNode [go m r f p1, go m r' f p2]
+ go r f (MultP p1 p2) =
+ MultNode [go r f p1, go r' f p2]
where r' = r || hasArg p1
- go m r f (AltP p1 p2) =
- AltNode altNodeType [go m r f p1, go m r f p2]
+ go r f (AltP p1 p2) =
+ AltNode altNodeType [go r f p1, go r f p2]
where
-- The 'AltNode' indicates if one of the branches has a default.
-- This is used for rendering brackets, as well as filtering
@@ -284,11 +292,11 @@
then MarkDefault
else NoDefault
- go _ r f (BindP p k) =
- let go' = go True r f p
+ go r f (BindP p k) =
+ let go' = go r f p
in case evalParser p of
- Nothing -> go'
- Just aa -> MultNode [ go', go True r f (k aa) ]
+ Nothing -> BindNode go'
+ Just aa -> BindNode (MultNode [ go', go r f (k aa) ])
hasArg :: Parser a -> Bool
hasArg (NilP _) = False
@@ -312,3 +320,5 @@
remove_alt (AltNode _ ts) = ts
remove_alt (MultNode []) = []
remove_alt t = [t]
+simplify (BindNode x) =
+ BindNode $ simplify x
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/optparse-applicative-0.15.1.0/src/Options/Applicative/Extra.hs
new/optparse-applicative-0.16.0.0/src/Options/Applicative/Extra.hs
--- old/optparse-applicative-0.15.1.0/src/Options/Applicative/Extra.hs
2019-09-12 13:53:27.000000000 +0200
+++ new/optparse-applicative-0.16.0.0/src/Options/Applicative/Extra.hs
2001-09-09 03:46:40.000000000 +0200
@@ -6,9 +6,7 @@
helper,
hsubparser,
execParser,
- execParserMaybe,
customExecParser,
- customExecParserMaybe,
execParserPure,
getParseResult,
handleParseResult,
@@ -22,7 +20,9 @@
) where
import Control.Applicative
+import Control.Monad (void)
import Data.Monoid
+import Data.Foldable (traverse_)
import Prelude
import System.Environment (getArgs, getProgName)
import System.Exit (exitSuccess, exitWith, ExitCode(..))
@@ -46,11 +46,23 @@
-- > opts = info (sample <**> helper) mempty
helper :: Parser (a -> a)
-helper = abortOption ShowHelpText $ mconcat
- [ long "help"
- , short 'h'
- , help "Show this help text"
- , hidden ]
+helper =
+ option helpReader $
+ mconcat
+ [ long "help",
+ short 'h',
+ help "Show this help text",
+ value id,
+ metavar "",
+ noGlobal,
+ noArgError (ShowHelpText Nothing),
+ hidden
+ ]
+ where
+ helpReader = do
+ potentialCommand <- readerAsk
+ readerAbort $
+ ShowHelpText (Just potentialCommand)
-- | Builder for a command parser with a \"helper\" option attached.
-- Used in the same way as `subparser`, but includes a \"--help|-h\" inside
@@ -104,24 +116,6 @@
getParseResult (Success a) = Just a
getParseResult _ = Nothing
--- | Run a program description in pure code.
---
--- This function behaves like 'execParser', but can be called from pure code.
--- Note that, in case of errors, no message is displayed, and this function
--- simply returns 'Nothing'.
---
--- 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 defaultPrefs
-
--- | Run a program description with custom preferences in pure code.
---
--- See 'execParserMaybe' for details.
-{-# DEPRECATED customExecParserMaybe "Use execParserPure together with
getParseResult instead" #-}
-customExecParserMaybe :: ParserPrefs -> ParserInfo a -> [String] -> Maybe a
-customExecParserMaybe pprefs pinfo args = getParseResult $ execParserPure
pprefs pinfo args
-
-- | The most general way to run a program description in pure code.
execParserPure :: ParserPrefs -- ^ Global preferences for this parser
-> ParserInfo a -- ^ Description of the program to run
@@ -146,21 +140,35 @@
parserFailure :: ParserPrefs -> ParserInfo a
-> ParseError -> [Context]
-> ParserFailure ParserHelp
-parserFailure pprefs pinfo msg ctx = ParserFailure $ \progn ->
+parserFailure pprefs pinfo msg ctx0 = ParserFailure $ \progn ->
let h = with_context ctx pinfo $ \names pinfo' -> mconcat
[ base_help pinfo'
, usage_help progn names pinfo'
, suggestion_help
+ , globals ctx
, error_help ]
in (h, exit_code, prefColumns pprefs)
where
+ --
+ -- Add another context layer if the argument to --help is
+ -- a valid command.
+ ctx = case msg of
+ ShowHelpText (Just potentialCommand) ->
+ let ctx1 = with_context ctx0 pinfo $ \_ pinfo' ->
+ snd
+ $ flip runP defaultPrefs { prefBacktrack = SubparserInline }
+ $ runParserStep (infoPolicy pinfo') (infoParser pinfo')
potentialCommand []
+ in ctx1 `mappend` ctx0
+ _ ->
+ ctx0
+
exit_code = case msg of
ErrorMsg {} -> ExitFailure (infoFailureCode pinfo)
UnknownError -> ExitFailure (infoFailureCode pinfo)
MissingError {} -> ExitFailure (infoFailureCode pinfo)
ExpectsArgError {} -> ExitFailure (infoFailureCode pinfo)
UnexpectedError {} -> ExitFailure (infoFailureCode pinfo)
- ShowHelpText -> ExitSuccess
+ ShowHelpText {} -> ExitSuccess
InfoMsg {} -> ExitSuccess
with_context :: [Context]
@@ -170,6 +178,21 @@
with_context [] i f = f [] i
with_context c@(Context _ i:_) _ f = f (contextNames c) i
+ globals :: [Context] -> ParserHelp
+ globals cs =
+ let
+ voided =
+ fmap (\(Context _ p) -> void p) cs `mappend` pure (void pinfo)
+
+ globalParsers =
+ traverse_ infoParser $
+ drop 1 voided
+ in
+ if prefHelpShowGlobal pprefs then
+ parserGlobals pprefs globalParsers
+ else
+ mempty
+
usage_help progn names i = case msg of
InfoMsg _
-> mempty
@@ -179,7 +202,7 @@
, fmap (indent 2) . infoProgDesc $ i ]
error_help = errorHelp $ case msg of
- ShowHelpText
+ ShowHelpText {}
-> mempty
ErrorMsg m
@@ -233,9 +256,10 @@
--
-- We won't worry about the 0 case, it won't be
-- shown anyway.
- prose = if length good < 2
- then stringChunk "Did you mean this?"
- else stringChunk "Did you mean one of these?"
+ prose = if length good < 2 then
+ stringChunk "Did you mean this?"
+ else
+ stringChunk "Did you mean one of these?"
--
-- Suggestions we will show, they're close enough
-- to what the user wrote
@@ -257,11 +281,11 @@
-- things the user could type. If it's a command
-- reader also ensure that it can be immediately
-- reachable from where the error was given.
- opt_completions hinfo opt = case optMain opt of
+ opt_completions reachability opt = case optMain opt of
OptReader ns _ _ -> fmap showOption ns
FlagReader ns _ -> fmap showOption ns
ArgReader _ -> []
- CmdReader _ ns _ | hinfoUnreachableArgs hinfo
+ CmdReader _ ns _ | argumentIsUnreachable reachability
-> []
| otherwise
-> ns
@@ -279,7 +303,7 @@
f = footerHelp (infoFooter i)
show_full_help = case msg of
- ShowHelpText -> True
+ ShowHelpText {} -> True
MissingError CmdStart _ | prefShowHelpOnEmpty pprefs
-> True
InfoMsg _ -> False
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/optparse-applicative-0.15.1.0/src/Options/Applicative/Help/Chunk.hs
new/optparse-applicative-0.16.0.0/src/Options/Applicative/Help/Chunk.hs
--- old/optparse-applicative-0.15.1.0/src/Options/Applicative/Help/Chunk.hs
2019-09-12 13:53:27.000000000 +0200
+++ new/optparse-applicative-0.16.0.0/src/Options/Applicative/Help/Chunk.hs
2001-09-09 03:46:40.000000000 +0200
@@ -1,6 +1,5 @@
module Options.Applicative.Help.Chunk
- ( mappendWith
- , Chunk(..)
+ ( Chunk(..)
, chunked
, listToChunk
, (<<+>>)
@@ -23,9 +22,6 @@
import Options.Applicative.Help.Pretty
-mappendWith :: Monoid a => a -> a -> a -> a
-mappendWith s x y = mconcat [x, s, y]
-
-- | The free monoid on a semigroup 'a'.
newtype Chunk a = Chunk
{ unChunk :: Maybe a }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/optparse-applicative-0.15.1.0/src/Options/Applicative/Help/Core.hs
new/optparse-applicative-0.16.0.0/src/Options/Applicative/Help/Core.hs
--- old/optparse-applicative-0.15.1.0/src/Options/Applicative/Help/Core.hs
2019-09-12 13:53:27.000000000 +0200
+++ new/optparse-applicative-0.16.0.0/src/Options/Applicative/Help/Core.hs
2001-09-09 03:46:40.000000000 +0200
@@ -3,6 +3,7 @@
briefDesc,
missingDesc,
fullDesc,
+ globalDesc,
ParserHelp(..),
errorHelp,
headerHelp,
@@ -10,15 +11,17 @@
usageHelp,
bodyHelp,
footerHelp,
+ globalsHelp,
parserHelp,
parserUsage,
+ parserGlobals
) where
import Control.Applicative
import Control.Monad (guard)
import Data.Function (on)
import Data.List (sort, intersperse, groupBy)
-import Data.Foldable (any)
+import Data.Foldable (any, foldl')
import Data.Maybe (maybeToList, catMaybes, fromMaybe)
import Data.Monoid (mempty)
import Data.Semigroup (Semigroup (..))
@@ -30,49 +33,54 @@
import Options.Applicative.Help.Chunk
-- | Style for rendering an option.
-data OptDescStyle = OptDescStyle
- { descSep :: Doc
- , descHidden :: Bool }
+data OptDescStyle
+ = OptDescStyle
+ { descSep :: Doc,
+ descHidden :: Bool,
+ descGlobal :: Bool
+ }
safelast :: [a] -> Maybe a
-safelast = foldl (const Just) Nothing
+safelast = foldl' (const Just) Nothing
-- | Generate description for a single option.
-optDesc :: ParserPrefs -> OptDescStyle -> OptHelpInfo -> Option a -> (Chunk
Doc, Wrapping)
-optDesc pprefs style info opt =
- let names
- = sort . optionNames . optMain $ opt
- meta
- = stringChunk $ optMetaVar opt
- descs
- = map (string . showOption) names
- descriptions
- = listToChunk (intersperse (descSep style) descs)
+optDesc :: ParserPrefs -> OptDescStyle -> ArgumentReachability -> Option a ->
(Chunk Doc, Parenthetic)
+optDesc pprefs style _reachability opt =
+ let names =
+ sort . optionNames . optMain $ opt
+ meta =
+ stringChunk $ optMetaVar opt
+ descs =
+ map (string . showOption) names
+ descriptions =
+ listToChunk (intersperse (descSep style) descs)
desc
- | prefHelpLongEquals pprefs && not (isEmpty meta) && any isLongName
(safelast names)
- = descriptions <> stringChunk "=" <> meta
- | otherwise
- = descriptions <<+>> meta
+ | prefHelpLongEquals pprefs && not (isEmpty meta) && any isLongName
(safelast names) =
+ descriptions <> stringChunk "=" <> meta
+ | otherwise =
+ descriptions <<+>> meta
show_opt
- | optVisibility opt == Hidden
- = descHidden style
- | otherwise
- = optVisibility opt == Visible
- suffix
- | hinfoMulti info
- = stringChunk . prefMultiSuffix $ pprefs
- | otherwise
- = mempty
+ | descGlobal style && not (propShowGlobal (optProps opt)) =
+ False
+ | optVisibility opt == Hidden =
+ descHidden style
+ | otherwise =
+ optVisibility opt == Visible
wrapping
- = wrapIf (length names > 1)
+ | null names =
+ NeverRequired
+ | length names == 1 =
+ MaybeRequired
+ | otherwise =
+ AlwaysRequired
rendered
- | not show_opt
- = mempty
- | otherwise
- = desc <> suffix
- modified
- = maybe id fmap (optDescMod opt) rendered
- in (modified, wrapping)
+ | not show_opt =
+ mempty
+ | otherwise =
+ desc
+ modified =
+ maybe id fmap (optDescMod opt) rendered
+ in (modified, wrapping)
-- | Generate descriptions for commands.
cmdDesc :: Parser a -> [(Maybe String, Chunk Doc)]
@@ -80,10 +88,13 @@
where
desc _ opt =
case optMain opt of
- CmdReader gn cmds p -> (,) gn $
- tabulate [(string cmd, align (extractChunk d))
- | cmd <- reverse cmds
- , d <- maybeToList . fmap infoProgDesc $ p cmd ]
+ CmdReader gn cmds p ->
+ (,) gn $
+ tabulate
+ [ (string cmd, align (extractChunk d))
+ | cmd <- reverse cmds,
+ d <- maybeToList . fmap infoProgDesc $ p cmd
+ ]
_ -> mempty
-- | Generate a brief help text for a parser.
@@ -98,67 +109,101 @@
-- | Generate a brief help text for a parser, allowing the specification
-- of if optional arguments are show.
briefDesc' :: Bool -> ParserPrefs -> Parser a -> Chunk Doc
-briefDesc' showOptional pprefs
- = wrap NoDefault . foldTree . mfilterOptional . treeMapParser (optDesc
pprefs style)
+briefDesc' showOptional pprefs =
+ wrapOver NoDefault MaybeRequired
+ . foldTree pprefs style
+ . mfilterOptional
+ . treeMapParser (optDesc pprefs style)
where
mfilterOptional
- | showOptional
- = id
- | otherwise
- = filterOptional
-
+ | showOptional =
+ id
+ | otherwise =
+ filterOptional
style = OptDescStyle
- { descSep = string "|"
- , descHidden = False }
+ { descSep = string "|",
+ descHidden = False,
+ descGlobal = False
+ }
-- | Wrap a doc in parentheses or brackets if required.
-wrap :: AltNodeType -> (Chunk Doc, Wrapping) -> Chunk Doc
-wrap altnode (chunk, wrapping)
- | altnode == MarkDefault
- = fmap brackets chunk
- | needsWrapping wrapping
- = fmap parens chunk
- | otherwise
- = chunk
+wrapOver :: AltNodeType -> Parenthetic -> (Chunk Doc, Parenthetic) -> Chunk Doc
+wrapOver altnode mustWrapBeyond (chunk, wrapping)
+ | altnode == MarkDefault =
+ fmap brackets chunk
+ | wrapping > mustWrapBeyond =
+ fmap parens chunk
+ | otherwise =
+ chunk
-- Fold a tree of option docs into a single doc with fully marked
-- optional areas and groups.
-foldTree :: OptTree (Chunk Doc, Wrapping) -> (Chunk Doc, Wrapping)
-foldTree (Leaf x)
- = x
-foldTree (MultNode xs)
- = (foldr ((<</>>) . wrap NoDefault . foldTree) mempty xs, Bare)
-foldTree (AltNode b xs)
- = (\x -> (x, Bare))
- . fmap groupOrNestLine
- . wrap b
- . alt_node
- . filter (not . isEmpty . fst)
- . map foldTree $ xs
- where
-
- alt_node :: [(Chunk Doc, Wrapping)] -> (Chunk Doc, Wrapping)
- alt_node [n] = n
- alt_node ns = (\y -> (y, Wrapped))
- . foldr (chunked altSep . wrap NoDefault) mempty
- $ ns
+foldTree :: ParserPrefs -> OptDescStyle -> OptTree (Chunk Doc, Parenthetic) ->
(Chunk Doc, Parenthetic)
+foldTree _ _ (Leaf x) =
+ x
+foldTree prefs s (MultNode xs) =
+ let go =
+ (<</>>) . wrapOver NoDefault MaybeRequired . foldTree prefs s
+ x =
+ foldr go mempty xs
+ wrapLevel =
+ mult_wrap xs
+ in (x, wrapLevel)
+ where
+ mult_wrap [_] = NeverRequired
+ mult_wrap _ = MaybeRequired
+foldTree prefs s (AltNode b xs) =
+ (\x -> (x, NeverRequired))
+ . fmap groupOrNestLine
+ . wrapOver b MaybeRequired
+ . alt_node
+ . filter (not . isEmpty . fst)
+ . map (foldTree prefs s)
+ $ xs
+ where
+ alt_node :: [(Chunk Doc, Parenthetic)] -> (Chunk Doc, Parenthetic)
+ alt_node [n] = n
+ alt_node ns =
+ (\y -> (y, AlwaysRequired))
+ . foldr (chunked altSep . wrapOver NoDefault MaybeRequired) mempty
+ $ ns
+foldTree prefs s (BindNode x) =
+ let rendered =
+ wrapOver NoDefault NeverRequired (foldTree prefs s x)
+
+ -- We always want to display the rendered option
+ -- if it exists, and only attach the suffix then.
+ withSuffix =
+ rendered >>= (\r -> pure r <> stringChunk (prefMultiSuffix prefs))
+ in (withSuffix, NeverRequired)
--- | Generate a full help text for a parser.
+-- | Generate a full help text for a parser
fullDesc :: ParserPrefs -> Parser a -> Chunk Doc
-fullDesc pprefs = tabulate . catMaybes . mapParser doc
+fullDesc = optionsDesc False
+
+-- | Generate a help text for the parser, showing
+-- only what is relevant in the "Global options: section"
+globalDesc :: ParserPrefs -> Parser a -> Chunk Doc
+globalDesc = optionsDesc True
+
+-- | Common generator for full descriptions and globals
+optionsDesc :: Bool -> ParserPrefs -> Parser a -> Chunk Doc
+optionsDesc global pprefs = tabulate . catMaybes . mapParser doc
where
doc info opt = do
guard . not . isEmpty $ n
guard . not . isEmpty $ h
- return (extractChunk n, align . extractChunk $ h <<+>> hdef)
+ return (extractChunk n, align . extractChunk $ h <</>> hdef)
where
n = fst $ optDesc pprefs style info opt
h = optHelp opt
hdef = Chunk . fmap show_def . optShowDefault $ opt
show_def s = parens (string "default:" <+> string s)
style = OptDescStyle
- { descSep = string ","
- , descHidden = True }
+ { descSep = string ",",
+ descHidden = True,
+ descGlobal = global
+ }
errorHelp :: Chunk Doc -> ParserHelp
errorHelp chunk = mempty { helpError = chunk }
@@ -169,6 +214,9 @@
suggestionsHelp :: Chunk Doc -> ParserHelp
suggestionsHelp chunk = mempty { helpSuggestions = chunk }
+globalsHelp :: Chunk Doc -> ParserHelp
+globalsHelp chunk = mempty { helpGlobals = chunk }
+
usageHelp :: Chunk Doc -> ParserHelp
usageHelp chunk = mempty { helpUsage = chunk }
@@ -180,36 +228,52 @@
-- | Generate the help text for a program.
parserHelp :: ParserPrefs -> Parser a -> ParserHelp
-parserHelp pprefs p = bodyHelp . vsepChunks
- $ with_title "Available options:" (fullDesc pprefs p)
- : (group_title <$> cs)
+parserHelp pprefs p =
+ bodyHelp . vsepChunks $
+ with_title "Available options:" (fullDesc pprefs p)
+ : (group_title <$> cs)
where
def = "Available commands:"
-
cs = groupBy ((==) `on` fst) $ cmdDesc p
- group_title a@((n,_):_) = with_title (fromMaybe def n) $
- vcatChunks (snd <$> a)
+ group_title a@((n, _) : _) =
+ with_title (fromMaybe def n) $
+ vcatChunks (snd <$> a)
group_title _ = mempty
-
with_title :: String -> Chunk Doc -> Chunk Doc
with_title title = fmap (string title .$.)
--- | Generate option summary.
-parserUsage :: ParserPrefs -> Parser a -> String -> Doc
-parserUsage pprefs p progn = hsep
- [ string "Usage:"
- , string progn
- , align (extractChunk (briefDesc pprefs p)) ]
-
-data Wrapping
- = Bare
- | Wrapped
- deriving (Eq, Show)
-wrapIf :: Bool -> Wrapping
-wrapIf b = if b then Wrapped else Bare
+parserGlobals :: ParserPrefs -> Parser a -> ParserHelp
+parserGlobals pprefs p =
+ globalsHelp $
+ (.$.) <$> stringChunk "Global options:"
+ <*> globalDesc pprefs p
+
-needsWrapping :: Wrapping -> Bool
-needsWrapping = (==) Wrapped
+
+-- | Generate option summary.
+parserUsage :: ParserPrefs -> Parser a -> String -> Doc
+parserUsage pprefs p progn =
+ hsep
+ [ string "Usage:",
+ string progn,
+ align (extractChunk (briefDesc pprefs p))
+ ]
+
+-- | Peek at the structure of the rendered tree within.
+--
+-- For example, if a child is an option with multiple
+-- alternatives, such as -a or -b, we need to know this
+-- when wrapping it. For example, whether it's optional:
+-- we don't want to have [(-a|-b)], rather [-a|-b] or
+-- (-a|-b).
+data Parenthetic
+ = NeverRequired
+ -- ^ Parenthesis are not required.
+ | MaybeRequired
+ -- ^ Parenthesis should be used if this group can be repeated
+ | AlwaysRequired
+ -- ^ Parenthesis should always be used.
+ deriving (Eq, Ord, Show)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/optparse-applicative-0.15.1.0/src/Options/Applicative/Help/Levenshtein.hs
new/optparse-applicative-0.16.0.0/src/Options/Applicative/Help/Levenshtein.hs
---
old/optparse-applicative-0.15.1.0/src/Options/Applicative/Help/Levenshtein.hs
2019-09-12 13:53:27.000000000 +0200
+++
new/optparse-applicative-0.16.0.0/src/Options/Applicative/Help/Levenshtein.hs
2001-09-09 03:46:40.000000000 +0200
@@ -14,25 +14,19 @@
-- Damerau-Levenshtein, which treats transposition
-- of adjacent characters as one change instead of
-- two.
+--
+-- Complexity
+-- O(|a|*(1 + editDistance a b))
editDistance :: Eq a => [a] -> [a] -> Int
-editDistance a b = last $
- case () of
- _ | lab == 0
- -> mainDiag
- | lab > 0
- -> lowers !! (lab - 1)
- | otherwise
- -> uppers !! (-1 - lab)
- where
- mainDiag = oneDiag a b (head uppers) (-1 : head lowers)
- uppers = eachDiag a b (mainDiag : uppers) -- upper diagonals
- lowers = eachDiag b a (mainDiag : lowers) -- lower diagonals
- eachDiag _ [] _ = []
- eachDiag _ _ [] = []
- eachDiag a' (_:bs) (lastDiag:diags) =
- oneDiag a' bs nextDiag lastDiag : eachDiag a' bs diags
- where
- nextDiag = head (tail diags)
+editDistance a b =
+ let
+ mainDiag =
+ oneDiag a b (head uppers) (-1 : head lowers)
+ uppers =
+ eachDiag a b (mainDiag : uppers) -- upper diagonals
+ lowers =
+ eachDiag b a (mainDiag : lowers) -- lower diagonals
+
oneDiag a' b' diagAbove diagBelow = thisdiag
where
doDiag [] _ _ _ _ = []
@@ -46,16 +40,40 @@
= nw : doDiag (ach' : as) (bch' : bs) nw (tail n) (tail w)
-- Standard case
doDiag (ach:as) (bch:bs) nw n w =
- me : doDiag as bs me (tail n) (tail w)
- where
+ let
me =
- if ach == bch
- then nw
- else 1 + min3 (head w) nw (head n)
+ if ach == bch then
+ nw
+ else
+ 1 + min3 (head w) nw (head n)
+ in
+ me : doDiag as bs me (tail n) (tail w)
+
firstelt = 1 + head diagBelow
thisdiag = firstelt : doDiag a' b' firstelt diagAbove (tail diagBelow)
- lab = length a - length b
+
+ eachDiag _ [] _ = []
+ eachDiag _ _ [] = []
+ eachDiag a' (_:bs) (lastDiag:diags) =
+ let
+ nextDiag = head (tail diags)
+ in
+ oneDiag a' bs nextDiag lastDiag : eachDiag a' bs diags
+
+ lab =
+ length a - length b
+
min3 x y z =
- if x < y
- then x
- else min y z
+ if x < y then
+ x
+ else
+ min y z
+
+ in
+ last $
+ if lab == 0 then
+ mainDiag
+ else if lab > 0 then
+ lowers !! (lab - 1)
+ else
+ uppers !! (-1 - lab)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/optparse-applicative-0.15.1.0/src/Options/Applicative/Help/Types.hs
new/optparse-applicative-0.16.0.0/src/Options/Applicative/Help/Types.hs
--- old/optparse-applicative-0.15.1.0/src/Options/Applicative/Help/Types.hs
2019-09-12 13:53:27.000000000 +0200
+++ new/optparse-applicative-0.16.0.0/src/Options/Applicative/Help/Types.hs
2001-09-09 03:46:40.000000000 +0200
@@ -15,23 +15,25 @@
, helpHeader :: Chunk Doc
, helpUsage :: Chunk Doc
, helpBody :: Chunk Doc
+ , helpGlobals :: Chunk Doc
, helpFooter :: Chunk Doc }
instance Show ParserHelp where
showsPrec _ h = showString (renderHelp 80 h)
instance Monoid ParserHelp where
- mempty = ParserHelp mempty mempty mempty mempty mempty mempty
+ mempty = ParserHelp mempty mempty mempty mempty mempty mempty mempty
mappend = (<>)
instance Semigroup ParserHelp where
- (ParserHelp e1 s1 h1 u1 b1 f1) <> (ParserHelp e2 s2 h2 u2 b2 f2)
+ (ParserHelp e1 s1 h1 u1 b1 g1 f1) <> (ParserHelp e2 s2 h2 u2 b2 g2 f2)
= ParserHelp (mappend e1 e2) (mappend s1 s2)
(mappend h1 h2) (mappend u1 u2)
- (mappend b1 b2) (mappend f1 f2)
+ (mappend b1 b2) (mappend g1 g2)
+ (mappend f1 f2)
helpText :: ParserHelp -> Doc
-helpText (ParserHelp e s h u b f) = extractChunk . vsepChunks $ [e, s, h, u,
b, f]
+helpText (ParserHelp e s h u b g f) = extractChunk . vsepChunks $ [e, s, h, u,
b, g, f]
-- | Convert a help text to 'String'.
renderHelp :: Int -> ParserHelp -> String
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/optparse-applicative-0.15.1.0/src/Options/Applicative/NonEmpty.hs
new/optparse-applicative-0.16.0.0/src/Options/Applicative/NonEmpty.hs
--- old/optparse-applicative-0.15.1.0/src/Options/Applicative/NonEmpty.hs
1970-01-01 01:00:00.000000000 +0100
+++ new/optparse-applicative-0.16.0.0/src/Options/Applicative/NonEmpty.hs
2001-09-09 03:46:40.000000000 +0200
@@ -0,0 +1,17 @@
+{-# LANGUAGE CPP, Rank2Types, ExistentialQuantification #-}
+module Options.Applicative.NonEmpty (
+ some1
+) where
+
+import Data.List.NonEmpty (NonEmpty (..))
+
+import Options.Applicative.Types
+import Control.Applicative
+import Prelude
+
+-- | Sequences an action one or more times.
+--
+-- Functionally identical to 'Data.List.NonEmpty.some1',
+-- but is preferred as it gives a nicer help text.
+some1 :: Parser a -> Parser (NonEmpty a)
+some1 p = fromM $ (:|) <$> oneM p <*> manyM p
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/optparse-applicative-0.15.1.0/src/Options/Applicative/Types.hs
new/optparse-applicative-0.16.0.0/src/Options/Applicative/Types.hs
--- old/optparse-applicative-0.15.1.0/src/Options/Applicative/Types.hs
2019-09-12 13:53:27.000000000 +0200
+++ new/optparse-applicative-0.16.0.0/src/Options/Applicative/Types.hs
2001-09-09 03:46:40.000000000 +0200
@@ -28,7 +28,7 @@
overFailure,
Args,
ArgPolicy(..),
- OptHelpInfo(..),
+ ArgumentReachability(..),
AltNodeType(..),
OptTree(..),
ParserHelp(..),
@@ -68,7 +68,7 @@
data ParseError
= ErrorMsg String
| InfoMsg String
- | ShowHelpText
+ | ShowHelpText (Maybe String)
| UnknownError
| MissingError IsCmdStart SomeParser
| ExpectsArgError String
@@ -123,6 +123,9 @@
, prefHelpLongEquals :: Bool -- ^ when displaying long names in usage and
help,
-- use an '=' sign for long names, rather
than a
-- single space (default: False)
+ , prefHelpShowGlobal :: Bool -- ^ when displaying subparsers' usage help,
+ -- show parent options under a "global
options"
+ -- section (default: True)
} deriving (Eq, Show)
data OptName = OptShort !Char
@@ -149,16 +152,18 @@
, 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
+ , propShowGlobal :: Bool -- ^ whether the option is presented
in global options text
, propDescMod :: Maybe ( Doc -> Doc ) -- ^ a function to run over the
brief description
}
instance Show OptProperties where
- showsPrec p (OptProperties pV pH pMV pSD _)
+ showsPrec p (OptProperties pV pH pMV pSD pSG _)
= showParen (p >= 11)
$ showString "OptProperties { propVisibility = " . shows pV
. showString ", propHelp = " . shows pH
. showString ", propMetaVar = " . shows pMV
. showString ", propShowDefault = " . shows pSD
+ . showString ", propShowGlobal = " . shows pSG
. showString ", propDescMod = _ }"
-- | A single option of a parser.
@@ -169,9 +174,9 @@
data SomeParser = forall a . SomeParser (Parser a)
--- | Subparser context, containing the 'name' of the subparser, and its parser
info.
+-- | Subparser context, containing the 'name' of the subparser and its parser
info.
-- Used by parserFailure to display relevant usage information when parsing
inside a subparser fails.
-data Context = forall a . Context String (ParserInfo a)
+data Context = forall a. Context String (ParserInfo a)
instance Show (Option a) where
show opt = "Option {optProps = " ++ show (optProps opt) ++ "}"
@@ -297,8 +302,8 @@
instance Alternative Parser where
empty = NilP Nothing
(<|>) = AltP
- many p = fromM $ manyM p
- some p = fromM $ (:) <$> oneM p <*> manyM p
+ many = fromM . manyM
+ some = fromM . someM
-- | A shell complete function.
newtype Completer = Completer
@@ -329,7 +334,7 @@
instance Show h => Show (ParserFailure h) where
showsPrec p (ParserFailure f)
= showParen (p > 10)
- $ showString "ParserFailure "
+ $ showString "ParserFailure"
. showsPrec 11 (f "<program>")
instance Functor ParserFailure where
@@ -392,10 +397,9 @@
-- but are supplying just a few of their own options.
deriving (Eq, Ord, Show)
-data OptHelpInfo = OptHelpInfo
- { hinfoMulti :: Bool -- ^ Whether this is part of a many or some
(approximately)
- , hinfoUnreachableArgs :: Bool -- ^ If the result is a positional, if it
can't be
- -- accessed in the current parser position
( first arg )
+newtype ArgumentReachability = ArgumentReachability
+ { argumentIsUnreachable :: Bool -- ^ If the result is a positional, if it
can't be
+ -- accessed in the current parser
position ( first arg )
} deriving (Eq, Show)
-- | This type encapsulates whether an 'AltNode' of an 'OptTree' should be
displayed
@@ -407,6 +411,7 @@
= Leaf a
| MultNode [OptTree a]
| AltNode AltNodeType [OptTree a]
+ | BindNode (OptTree a)
deriving Show
filterOptional :: OptTree a -> OptTree a
@@ -419,6 +424,8 @@
-> AltNode MarkDefault []
AltNode NoDefault xs
-> AltNode NoDefault (map filterOptional xs)
+ BindNode xs
+ -> BindNode (filterOptional xs)
optVisibility :: Option a -> OptVisibility
optVisibility = propVisibility . optProps
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/optparse-applicative-0.15.1.0/src/Options/Applicative.hs
new/optparse-applicative-0.16.0.0/src/Options/Applicative.hs
--- old/optparse-applicative-0.15.1.0/src/Options/Applicative.hs
2019-09-12 13:53:27.000000000 +0200
+++ new/optparse-applicative-0.16.0.0/src/Options/Applicative.hs
2001-09-09 03:46:40.000000000 +0200
@@ -196,6 +196,7 @@
subparserInline,
columns,
helpLongEquals,
+ helpShowGlobals,
defaultPrefs,
-- * Completions
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/optparse-applicative-0.15.1.0/tests/Examples/Cabal.hs
new/optparse-applicative-0.16.0.0/tests/Examples/Cabal.hs
--- old/optparse-applicative-0.15.1.0/tests/Examples/Cabal.hs 2019-09-12
13:53:27.000000000 +0200
+++ new/optparse-applicative-0.16.0.0/tests/Examples/Cabal.hs 2001-09-09
03:46:40.000000000 +0200
@@ -124,5 +124,5 @@
main :: IO ()
main = do
- r <- execParser pinfo
+ r <- customExecParser (prefs helpShowGlobals) pinfo
print r
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/optparse-applicative-0.15.1.0/tests/cabal.err.txt
new/optparse-applicative-0.16.0.0/tests/cabal.err.txt
--- old/optparse-applicative-0.15.1.0/tests/cabal.err.txt 2019-09-12
13:53:27.000000000 +0200
+++ new/optparse-applicative-0.16.0.0/tests/cabal.err.txt 2001-09-09
03:46:40.000000000 +0200
@@ -5,3 +5,7 @@
--enable-tests Enable compilation of test suites
-f,--flags FLAGS Enable the given flag
-h,--help Show this help text
+
+Global options:
+ -v,--verbose LEVEL Set verbosity to LEVEL
+ --version Print version information
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/optparse-applicative-0.15.1.0/tests/test.hs
new/optparse-applicative-0.16.0.0/tests/test.hs
--- old/optparse-applicative-0.15.1.0/tests/test.hs 2019-09-12
13:53:27.000000000 +0200
+++ new/optparse-applicative-0.16.0.0/tests/test.hs 2001-09-09
03:46:40.000000000 +0200
@@ -15,6 +15,7 @@
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS8
import Data.List hiding (group)
+import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Semigroup hiding (option)
import Data.String
@@ -24,6 +25,10 @@
import Options.Applicative
import Options.Applicative.Types
+import qualified Options.Applicative.NonEmpty
+
+
+import qualified Options.Applicative.Help as H
import Options.Applicative.Help.Pretty (Doc, SimpleDoc(..))
import qualified Options.Applicative.Help.Pretty as Doc
import Options.Applicative.Help.Chunk
@@ -84,7 +89,7 @@
prop_cabal_conf :: Property
prop_cabal_conf = once $
- checkHelpText "cabal" Cabal.pinfo ["configure", "--help"]
+ checkHelpTextWith ExitSuccess (prefs helpShowGlobals) "cabal" Cabal.pinfo
["configure", "--help"]
prop_args :: Property
prop_args = once $
@@ -772,6 +777,131 @@
result = run i ["testValue"]
in assertResult result $ \xs -> BS8.pack t === xs
+prop_grouped_some_option_ellipsis :: Property
+prop_grouped_some_option_ellipsis = once $
+ let x :: Parser String
+ x = strOption (short 'x' <> metavar "X")
+ p = prefs (multiSuffix "...")
+ r = show . extractChunk $ H.briefDesc p (x *> some x)
+ in r === "-x X (-x X)..."
+
+prop_grouped_many_option_ellipsis :: Property
+prop_grouped_many_option_ellipsis = once $
+ let x :: Parser String
+ x = strOption (short 'x' <> metavar "X")
+ p = prefs (multiSuffix "...")
+ r = show . extractChunk $ H.briefDesc p (x *> many x)
+ in r === "-x X [-x X]..."
+
+prop_grouped_some_argument_ellipsis :: Property
+prop_grouped_some_argument_ellipsis = once $
+ let x :: Parser String
+ x = strArgument (metavar "X")
+ p = prefs (multiSuffix "...")
+ r = show . extractChunk $ H.briefDesc p (x *> some x)
+ in r === "X X..."
+
+prop_grouped_many_argument_ellipsis :: Property
+prop_grouped_many_argument_ellipsis = once $
+ let x :: Parser String
+ x = strArgument (metavar "X")
+ p = prefs (multiSuffix "...")
+ r = show . extractChunk $ H.briefDesc p (x *> many x)
+ in r === "X [X]..."
+
+prop_grouped_some_pairs_argument_ellipsis :: Property
+prop_grouped_some_pairs_argument_ellipsis = once $
+ let x :: Parser String
+ x = strArgument (metavar "X")
+ p = prefs (multiSuffix "...")
+ r = show . extractChunk $ H.briefDesc p (x *> some (x *> x))
+ in r === "X (X X)..."
+
+prop_grouped_many_pairs_argument_ellipsis :: Property
+prop_grouped_many_pairs_argument_ellipsis = once $
+ let x :: Parser String
+ x = strArgument (metavar "X")
+ p = prefs (multiSuffix "...")
+ r = show . extractChunk $ H.briefDesc p (x *> many (x *> x))
+ in r === "X [X X]..."
+
+prop_grouped_some_dual_option_ellipsis :: Property
+prop_grouped_some_dual_option_ellipsis = once $
+ let x :: Parser String
+ x = strOption (short 'a' <> short 'b' <> metavar "X")
+ p = prefs (multiSuffix "...")
+ r = show . extractChunk $ H.briefDesc p (x *> some x)
+ in r === "(-a|-b X) (-a|-b X)..."
+
+prop_grouped_many_dual_option_ellipsis :: Property
+prop_grouped_many_dual_option_ellipsis = once $
+ let x :: Parser String
+ x = strOption (short 'a' <> short 'b' <> metavar "X")
+ p = prefs (multiSuffix "...")
+ r = show . extractChunk $ H.briefDesc p (x *> many x)
+ in r === "(-a|-b X) [-a|-b X]..."
+
+prop_grouped_some_dual_flag_ellipsis :: Property
+prop_grouped_some_dual_flag_ellipsis = once $
+ let x = flag' () (short 'a' <> short 'b')
+ p = prefs (multiSuffix "...")
+ r = show . extractChunk $ H.briefDesc p (x *> some x)
+ in r === "(-a|-b) (-a|-b)..."
+
+prop_grouped_many_dual_flag_ellipsis :: Property
+prop_grouped_many_dual_flag_ellipsis = once $
+ let x = flag' () (short 'a' <> short 'b')
+ p = prefs (multiSuffix "...")
+ r = show . extractChunk $ H.briefDesc p (x *> many x)
+ in r === "(-a|-b) [-a|-b]..."
+
+prop_issue_402 :: Property
+prop_issue_402 = once $
+ let x = some (flag' () (short 'a')) <|> some (flag' () (short 'b' <>
internal))
+ p = prefs (multiSuffix "...")
+ r = show . extractChunk $ H.briefDesc p x
+ in r === "(-a)..."
+
+prop_nice_some1 :: Property
+prop_nice_some1 = once $
+ let x = Options.Applicative.NonEmpty.some1 (flag' () (short 'a'))
+ p = prefs (multiSuffix "...")
+ r = show . extractChunk $ H.briefDesc p x
+ in r === "(-a)..."
+
+prop_some1_works :: Property
+prop_some1_works = once $
+ let p = Options.Applicative.NonEmpty.some1 (flag' () (short 'a'))
+ i = info p idm
+ result = run i ["-a", "-a"]
+ in assertResult result $ \xs -> () :| [()] === xs
+
+prop_help_contexts :: Property
+prop_help_contexts = once $
+ let
+ grabHelpMessage (Failure failure) =
+ let (msg, ExitSuccess) = renderFailure failure "<text>"
+ in msg
+ grabHelpMessage _ = error "Parse did not render help text"
+
+ i = Cabal.pinfo
+ pre = run i ["install", "--help"]
+ post = run i ["--help", "install"]
+ in grabHelpMessage pre === grabHelpMessage post
+
+prop_help_unknown_context :: Property
+prop_help_unknown_context = once $
+ let
+ grabHelpMessage (Failure failure) =
+ let (msg, ExitSuccess) = renderFailure failure "<text>"
+ in msg
+ grabHelpMessage _ = error "Parse did not render help text"
+
+ i = Cabal.pinfo
+ pre = run i ["--help"]
+ post = run i ["--help", "not-a-command"]
+ in grabHelpMessage pre === grabHelpMessage post
+
---
deriving instance Arbitrary a => Arbitrary (Chunk a)
