diff --git a/optparse-applicative.cabal b/optparse-applicative.cabal index fb9fa569..5a71f5d0 100644 --- a/optparse-applicative.cabal +++ b/optparse-applicative.cabal @@ -88,19 +88,22 @@ library , Options.Applicative.Common , Options.Applicative.Extra , Options.Applicative.Help + , Options.Applicative.Help.Ann , Options.Applicative.Help.Chunk , Options.Applicative.Help.Core , Options.Applicative.Help.Levenshtein , Options.Applicative.Help.Pretty + , Options.Applicative.Help.Style , Options.Applicative.Help.Types , Options.Applicative.NonEmpty , Options.Applicative.Types , Options.Applicative.Internal build-depends: base == 4.* + , ansi-terminal >= 0.4.0 + , prettyprinter >= 1.7.1 && < 1.8 , transformers >= 0.2 && < 0.7 , transformers-compat >= 0.3 && < 0.8 - , ansi-wl-pprint >= 0.6.8 && < 0.7 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 7a9a1109..8810e379 100644 --- a/src/Options/Applicative/BashCompletion.hs +++ b/src/Options/Applicative/BashCompletion.hs @@ -143,7 +143,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 (renderShowS (layoutPretty (LayoutOptions (AvailablePerLine len 1.0)) doc) "") of [] -> "" [x] -> x x : _ -> x ++ "..." diff --git a/src/Options/Applicative/Builder.hs b/src/Options/Applicative/Builder.hs index ec7809c0..515fd93f 100644 --- a/src/Options/Applicative/Builder.hs +++ b/src/Options/Applicative/Builder.hs @@ -116,8 +116,9 @@ import Options.Applicative.Builder.Completer import Options.Applicative.Builder.Internal import Options.Applicative.Common import Options.Applicative.Types -import Options.Applicative.Help.Pretty import Options.Applicative.Help.Chunk +import Options.Applicative.Help.Pretty +import Options.Applicative.Help.Types (renderHelp) -- Readers -- @@ -545,7 +546,8 @@ prefs m = applyPrefsMod m base , prefColumns = 80 , prefHelpLongEquals = False , prefHelpShowGlobal = False - , prefTabulateFill = 24 } + , prefTabulateFill = 24 + } -- Convenience shortcuts diff --git a/src/Options/Applicative/Help/Ann.hs b/src/Options/Applicative/Help/Ann.hs new file mode 100644 index 00000000..de10aaf8 --- /dev/null +++ b/src/Options/Applicative/Help/Ann.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE FlexibleInstances #-} + +module Options.Applicative.Help.Ann + ( Ann(..) + ) where + +import Options.Applicative.Help.Style + +newtype Ann = AnnStyle SetStyle + deriving (Eq, Show) diff --git a/src/Options/Applicative/Help/Chunk.hs b/src/Options/Applicative/Help/Chunk.hs index 6fd39a91..dbc3b072 100644 --- a/src/Options/Applicative/Help/Chunk.hs +++ b/src/Options/Applicative/Help/Chunk.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE FlexibleInstances #-} + module Options.Applicative.Help.Chunk ( Chunk(..) , chunked @@ -11,6 +13,7 @@ module Options.Applicative.Help.Chunk , paragraph , extractChunk , tabulate + , chunkFlatAlt ) where import Control.Applicative @@ -134,3 +137,9 @@ tabulate _ [] = mempty tabulate size table = pure $ vcat [ indent 2 (fillBreak size key <+> value) | (key, value) <- table ] + +-- | By default, @('chunkFlatAlt' x y)@ renders as @x@. However when 'group'ed, +-- @y@ will be preferred, with @x@ as the fallback for the case when @y@ +-- doesn't fit. +chunkFlatAlt :: Chunk Doc -> Chunk Doc -> Chunk Doc +chunkFlatAlt x y = pure (flatAlt (extractChunk x) (extractChunk y)) diff --git a/src/Options/Applicative/Help/Core.hs b/src/Options/Applicative/Help/Core.hs index 1ee7a7e5..13e59c7a 100644 --- a/src/Options/Applicative/Help/Core.hs +++ b/src/Options/Applicative/Help/Core.hs @@ -35,8 +35,8 @@ import Prelude hiding (any) import Options.Applicative.Common import Options.Applicative.Types -import Options.Applicative.Help.Pretty import Options.Applicative.Help.Chunk +import Options.Applicative.Help.Pretty -- | Style for rendering an option. data OptDescStyle @@ -157,6 +157,7 @@ foldTree prefs s (MultNode xs) = where mult_wrap [_] = NeverRequired mult_wrap _ = MaybeRequired + foldTree prefs s (AltNode b xs) = (\x -> (x, NeverRequired)) . fmap groupOrNestLine diff --git a/src/Options/Applicative/Help/Pretty.hs b/src/Options/Applicative/Help/Pretty.hs index 5954b4e8..ecb5141e 100644 --- a/src/Options/Applicative/Help/Pretty.hs +++ b/src/Options/Applicative/Help/Pretty.hs @@ -1,10 +1,70 @@ {-# LANGUAGE CPP #-} + module Options.Applicative.Help.Pretty - ( module Text.PrettyPrint.ANSI.Leijen + ( module PP + , Ann(..) + , Doc , (.$.) , groupOrNestLine , altSep , hangAtIfOver + + , enclose + , parens + , brackets + , hang + , indent + , nest + + , text + , plain + , deunderline + , underline + , debold + , bold + , ondullwhite + , onwhite + , ondullcyan + , oncyan + , ondullmagenta + , onmagenta + , ondullblue + , onblue + , ondullyellow + , onyellow + , ondullgreen + , ongreen + , ondullred + , onred + , ondullblack + , onblack + , dullwhite + , white + , dullcyan + , cyan + , dullmagenta + , magenta + , dullblue + , blue + , dullyellow + , yellow + , dullgreen + , green + , dullred + , red + , dullblack + , black + + -- TODO Remove these + -- , (<$>) + , () + , (<$$>) + , () + , string + + , isEffectivelyEmpty + + , renderShowS ) where import Control.Applicative @@ -12,15 +72,19 @@ import Control.Applicative import Data.Semigroup ((<>)) #endif -import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>), columns) -import Text.PrettyPrint.ANSI.Leijen.Internal (Doc (..), flatten) -import qualified Text.PrettyPrint.ANSI.Leijen as PP +import Options.Applicative.Help.Ann +import Prettyprinter hiding ((<>), Doc, enclose, parens, brackets, hang, indent, nest) +import qualified Prettyprinter as PP +import qualified Prettyprinter.Internal as PPI +import Prettyprinter.Render.String (renderShowS) +import qualified Options.Applicative.Help.Style as S import Prelude -(.$.) :: Doc -> Doc -> Doc -(.$.) = (PP.<$>) +type Doc = PPI.Doc Ann +(.$.) :: Doc -> Doc -> Doc +(.$.) x y = x <> line <> y -- | Apply the function if we're not at the -- start of our nesting level. @@ -38,8 +102,8 @@ ifAtRoot = -- start of our nesting level. ifElseAtRoot :: (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc ifElseAtRoot f g doc = - Nesting $ \i -> - Column $ \j -> + PPI.Nesting $ \i -> + PPI.Column $ \j -> if i == j then f doc else g doc @@ -52,10 +116,25 @@ ifElseAtRoot f g doc = -- group. groupOrNestLine :: Doc -> Doc groupOrNestLine = - Union + PPI.Union <$> flatten <*> ifNotAtRoot (line <>) . nest 2 + where flatten :: Doc -> Doc + flatten doc = case doc of + PPI.FlatAlt _ y -> flatten y + PPI.Cat x y -> PPI.Cat (flatten x) (flatten y) + PPI.Nest i x -> PPI.Nest i (flatten x) + PPI.Line -> PPI.Fail + PPI.Union x _ -> flatten x + PPI.Column f -> PPI.Column (flatten . f) + PPI.WithPageWidth f -> PPI.WithPageWidth (flatten . f) + PPI.Nesting f -> PPI.Nesting (flatten . f) + PPI.Annotated ann x -> PPI.Annotated ann (flatten x) + x@PPI.Fail -> x + x@PPI.Empty -> x + x@PPI.Char{} -> x + x@PPI.Text{} -> x -- | Separate items in an alternative with a pipe. -- @@ -69,8 +148,7 @@ groupOrNestLine = -- next line. altSep :: Doc -> Doc -> Doc altSep x y = - group (x <+> char '|' <> line) y - + group (x <+> pretty "|" <> line) <> softline' <> y -- | Printer hacks to get nice indentation for long commands -- and subcommands. @@ -85,8 +163,186 @@ altSep x y = -- the starting column, and it won't be indented more. hangAtIfOver :: Int -> Int -> Doc -> Doc hangAtIfOver i j d = - Column $ \k -> + PPI.Column $ \k -> if k <= j then align d else linebreak <> ifAtRoot (indent i) d + +() :: Doc -> Doc -> Doc +() x y = x <> softline <> y + +(<$$>) :: Doc -> Doc -> Doc +(<$$>) x y = x <> linebreak <> y + +() :: Doc -> Doc -> Doc +() x y = x <> softbreak <> y + +linebreak :: Doc +linebreak = flatAlt line mempty + +softbreak :: Doc +softbreak = group linebreak + +-- | Traced version of 'PP.string'. +string :: String -> Doc +string = PP.pretty + +-- | Traced version of 'PP.parens'. +parens :: Doc -> Doc +parens = PP.parens + +-- | Traced version of 'PP.brackets'. +brackets :: Doc -> Doc +brackets = PP.brackets + +-- | Traced version of 'PP.enclose'. +enclose + :: Doc -- ^ L + -> Doc -- ^ R + -> Doc -- ^ x + -> Doc -- ^ LxR +enclose = PP.enclose + +-- | Traced version of 'PP.hang'. +hang :: Int -> Doc -> Doc +hang = PP.hang + +-- | Traced version of 'PP.nest'. +nest :: Int -> Doc -> Doc +nest = PP.nest + +-- | Traced version of 'PP.indent'. +indent :: Int -> Doc -> Doc +indent = PP.indent + +-- | Determine if the document is empty when rendered +isEffectivelyEmpty :: Doc -> Bool +isEffectivelyEmpty doc = case doc of + PPI.Fail -> True + PPI.Empty -> True + PPI.Char _ -> False + PPI.Text _ _ -> False + PPI.Line -> False + PPI.FlatAlt _ d -> isEffectivelyEmpty d + PPI.Cat a b -> isEffectivelyEmpty a && isEffectivelyEmpty b + PPI.Nest _ d -> isEffectivelyEmpty d + PPI.Union _ d -> isEffectivelyEmpty d + PPI.Column _ -> True + PPI.WithPageWidth _ -> False + PPI.Nesting _ -> False + PPI.Annotated _ d -> isEffectivelyEmpty d + +text :: String -> Doc +text = pretty + +plain :: Doc -> Doc +plain = id + +deunderline :: Doc -> Doc +deunderline = id + +underline :: Doc -> Doc +underline = annotate (AnnStyle S.underlined) + +debold :: Doc -> Doc +debold = id + +bold :: Doc -> Doc +bold = annotate (AnnStyle S.bold) + +ondullwhite :: Doc -> Doc +ondullwhite = annotate (AnnStyle (S.bgColorDull S.White)) + +onwhite :: Doc -> Doc +onwhite = annotate (AnnStyle (S.bgColor S.White)) + +ondullcyan :: Doc -> Doc +ondullcyan = annotate (AnnStyle (S.bgColorDull S.Cyan)) + +oncyan :: Doc -> Doc +oncyan = annotate (AnnStyle (S.bgColor S.Cyan)) + +ondullmagenta :: Doc -> Doc +ondullmagenta = annotate (AnnStyle (S.bgColorDull S.Magenta)) + +onmagenta :: Doc -> Doc +onmagenta = annotate (AnnStyle (S.bgColor S.Magenta)) + +ondullblue :: Doc -> Doc +ondullblue = annotate (AnnStyle (S.bgColorDull S.Blue)) + +onblue :: Doc -> Doc +onblue = annotate (AnnStyle (S.bgColor S.Blue)) + +ondullyellow :: Doc -> Doc +ondullyellow = annotate (AnnStyle (S.bgColorDull S.Yellow)) + +onyellow :: Doc -> Doc +onyellow = annotate (AnnStyle (S.bgColor S.Yellow)) + +ondullgreen :: Doc -> Doc +ondullgreen = annotate (AnnStyle (S.bgColorDull S.Green)) + +ongreen :: Doc -> Doc +ongreen = annotate (AnnStyle (S.bgColor S.Green)) + +ondullred :: Doc -> Doc +ondullred = annotate (AnnStyle (S.bgColorDull S.Red)) + +onred :: Doc -> Doc +onred = annotate (AnnStyle (S.bgColor S.Red)) + +ondullblack :: Doc -> Doc +ondullblack = annotate (AnnStyle (S.bgColorDull S.Black)) + +onblack :: Doc -> Doc +onblack = annotate (AnnStyle (S.bgColor S.Black)) + +dullwhite :: Doc -> Doc +dullwhite = annotate (AnnStyle (S.colorDull S.White)) + +white :: Doc -> Doc +white = annotate (AnnStyle (S.color S.White)) + +dullcyan :: Doc -> Doc +dullcyan = annotate (AnnStyle (S.colorDull S.Cyan)) + +cyan :: Doc -> Doc +cyan = annotate (AnnStyle (S.color S.Cyan)) + +dullmagenta :: Doc -> Doc +dullmagenta = annotate (AnnStyle (S.colorDull S.Magenta)) + +magenta :: Doc -> Doc +magenta = annotate (AnnStyle (S.color S.Magenta)) + +dullblue :: Doc -> Doc +dullblue = annotate (AnnStyle (S.colorDull S.Blue)) + +blue :: Doc -> Doc +blue = annotate (AnnStyle (S.color S.Blue)) + +dullyellow :: Doc -> Doc +dullyellow = annotate (AnnStyle (S.colorDull S.Yellow)) + +yellow :: Doc -> Doc +yellow = annotate (AnnStyle (S.color S.Yellow)) + +dullgreen :: Doc -> Doc +dullgreen = annotate (AnnStyle (S.colorDull S.Green)) + +green :: Doc -> Doc +green = annotate (AnnStyle (S.color S.Green)) + +dullred :: Doc -> Doc +dullred = annotate (AnnStyle (S.colorDull S.Red)) + +red :: Doc -> Doc +red = annotate (AnnStyle (S.color S.Red)) + +dullblack :: Doc -> Doc +dullblack = annotate (AnnStyle (S.colorDull S.Black)) + +black :: Doc -> Doc +black = annotate (AnnStyle (S.color S.Black)) diff --git a/src/Options/Applicative/Help/Style.hs b/src/Options/Applicative/Help/Style.hs new file mode 100644 index 00000000..49906574 --- /dev/null +++ b/src/Options/Applicative/Help/Style.hs @@ -0,0 +1,121 @@ +module Options.Applicative.Help.Style + ( SetStyle (..) + , ColorIntensity (..) + , Layer (..) + , ConsoleIntensity (..) + , Underlining (..) + , Italicized (..) + , Color (..) + , color + , bgColor + , colorDull + , bgColorDull + , bold + , underlined + , italicized + , styleToRawText + , defaultStyle + ) where + +import Control.Applicative +import Data.Maybe +import System.Console.ANSI (ConsoleIntensity (..), ColorIntensity (..), Underlining (..)) + +import qualified System.Console.ANSI as ANSI + +data SetStyle = SetStyle + { ansiReset :: Bool + , ansiForeground :: Maybe (ColorIntensity, Color) -- ^ Set the foreground color, or keep the old one. + , ansiBackground :: Maybe (ColorIntensity, Color) -- ^ Set the background color, or keep the old one. + , ansiConsoleIntensity :: Maybe ConsoleIntensity -- ^ Adjust boldness + , ansiItalics :: Maybe Italicized -- ^ Adjust italics + , ansiUnderlining :: Maybe Underlining -- ^ Adjust underlining + } deriving (Eq, Ord, Show) + +instance Monoid SetStyle where + mempty = SetStyle False Nothing Nothing Nothing Nothing Nothing + mappend = (<>) + +defaultStyle :: SetStyle +defaultStyle = SetStyle + { ansiReset = True + , ansiForeground = Nothing + , ansiBackground = Nothing + , ansiConsoleIntensity = Just NormalIntensity + , ansiItalics = Just NoItalics + , ansiUnderlining = Just NoUnderline + } + +isItalicised :: Italicized -> Bool +isItalicised Italicized = True +isItalicised NoItalics = False + +styleToRawText :: SetStyle -> String +styleToRawText = ANSI.setSGRCode . stylesToSgrs + where + stylesToSgrs :: SetStyle -> [ANSI.SGR] + stylesToSgrs (SetStyle r fg bg b i u) = catMaybes + [ if r then Just ANSI.Reset else Nothing + , fmap (\(intensity, c) -> ANSI.SetColor ANSI.Foreground intensity (convertColor c)) fg + , fmap (\(intensity, c) -> ANSI.SetColor ANSI.Background intensity (convertColor c)) bg + , fmap ANSI.SetConsoleIntensity b + , fmap (ANSI.SetItalicized . isItalicised) i + , fmap ANSI.SetUnderlining u + ] + + convertColor :: Color -> ANSI.Color + convertColor = \c -> case c of + Black -> ANSI.Black + Red -> ANSI.Red + Green -> ANSI.Green + Yellow -> ANSI.Yellow + Blue -> ANSI.Blue + Magenta -> ANSI.Magenta + Cyan -> ANSI.Cyan + White -> ANSI.White + +data Layer = Foreground | Background + deriving (Eq, Ord, Show) + +data Italicized = Italicized | NoItalics deriving (Eq, Ord, Show) + +instance Semigroup SetStyle where + cs1 <> cs2 = SetStyle + { ansiReset = ansiReset cs1 && ansiReset cs2 + , ansiForeground = ansiForeground cs1 <|> ansiForeground cs2 + , ansiBackground = ansiBackground cs1 <|> ansiBackground cs2 + , ansiConsoleIntensity = ansiConsoleIntensity cs1 <|> ansiConsoleIntensity cs2 + , ansiItalics = ansiItalics cs1 <|> ansiItalics cs2 + , ansiUnderlining = ansiUnderlining cs1 <|> ansiUnderlining cs2 + } + +data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White + deriving (Eq, Ord, Show) + +-- | Style the foreground with a vivid color. +color :: Color -> SetStyle +color c = mempty { ansiForeground = Just (Vivid, c) } + +-- | Style the background with a vivid color. +bgColor :: Color -> SetStyle +bgColor c = mempty { ansiBackground = Just (Vivid, c) } + +-- | Style the foreground with a dull color. +colorDull :: Color -> SetStyle +colorDull c = mempty { ansiForeground = Just (Dull, c) } + +-- | Style the background with a dull color. +bgColorDull :: Color -> SetStyle +bgColorDull c = mempty { ansiBackground = Just (Dull, c) } + +-- | Render in __bold__. +bold :: SetStyle +bold = mempty { ansiConsoleIntensity = Just BoldIntensity } + +-- | Render in /italics/. +italicized :: SetStyle +italicized = mempty { ansiItalics = Just Italicized } + +-- | Render underlined. +underlined :: SetStyle +underlined = mempty { ansiUnderlining = Just SingleUnderline } diff --git a/src/Options/Applicative/Help/Types.hs b/src/Options/Applicative/Help/Types.hs index 0e2d05c0..db642270 100644 --- a/src/Options/Applicative/Help/Types.hs +++ b/src/Options/Applicative/Help/Types.hs @@ -1,13 +1,19 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + module Options.Applicative.Help.Types ( ParserHelp (..) , renderHelp + , helpText ) where import Data.Semigroup -import Prelude - +import Data.String (fromString) import Options.Applicative.Help.Chunk import Options.Applicative.Help.Pretty +import Options.Applicative.Help.Style (SetStyle (..), styleToRawText, defaultStyle) +import Prelude data ParserHelp = ParserHelp { helpError :: Chunk Doc @@ -42,6 +48,43 @@ 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 + = (`renderShowS` "") + . renderAnsi + . layoutPretty (LayoutOptions (AvailablePerLine cols 1.0)) . helpText + +renderAnsi :: SimpleDocStream Ann -> SimpleDocStream () +renderAnsi + = renderCtxDecorated defaultStyle renderPush renderPop + . alterAnnotationsS alter + where + alter :: Ann -> Maybe SetStyle + alter (AnnStyle setStyle) = Just setStyle + renderPush :: SetStyle -> SetStyle -> SimpleDocStream () -> SimpleDocStream () + renderPush _ setStyle = SText 0 (fromString (styleToRawText setStyle)) + renderPop :: SetStyle -> SetStyle -> SimpleDocStream () -> SimpleDocStream () + renderPop setStyle _ = SText 0 (fromString (styleToRawText setStyle)) + +renderCtxDecorated + :: forall ann. + Monoid ann + => ann + -> (ann -> ann -> SimpleDocStream () -> SimpleDocStream ()) -- ^ How to render an annotation + -> (ann -> ann -> SimpleDocStream () -> SimpleDocStream ()) -- ^ How to render the removed annotation + -> SimpleDocStream ann + -> SimpleDocStream () +renderCtxDecorated topAnn push pop = go [topAnn] + where + go :: [ann] -> SimpleDocStream ann -> SimpleDocStream () + go _ SFail = SFail + go [] SEmpty = SEmpty + go (_:_:_) SEmpty = SEmpty + go (_:_) SEmpty = SEmpty + go stack (SChar c rest) = SChar c (go stack rest) + go stack (SText l t rest) = SText l t (go stack rest) + go stack (SLine i rest) = SLine i (go stack rest) + go stack@(ctxAnn:_) (SAnnPush ann rest) = push ctxAnn ann (go ((ctxAnn <> ann) : stack) rest) + go (ann:stack@(ctxAnn:_)) (SAnnPop rest) = pop ctxAnn ann (go stack rest) + go _ (SAnnPush _ _) = error "An unpaired style initiator was encountered. This is a bug in the layout algorithm. Please report this as a bug" + go _ (SAnnPop _) = error "An unpaired style terminator was encountered. This is a bug in the layout algorithm. Please report this as a bug" +{-# INLINE renderCtxDecorated #-} diff --git a/src/Options/Applicative/Types.hs b/src/Options/Applicative/Types.hs index a556f2a8..1ffe692d 100644 --- a/src/Options/Applicative/Types.hs +++ b/src/Options/Applicative/Types.hs @@ -126,7 +126,7 @@ data ParserPrefs = ParserPrefs , prefHelpShowGlobal :: Bool -- ^ when displaying subparsers' usage help, -- show parent options under a "global options" -- section (default: False) - , prefTabulateFill ::Int -- ^ Indentation width for tables + , prefTabulateFill :: Int -- ^ Indentation width for tables } deriving (Eq, Show) data OptName = OptShort !Char diff --git a/tests/test.hs b/tests/test.hs index 4ae75df3..d18d9b63 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 @@ -949,12 +949,10 @@ prop_long_command_line_flow = once $ --- 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.layoutPretty (Doc.LayoutOptions (Doc.AvailablePerLine w f)) d1 + === Doc.layoutPretty (Doc.LayoutOptions (Doc.AvailablePerLine w f)) d2 prop_listToChunk_1 :: [String] -> Property prop_listToChunk_1 xs = isEmpty (listToChunk xs) === null xs @@ -968,7 +966,7 @@ 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)