optparse-applicative 0.15.1.0 → 0.16.0.0

raw patch · 18 files changed

+594/−245 lines, 18 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +43/−0
• README.md +4/−0
• optparse-applicative.cabal +11/−8
• src/Options/Applicative.hs +1/−0
• src/Options/Applicative/BashCompletion.hs +3/−3
• src/Options/Applicative/Builder.hs +25/−8
• src/Options/Applicative/Builder/Internal.hs +11/−2
• src/Options/Applicative/Common.hs +49/−39
• src/Options/Applicative/Extra.hs +58/−34
• src/Options/Applicative/Help/Chunk.hs +1/−5
• src/Options/Applicative/Help/Core.hs +165/−101
• src/Options/Applicative/Help/Levenshtein.hs +45/−27
• src/Options/Applicative/Help/Types.hs +6/−4
• src/Options/Applicative/NonEmpty.hs +17/−0
• src/Options/Applicative/Types.hs +19/−12
• tests/Examples/Cabal.hs +1/−1
• tests/cabal.err.txt +4/−0
• tests/test.hs +131/−1

@@ -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.

@@ -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

@@ -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 <paolo@capriotti.io> 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,9 +106,10 @@    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                      , Examples.Commands@@ -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

@@ -196,6 +196,7 @@   subparserInline,   columns,   helpLongEquals,+  helpShowGlobals,   defaultPrefs,    -- * Completions

@@ -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

@@ -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 

@@ -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 }

@@ -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+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, 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+          (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+          (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

@@ -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

@@ -1,6 +1,5 @@ module Options.Applicative.Help.Chunk-  ( mappendWith-  , Chunk(..)+  ( Chunk(..)   , chunked   , listToChunk   , (<<+>>)@@ -22,9 +21,6 @@ import Prelude  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

@@ -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+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) -  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+      -- 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)+parserGlobals :: ParserPrefs -> Parser a -> ParserHelp+parserGlobals pprefs p =+  globalsHelp $+    (.$.) <$> stringChunk "Global options:"+          <*> globalDesc pprefs p -wrapIf :: Bool -> Wrapping-wrapIf b = if b then Wrapped else Bare -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)

@@ -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)

@@ -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

@@ -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

@@ -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

@@ -124,5 +124,5 @@  main :: IO () main = do-  r <- execParser pinfo+  r <- customExecParser (prefs helpShowGlobals) pinfo   print r

@@ -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

@@ -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 $@@ -771,6 +776,131 @@       i = info p idm       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  ---