diff --git a/src/Data/TreeDiff/Class.hs b/src/Data/TreeDiff/Class.hs index d87667b..c8db229 100644 --- a/src/Data/TreeDiff/Class.hs +++ b/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 diff --git a/src/Data/TreeDiff/Golden.hs b/src/Data/TreeDiff/Golden.hs index f827e02..c7ff7a3 100644 --- a/src/Data/TreeDiff/Golden.hs +++ b/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} diff --git a/src/Data/TreeDiff/List.hs b/src/Data/TreeDiff/List.hs index 29ea48b..a0cc5ca 100644 --- a/src/Data/TreeDiff/List.hs +++ b/src/Data/TreeDiff/List.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} -- | A list diff. module Data.TreeDiff.List ( @@ -6,7 +6,7 @@ module Data.TreeDiff.List ( Edit (..), ) where -import Control.DeepSeq (NFData (..)) +import Control.DeepSeq (NFData (..)) import Control.Monad.ST (ST, runST) import qualified Data.Primitive as P diff --git a/src/Data/TreeDiff/Pretty.hs b/src/Data/TreeDiff/Pretty.hs index f66208a..ddbde48 100644 --- a/src/Data/TreeDiff/Pretty.hs +++ b/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,42 +176,42 @@ 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 ------------------------------------------------------------------------------- @@ -216,34 +219,37 @@ prettyEditExprCompact = ppEditExprCompact prettyPretty ------------------------------------------------------------------------------- -- | '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 ------------------------------------------------------------------------------- @@ -251,20 +257,20 @@ ansiWlEditExprCompact = ppEditExprCompact ansiWlPretty ------------------------------------------------------------------------------- -- | 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 diff --git a/src/Data/TreeDiff/QuickCheck.hs b/src/Data/TreeDiff/QuickCheck.hs index 205dc8f..a04e69b 100644 --- a/src/Data/TreeDiff/QuickCheck.hs +++ b/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 diff --git a/tests/Tests.hs b/tests/Tests.hs index 067a2ea..1548c4c 100644 --- a/tests/Tests.hs +++ b/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) "" doc info = case res of diff --git a/tree-diff.cabal b/tree-diff.cabal index e1986a7..6a41088 100644 --- a/tree-diff.cabal +++ b/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