wl-pprint-extras 3.4 → 3.5
raw patch · 5 files changed
+451/−67 lines, 5 filesdep +HUnitdep +test-frameworkdep +test-framework-hunitdep ~natsdep ~semigroupoidsdep ~semigroups
Dependencies added: HUnit, test-framework, test-framework-hunit, wl-pprint-extras
Dependency ranges changed: nats, semigroupoids, semigroups, text
Files
- LICENSE +1/−0
- src/Text/PrettyPrint/Free.hs +8/−7
- src/Text/PrettyPrint/Free/Internal.hs +158/−54
- test/WLPPrintTests.hs +264/−0
- wl-pprint-extras.cabal +20/−6
LICENSE view
@@ -1,3 +1,4 @@+Portions Copyright 2013, Google, Inc. Copyright 2011, Edward Kmett Copyright 2000, Daan Leijen
src/Text/PrettyPrint/Free.hs view
@@ -2,15 +2,16 @@ ----------------------------------------------------------------------------- -- | -- Module : Text.PrettyPrint.Free--- Copyright : Edward Kmett (c) 2011,--- Daan Leijen (c) 2000+-- Copyright : Google, Inc. (c) 2013,+-- Edward Kmett (c) 2011,+-- Daan Leijen (c) 2000 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : ekmett@gmail.com -- Stability : experimental -- Portability : portable ----- Pretty print module based on Daan Leijen's implementation of Philip Wadler's +-- Pretty print module based on Daan Leijen's implementation of Philip Wadler's -- \"prettier printer\" -- -- @@@ -60,8 +61,8 @@ -- -- * A type argument has been added and embedded 'effects' can be seen in -- the SimpleDoc type.--- --- +--+-- ----------------------------------------------------------- module Text.PrettyPrint.Free (@@ -70,7 +71,7 @@ -- * Basic combinators , char, text, nest, line, linebreak, group, softline- , softbreak+ , softbreak, hardline, flatAlt, flatten -- * Alignment --@@ -106,7 +107,7 @@ , Pretty(..) -- * Rendering- , SimpleDoc(..), renderPretty, renderCompact+ , SimpleDoc(..), renderPretty, renderCompact, renderSmart , displayS, displayIO -- * Undocumented
src/Text/PrettyPrint/Free/Internal.hs view
@@ -2,15 +2,17 @@ ----------------------------------------------------------------------------- -- | -- Module : Text.PrettyPrint.Free.Internal--- Copyright : Edward Kmett (c) 2011,--- Daan Leijen (c) 2000+-- Copyright : Google, Inc. (c) 2013,+-- Edward Kmett (c) 2011,+-- Daan Leijen (c) 2000+-- -- License : BSD-style (see the file LICENSE) -- -- Maintainer : ekmett@gmail.com -- Stability : experimental -- Portability : portable ----- Pretty print module based on Daan Leijen's implementation of Philip Wadler's +-- Pretty print module based on Daan Leijen's implementation of Philip Wadler's -- \"prettier printer\" -- -- @@@ -50,7 +52,7 @@ -- 'renderCompact' for compact output. The pretty printing algorithm -- also uses a ribbon-width now for even prettier output. ----- * There are two display routines, 'displayS' for strings and 'displayIO' +-- * There are two display routines, 'displayS' for strings and 'displayIO' -- for file based output. -- -- * There is a 'Pretty' class.@@ -60,8 +62,8 @@ -- -- * A type argument has been added and embedded 'effects' can be seen in -- the SimpleDoc type.--- --- +--+-- ----------------------------------------------------------- module Text.PrettyPrint.Free.Internal (@@ -70,7 +72,7 @@ -- * Basic combinators , char, text, nest, line, linebreak, group, softline- , softbreak+ , softbreak, hardline, flatAlt, flatten -- * Alignment --@@ -106,7 +108,7 @@ , Pretty(..) -- * Rendering- , SimpleDoc(..), renderPretty, renderCompact+ , SimpleDoc(..), renderPretty, renderCompact, renderSmart , displayS, displayIO -- * Undocumented@@ -159,7 +161,7 @@ -- encloses them in parenthesis. The documents are rendered -- horizontally if that fits the page. Otherwise they are aligned -- vertically. All comma separators are put in front of the elements.-tupled :: Foldable f => f (Doc e) -> Doc e +tupled :: Foldable f => f (Doc e) -> Doc e tupled = encloseSep lparen rparen comma (<+>) :: Doc e -> Doc e -> Doc e@@ -185,22 +187,26 @@ -- Which is layed out with a page width of 20 as: -- -- @--- list [10,200,3000]+-- list [10, 200, 3000] -- @ -- -- But when the page width is 15, it is layed out as: -- -- @--- list [10--- ,200--- ,3000]+-- list [ 10+-- , 200+-- , 3000 ] -- @ encloseSep :: Foldable f => Doc e -> Doc e -> Doc e -> f (Doc e) -> Doc e encloseSep left right sp ds0 = case toList ds0 of [] -> left <> right [d] -> left <> d <> right- ds -> align (cat (zipWith (<>) (left : repeat sp) ds) <> right) + ds -> group $ align $ left'+ <> (vcat (zipWith (<>) (empty : repeat (sp <> space)) ds))+ <> right'+ where left' = left <> flatAlt space empty+ right' = flatAlt space empty <> right -----------------------------------------------------------@@ -322,7 +328,7 @@ vcat = fold aboveBreak fold :: Foldable f => (Doc e -> Doc e -> Doc e) -> f (Doc e) -> Doc e-fold f xs = case toList xs of +fold f xs = case toList xs of [] -> empty _ -> foldr1 f xs @@ -465,7 +471,7 @@ -- | The document @space@ contains a single space, \" \". -- -- > x <+> y = x <> space <> y-space :: Doc e +space :: Doc e space = char ' ' -- | The document @dot@ contains a single dot, \".\".@@ -605,7 +611,7 @@ -- -- @ -- let empty :: Doc e--- nest :: Int -> Doc e -> Doc e +-- nest :: Int -> Doc e -> Doc e -- linebreak -- :: Doc e -- @@@ -639,7 +645,7 @@ -- @ fill :: Int -> Doc e -> Doc e fill f d = width d $ \w ->- if (w >= f) + if (w >= f) then empty else text (spaces (f - w)) @@ -707,7 +713,7 @@ -- world -- @ align :: Doc e -> Doc e-align d = column $ \k -> +align d = column $ \k -> nesting $ \i -> nest (k - i) d --nesting might be negative :-) -----------------------------------------------------------@@ -729,10 +735,12 @@ -- world -- @ data Doc e- = Empty+ = Fail+ | Empty | Char {-# UNPACK #-} !Char -- invariant: char is not '\n' | Text {-# UNPACK #-} !Int String -- invariant: text doesn't contain '\n'- | Line !(Maybe Char) -- Nothing <=> when undone by group, do not insert a space+ | Line+ | FlatAlt (Doc e) (Doc e) -- Render the first doc, but when flattened, render the second. | Cat (Doc e) (Doc e) | Nest {-# UNPACK #-} !Int (Doc e) | Union (Doc e) (Doc e) -- invariant: first lines of first doc longer than the first lines of the second doc@@ -745,7 +753,7 @@ instance Functor Doc where fmap _ Empty = Empty fmap _ (Char c) = Char c- fmap _ (Line b) = Line b+ fmap _ Line = Line fmap _ (Text i s) = Text i s fmap f (Cat l r) = Cat (fmap f l) (fmap f r) fmap f (Nest i d) = Nest i (fmap f d)@@ -771,7 +779,7 @@ Empty >>= _ = Empty Char c >>= _ = Char c Text i s >>= _ = Text i s- Line b >>= _ = Line b+ Line >>= _ = Line Cat l r >>= k = Cat (l >>= k) (r >>= k) Nest i d >>= k = Nest i (d >>= k) Union l r >>= k = Union (l >>= k) (r >>= k)@@ -796,9 +804,9 @@ empty = Empty instance MonadPlus Doc where- mplus = (<>) + mplus = (<>) mzero = empty- + -- | The data type @SimpleDoc@ represents rendered documents and is -- used by the display functions. --@@ -807,8 +815,9 @@ -- provides two default display functions 'displayS' and -- 'displayIO'. You can provide your own display function by writing a -- function from a @SimpleDoc@ to your own output format.-data SimpleDoc e - = SEmpty+data SimpleDoc e+ = SFail+ | SEmpty | SChar {-# UNPACK #-} !Char (SimpleDoc e) | SText {-# UNPACK #-} !Int String (SimpleDoc e) | SLine {-# UNPACK #-} !Int (SimpleDoc e)@@ -854,14 +863,19 @@ -- current nesting level. Document @line@ behaves like @(text \" \")@ -- if the line break is undone by 'group'. line :: Doc e-line = Line (Just ' ')+line = FlatAlt Line space -- | The @linebreak@ document advances to the next line and indents to -- the current nesting level. Document @linebreak@ behaves like -- 'empty' if the line break is undone by 'group'. linebreak :: Doc e-linebreak = Line Nothing+linebreak = FlatAlt Line empty +-- | A linebreak that can not be flattened; it is guaranteed to be+-- rendered as a newline.+hardline :: Doc e+hardline = Line+ -- | The document @(nest i x)@ renders document @x@ with the current -- indentation level increased by i (See also 'hang', 'align' and -- 'indent').@@ -896,10 +910,17 @@ group :: Doc e -> Doc e group x = Union (flatten x) x +-- | @flatAlt@ creates a document that changes when flattened; normally+-- it is rendered as the first argument, but when flattened is rendered+-- as the second.+flatAlt :: Doc e -> Doc e -> Doc e+flatAlt = FlatAlt+ flatten :: Doc e -> Doc e+flatten (FlatAlt _ y) = y flatten (Cat x y) = Cat (flatten x) (flatten y) flatten (Nest i x) = Nest i (flatten x)-flatten (Line brk) = maybe Empty Char brk+flatten Line = Fail flatten (Union x _) = flatten x flatten (Column f) = Column (flatten . f) flatten (Nesting f) = Nesting (flatten . f)@@ -929,7 +950,62 @@ -- @ribbonfrac@ should be between @0.0@ and @1.0@. If it is lower or -- higher, the ribbon width will be 0 or @width@ respectively. renderPretty :: Float -> Int -> Doc e -> SimpleDoc e-renderPretty rfrac w x+renderPretty = renderFits nicest1++-- | A slightly smarter rendering algorithm with more lookahead. It provides+-- provide earlier breaking on deeply nested structures.+-- For example, consider this python-ish pseudocode:+-- @fun(fun(fun(fun(fun([abcdefg, abcdefg])))))@+-- If we put a softbreak (+ nesting 2) after each open parenthesis, and align+-- the elements of the list to match the opening brackets, this will render with+-- @renderPretty@ and a page width of 20c as:+-- @+-- fun(fun(fun(fun(fun([+-- | abcdef,+-- | abcdef,+-- ]+-- ))))) |+-- @+-- Where the 20c. boundary has been marked with |. Because @renderPretty@ only+-- uses one-line lookahead, it sees that the first line fits, and is stuck+-- putting the second and third lines after the 20c mark. In contrast,+-- @renderSmart@ will continue to check the potential document up to the end of+-- the indentation level. Thus, it will format the document as:+--+-- @+-- fun( |+-- fun( |+-- fun( |+-- fun( |+-- fun([ |+-- abcdef,+-- abcdef,+-- ] |+-- ))))) |+-- @+-- Which fits within the 20c. mark.+-- In addition, @renderSmart@ uses this lookahead to minimize the number of+-- lines printed, leading to more compact and visually appealing output.+-- Consider this example using the same syntax as above:+-- @aaaaaaaaaaa([abc, def, ghi])@+-- When rendered with @renderPretty@ and a page width of 20c, we get:+-- @+-- aaaaaaaaaaa([ abc+-- , def+-- , ghi ])+-- @+-- Whereas when rendered with @renderSmart@ and a page width of 20c, we get:+-- @+-- aaaaaaaaaaa(+-- [abc, def, ghi])+-- @+renderSmart :: Int -> Doc e -> SimpleDoc e+renderSmart = renderFits nicestR 1.0++renderFits :: (Int -> Int -> Int -> Int -> SimpleDoc e -> SimpleDoc e+ -> SimpleDoc e)+ -> Float -> Int -> Doc e -> SimpleDoc e+renderFits nicest rfrac w x = best 0 0 (Cons 0 x Nil) where -- r :: the ribbon width in characters@@ -941,38 +1017,61 @@ best _ _ Nil = SEmpty best n k (Cons i d ds) = case d of+ Fail -> SFail Empty -> best n k ds Char c -> let k' = k+1 in seq k' (SChar c (best n k' ds)) Text l s -> let k' = k+l in seq k' (SText l s (best n k' ds))- Line _ -> SLine i (best i i ds)- Cat x' y -> best n k (Cons i x' (Cons i y ds))- Nest j x' -> let i' = i+j in seq i' (best n k (Cons i' x' ds))+ Line -> SLine i (best i i ds)+ FlatAlt l _ -> best n k (Cons i l ds)+ Cat x' y -> best n k (Cons i x' (Cons i y ds))+ Nest j x' -> let i' = i+j in seq i' (best n k (Cons i' x' ds)) Effect e -> SEffect e (best n k ds)- Union x' y -> nicest n k (best n k (Cons i x' ds))- (best n k (Cons i y ds))-+ Union p q -> nicest n k w r (best n k (Cons i p ds))+ (best n k (Cons i q ds)) Column f -> best n k (Cons i (f k) ds) Nesting f -> best n k (Cons i (f i) ds) Columns f -> best n k (Cons i (f w) ds) Ribbon f -> best n k (Cons i (f r) ds) - --nicest :: r = ribbon width, w = page width,- -- n = indentation of current line, k = current column- -- x and y, the (simple) documents to chose from.- -- precondition: first line of x are longer than the first line of y.- nicest n k x' y | fits wid x' = x'- | otherwise = y- where- wid = min (w - k) (r - k + n)-+-- @nicest1@ compares the first lines of the two documents.+-- n = nesting, k = column, p = pagewidth+nicest1 :: Int -> Int -> Int -> Int -> SimpleDoc e -> SimpleDoc e -> SimpleDoc e+nicest1 n k p r x' y | fits (min n k) wid x' = x'+ | otherwise = y+ where wid = min (p - k) (r - k + n)+ fits _ w _ | w < 0 = False+ fits _ _ SFail = False+ fits _ _ SEmpty = True+ fits m w (SChar _ x) = fits m (w - 1) x+ fits m w (SText l _ x) = fits m (w - l) x+ fits _ _ (SLine _ _) = True -fits :: Int -> SimpleDoc e -> Bool-fits w _ | w < 0 = False-fits _ SEmpty = True-fits w (SChar _ x) = fits (w - 1) x-fits w (SText l _ x) = fits (w - l) x-fits _ (SLine _ _) = True-fits w (SEffect _ x) = fits w x+-- @nicestR@ compares the initial lines of the two documents that are nested at+-- least as deep as the current nesting level. If the initial lines of both+-- documents fit within the page width, the document that takes fewer lines is+-- prefered, with preference toward the first.+nicestR :: Int -> Int -> Int -> Int -> SimpleDoc e -> SimpleDoc e -> SimpleDoc e+nicestR n k p r x' y =+ if fits (min n k) wid x' <= fits (min n k) wid y then x' else y+ where wid = min (p - k) (r - k + n)+ inf = 1.0/0 :: Double+ -- @fitsR@ has a little more lookahead: assuming that nesting roughly+ -- corresponds to syntactic depth, @fitsR@ checks that not only the+ -- current line fits, but the entire syntactic structure being formatted+ -- at this level of indentation fits. If we were to remove the second+ -- case for @SLine@, we would check that not only the current structure+ -- fits, but also the rest of the document, which would be slightly more+ -- intelligent but would have exponential runtime (and is prohibitively+ -- expensive in practice).+ -- m = minimum nesting level to fit in+ -- w = the width in which to fit the first line+ fits _ w _ | w < 0 = inf+ fits _ _ SFail = inf+ fits _ _ SEmpty = 0+ fits m w (SChar _ x) = fits m (w - 1) x+ fits m w (SText l _ x) = fits m (w - l) x+ fits m _ (SLine i x) | m < i = 1 + fits m (p - i) x+ | otherwise = 0 -----------------------------------------------------------@@ -992,11 +1091,12 @@ where scan _ [] = SEmpty scan k (d:ds) = case d of+ Fail -> SFail Empty -> scan k ds Char c -> let k' = k+1 in seq k' (SChar c (scan k' ds)) Text l s -> let k' = k+l in seq k' (SText l s (scan k' ds)) Effect e -> SEffect e (scan k ds)- Line _ -> SLine 0 (scan 0 ds)+ Line -> SLine 0 (scan 0 ds) Cat y z -> scan k (y:z:ds) Nest _ y -> scan k (y:ds) Union _ y -> scan k (y:ds)@@ -1017,6 +1117,8 @@ -- > showWidth :: Int -> Doc -> String -- > showWidth w x = displayS (renderPretty 0.4 w x) "" displayS :: SimpleDoc e -> ShowS+displayS SFail = error $ "@SFail@ can not appear uncaught in a " +++ "rendered @SimpleDoc@" displayS SEmpty = id displayS (SChar c x) = showChar c . displayS x displayS (SText _ s x) = showString s . displayS x@@ -1029,6 +1131,8 @@ -- > hPutDoc handle doc = displayIO handle (renderPretty 0.4 100 doc) displayIO :: Handle -> SimpleDoc e -> IO () displayIO handle = go where+ go SFail = error $ "@SFail@ can not appear uncaught in a " +++ "rendered @SimpleDoc@" go SEmpty = return () go (SChar c x) = hPutChar handle c >> go x go (SText _ s x) = hPutStr handle s >> go x
+ test/WLPPrintTests.hs view
@@ -0,0 +1,264 @@+module Main where++import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit hiding (Test)+import Text.PrettyPrint.Free.Internal++main :: IO ()+main = defaultMain [+ testGroup "Tests for each data constructor" conTests+ , testGroup "Tests for some combinators" codeTests+ , testGroup "Tests for the formatting algorithms" formatTests+ , testGroup "Tests for the code examples in the documentation" docTests+ ]++conTests :: [Test]+conTests = [+ testCase "Empty tests" emptyTests+ , testCase "Char tests" charTests+ , testCase "Text tests" textTests+ , testCase "Line tests" textTests+ , testCase "FlatAlt tests" flatAltTests+ , testCase "Cat tests" catTests+ , testCase "Nest tests" nestTests+ , testCase "Union tests" unionTests+ , testCase "Column tests" columnTests+ , testCase "Nesting tests" nestingTests+ , testCase "Columns tests" columnsTests+ , testCase "Ribbon tests" ribbonTests+ ]++------------------------------------------------------------+-- We test the @Doc@ constructors.++assertPretty :: Int -> String -> String -> Doc e -> Assertion+assertPretty w desc str doc = assertEqual (desc ++ " (pretty)") str+ $ displayS (renderPretty 1.0 w doc) ""++assertSmart :: Int -> String -> String -> Doc e -> Assertion+assertSmart w desc str doc = assertEqual (desc ++ " (smart)") str+ $ displayS (renderSmart w doc) ""++assertRender :: Int -> String -> String -> Doc e -> Assertion+assertRender w desc str doc = do assertPretty w desc str doc+ assertSmart w desc str doc++emptyTests :: Assertion+emptyTests = assertRender 80 "Empty test 1" "" empty++charTests :: Assertion+charTests = assertRender 80 "Char test 1" "a" (char 'a')++textTests :: Assertion+textTests = assertRender 80 "Text test 1" "text..." (text "text...")++lineTests :: Assertion+lineTests = assertRender 80 "Line test 1" "\n" hardline++flatAltTests :: Assertion+flatAltTests = do assertRender 80 "FlatAlt test 1" "x"+ $ flatAlt (text "x") (text "y")+ assertRender 80 "FlatAlt test 2" "y"+ $ flatten $ flatAlt (text "x") (text "y")++catTests :: Assertion+catTests = do assertRender 80 "Cat test 1" "some code"+ $ text "some" <> space <> text "code"++nestTests :: Assertion+nestTests = do assertRender 80 "Nest test 1" "foo bar"+ $ text "foo" <+> nest 2 (text "bar")+ assertRender 80 "Nest test 2" "foo\n bar"+ $ text "foo" <> nest 2 (line <> text "bar")++unionTests :: Assertion+unionTests = do assertRender 80 "Union test 1" "foo bar"+ $ text "foo" </> text "bar"+ assertRender 5 "Union test 2" "foo\nbar"+ $ text "foo" </> text "bar"++columnTests :: Assertion+columnTests = do assertRender 80 "Column test 1" "foo 4"+ $ text "foo" <+> (column $ \c -> pretty c)++nestingTests :: Assertion+nestingTests = do assertRender 80 "Nesting test 1" "foo 2"+ $ text "foo" <+> (nest 2 $ nesting $ \n -> pretty n)++columnsTests :: Assertion+columnsTests = do assertRender 21 "Columns test 1" "foo 21"+ $ text "foo" <+> (nest 2 $ columns $ \w -> pretty w)++ribbonTests :: Assertion+ribbonTests = do assertEqual "Ribbon test 1" "foo 32"+ $ show (text "foo" <+> (ribbon $ \r -> pretty r))++------------------------------------------------------------+-- We test some combinators.++codeTests :: [Test]+codeTests = [+ testCase "@list@ tests" listTests+ , testCase "@tupled@ tests" tupledTests+ ]++listTests :: Assertion+listTests = do assertRender 80 "@list@ test 1" "[1, 2, 3]"+ $ pretty ([1, 2, 3] :: [Int])+ assertRender 5 "@list@ test 2" "[ 1\n, 2\n, 3 ]"+ $ pretty ([1, 2, 3] :: [Int])++tupledTests :: Assertion+tupledTests = do assertRender 80 "@tupled@ test 1" "(1, True, a)"+ $ pretty (1 :: Int, True, 'a')+ assertRender 5 "@tupled@ test 2" "( 1\n, True\n, a )"+ $ pretty (1 :: Int, True, 'a')++------------------------------------------------------------+-- We test some corner cases of the formatting algorithms on a prototypical+-- syntax for a scripting language (e.g. Python).++formatTests :: [Test]+formatTests = [+ testCase "@renderPretty@ test" renderPrettyTest+ , testCase "@renderSmart@ test" renderSmartTest+ ]++data Syn = Call String [Syn] -- name(syn, ..., syn)+ | Plus Syn Syn -- syn + syn+ | List [Syn] -- [syn, ..., syn]+ | Name String++instance Pretty Syn where+ pretty (Call n s) =+ text (n ++ "(") <> nest 2 (softbreak <> align body) <//> rparen+ where body = hcat $ punctuate (comma <> softline) (map pretty s)+ pretty (Plus s t) = nest 2 (pretty s) </> text "+" </> nest 2 (pretty t)+ pretty (List l) = list (map pretty l)+ pretty (Name n) = text n++deep :: Int -> Syn+deep 0 = List (map Name ["abc", "abcdef", "abcdef"])+deep i = Call "fun" [deep (i - 1)]++branch :: Int -> Syn+branch 0 = List (map Name ["abc", "abc"])+branch i | i < 3 = Call "fun" [branch (i - 1), branch (i - 1)]+ | otherwise = Call "fun" [branch (i - 1)]++wide :: Syn+wide = Call "aaaaaaaaaaa" [List $ map Name ["abc", "def", "ghi"]]++-- @renderPretty@ has only one line of lookahead, so it can not fit the+-- entire document within the pagewidth (20c), only the first line.+renderPrettyTest :: Assertion+renderPrettyTest = do assertPretty 20 "@renderPretty@ test 1" (concat [+ "fun(fun(fun(fun(fun(\n"+ , " [ abc\n"+ , " , abcdef\n"+ , " , abcdef ]\n"+ , " ))))\n"+ , ")" ])+ $ pretty (deep 5)+ assertPretty 20 "@renderPretty@ test 2" (concat [+ "fun(fun(fun([ abc\n"+ , " , abc ],\n"+ , " [ abc\n"+ , " , abc ]\n"+ , " ), fun([ abc\n"+ , " , abc ],\n"+ , " [ abc\n"+ , " , abc ]\n"+ , " )))" ])+ $ pretty (branch 3)+ assertPretty 20 "@renderPretty@ test 3" (concat [+ "aaaaaaaaaaa([ abc\n"+ , " , def\n"+ , " , ghi ])" ])+ $ pretty wide++-- @renderSmart@ has more sophisiticated lookahead, so it fits the entire+-- structure within the pagewidth (20c).+renderSmartTest :: Assertion+renderSmartTest = do assertSmart 20 "@renderSmart@ test 1" (concat [+ "fun(\n"+ , " fun(\n"+ , " fun(\n"+ , " fun(\n"+ , " fun(\n"+ , " [ abc\n"+ , " , abcdef\n"+ , " , abcdef ]\n"+ , " )))))" ])+ $ pretty (deep 5)+ assertSmart 20 "@renderSmart@ test 2" (concat [+ "fun(\n"+ , " fun(\n"+ , " fun(\n"+ , " fun(\n"+ , " fun([ abc\n"+ , " , abc ],\n"+ , " [ abc\n"+ , " , abc ]\n"+ , " ),\n"+ , " fun([ abc\n"+ , " , abc ],\n"+ , " [ abc\n"+ , " , abc ])\n"+ , " ))))" ])+ $ pretty (branch 5)+ assertSmart 20 "@renderSmart@ test 3" (concat [+ "aaaaaaaaaaa(\n"+ , " [abc, def, ghi])" ])+ $ pretty wide++------------------------------------------------------------+-- We test the code examples in the haddock comments.++docTests :: [Test]+docTests = [+ testCase "@fill@ test" fillTest+ , testCase "@fillBreak@ test" fillBreakTest+ , testCase "@hang@ test" hangTest+ , testCase "@align@ test" alignTest+ ]++types :: [(String, String)]+types = [ ("empty","Doc e")+ , ("nest","Int -> Doc e -> Doc e")+ , ("linebreak","Doc e") ]++fillTest :: Assertion+fillTest = do assertRender 80 "@fill@ test 1" (concat [+ "let empty :: Doc e\n"+ , " nest :: Int -> Doc e -> Doc e\n"+ , " linebreak :: Doc e" ])+ $ text "let" <+> align (vcat (map ptype types))+ where ptype (name, tp) =+ fill 6 (text name) <+> text "::" <+> text tp++fillBreakTest :: Assertion+fillBreakTest = do assertRender 80 "@fillBreak@ test 1" (concat [+ "let empty :: Doc e\n"+ , " nest :: Int -> Doc e -> Doc e\n"+ , " linebreak\n"+ , " :: Doc e" ])+ $ text "let" <+> align (vcat (map ptype types))+ where ptype (name, tp) =+ fillBreak 6 (text name) <+> (text "::" <+> text tp)++hangTest :: Assertion+hangTest = do assertRender 20 "@hang@ test 1" (concat [+ "the hang combinator\n"+ , " indents these\n"+ , " words !" ])+ $ hang 4 $ fillSep $ map text+ $ words "the hang combinator indents these words !"++alignTest :: Assertion+alignTest = do assertRender 20 "@align@ test 1" (concat [+ "hi nice\n"+ , " world" ])+ $ text "hi" <+> (text "nice" $$ text "world")+ where x $$ y = align $ x <> linebreak <> y
wl-pprint-extras.cabal view
@@ -1,7 +1,7 @@ name: wl-pprint-extras category: Control, Monads, Text-version: 3.4-cabal-version: >= 1.6+version: 3.5+cabal-version: >= 1.8 license: BSD3 license-file: LICENSE author: Edward A. Kmett@@ -25,11 +25,11 @@ build-depends: base == 4.*, containers >= 0.4 && < 0.6,- nats >= 0.1,- semigroups >= 0.9,- semigroupoids >= 3,+ nats >= 0.1 && < 1,+ semigroups >= 0.9 && < 1,+ semigroupoids >= 3 && < 5, utf8-string >= 0.3.6 && < 0.4,- text == 0.11.*+ text >= 0.11 && < 1.2 exposed-modules: Text.PrettyPrint.Free@@ -37,3 +37,17 @@ ghc-options: -Wall hs-source-dirs: src++test-suite wl-pprint-tests++ build-depends:+ base == 4.*,+ wl-pprint-extras,+ HUnit,+ test-framework,+ test-framework-hunit++ main-is: WLPPrintTests.hs+ type: exitcode-stdio-1.0+ ghc-options: -Wall+ hs-source-dirs: test