Use wl-pprint-text to pretty print diff summaries

semantic-diff.cabal

@@ -76,6 +76,7 @@ library
                      , free
                      , comonad
                      , protolude
+                     , wl-pprint-text
   default-language:    Haskell2010
   default-extensions:  DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveGeneric, FlexibleContexts, FlexibleInstances, OverloadedStrings, NoImplicitPrelude, RecordWildCards, LambdaCase
   ghc-options:        -Wall -fno-warn-name-shadowing -O2 -threaded -fprof-auto "-with-rtsopts=-N -p -s -h -i0.1" -j
@@ -126,6 +127,7 @@ test-suite semantic-diff-test
                      , these
                      , free
                      , recursion-schemes >= 4.1
+                     , wl-pprint-text
   if os(darwin)
     ghc-options:       -threaded -rtsopts -with-rtsopts=-N -j
   else

src/DiffSummary.hs

@@ -13,7 +13,9 @@ import Data.Functor.Foldable as Foldable
 import Data.Functor.Both
 import Data.OrderedMap
 import Data.Record
-import Data.Text as Text (intercalate, unpack)
+import Data.Text as Text (intercalate)
+import Text.PrettyPrint.Leijen.Text ((<+>), squotes, space, string)
+import qualified Text.PrettyPrint.Leijen.Text as P
 
 data DiffInfo = DiffInfo { categoryName :: Text, termName :: Text } deriving (Eq, Show)
 
@@ -102,19 +104,18 @@ instance (HasCategory leaf, HasField fields Category) => HasCategory (Term leaf
 data DiffSummary a = DiffSummary {
   patch :: Patch a,
   parentAnnotations :: [Category]
-} deriving (Eq, Functor)
+} deriving (Eq, Functor, Show)
 
-instance Show (DiffSummary DiffInfo) where
-  showsPrec _ DiffSummary{..} s = (++s) . unpack $ case patch of
-    (Insert diffInfo) -> "Added the " <> "'" <> termName diffInfo <> "' " <> categoryName diffInfo <> maybeParentContext parentAnnotations
-    (Delete diffInfo) -> "Deleted the " <> "'" <> termName diffInfo <> "' " <> categoryName diffInfo <> maybeParentContext parentAnnotations
-    (Replace t1 t2) ->
-      "Replaced the " <> "'" <> termName t1 <> "' " <> categoryName t1
-      <> " with the " <> "'" <> termName t2 <> "' " <> categoryName t2
-      <> maybeParentContext parentAnnotations
-    where maybeParentContext parentAnnotations = if null parentAnnotations
-            then ""
-            else " in the " <> intercalate "/" (toCategoryName <$> parentAnnotations) <> " context"
+instance P.Pretty (DiffSummary DiffInfo) where
+  pretty DiffSummary{..} = case patch of
+    Insert diffInfo -> "Added the" <+> squotes (toDoc $ termName diffInfo) <+> (toDoc $ categoryName diffInfo) P.<> maybeParentContext parentAnnotations
+    Delete diffInfo -> "Deleted the" <+> squotes (toDoc $ termName diffInfo) <+> (toDoc $ categoryName diffInfo) P.<> maybeParentContext parentAnnotations
+    Replace t1 t2 -> "Replaced the" <+> squotes (toDoc $ termName t1) <+> (toDoc $ categoryName t1) <+> "with the" <+> P.squotes (toDoc $ termName t2) <+> (toDoc $ categoryName t2) P.<> maybeParentContext parentAnnotations
+    where
+      maybeParentContext annotations = if null annotations
+        then ""
+        else space <> "in the" <+> (toDoc . intercalate "/" $ toCategoryName <$> annotations) <+> "context"
+      toDoc = string . toS
 
 diffSummary :: (HasCategory leaf, HasField fields Category) => Diff leaf (Record fields) -> [DiffSummary DiffInfo]
 diffSummary = cata $ \case

src/Renderer/Summary.hs

@@ -5,6 +5,7 @@ import Renderer
 import DiffSummary
 import Data.Aeson
 import Data.Text (pack)
+import Text.PrettyPrint.Leijen.Text (pretty)
 
 summary :: Renderer
-summary diff _ = toS . encode $ pack . show <$> diffSummary diff
+summary diff _ = toS . encode $ pack . show . pretty <$> diffSummary diff

test/DiffSummarySpec.hs

@@ -10,6 +10,7 @@ import Patch
 import Range
 import Category
 import DiffSummary
+import Text.PrettyPrint.Leijen.Text
 
 arrayInfo :: Info
 arrayInfo = rangeAt 0 .: ArrayLiteral .: 2 .: 0 .: RNil
@@ -33,6 +34,6 @@ spec = parallel $ do
       diffSummary testDiff `shouldBe` [ DiffSummary { patch = Insert (DiffInfo "string" "a"), parentAnnotations = [ ArrayLiteral ] } ]
   describe "show" $ do
     it "should print adds" $
-      show testSummary `shouldBe` ("Added the 'a' string" :: Text)
+      show (pretty testSummary) `shouldBe` ("Added the 'a' string" :: Text)
     it "prints a replacement" $ do
-      show replacementSummary `shouldBe` ("Replaced the 'a' string with the 'b' symbol in the array context" :: Text)
+      show (pretty replacementSummary) `shouldBe` ("Replaced the 'a' string with the 'b' symbol in the array context" :: Text)