From 856046e18012dc0409f162f648914fe5cabe73d8 Mon Sep 17 00:00:00 2001 From: Huw Campbell Date: Sat, 20 May 2023 19:01:57 +1000 Subject: [PATCH 1/2] Move to pretty printer --- .github/workflows/haskell-ci.yml | 10 ---- optparse-applicative.cabal | 5 +- src/Options/Applicative/BashCompletion.hs | 3 +- src/Options/Applicative/Help/Chunk.hs | 3 +- src/Options/Applicative/Help/Core.hs | 17 ++++--- src/Options/Applicative/Help/Pretty.hs | 57 ++++++++++++++--------- src/Options/Applicative/Help/Types.hs | 3 +- tests/test.hs | 12 ++--- 8 files changed, 56 insertions(+), 54 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 5d2a1300..6ca82301 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -98,16 +98,6 @@ jobs: compilerVersion: 7.4.2 setup-method: hvr-ppa allow-failure: false - - compiler: ghc-7.2.2 - compilerKind: ghc - compilerVersion: 7.2.2 - setup-method: hvr-ppa - allow-failure: false - - compiler: ghc-7.0.4 - compilerKind: ghc - compilerVersion: 7.0.4 - setup-method: hvr-ppa - allow-failure: false fail-fast: false steps: - name: apt diff --git a/optparse-applicative.cabal b/optparse-applicative.cabal index 211c0c8e..641743f3 100644 --- a/optparse-applicative.cabal +++ b/optparse-applicative.cabal @@ -100,10 +100,11 @@ library , Options.Applicative.Types , Options.Applicative.Internal - build-depends: base == 4.* + build-depends: base >= 4.5 && < 5 , transformers >= 0.2 && < 0.7 , transformers-compat >= 0.3 && < 0.8 - , ansi-wl-pprint >= 0.6.8 && < 1.1 + , prettyprinter >= 1.7 && < 1.8 + , prettyprinter-ansi-terminal >= 1.1 && < 1.2 if flag(process) build-depends: process >= 1.0 && < 1.7 diff --git a/src/Options/Applicative/BashCompletion.hs b/src/Options/Applicative/BashCompletion.hs index 4a041c2f..e4b6356c 100644 --- a/src/Options/Applicative/BashCompletion.hs +++ b/src/Options/Applicative/BashCompletion.hs @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- | You don't need to import this module to enable bash completion. -- -- See @@ -150,7 +149,7 @@ bashCompletionQuery pinfo pprefs richness ws i _ = case runCompletion compl ppre -- 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 ++ "..." diff --git a/src/Options/Applicative/Help/Chunk.hs b/src/Options/Applicative/Help/Chunk.hs index 73d0bfa7..881a3819 100644 --- a/src/Options/Applicative/Help/Chunk.hs +++ b/src/Options/Applicative/Help/Chunk.hs @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} module Options.Applicative.Help.Chunk ( Chunk(..) , chunked @@ -116,7 +115,7 @@ isEmpty = isNothing . unChunk -- > 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 --git a/src/Options/Applicative/Help/Core.hs b/src/Options/Applicative/Help/Core.hs index 54c37032..ce89070f 100644 --- a/src/Options/Applicative/Help/Core.hs +++ b/src/Options/Applicative/Help/Core.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} module Options.Applicative.Help.Core ( cmdDesc, briefDesc, @@ -58,7 +57,7 @@ optDesc pprefs style _reachability opt = meta = stringChunk $ optMetaVar opt descs = - map (string . showOption) names + map (pretty . showOption) names descriptions = listToChunk (intersperse (descSep style) descs) desc @@ -98,7 +97,7 @@ cmdDesc pprefs = mapParser desc CmdReader gn cmds -> (,) gn $ tabulate (prefTabulateFill pprefs) - [ (string nm, align (extractChunk (infoProgDesc cmd))) + [ (pretty nm, align (extractChunk (infoProgDesc cmd))) | (nm, cmd) <- reverse cmds ] _ -> mempty @@ -127,7 +126,7 @@ briefDesc' showOptional pprefs = | otherwise = filterOptional style = OptDescStyle - { descSep = string "|", + { descSep = pretty '|', descHidden = False, descGlobal = False } @@ -204,9 +203,9 @@ optionsDesc global pprefs = tabulate (prefTabulateFill pprefs) . catMaybes . map 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 @@ parserHelp pprefs p = 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 :: ParserPrefs -> Parser a -> String -> Doc parserUsage pprefs p progn = group $ hsep - [ string "Usage:", - string progn, + [ pretty "Usage:", + pretty progn, hangAtIfOver 9 35 (extractChunk (briefDesc pprefs p)) ] diff --git a/src/Options/Applicative/Help/Pretty.hs b/src/Options/Applicative/Help/Pretty.hs index b20e0dcc..c5ab867a 100644 --- a/src/Options/Applicative/Help/Pretty.hs +++ b/src/Options/Applicative/Help/Pretty.hs @@ -1,40 +1,41 @@ {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} module Options.Applicative.Help.Pretty - ( module Text.PrettyPrint.ANSI.Leijen + ( module Prettyprinter + , module Prettyprinter.Render.Terminal , Doc - , indent - , renderPretty - , displayS + , SimpleDoc + , (.$.) + , () + , groupOrNestLine , altSep , hangAtIfOver + + , prettyString ) where #if !MIN_VERSION_base(4,11,0) -import Data.Semigroup ((<>)) +import Data.Semigroup ((<>), mempty) #endif -import Text.PrettyPrint.ANSI.Leijen hiding (Doc, (<$>), (<>), columns, indent, renderPretty, displayS) -import qualified Text.PrettyPrint.ANSI.Leijen as PP +import Prettyprinter hiding (Doc) +import qualified Prettyprinter as PP +import qualified Prettyprinter.Render.String as PP +import Prettyprinter.Render.Terminal import Prelude -type Doc = PP.Doc +type Doc = PP.Doc Prettyprinter.Render.Terminal.AnsiStyle +type SimpleDoc = SimpleDocStream AnsiStyle -indent :: Int -> PP.Doc -> PP.Doc -indent = PP.indent - -renderPretty :: Float -> Int -> PP.Doc -> SimpleDoc -renderPretty = PP.renderPretty - -displayS :: SimpleDoc -> ShowS -displayS = PP.displayS +linebreak :: Doc +linebreak = flatAlt line mempty (.$.) :: Doc -> Doc -> Doc -(.$.) = (PP.<$>) - +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. @@ -58,7 +59,6 @@ ifElseAtRoot f g doc = then f doc else g doc - -- | Render flattened text on this line, or start -- a new line before rendering any text. -- @@ -81,7 +81,7 @@ groupOrNestLine = -- 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 @@ -102,3 +102,18 @@ hangAtIfOver i j d = align d else linebreak <> ifAtRoot (indent i) d + + +renderPretty :: Double -> Int -> Doc -> SimpleDocStream AnsiStyle +renderPretty ribbonFraction lineWidth + = layoutSmart LayoutOptions + { layoutPageWidth = AvailablePerLine lineWidth ribbonFraction } + +prettyString :: Double -> Int -> Doc -> String +prettyString ribbonFraction lineWidth + = streamToString + . renderPretty ribbonFraction lineWidth + +streamToString :: SimpleDocStream AnsiStyle -> String +streamToString stream = + PP.renderShowS stream "" diff --git a/src/Options/Applicative/Help/Types.hs b/src/Options/Applicative/Help/Types.hs index 0e2d05c0..e9743ca2 100644 --- a/src/Options/Applicative/Help/Types.hs +++ b/src/Options/Applicative/Help/Types.hs @@ -42,6 +42,5 @@ helpText (ParserHelp e s h u d b g f) = -- | Convert a help text to 'String'. renderHelp :: Int -> ParserHelp -> String renderHelp cols - = (`displayS` "") - . renderPretty 1.0 cols + = prettyString 1.0 cols . helpText diff --git a/tests/test.hs b/tests/test.hs index ecbe1e28..4c888dca 100644 --- a/tests/test.hs +++ b/tests/test.hs @@ -28,7 +28,7 @@ import qualified Options.Applicative.NonEmpty 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 @@ -951,9 +951,9 @@ prop_long_command_line_flow = once $ deriving instance Arbitrary a => Arbitrary (Chunk a) -equalDocs :: Float -> Int -> Doc -> Doc -> Property -equalDocs f w d1 d2 = Doc.displayS (Doc.renderPretty f w d1) "" - === Doc.displayS (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 @@ -967,10 +967,10 @@ prop_extractChunk_1 x = extractChunk (pure x) === x 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 From a67b20e70540cd1e0126730c274b55a0f23b8764 Mon Sep 17 00:00:00 2001 From: Huw Campbell Date: Sun, 21 May 2023 08:59:02 +1000 Subject: [PATCH 2/2] Bump version and add changelog. This also adds in the changelog for 0.17.1 which is not strictly a parent of this commit, but it's close enough and will be release in time order. --- CHANGELOG.md | 30 ++++++++++++++++++++++-------- optparse-applicative.cabal | 2 +- 2 files changed, 23 insertions(+), 9 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 56375351..04131555 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,23 @@ -## Unreleased +## 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 @@ -10,15 +29,10 @@ - Add `simpleVersioner` utility for adding a '--version' option to a parser. -- 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 submatches. - - 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 --git a/optparse-applicative.cabal b/optparse-applicative.cabal index 641743f3..be172b16 100644 --- a/optparse-applicative.cabal +++ b/optparse-applicative.cabal @@ -1,5 +1,5 @@ name: optparse-applicative -version: 0.17.0.0 +version: 0.18.0.0 synopsis: Utilities and combinators for parsing command line options description: optparse-applicative is a haskell library for parsing options