Replace ansi-wl-print with prettyprinter

src/Data/TreeDiff/Class.hs

@@ -98,7 +98,7 @@ import qualified Data.Strict as Strict
 import Data.These (These (..))
 
 -- primitive
-import qualified Data.Primitive  as Prim
+import qualified Data.Primitive as Prim
 
 -- $setup
 -- >>> :set -XDeriveGeneric

src/Data/TreeDiff/Golden.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 -- | "Golden tests" using 'ediff' comparison.
 module Data.TreeDiff.Golden (
     ediffGolden,
@@ -8,10 +9,13 @@ import System.Console.ANSI (SGR (Reset), setSGRCode)
 import Text.Parsec         (eof, parse)
 import Text.Parsec.Text ()
 
-import qualified Data.ByteString              as BS
-import qualified Data.Text                    as T
-import qualified Data.Text.Encoding           as TE
-import qualified Text.PrettyPrint.ANSI.Leijen as WL
+import qualified Data.ByteString               as BS
+import qualified Data.Text                     as T
+import qualified Data.Text.Encoding            as TE
+import           Prettyprinter
+                 (LayoutOptions (LayoutOptions, layoutPageWidth),
+                 PageWidth (AvailablePerLine), layoutPretty, unAnnotate)
+import           Prettyprinter.Render.Terminal (renderStrict)
 
 -- | Make a golden tests.
 --
@@ -52,8 +56,6 @@ ediffGolden impl testName fp x = impl testName expect actual cmp wrt
     cmp a b
         | a == b    = return Nothing
         | otherwise = return $ Just $
-            setSGRCode [Reset] ++ showWL (ansiWlEditExprCompact $ ediff a b)
-    wrt expr = BS.writeFile fp $ TE.encodeUtf8 $ T.pack $ showWL (WL.plain (ansiWlExpr expr)) ++ "\n"
-
-showWL :: WL.Doc -> String
-showWL doc = WL.displayS (WL.renderSmart 0.4 80 doc) ""
+            setSGRCode [Reset] ++ T.unpack (render $ ansiWlEditExprCompact $ ediff a b)
+    wrt expr = BS.writeFile fp $ TE.encodeUtf8 $ render (unAnnotate (ansiWlExpr expr)) `T.append` "\n"
+    render = renderStrict . layoutPretty LayoutOptions {layoutPageWidth=AvailablePerLine 80 0.4}

src/Data/TreeDiff/List.hs

@@ -1,12 +1,12 @@
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns        #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 -- | A list diff.
 module Data.TreeDiff.List (
     diffBy,
     Edit (..),
 ) where
 
-import Control.DeepSeq (NFData (..))
+import Control.DeepSeq  (NFData (..))
 import Control.Monad.ST (ST, runST)
 
 import qualified Data.Primitive as P

src/Data/TreeDiff/Pretty.hs

@@ -30,9 +30,12 @@ import Data.TreeDiff.Expr
 import Numeric            (showHex)
 import Text.Read          (readMaybe)
 
-import qualified Data.TreeDiff.OMap           as OMap
-import qualified Text.PrettyPrint             as HJ
-import qualified Text.PrettyPrint.ANSI.Leijen as WL
+import qualified Data.TreeDiff.OMap            as OMap
+import qualified Prettyprinter                 as PP
+import qualified Prettyprinter.Render.Terminal as PP
+
+type PlainDoc = PP.Doc ()
+type AnsiDoc = PP.Doc PP.AnsiStyle
 
 -- $setup
 -- >>> import qualified Data.TreeDiff.OMap as OMap
@@ -173,98 +176,101 @@ ppEditExpr' compact p = go
 -------------------------------------------------------------------------------
 
 -- | 'Pretty' via @pretty@ library.
-prettyPretty :: Pretty HJ.Doc
+prettyPretty :: Pretty PlainDoc
 prettyPretty = Pretty
-    { ppCon    = HJ.text
-    , ppRec    = \c xs -> prettyGroup (c HJ.<+> HJ.char '{') (HJ.char '}')
-               $ map (\(fn, d) -> HJ.sep [HJ.text fn HJ.<+> HJ.equals, d]) xs
-    , ppLst    = prettyGroup (HJ.char '[') (HJ.char ']')
+    { ppCon    = PP.pretty
+    , ppRec    = \c xs -> prettyGroup (c PP.<+> PP.pretty '{') (PP.pretty '}')
+               $ map (\(fn, d) -> PP.sep [PP.pretty fn PP.<+> PP.equals, d]) xs
+    , ppLst    = prettyGroup (PP.pretty '[') (PP.pretty ']')
     , ppCpy    = id
-    , ppIns    = \d -> HJ.char '+' HJ.<> d
-    , ppDel    = \d -> HJ.char '-' HJ.<> d
-    , ppEdits  = HJ.sep
-    , ppEllip  = HJ.text "..."
-    , ppApp    = \f xs -> HJ.sep [ f, HJ.nest 2 $ HJ.sep xs ]
-    , ppParens = HJ.parens
+    , ppIns    = \d -> PP.pretty '+' PP.<> d
+    , ppDel    = \d -> PP.pretty '-' PP.<> d
+    , ppEdits  = PP.sep
+    , ppEllip  = PP.pretty "..."
+    , ppApp    = \f xs -> PP.sep [ f, PP.nest 2 $ PP.sep xs ]
+    , ppParens = PP.parens
     }
 
-prettyGroup :: HJ.Doc -> HJ.Doc -> [HJ.Doc] -> HJ.Doc
-prettyGroup l r xs = HJ.cat [l, HJ.sep (map (HJ.nest 2) (prettyPunct (HJ.char ',') r xs))]
+prettyGroup :: PlainDoc -> PlainDoc -> [PlainDoc] -> PlainDoc
+prettyGroup l r xs = PP.cat [l, PP.sep (map (PP.nest 2) (prettyPunct (PP.pretty ',') r xs))]
 
-prettyPunct :: HJ.Doc -> HJ.Doc -> [HJ.Doc] -> [HJ.Doc]
+prettyPunct :: PlainDoc -> PlainDoc -> [PlainDoc] -> [PlainDoc]
 prettyPunct _   end []     = [end]
-prettyPunct _   end [x]    = [x HJ.<> end]
-prettyPunct sep end (x:xs) = (x HJ.<> sep) : prettyPunct sep end xs
+prettyPunct _   end [x]    = [x PP.<> end]
+prettyPunct sep end (x:xs) = (x PP.<> sep) : prettyPunct sep end xs
 
 -- | Pretty print 'Expr' using @pretty@.
 --
 -- >>> prettyExpr $ Rec "ex" (OMap.fromList [("[]", App "bar" [])])
 -- ex {`[]` = bar}
-prettyExpr :: Expr -> HJ.Doc
+prettyExpr :: Expr -> PlainDoc
 prettyExpr = ppExpr prettyPretty
 
 -- | Pretty print @'Edit' 'EditExpr'@ using @pretty@.
-prettyEditExpr :: Edit EditExpr -> HJ.Doc
+prettyEditExpr :: Edit EditExpr -> PlainDoc
 prettyEditExpr = ppEditExpr prettyPretty
 
 -- | Compact 'prettyEditExpr'.
-prettyEditExprCompact :: Edit EditExpr -> HJ.Doc
+prettyEditExprCompact :: Edit EditExpr -> PlainDoc
 prettyEditExprCompact = ppEditExprCompact prettyPretty
 
 -------------------------------------------------------------------------------
 -- ansi-wl-pprint
 -------------------------------------------------------------------------------
 
 -- | 'Pretty' via @ansi-wl-pprint@ library (with colors).
-ansiWlPretty :: Pretty WL.Doc
+ansiWlPretty :: Pretty AnsiDoc
 ansiWlPretty = Pretty
-    { ppCon    = WL.text
-    , ppRec    = \c xs -> ansiGroup (c WL.<+> WL.lbrace) WL.rbrace
-               $ map (\(fn, d) -> WL.text fn WL.<+> WL.equals WL.</> d) xs
-    , ppLst    = ansiGroup WL.lbracket WL.rbracket
-    , ppCpy    = WL.dullwhite
-    , ppIns    = \d -> WL.green $ WL.plain $ WL.char '+' WL.<> d
-    , ppDel    = \d -> WL.red   $ WL.plain $ WL.char '-' WL.<> d
-    , ppApp    = \f xs -> WL.group $ WL.nest 2 $ f WL.<$> WL.vsep xs
-    , ppEdits  = WL.sep
-    , ppEllip  = WL.text "..."
-    , ppParens = WL.parens
+    { ppCon    = PP.pretty
+    , ppRec    = \c xs -> ansiGroup (c PP.<+> PP.lbrace) PP.rbrace
+               $ map (\(fn, d) -> PP.pretty fn PP.<+> PP.equals <> PP.softline <> d) xs
+    , ppLst    = ansiGroup PP.lbracket PP.rbracket
+    , ppCpy    = PP.annotate (PP.colorDull PP.White)
+    , ppIns    = \d -> PP.annotate (PP.color PP.Green) $ PP.unAnnotate $ PP.pretty '+' PP.<> d
+    , ppDel    = \d -> PP.annotate (PP.color PP.Red)   $ PP.unAnnotate $ PP.pretty '-' PP.<> d
+    , ppApp    = \f xs -> PP.group $ PP.nest 2 $ f <> PP.line <> PP.vsep xs
+    , ppEdits  = PP.sep
+    , ppEllip  = PP.pretty "..."
+    , ppParens = PP.parens
     }
 
-ansiGroup :: WL.Doc -> WL.Doc -> [WL.Doc] -> WL.Doc
-ansiGroup l r xs = WL.group $ WL.nest 2 (l WL.<$$> WL.vsep (WL.punctuate WL.comma xs) WL.<> r)
+ansiGroup :: AnsiDoc -> AnsiDoc -> [AnsiDoc] -> AnsiDoc
+ansiGroup l r xs = PP.group $ PP.nest 2 (l <> linebreak <> PP.vsep (PP.punctuate PP.comma xs) PP.<> r)
+
+linebreak :: PP.Doc ann
+linebreak = PP.flatAlt PP.line mempty
 
 -- | Pretty print 'Expr' using @ansi-wl-pprint@.
-ansiWlExpr :: Expr -> WL.Doc
+ansiWlExpr :: Expr -> AnsiDoc
 ansiWlExpr = ppExpr ansiWlPretty
 
 -- | Pretty print @'Edit' 'EditExpr'@ using @ansi-wl-pprint@.
-ansiWlEditExpr :: Edit EditExpr -> WL.Doc
+ansiWlEditExpr :: Edit EditExpr -> AnsiDoc
 ansiWlEditExpr = ppEditExpr ansiWlPretty
 
 -- | Compact 'ansiWlEditExpr'
-ansiWlEditExprCompact :: Edit EditExpr -> WL.Doc
+ansiWlEditExprCompact :: Edit EditExpr -> AnsiDoc
 ansiWlEditExprCompact = ppEditExprCompact ansiWlPretty
 
 -------------------------------------------------------------------------------
 -- Background
 -------------------------------------------------------------------------------
 
 -- | Like 'ansiWlPretty' but color the background.
-ansiWlBgPretty :: Pretty WL.Doc
+ansiWlBgPretty :: Pretty AnsiDoc
 ansiWlBgPretty = ansiWlPretty
-    { ppIns    = \d -> WL.ondullgreen $ WL.white $ WL.plain $ WL.char '+' WL.<> d
-    , ppDel    = \d -> WL.ondullred   $ WL.white $ WL.plain $ WL.char '-' WL.<> d
+    { ppIns    = \d -> PP.annotate (PP.bgColorDull PP.Green) $ PP.annotate (PP.color PP.White) $ PP.unAnnotate $ PP.pretty '+' PP.<> d
+    , ppDel    = \d -> PP.annotate (PP.bgColorDull PP.Red)   $ PP.annotate (PP.color PP.White) $ PP.unAnnotate $ PP.pretty '-' PP.<> d
     }
 
 -- | Pretty print 'Expr' using @ansi-wl-pprint@.
-ansiWlBgExpr :: Expr -> WL.Doc
+ansiWlBgExpr :: Expr -> AnsiDoc
 ansiWlBgExpr = ppExpr ansiWlBgPretty
 
 -- | Pretty print @'Edit' 'EditExpr'@ using @ansi-wl-pprint@.
-ansiWlBgEditExpr :: Edit EditExpr -> WL.Doc
+ansiWlBgEditExpr :: Edit EditExpr -> AnsiDoc
 ansiWlBgEditExpr = ppEditExpr ansiWlBgPretty
 
 -- | Compact 'ansiWlBgEditExpr'.
-ansiWlBgEditExprCompact :: Edit EditExpr -> WL.Doc
+ansiWlBgEditExprCompact :: Edit EditExpr -> AnsiDoc
 ansiWlBgEditExprCompact = ppEditExprCompact ansiWlBgPretty

src/Data/TreeDiff/QuickCheck.hs

@@ -3,12 +3,18 @@ module Data.TreeDiff.QuickCheck (
     ediffEq,
     ) where
 
-import Data.TreeDiff
-import System.Console.ANSI (SGR (Reset), setSGRCode)
-import Test.QuickCheck     (Property, counterexample)
+import qualified Data.Text.Lazy                as TL
+import           Data.TreeDiff
+import           Prettyprinter
+                 (defaultLayoutOptions, layoutPretty)
+import           Prettyprinter.Render.Terminal (renderLazy)
+import           System.Console.ANSI           (SGR (Reset), setSGRCode)
+import           Test.QuickCheck               (Property, counterexample)
 
 -- | A variant of '===', which outputs a diff when values are inequal.
 ediffEq :: (Eq a, ToExpr a) => a -> a -> Property
 ediffEq x y = counterexample
-    (setSGRCode [Reset] ++ show (ansiWlEditExpr $ ediff x y))
+    (setSGRCode [Reset] ++ render (ansiWlEditExpr $ ediff x y))
     (x == y)
+    where
+        render = TL.unpack . renderLazy . layoutPretty defaultLayoutOptions

tests/Tests.hs

@@ -10,12 +10,12 @@ import Test.Tasty                 (TestTree, defaultMain, testGroup)
 import Test.Tasty.Golden.Advanced (goldenTest)
 import Test.Tasty.QuickCheck      (testProperty)
 
-import qualified Data.HashSet                 as HS
-import qualified Data.Primitive               as Prim
-import qualified Text.Parsec                  as P
-import qualified Text.PrettyPrint.ANSI.Leijen as WL
-import qualified Text.Trifecta                as T (eof, parseString)
-import qualified Text.Trifecta.Result         as T (ErrInfo (..), Result (..))
+import qualified Data.HashSet         as HS
+import qualified Data.Primitive       as Prim
+import qualified Prettyprinter        as PP
+import qualified Text.Parsec          as P
+import qualified Text.Trifecta        as T (eof, parseString)
+import qualified Text.Trifecta.Result as T (ErrInfo (..), Result (..))
 
 import Data.TreeDiff
 import Data.TreeDiff.Golden
@@ -27,7 +27,7 @@ import qualified RefDiffBy
 main :: IO ()
 main = defaultMain $ testGroup "tests"
     [ testProperty "trifecta-pretty roundtrip" roundtripTrifectaPretty
-    , testProperty "parsec-ansi-wl-pprint roundtrip" roundtripParsecAnsiWl
+    , testProperty "parsec-prettyprinter-ansi-terminal roundtrip" roundtripParsecAnsiWl
     , testProperty "diffBy example1" $ diffByModel [7,1,6,0,0] [0,0,6,7,1,0,0]
     , testProperty "diffBy model" diffByModel
     , goldenTests
@@ -73,7 +73,7 @@ roundtripTrifectaPretty e = counterexample info $ ediffEq (Just e) res'
 roundtripParsecAnsiWl :: Expr -> Property
 roundtripParsecAnsiWl e = counterexample info $ ediffEq (Just e) res'
   where
-    doc = show (WL.plain (ansiWlExpr e))
+    doc = show (PP.unAnnotate (ansiWlExpr e))
     res = P.parse (exprParser <* P.eof) "<memory>" doc
 
     info = case res of

tree-diff.cabal

@@ -91,21 +91,22 @@ library
     , time        ^>=1.8.0.2  || ^>=1.9.3    || ^>=1.10     || ^>=1.11 || ^>=1.12
 
   build-depends:
-    , aeson                 ^>=2.2.0.0
-    , ansi-terminal         ^>=1.1
-    , ansi-wl-pprint        ^>=1.0.2
-    , hashable              ^>=1.4.4.0  || ^>=1.5.0.0
-    , parsers               ^>=0.12.11
-    , primitive             ^>=0.9.0.0
-    , QuickCheck            ^>=2.14.2   || ^>=2.15
-    , scientific            ^>=0.3.8.0
-    , semialign             ^>=1.3.1
-    , strict                ^>=0.5
-    , tagged                ^>=0.8.8
-    , these                 ^>=1.2.1
-    , unordered-containers  ^>=0.2.20
-    , uuid-types            ^>=1.0.6
-    , vector                ^>=0.13.1.0
+    , aeson                       ^>=2.2.0.0
+    , ansi-terminal               ^>=1.1
+    , prettyprinter               ^>=1.7.1
+    , prettyprinter-ansi-terminal ^>=1.1.3
+    , hashable                    ^>=1.4.4.0  || ^>=1.5.0.0
+    , parsers                     ^>=0.12.11
+    , primitive                   ^>=0.9.0.0
+    , QuickCheck                  ^>=2.14.2   || ^>=2.15
+    , scientific                  ^>=0.3.8.0
+    , semialign                   ^>=1.3.1
+    , strict                      ^>=0.5
+    , tagged                      ^>=0.8.8
+    , these                       ^>=1.2.1
+    , unordered-containers        ^>=0.2.20
+    , uuid-types                  ^>=1.0.6
+    , vector                      ^>=0.13.1.0
 
   if (impl(ghc >=8) && !impl(ghc >=9.4))
     build-depends: data-array-byte ^>=0.1.0.1
@@ -134,7 +135,7 @@ test-suite tree-diff-test
   -- dependencies from library
   build-depends:
     , ansi-terminal
-    , ansi-wl-pprint
+    , prettyprinter
     , base
     , parsec
     , primitive