1
1
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +03:00

Define printDiff as a catamorphism.

This commit is contained in:
Rob Rix 2017-09-09 16:55:32 +01:00
parent 1801fdc1a8
commit 9765775242

View File

@ -6,6 +6,7 @@ module Renderer.SExpression
import Data.Bifunctor.Join
import Data.ByteString.Char8 hiding (foldr, spanEnd)
import Data.Functor.Foldable (cata)
import Data.Record
import Data.Semigroup
import Diff
@ -14,20 +15,20 @@ import Prelude hiding (replicate)
import Term
-- | Returns a ByteString SExpression formatted diff.
renderSExpressionDiff :: (ConstrainAll Show fields, Foldable f) => Diff f (Record fields) -> ByteString
renderSExpressionDiff :: (ConstrainAll Show fields, Foldable f, Functor f) => Diff f (Record fields) -> ByteString
renderSExpressionDiff diff = printDiff diff 0 <> "\n"
-- | Returns a ByteString SExpression formatted term.
renderSExpressionTerm :: (ConstrainAll Show fields, Foldable f) => Term f (Record fields) -> ByteString
renderSExpressionTerm :: (ConstrainAll Show fields, Foldable f, Functor f) => Term f (Record fields) -> ByteString
renderSExpressionTerm term = printTerm term 0 <> "\n"
printDiff :: (ConstrainAll Show fields, Foldable f) => Diff f (Record fields) -> Int -> ByteString
printDiff diff level = case unDiff diff of
printDiff :: (ConstrainAll Show fields, Foldable f, Functor f) => Diff f (Record fields) -> Int -> ByteString
printDiff = cata $ \ diff level -> case diff of
Patch patch -> case patch of
Insert term -> pad (level - 1) <> "{+" <> printTerm term level <> "+}"
Delete term -> pad (level - 1) <> "{-" <> printTerm term level <> "-}"
Replace a b -> pad (level - 1) <> "{ " <> printTerm a level <> pad (level - 1) <> "->" <> printTerm b level <> " }"
Copy (Join (_, annotation)) syntax -> pad' level <> "(" <> showAnnotation annotation <> foldr (\d acc -> printDiff d (level + 1) <> acc) "" syntax <> ")"
Copy (Join (_, annotation)) syntax -> pad' level <> "(" <> showAnnotation annotation <> foldr (\d acc -> d (level + 1) <> acc) "" syntax <> ")"
where
pad' :: Int -> ByteString
pad' n = if n < 1 then "" else pad n