Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-optparse-applicative for openSUSE:Factory checked in at 2023-06-22 23:25:29 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-optparse-applicative (Old) and /work/SRC/openSUSE:Factory/.ghc-optparse-applicative.new.15902 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-optparse-applicative" Thu Jun 22 23:25:29 2023 rev:24 rq:1094441 version:0.18.1.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-optparse-applicative/ghc-optparse-applicative.changes 2023-04-04 21:22:12.397803892 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-optparse-applicative.new.15902/ghc-optparse-applicative.changes 2023-06-22 23:25:55.873801842 +0200 @@ -1,0 +2,27 @@ +Tue May 30 03:40:17 UTC 2023 - Peter Simons <psim...@suse.com> + +- Update optparse-applicative to version 0.18.1.0. + Upstream has edited the change log file since the last release in + a non-trivial way, i.e. they did more than just add a new entry + at the top. You can review the file at: + http://hackage.haskell.org/package/optparse-applicative-0.18.1.0/src/CHANGELOG.md + +------------------------------------------------------------------- +Tue May 23 10:09:19 UTC 2023 - Peter Simons <psim...@suse.com> + +- Update optparse-applicative to version 0.17.1.0. + ## Version 0.17.1.0 (21 May 2023) + + - Widen bounds for `ansi-wl-pprint`. This supports the use of `prettyprinter` + in a non-breaking way, as the `ansi-wl-pprint > 1.0` support the newer + library. + + - Export `helpIndent` from `Options.Applicative`. + + - Export completion script generators from `Options.Applicative.BashCompletion`. + + - Add `simpleVersioner` utility for adding a '--version' option to a parser. + + - Improve documentation. + +------------------------------------------------------------------- Old: ---- optparse-applicative-0.17.0.0.tar.gz New: ---- optparse-applicative-0.18.1.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-optparse-applicative.spec ++++++ --- /var/tmp/diff_new_pack.rAMv28/_old 2023-06-22 23:25:56.373804392 +0200 +++ /var/tmp/diff_new_pack.rAMv28/_new 2023-06-22 23:25:56.381804432 +0200 @@ -20,20 +20,24 @@ %global pkgver %{pkg_name}-%{version} %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.17.0.0 +Version: 0.18.1.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 BuildRequires: ghc-Cabal-devel -BuildRequires: ghc-ansi-wl-pprint-devel -BuildRequires: ghc-ansi-wl-pprint-prof BuildRequires: ghc-base-devel BuildRequires: ghc-base-prof +BuildRequires: ghc-prettyprinter-ansi-terminal-devel +BuildRequires: ghc-prettyprinter-ansi-terminal-prof +BuildRequires: ghc-prettyprinter-devel +BuildRequires: ghc-prettyprinter-prof BuildRequires: ghc-process-devel BuildRequires: ghc-process-prof BuildRequires: ghc-rpm-macros +BuildRequires: ghc-text-devel +BuildRequires: ghc-text-prof BuildRequires: ghc-transformers-compat-devel BuildRequires: ghc-transformers-compat-prof BuildRequires: ghc-transformers-devel ++++++ optparse-applicative-0.17.0.0.tar.gz -> optparse-applicative-0.18.1.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/CHANGELOG.md new/optparse-applicative-0.18.1.0/CHANGELOG.md --- old/optparse-applicative-0.17.0.0/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,3 +1,50 @@ +## Version 0.18.1.0 (29 May 2023) + +- Change pretty printer layout algorithm used. + + The layoutSmart algorithm appears to be extremely slow with some command line + sets, to the point where the program appears to hang. + + Fixes issues: + * \# 476 - Stack executable 'hangs' with 0.17.1 and 0.18.0. + +- Render help text with `AnsiStyle` aware rendering functions. + +## Version 0.18.0.0 (22 May 2023) + +- Move to 'prettyprinter` library for pretty printing. + + This is a potentially breaking change when one uses the '*Doc' family of functions + (like `headerDoc`) from `Options.Applicative`. However, as versions of + 'ansi-wl-pprint > 1.0' export a compatible `Doc` type, this can be mitigated by + using a recent version. + + One can also either import directly from `Options.Applicative.Help` or from the + `Prettyprinter` module of 'prettyprinter'. + +- Allow commands to be disambiguated in a similar manner to flags when the + `disambiguate` modifier is used. + + This is a potentially breaking change as the internal `CmdReader` constructor + has been adapted so it is able to be inspected to a greater degree to support + finding prefix matches. + +## Version 0.17.1.0 (22 May 2023) + +- Widen bounds for `ansi-wl-pprint`. This supports the use of `prettyprinter` + in a non-breaking way, as the `ansi-wl-pprint > 1.0` support the newer + library. + +- Export `helpIndent` from `Options.Applicative`. + +- Export completion script generators from `Options.Applicative.BashCompletion`. + +- Add `simpleVersioner` utility for adding a '--version' option to a parser. + +- Improve documentation. + +- Drop support for GHC 7.0 and 7.2. + ## Version 0.17.0.0 (1 Feb 2022) - Make tabulation width configurable in usage texts. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/README.md new/optparse-applicative-0.18.1.0/README.md --- old/optparse-applicative-0.17.0.0/README.md 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/README.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,7 +1,6 @@ # 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] @@ -75,7 +74,6 @@ ```haskell import Options.Applicative -import Data.Semigroup ((<>)) data Sample = Sample { hello :: String @@ -303,7 +301,14 @@ parsers are also able to be composed with standard combinators. For example: `optional :: Alternative f => f a -> f (Maybe a)` will mean the user is not required to provide input for the affected -`Parser`. +`Parser`. For example, the following parser will return `Nothing` +instead of failing if the user doesn't supply an `output` option: + +```haskell +optional $ strOption + ( long "output" + <> metavar "DIRECTORY" ) +``` ### Running parsers @@ -1018,8 +1023,6 @@ [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.17.0.0/optparse-applicative.cabal new/optparse-applicative-0.18.1.0/optparse-applicative.cabal --- old/optparse-applicative-0.17.0.0/optparse-applicative.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/optparse-applicative.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,5 @@ name: optparse-applicative -version: 0.17.0.0 +version: 0.18.1.0 synopsis: Utilities and combinators for parsing command line options description: optparse-applicative is a haskell library for parsing options @@ -45,19 +45,22 @@ homepage: https://github.com/pcapriotti/optparse-applicative bug-reports: https://github.com/pcapriotti/optparse-applicative/issues tested-with: - GHC==7.0.4, - GHC==7.2.2, - GHC==7.4.2, - GHC==7.6.3, - GHC==7.8.4, - GHC==7.10.3, - GHC==8.0.2, - GHC==8.2.2, - GHC==8.4.4, - GHC==8.6.5, - GHC==8.8.4, - GHC==8.10.4, - GHC==9.0.1 + GHC==9.6.1 + GHC==9.4.4 + GHC==9.2.7 + GHC==9.0.2 + GHC==8.10.7 + GHC==8.8.4 + GHC==8.6.5 + GHC==8.4.4 + GHC==8.2.2 + GHC==8.0.2 + GHC==7.10.3 + GHC==7.8.4 + GHC==7.6.3 + GHC==7.4.2 + GHC==7.2.2 + GHC==7.0.4 source-repository head type: git @@ -97,10 +100,12 @@ , Options.Applicative.Types , Options.Applicative.Internal - build-depends: base == 4.* + build-depends: base >= 4.5 && < 5 + , text >= 1.2 , transformers >= 0.2 && < 0.7 , transformers-compat >= 0.3 && < 0.8 - , ansi-wl-pprint >= 0.6.8 && < 0.7 + , prettyprinter >= 1.7 && < 1.8 + , prettyprinter-ansi-terminal >= 1.1 && < 1.2 if flag(process) build-depends: process >= 1.0 && < 1.7 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/src/Options/Applicative/BashCompletion.hs new/optparse-applicative-0.18.1.0/src/Options/Applicative/BashCompletion.hs --- old/optparse-applicative-0.17.0.0/src/Options/Applicative/BashCompletion.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/src/Options/Applicative/BashCompletion.hs 2001-09-09 03:46:40.000000000 +0200 @@ -4,7 +4,11 @@ -- <http://github.com/pcapriotti/optparse-applicative/wiki/Bash-Completion the wiki> -- for more information on bash completion. module Options.Applicative.BashCompletion - ( bashCompletionParser + ( bashCompletionParser, + + bashCompletionScript, + fishCompletionScript, + zshCompletionScript, ) where import Control.Applicative @@ -34,11 +38,15 @@ bashCompletionParser :: ParserInfo a -> ParserPrefs -> Parser CompletionResult bashCompletionParser pinfo pprefs = complParser where - failure opts = CompletionResult - { execCompletion = \progn -> unlines <$> opts progn } + returnCompletions opts = + CompletionResult $ + \progn -> unlines <$> opts progn + + scriptRequest = + CompletionResult . fmap pure complParser = asum - [ failure <$> + [ returnCompletions <$> ( bashCompletionQuery pinfo pprefs -- To get rich completions, one just needs the first -- command. To customise the lengths, use either of @@ -53,15 +61,13 @@ <*> (many . strOption) (long "bash-completion-word" `mappend` internal) <*> option auto (long "bash-completion-index" `mappend` internal) ) - , failure <$> - (bashCompletionScript <$> - strOption (long "bash-completion-script" `mappend` internal)) - , failure <$> - (fishCompletionScript <$> - strOption (long "fish-completion-script" `mappend` internal)) - , failure <$> - (zshCompletionScript <$> - strOption (long "zsh-completion-script" `mappend` internal)) + + , scriptRequest . bashCompletionScript <$> + strOption (long "bash-completion-script" `mappend` internal) + , scriptRequest . fishCompletionScript <$> + strOption (long "fish-completion-script" `mappend` internal) + , scriptRequest . zshCompletionScript <$> + strOption (long "zsh-completion-script" `mappend` internal) ] bashCompletionQuery :: ParserInfo a -> ParserPrefs -> Richness -> [String] -> Int -> String -> IO [String] @@ -107,11 +113,11 @@ -> return [] | otherwise -> run_completer (crCompleter rdr) - CmdReader _ ns p + CmdReader _ ns | argumentIsUnreachable reachability -> return [] | otherwise - -> return . add_cmd_help p $ filter_names ns + -> return . with_cmd_help $ filter (is_completion . fst) ns -- When doing enriched completions, add any help specified -- to the completion variables (tab separated). @@ -126,30 +132,28 @@ -- When doing enriched completions, add the command description -- to the completion variables (tab separated). - add_cmd_help :: Functor f => (String -> Maybe (ParserInfo a)) -> f String -> f String - add_cmd_help p = case richness of - Standard -> - id - Enriched _ len -> - fmap $ \cmd -> - let h = p cmd >>= unChunk . infoProgDesc - in maybe cmd (\h' -> cmd ++ "\t" ++ render_line len h') h + with_cmd_help :: Functor f => f (String, ParserInfo a) -> f String + with_cmd_help = + case richness of + Standard -> + fmap fst + Enriched _ len -> + fmap $ \(cmd, cmdInfo) -> + let h = unChunk (infoProgDesc cmdInfo) + in maybe cmd (\h' -> cmd ++ "\t" ++ render_line len h') h show_names :: [OptName] -> [String] - show_names = filter_names . map showOption + show_names = filter is_completion . map showOption -- We only want to show a single line in the completion results description. -- If there was a line break, it would come across as a different completion -- possibility. render_line :: Int -> Doc -> String - render_line len doc = case lines (displayS (renderPretty 1 len doc) "") of + render_line len doc = case lines (prettyString 1 len doc) of [] -> "" [x] -> x x : _ -> x ++ "..." - filter_names :: [String] -> [String] - filter_names = filter is_completion - run_completer :: Completer -> IO [String] run_completer c = runCompleter c (fromMaybe "" (listToMaybe ws'')) @@ -161,8 +165,9 @@ w:_ -> isPrefixOf w _ -> const True -bashCompletionScript :: String -> String -> IO [String] -bashCompletionScript prog progn = return +-- | Generated bash shell completion script +bashCompletionScript :: String -> String -> String +bashCompletionScript prog progn = unlines [ "_" ++ progn ++ "()" , "{" , " local CMDLINE" @@ -196,8 +201,10 @@ Tab characters separate items from descriptions. -} -fishCompletionScript :: String -> String -> IO [String] -fishCompletionScript prog progn = return + +-- | Generated fish shell completion script +fishCompletionScript :: String -> String -> String +fishCompletionScript prog progn = unlines [ " function _" ++ progn , " set -l cl (commandline --tokenize --current-process)" , " # Hack around fish issue #3934" @@ -219,8 +226,9 @@ , "complete --no-files --command " ++ progn ++ " --arguments '(_" ++ progn ++ ")'" ] -zshCompletionScript :: String -> String -> IO [String] -zshCompletionScript prog progn = return +-- | Generated zsh shell completion script +zshCompletionScript :: String -> String -> String +zshCompletionScript prog progn = unlines [ "#compdef " ++ progn , "" , "local request" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/src/Options/Applicative/Builder/Completer.hs new/optparse-applicative-0.18.1.0/src/Options/Applicative/Builder/Completer.hs --- old/optparse-applicative-0.17.0.0/src/Options/Applicative/Builder/Completer.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/src/Options/Applicative/Builder/Completer.hs 2001-09-09 03:46:40.000000000 +0200 @@ -6,6 +6,8 @@ , listIOCompleter , listCompleter , bashCompleter + + , requote ) where import Control.Applicative diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/src/Options/Applicative/Builder/Internal.hs new/optparse-applicative-0.18.1.0/src/Options/Applicative/Builder/Internal.hs --- old/optparse-applicative-0.17.0.0/src/Options/Applicative/Builder/Internal.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/src/Options/Applicative/Builder/Internal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -152,8 +152,8 @@ , propShowGlobal = True } -mkCommand :: Mod CommandFields a -> (Maybe String, [String], String -> Maybe (ParserInfo a)) -mkCommand m = (group, map fst cmds, (`lookup` cmds)) +mkCommand :: Mod CommandFields a -> (Maybe String, [(String, ParserInfo a)]) +mkCommand m = (group, cmds) where Mod f _ _ = m CommandFields cmds group = f (CommandFields [] Nothing) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/src/Options/Applicative/Builder.hs new/optparse-applicative-0.18.1.0/src/Options/Applicative/Builder.hs --- old/optparse-applicative-0.17.0.0/src/Options/Applicative/Builder.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/src/Options/Applicative/Builder.hs 2001-09-09 03:46:40.000000000 +0200 @@ -189,7 +189,7 @@ help :: String -> Mod f a help s = optionMod $ \p -> p { propHelp = paragraph s } --- | Specify the help text for an option as a 'Text.PrettyPrint.ANSI.Leijen.Doc' +-- | Specify the help text for an option as a 'Prettyprinter.Doc AnsiStyle' -- value. helpDoc :: Maybe Doc -> Mod f a helpDoc doc = optionMod $ \p -> p { propHelp = Chunk doc } @@ -215,7 +215,7 @@ -- | Apply a function to the option description in the usage text. -- -- > import Options.Applicative.Help --- > flag' () (short 't' <> style bold) +-- > flag' () (short 't' <> style (annotate bold)) -- -- /NOTE/: This builder is more flexible than its name and example -- allude. One of the motivating examples for its addition was to @@ -282,8 +282,8 @@ subparser m = mkParser d g rdr where Mod _ d g = metavar "COMMAND" `mappend` m - (groupName, cmds, subs) = mkCommand m - rdr = CmdReader groupName cmds subs + (groupName, cmds) = mkCommand m + rdr = CmdReader groupName cmds -- | Builder for an argument parser. argument :: ReadM a -> Mod ArgumentFields a -> Parser a @@ -402,7 +402,7 @@ header :: String -> InfoMod a header s = InfoMod $ \i -> i { infoHeader = paragraph s } --- | Specify a header for this parser as a 'Text.PrettyPrint.ANSI.Leijen.Doc' +-- | Specify a header for this parser as a 'Prettyprinter.Doc AnsiStyle' -- value. headerDoc :: Maybe Doc -> InfoMod a headerDoc doc = InfoMod $ \i -> i { infoHeader = Chunk doc } @@ -411,7 +411,7 @@ footer :: String -> InfoMod a footer s = InfoMod $ \i -> i { infoFooter = paragraph s } --- | Specify a footer for this parser as a 'Text.PrettyPrint.ANSI.Leijen.Doc' +-- | Specify a footer for this parser as a 'Prettyprinter.Doc AnsiStyle' -- value. footerDoc :: Maybe Doc -> InfoMod a footerDoc doc = InfoMod $ \i -> i { infoFooter = Chunk doc } @@ -420,7 +420,7 @@ progDesc :: String -> InfoMod a progDesc s = InfoMod $ \i -> i { infoProgDesc = paragraph s } --- | Specify a short program description as a 'Text.PrettyPrint.ANSI.Leijen.Doc' +-- | Specify a short program description as a 'Prettyprinter.Doc AnsiStyle' -- value. progDescDoc :: Maybe Doc -> InfoMod a progDescDoc doc = InfoMod $ \i -> i { infoProgDesc = Chunk doc } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/src/Options/Applicative/Common.hs new/optparse-applicative-0.18.1.0/src/Options/Applicative/Common.hs --- old/optparse-applicative-0.17.0.0/src/Options/Applicative/Common.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/src/Options/Applicative/Common.hs 2001-09-09 03:46:40.000000000 +0200 @@ -166,24 +166,29 @@ 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 + CmdReader _ cs -> do + subp <- hoistList (cmdMatches cs) + case prefBacktrack prefs of + NoBacktrack -> lift $ do args <- get <* put [] fmap pure . lift $ enterContext arg subp *> runParserInfo subp args <* exitContext - (Just subp, Backtrack) -> fmap pure . lift . StateT $ \args -> + Backtrack -> fmap pure . lift . StateT $ \args -> enterContext arg subp *> runParser (infoPolicy subp) CmdStart (infoParser subp) args <* exitContext - (Just subp, SubparserInline) -> lift $ do + SubparserInline -> lift $ do lift $ enterContext arg subp return $ infoParser subp - (Nothing, _) -> mzero ArgReader rdr -> fmap pure . lift . lift $ runReadM (crReader rdr) arg _ -> mzero + where + cmdMatches cs + | prefDisambiguate prefs = snd <$> filter (isPrefixOf arg . fst) cs + | otherwise = maybeToList (lookup arg cs) + stepParser :: MonadP m => ParserPrefs -> ArgPolicy -> String -> Parser a -> NondetT (StateT Args m) (Parser a) stepParser pprefs AllPositionals arg p = diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/src/Options/Applicative/Extra.hs new/optparse-applicative-0.18.1.0/src/Options/Applicative/Extra.hs --- old/optparse-applicative-0.17.0.0/src/Options/Applicative/Extra.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/src/Options/Applicative/Extra.hs 2001-09-09 03:46:40.000000000 +0200 @@ -6,6 +6,7 @@ helper, helperWith, hsubparser, + simpleVersioner, execParser, customExecParser, execParserPure, @@ -88,11 +89,24 @@ hsubparser m = mkParser d g rdr where Mod _ d g = metavar "COMMAND" `mappend` m - (groupName, cmds, subs) = mkCommand m - rdr = CmdReader groupName cmds (fmap add_helper . subs) + (groupName, cmds) = mkCommand m + rdr = CmdReader groupName ((fmap . fmap) add_helper cmds) add_helper pinfo = pinfo { infoParser = infoParser pinfo <**> helper } +-- | A hidden \"--version\" option that displays the version. +-- +-- > opts :: ParserInfo Sample +-- > opts = info (sample <**> simpleVersioner "v1.2.3") mempty +simpleVersioner :: String -- ^ Version string to be shown + -> Parser (a -> a) +simpleVersioner version = infoOption version $ + mconcat + [ long "version" + , help "Show version information" + , hidden + ] + -- | Run a program description. -- -- Parse command line arguments. Display help text and exit if any parse error @@ -153,7 +167,7 @@ -- -- This function can be used, for example, to show the help text for a parser: -- --- @handleParseResult . Failure $ parserFailure pprefs pinfo ShowHelpText mempty@ +-- @handleParseResult . Failure $ parserFailure pprefs pinfo (ShowHelpText Nothing) mempty@ parserFailure :: ParserPrefs -> ParserInfo a -> ParseError -> [Context] -> ParserFailure ParserHelp @@ -303,10 +317,10 @@ OptReader ns _ _ -> fmap showOption ns FlagReader ns _ -> fmap showOption ns ArgReader _ -> [] - CmdReader _ ns _ | argumentIsUnreachable reachability + CmdReader _ ns | argumentIsUnreachable reachability -> [] | otherwise - -> ns + -> fst <$> ns _ -> mempty diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/src/Options/Applicative/Help/Chunk.hs new/optparse-applicative-0.18.1.0/src/Options/Applicative/Help/Chunk.hs --- old/optparse-applicative-0.17.0.0/src/Options/Applicative/Help/Chunk.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/src/Options/Applicative/Help/Chunk.hs 2001-09-09 03:46:40.000000000 +0200 @@ -115,7 +115,7 @@ -- > extractChunk . stringChunk = string stringChunk :: String -> Chunk Doc stringChunk "" = mempty -stringChunk s = pure (string s) +stringChunk s = pure (pretty s) -- | Convert a paragraph into a 'Chunk'. The resulting chunk is composed by the -- words of the original paragraph separated by softlines, so it will be diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/src/Options/Applicative/Help/Core.hs new/optparse-applicative-0.18.1.0/src/Options/Applicative/Help/Core.hs --- old/optparse-applicative-0.17.0.0/src/Options/Applicative/Help/Core.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/src/Options/Applicative/Help/Core.hs 2001-09-09 03:46:40.000000000 +0200 @@ -24,7 +24,7 @@ import Data.Function (on) import Data.List (sort, intersperse, groupBy) import Data.Foldable (any, foldl') -import Data.Maybe (maybeToList, catMaybes, fromMaybe) +import Data.Maybe (catMaybes, fromMaybe) #if !MIN_VERSION_base(4,8,0) import Data.Monoid (mempty) #endif @@ -57,7 +57,7 @@ meta = stringChunk $ optMetaVar opt descs = - map (string . showOption) names + map (pretty . showOption) names descriptions = listToChunk (intersperse (descSep style) descs) desc @@ -94,12 +94,11 @@ where desc _ opt = case optMain opt of - CmdReader gn cmds p -> + CmdReader gn cmds -> (,) gn $ tabulate (prefTabulateFill pprefs) - [ (string cmd, align (extractChunk d)) - | cmd <- reverse cmds, - d <- maybeToList . fmap infoProgDesc $ p cmd + [ (pretty nm, align (extractChunk (infoProgDesc cmd))) + | (nm, cmd) <- reverse cmds ] _ -> mempty @@ -127,7 +126,7 @@ | otherwise = filterOptional style = OptDescStyle - { descSep = string "|", + { descSep = pretty '|', descHidden = False, descGlobal = False } @@ -204,9 +203,9 @@ 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) + show_def s = parens (pretty "default:" <+> pretty s) style = OptDescStyle - { descSep = string ",", + { descSep = pretty ',', descHidden = True, descGlobal = global } @@ -251,7 +250,7 @@ group_title _ = mempty with_title :: String -> Chunk Doc -> Chunk Doc - with_title title = fmap (string title .$.) + with_title title = fmap (pretty title .$.) parserGlobals :: ParserPrefs -> Parser a -> ParserHelp @@ -267,8 +266,8 @@ parserUsage pprefs p progn = group $ hsep - [ string "Usage:", - string progn, + [ pretty "Usage:", + pretty progn, hangAtIfOver 9 35 (extractChunk (briefDesc pprefs p)) ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/src/Options/Applicative/Help/Pretty.hs new/optparse-applicative-0.18.1.0/src/Options/Applicative/Help/Pretty.hs --- old/optparse-applicative-0.17.0.0/src/Options/Applicative/Help/Pretty.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/src/Options/Applicative/Help/Pretty.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,26 +1,41 @@ {-# LANGUAGE CPP #-} module Options.Applicative.Help.Pretty - ( module Text.PrettyPrint.ANSI.Leijen + ( module Prettyprinter + , module Prettyprinter.Render.Terminal + , Doc + , SimpleDoc + , (.$.) + , (</>) + , groupOrNestLine , altSep , hangAtIfOver + + , prettyString ) where -import Control.Applicative #if !MIN_VERSION_base(4,11,0) -import Data.Semigroup ((<>)) +import Data.Semigroup ((<>), mempty) #endif +import qualified Data.Text.Lazy as Lazy -import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>), columns) -import Text.PrettyPrint.ANSI.Leijen.Internal (Doc (..), flatten) -import qualified Text.PrettyPrint.ANSI.Leijen as PP +import Prettyprinter hiding (Doc) +import qualified Prettyprinter as PP +import Prettyprinter.Render.Terminal import Prelude -(.$.) :: Doc -> Doc -> Doc -(.$.) = (PP.<$>) +type Doc = PP.Doc AnsiStyle +type SimpleDoc = SimpleDocStream AnsiStyle +linebreak :: Doc +linebreak = flatAlt line mempty + +(.$.) :: Doc -> Doc -> Doc +x .$. y = x <> line <> y +(</>) :: Doc -> Doc -> Doc +x </> y = x <> softline <> y -- | Apply the function if we're not at the -- start of our nesting level. @@ -38,13 +53,12 @@ -- start of our nesting level. ifElseAtRoot :: (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc ifElseAtRoot f g doc = - Nesting $ \i -> - Column $ \j -> + nesting $ \i -> + column $ \j -> if i == j then f doc else g doc - -- | Render flattened text on this line, or start -- a new line before rendering any text. -- @@ -52,9 +66,7 @@ -- group. groupOrNestLine :: Doc -> Doc groupOrNestLine = - Union - <$> flatten - <*> ifNotAtRoot (line <>) . nest 2 + group . ifNotAtRoot (linebreak <>) . nest 2 -- | Separate items in an alternative with a pipe. @@ -69,7 +81,7 @@ -- next line. altSep :: Doc -> Doc -> Doc altSep x y = - group (x <+> char '|' <> line) <//> y + group (x <+> pretty '|' <> line) <> group linebreak <> y -- | Printer hacks to get nice indentation for long commands @@ -85,8 +97,27 @@ -- the starting column, and it won't be indented more. hangAtIfOver :: Int -> Int -> Doc -> Doc hangAtIfOver i j d = - Column $ \k -> + column $ \k -> if k <= j then align d else linebreak <> ifAtRoot (indent i) d + + +renderPretty :: Double -> Int -> Doc -> SimpleDocStream AnsiStyle +renderPretty ribbonFraction lineWidth + = layoutPretty LayoutOptions + { layoutPageWidth = AvailablePerLine lineWidth ribbonFraction } + +prettyString :: Double -> Int -> Doc -> String +prettyString ribbonFraction lineWidth + = streamToString + . renderPretty ribbonFraction lineWidth + +streamToString :: SimpleDocStream AnsiStyle -> String +streamToString sdoc = + let + rendered = + Prettyprinter.Render.Terminal.renderLazy sdoc + in + Lazy.unpack rendered diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/src/Options/Applicative/Help/Types.hs new/optparse-applicative-0.18.1.0/src/Options/Applicative/Help/Types.hs --- old/optparse-applicative-0.17.0.0/src/Options/Applicative/Help/Types.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/src/Options/Applicative/Help/Types.hs 2001-09-09 03:46:40.000000000 +0200 @@ -42,6 +42,5 @@ -- | Convert a help text to 'String'. renderHelp :: Int -> ParserHelp -> String renderHelp cols - = (`displayS` "") - . renderPretty 1.0 cols + = prettyString 1.0 cols . helpText diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/src/Options/Applicative/Internal.hs new/optparse-applicative-0.18.1.0/src/Options/Applicative/Internal.hs --- old/optparse-applicative-0.17.0.0/src/Options/Applicative/Internal.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/src/Options/Applicative/Internal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -18,6 +18,7 @@ , ListT , takeListT , runListT + , hoistList , NondetT , cut @@ -172,9 +173,6 @@ bimapTStep _ _ TNil = TNil bimapTStep f g (TCons a x) = TCons (f a) (g x) -hoistList :: Monad m => [a] -> ListT m a -hoistList = foldr (\x xt -> ListT (return (TCons x xt))) mzero - takeListT :: Monad m => Int -> ListT m a -> ListT m a takeListT 0 = const mzero takeListT n = ListT . liftM (bimapTStep id (takeListT (n - 1))) . stepListT @@ -192,7 +190,7 @@ . stepListT instance Monad m => Applicative (ListT m) where - pure = hoistList . pure + pure a = ListT (return (TCons a mzero)) (<*>) = ap instance Monad m => Monad (ListT m) where @@ -263,3 +261,8 @@ return $ case xs' of [x] -> Just x _ -> Nothing + +hoistList :: Alternative m => [a] -> m a +hoistList = foldr cons empty + where + cons x xs = pure x <|> xs diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/src/Options/Applicative/Types.hs new/optparse-applicative-0.18.1.0/src/Options/Applicative/Types.hs --- old/optparse-applicative-0.17.0.0/src/Options/Applicative/Types.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/src/Options/Applicative/Types.hs 2001-09-09 03:46:40.000000000 +0200 @@ -242,14 +242,14 @@ -- ^ flag reader | ArgReader (CReader a) -- ^ argument reader - | CmdReader (Maybe String) [String] (String -> Maybe (ParserInfo a)) + | CmdReader (Maybe String) [(String, ParserInfo a)] -- ^ command reader instance Functor OptReader where fmap f (OptReader ns cr e) = OptReader ns (fmap f cr) e fmap f (FlagReader ns x) = FlagReader ns (f x) fmap f (ArgReader cr) = ArgReader (fmap f cr) - fmap f (CmdReader n cs g) = CmdReader n cs ((fmap . fmap) f . g) + fmap f (CmdReader n cs) = CmdReader n ((fmap . fmap . fmap) f cs) -- | A @Parser a@ is an option parser returning a value of type 'a'. data Parser a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/src/Options/Applicative.hs new/optparse-applicative-0.18.1.0/src/Options/Applicative.hs --- old/optparse-applicative-0.17.0.0/src/Options/Applicative.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/src/Options/Applicative.hs 2001-09-09 03:46:40.000000000 +0200 @@ -74,6 +74,7 @@ abortOption, infoOption, helper, + simpleVersioner, -- ** Modifiers -- @@ -197,6 +198,7 @@ columns, helpLongEquals, helpShowGlobals, + helpIndent, defaultPrefs, -- * Completions diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/tests/Examples/Cabal.hs new/optparse-applicative-0.18.1.0/tests/Examples/Cabal.hs --- old/optparse-applicative-0.17.0.0/tests/Examples/Cabal.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/tests/Examples/Cabal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -39,10 +39,6 @@ { buildDir :: FilePath } deriving Show -version :: Parser (a -> a) -version = infoOption "0.0.0" - ( long "version" - <> help "Print version information" ) parser :: Parser Args parser = runA $ proc () -> do @@ -60,7 +56,7 @@ <> command "build" (info buildParser (progDesc "Make this package ready for installation")) ) -< () - A version >>> A helper -< Args opts cmds + A (simpleVersioner "0.0.0") >>> A helper -< Args opts cmds commonOpts :: Parser CommonOpts commonOpts = CommonOpts diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/tests/cabal.err.txt new/optparse-applicative-0.18.1.0/tests/cabal.err.txt --- old/optparse-applicative-0.17.0.0/tests/cabal.err.txt 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/tests/cabal.err.txt 2001-09-09 03:46:40.000000000 +0200 @@ -9,4 +9,4 @@ Global options: -v,--verbose LEVEL Set verbosity to LEVEL - --version Print version information + --version Show version information diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/optparse-applicative-0.17.0.0/tests/test.hs new/optparse-applicative-0.18.1.0/tests/test.hs --- old/optparse-applicative-0.17.0.0/tests/test.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/optparse-applicative-0.18.1.0/tests/test.hs 2001-09-09 03:46:40.000000000 +0200 @@ -28,7 +28,7 @@ import qualified Options.Applicative.Help as H -import Options.Applicative.Help.Pretty (Doc, SimpleDoc(..)) +import Options.Applicative.Help.Pretty (Doc) import qualified Options.Applicative.Help.Pretty as Doc import Options.Applicative.Help.Chunk import Options.Applicative.Help.Levenshtein @@ -318,6 +318,49 @@ result = execParserPure (prefs disambiguate) i ["--ba"] in assertError result (\_ -> property succeeded) + +prop_disambiguate_in_same_subparsers :: Property +prop_disambiguate_in_same_subparsers = once $ + let p0 = subparser (command "oranges" (info (pure "oranges") idm) <> command "apples" (info (pure "apples") idm) <> metavar "B") + i = info (p0 <**> helper) idm + result = execParserPure (prefs disambiguate) i ["orang"] + in assertResult result ((===) "oranges") + +prop_disambiguate_commands_in_separate_subparsers :: Property +prop_disambiguate_commands_in_separate_subparsers = once $ + let p2 = subparser (command "oranges" (info (pure "oranges") idm) <> metavar "B") + p1 = subparser (command "apples" (info (pure "apples") idm) <> metavar "C") + p0 = p1 <|> p2 + i = info (p0 <**> helper) idm + result = execParserPure (prefs disambiguate) i ["orang"] + in assertResult result ((===) "oranges") + +prop_fail_ambiguous_commands_in_same_subparser :: Property +prop_fail_ambiguous_commands_in_same_subparser = once $ + let p0 = subparser (command "oranges" (info (pure ()) idm) <> command "orangutans" (info (pure ()) idm) <> metavar "B") + i = info (p0 <**> helper) idm + result = execParserPure (prefs disambiguate) i ["orang"] + in assertError result (\_ -> property succeeded) + +prop_fail_ambiguous_commands_in_separate_subparser :: Property +prop_fail_ambiguous_commands_in_separate_subparser = once $ + let p2 = subparser (command "oranges" (info (pure ()) idm) <> metavar "B") + p1 = subparser (command "orangutans" (info (pure ()) idm) <> metavar "C") + p0 = p1 <|> p2 + i = info (p0 <**> helper) idm + result = execParserPure (prefs disambiguate) i ["orang"] + in assertError result (\_ -> property succeeded) + +prop_without_disambiguation_same_named_commands_should_parse_in_order :: Property +prop_without_disambiguation_same_named_commands_should_parse_in_order = once $ + let p3 = subparser (command "b" (info (pure ()) idm) <> metavar "B") + p2 = subparser (command "a" (info (pure ()) idm) <> metavar "B") + p1 = subparser (command "a" (info (pure ()) idm) <> metavar "C") + p0 = (,,) <$> p1 <*> p2 <*> p3 + i = info (p0 <**> helper) idm + result = execParserPure defaultPrefs i ["b", "a", "a"] + in assertResult result ((===) ((), (), ())) + prop_completion :: Property prop_completion = once . ioProperty $ let p = (,) @@ -903,16 +946,14 @@ , "to fit the size of the terminal" ]) ) in checkHelpTextWith ExitSuccess (prefs (columns 50)) "formatting-long-subcommand" i ["hello-very-long-sub", "--help"] - --- deriving instance Arbitrary a => Arbitrary (Chunk a) -deriving instance Eq SimpleDoc -deriving instance Show SimpleDoc -equalDocs :: Float -> Int -> Doc -> Doc -> Property -equalDocs f w d1 d2 = Doc.renderPretty f w d1 - === Doc.renderPretty f w d2 + +equalDocs :: Double -> Int -> Doc -> Doc -> Property +equalDocs f w d1 d2 = Doc.prettyString f w d1 + === Doc.prettyString f w d2 prop_listToChunk_1 :: [String] -> Property prop_listToChunk_1 xs = isEmpty (listToChunk xs) === null xs @@ -926,10 +967,10 @@ prop_extractChunk_2 :: Chunk String -> Property prop_extractChunk_2 x = extractChunk (fmap pure x) === x -prop_stringChunk_1 :: Positive Float -> Positive Int -> String -> Property +prop_stringChunk_1 :: Positive Double -> Positive Int -> String -> Property prop_stringChunk_1 (Positive f) (Positive w) s = equalDocs f w (extractChunk (stringChunk s)) - (Doc.string s) + (Doc.pretty s) prop_stringChunk_2 :: String -> Property prop_stringChunk_2 s = isEmpty (stringChunk s) === null s