diff --git a/semantic-diff.cabal b/semantic-diff.cabal index a1c619429..a01e2bc36 100644 --- a/semantic-diff.cabal +++ b/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 diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs index bad6b81da..af73f4e41 100644 --- a/src/DiffSummary.hs +++ b/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 diff --git a/src/Renderer/Summary.hs b/src/Renderer/Summary.hs index feeb4fe39..4536e9d2c 100644 --- a/src/Renderer/Summary.hs +++ b/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 diff --git a/test/DiffSummarySpec.hs b/test/DiffSummarySpec.hs index f7db5b1eb..ef4b7f3a2 100644 --- a/test/DiffSummarySpec.hs +++ b/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)