From 3637bfee243739336a43cf76fb1896f5352955cd Mon Sep 17 00:00:00 2001 From: Matt Diephouse Date: Tue, 19 Jan 2016 13:51:17 -0500 Subject: [PATCH 01/13] Document Interpreter.hs --- src/Interpreter.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Interpreter.hs b/src/Interpreter.hs index 38558db5f..788ee8719 100644 --- a/src/Interpreter.hs +++ b/src/Interpreter.hs @@ -20,9 +20,11 @@ import Data.Maybe -- | Returns whether two terms are comparable type Comparable a annotation = Term a annotation -> Term a annotation -> Bool +-- | Diff two terms, given a function that determines whether two terms can be compared. interpret :: (Eq a, Eq annotation) => Comparable a annotation -> Term a annotation -> Term a annotation -> Diff a annotation interpret comparable a b = fromMaybe (Pure $ Replace a b) $ constructAndRun comparable a b +-- | A hylomorphism. Given an `a`, unfold and then refold into a `b`. hylo :: Functor f => (t -> f b -> b) -> (a -> (t, f a)) -> a -> b hylo down up a = down annotation $ hylo down up <$> syntax where (annotation, syntax) = up a From b8c7aaeccd1fa67cf21d0e02dddf3239e30e209f Mon Sep 17 00:00:00 2001 From: Matt Diephouse Date: Thu, 21 Jan 2016 10:29:52 -0500 Subject: [PATCH 02/13] Document SES.hs --- src/SES.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/SES.hs b/src/SES.hs index 991dfe9bf..1a5277fec 100644 --- a/src/SES.hs +++ b/src/SES.hs @@ -10,13 +10,18 @@ import Data.List (uncons) import qualified Data.Map as Map import Data.Ord (comparing) +-- | A function that maybe creates a diff from two terms. type Compare a annotation = Term a annotation -> Term a annotation -> Maybe (Diff a annotation) + +-- | A function that computes the cost of a diff. type Cost a annotation = Diff a annotation -> Integer +-- | Find the shortest edit script (diff) between two terms given a function to compute the cost. ses :: Compare a annotation -> Cost a annotation -> [Term a annotation] -> [Term a annotation] -> [Diff a annotation] ses diffTerms cost as bs = fst <$> evalState diffState Map.empty where diffState = diffAt diffTerms cost (0, 0) as bs +-- | Find the shortest edit script between two terms at a given vertex in the edit graph. diffAt :: Compare a annotation -> Cost a annotation -> (Integer, Integer) -> [Term a annotation] -> [Term a annotation] -> State (Map.Map (Integer, Integer) [(Diff a annotation, Integer)]) [(Diff a annotation, Integer)] diffAt _ _ _ [] [] = return [] diffAt _ cost _ [] bs = return $ foldr toInsertions [] bs where @@ -46,5 +51,6 @@ diffAt diffTerms cost (i, j) (a : as) (b : bs) = do best = minimumBy (comparing costOf) recur = diffAt diffTerms cost +-- | Prepend a diff to the list with the cumulative cost. consWithCost :: Cost a annotation -> Diff a annotation -> [(Diff a annotation, Integer)] -> [(Diff a annotation, Integer)] consWithCost cost diff rest = (diff, cost diff + maybe 0 snd (fst <$> uncons rest)) : rest From 192dd7c5f970cfaee4913b77d81f1bd7b30017ff Mon Sep 17 00:00:00 2001 From: Matt Diephouse Date: Thu, 21 Jan 2016 13:04:42 -0500 Subject: [PATCH 03/13] Reformat where clause --- src/Unified.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Unified.hs b/src/Unified.hs index 104b6b9a6..bf4abf798 100644 --- a/src/Unified.hs +++ b/src/Unified.hs @@ -26,9 +26,10 @@ unified diff (before, after) = do annotationAndSyntaxToChunks source (Info range _) (Keyed k) = (unifiedRange range (sort $ snd <$> Map.toList k) source, Just range) unifiedPatch :: Patch (Term a Info) -> [Chunk String] - unifiedPatch patch = (fore red . bold <$> beforeChunk) <> (fore green . bold <$> afterChunk) where - beforeChunk = maybe [] (change "-" . unifiedTerm before) $ Patch.before patch - afterChunk = maybe [] (change "+" . unifiedTerm after) $ Patch.after patch + unifiedPatch patch = (fore red . bold <$> beforeChunk) <> (fore green . bold <$> afterChunk) + where + beforeChunk = maybe [] (change "-" . unifiedTerm before) $ Patch.before patch + afterChunk = maybe [] (change "+" . unifiedTerm after) $ Patch.after patch unifiedTerm :: Source Char -> Term a Info -> [Chunk String] From bd74e7d971f8c8806e81d472f4c6dd96793d6c40 Mon Sep 17 00:00:00 2001 From: Matt Diephouse Date: Thu, 21 Jan 2016 13:04:50 -0500 Subject: [PATCH 04/13] Remove spurious blank line --- src/Unified.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Unified.hs b/src/Unified.hs index bf4abf798..ccb3874ad 100644 --- a/src/Unified.hs +++ b/src/Unified.hs @@ -32,7 +32,6 @@ unified diff (before, after) = do afterChunk = maybe [] (change "+" . unifiedTerm after) $ Patch.after patch unifiedTerm :: Source Char -> Term a Info -> [Chunk String] - unifiedTerm source term = fst $ cata (annotationAndSyntaxToChunks source) term unifiedRange :: Range -> [([Chunk String], Maybe Range)] -> Source Char -> [Chunk String] From 160c2e309abe2a1efb1081097a608281bcf537c2 Mon Sep 17 00:00:00 2001 From: Matt Diephouse Date: Thu, 21 Jan 2016 13:05:15 -0500 Subject: [PATCH 05/13] Pass the chunk renderer into unified --- app/Main.hs | 5 ++++- src/Unified.hs | 7 +++---- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index ec2387bb6..9400e5240 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -23,6 +23,7 @@ import qualified System.IO as IO import qualified Data.Text.ICU.Detect as Detect import qualified Data.Text.ICU.Convert as Convert import Data.Bifunctor.Join +import Rainbow -- | The available types of diff rendering. data Format = Unified | Split | Patch @@ -59,7 +60,9 @@ diff = interpret comparable -- | Return a renderer from the command-line arguments that will print the diff. printDiff :: Arguments -> Renderer T.Text (IO ()) printDiff arguments diff sources = case format arguments of - Unified -> B1.putStr =<< unified diff sources + Unified -> B1.putStr =<< render <$> byteStringMakerFromEnvironment + where + render renderer = unified renderer diff sources Split -> put (output arguments) =<< split diff sources where put Nothing rendered = TextIO.putStr rendered diff --git a/src/Unified.hs b/src/Unified.hs index ccb3874ad..f112d2ec4 100644 --- a/src/Unified.hs +++ b/src/Unified.hs @@ -14,10 +14,9 @@ import Data.List hiding (foldl) import qualified Data.OrderedMap as Map import Rainbow -unified :: Renderer a (IO ByteString) -unified diff (before, after) = do - renderer <- byteStringMakerFromEnvironment - return . mconcat . chunksToByteStrings renderer . fst $ iter g mapped where +unified :: (Chunk String -> [ByteString] -> [ByteString]) -> Renderer a ByteString +unified renderer diff (before, after) = + mconcat . chunksToByteStrings renderer . fst $ iter g mapped where mapped = fmap (unifiedPatch &&& range) diff g (Annotated (_, info) syntax) = annotationAndSyntaxToChunks after info syntax annotationAndSyntaxToChunks source (Info range _) (Leaf _) = (pure . chunk . toList $ slice range source, Just range) From 80273c1fd4b8d7c491bfea551307ff6bec2289bb Mon Sep 17 00:00:00 2001 From: Matt Diephouse Date: Thu, 21 Jan 2016 13:05:25 -0500 Subject: [PATCH 06/13] Document unified --- src/Unified.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Unified.hs b/src/Unified.hs index f112d2ec4..e56808a4b 100644 --- a/src/Unified.hs +++ b/src/Unified.hs @@ -14,6 +14,7 @@ import Data.List hiding (foldl) import qualified Data.OrderedMap as Map import Rainbow +-- | Render a diff with the unified format. unified :: (Chunk String -> [ByteString] -> [ByteString]) -> Renderer a ByteString unified renderer diff (before, after) = mconcat . chunksToByteStrings renderer . fst $ iter g mapped where From a166c354e3c3108d08c8677042b10c2765c6624a Mon Sep 17 00:00:00 2001 From: Matt Diephouse Date: Thu, 21 Jan 2016 13:05:51 -0500 Subject: [PATCH 07/13] Reformat where clause --- src/Unified.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Unified.hs b/src/Unified.hs index e56808a4b..5a2af9eea 100644 --- a/src/Unified.hs +++ b/src/Unified.hs @@ -16,8 +16,8 @@ import Rainbow -- | Render a diff with the unified format. unified :: (Chunk String -> [ByteString] -> [ByteString]) -> Renderer a ByteString -unified renderer diff (before, after) = - mconcat . chunksToByteStrings renderer . fst $ iter g mapped where +unified renderer diff (before, after) = mconcat . chunksToByteStrings renderer . fst $ iter g mapped + where mapped = fmap (unifiedPatch &&& range) diff g (Annotated (_, info) syntax) = annotationAndSyntaxToChunks after info syntax annotationAndSyntaxToChunks source (Info range _) (Leaf _) = (pure . chunk . toList $ slice range source, Just range) From b074325f674ed5a17373dcb49a207bb870c0bd05 Mon Sep 17 00:00:00 2001 From: Matt Diephouse Date: Thu, 21 Jan 2016 13:27:16 -0500 Subject: [PATCH 08/13] Make unified into a Renderer of [Chunk String] --- app/Main.hs | 6 ++++-- src/Unified.hs | 4 ++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 9400e5240..1dcf39193 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -60,9 +60,11 @@ diff = interpret comparable -- | Return a renderer from the command-line arguments that will print the diff. printDiff :: Arguments -> Renderer T.Text (IO ()) printDiff arguments diff sources = case format arguments of - Unified -> B1.putStr =<< render <$> byteStringMakerFromEnvironment + Unified -> put $ unified diff sources where - render renderer = unified renderer diff sources + put chunks = do + renderer <- byteStringMakerFromEnvironment + B1.putStr $ mconcat $ chunksToByteStrings renderer chunks Split -> put (output arguments) =<< split diff sources where put Nothing rendered = TextIO.putStr rendered diff --git a/src/Unified.hs b/src/Unified.hs index 5a2af9eea..9257f6057 100644 --- a/src/Unified.hs +++ b/src/Unified.hs @@ -15,8 +15,8 @@ import qualified Data.OrderedMap as Map import Rainbow -- | Render a diff with the unified format. -unified :: (Chunk String -> [ByteString] -> [ByteString]) -> Renderer a ByteString -unified renderer diff (before, after) = mconcat . chunksToByteStrings renderer . fst $ iter g mapped +unified :: Renderer a [Chunk String] +unified diff (before, after) = fst $ iter g mapped where mapped = fmap (unifiedPatch &&& range) diff g (Annotated (_, info) syntax) = annotationAndSyntaxToChunks after info syntax From 316a7827c3e892b292826f70d20049ed70353efb Mon Sep 17 00:00:00 2001 From: Matt Diephouse Date: Thu, 21 Jan 2016 13:32:00 -0500 Subject: [PATCH 09/13] Add Rainbow to semantic-diff-exe --- semantic-diff.cabal | 1 + src/Unified.hs | 3 +-- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 6b5803861..f059ae3ac 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -67,6 +67,7 @@ executable semantic-diff-exe , filepath , free , optparse-applicative + , rainbow , semantic-diff , text >= 1.2.1.3 , text-icu diff --git a/src/Unified.hs b/src/Unified.hs index 9257f6057..c7890f1c5 100644 --- a/src/Unified.hs +++ b/src/Unified.hs @@ -16,9 +16,8 @@ import Rainbow -- | Render a diff with the unified format. unified :: Renderer a [Chunk String] -unified diff (before, after) = fst $ iter g mapped +unified diff (before, after) = fst $ iter g $ fmap (unifiedPatch &&& range) diff where - mapped = fmap (unifiedPatch &&& range) diff g (Annotated (_, info) syntax) = annotationAndSyntaxToChunks after info syntax annotationAndSyntaxToChunks source (Info range _) (Leaf _) = (pure . chunk . toList $ slice range source, Just range) annotationAndSyntaxToChunks source (Info range _) (Indexed i) = (unifiedRange range i source, Just range) From b4f6318e22b1b65efe138b1b1185c5bd433f4274 Mon Sep 17 00:00:00 2001 From: Matt Diephouse Date: Thu, 21 Jan 2016 14:58:42 -0500 Subject: [PATCH 10/13] Cleanup --- src/Unified.hs | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/src/Unified.hs b/src/Unified.hs index c7890f1c5..a721d9583 100644 --- a/src/Unified.hs +++ b/src/Unified.hs @@ -16,28 +16,31 @@ import Rainbow -- | Render a diff with the unified format. unified :: Renderer a [Chunk String] -unified diff (before, after) = fst $ iter g $ fmap (unifiedPatch &&& range) diff +unified diff (before, after) = fst $ iter g mapped where + mapped = fmap (unifiedPatch &&& range) diff + toChunk = chunk . toList g (Annotated (_, info) syntax) = annotationAndSyntaxToChunks after info syntax - annotationAndSyntaxToChunks source (Info range _) (Leaf _) = (pure . chunk . toList $ slice range source, Just range) + annotationAndSyntaxToChunks source (Info range _) (Leaf _) = ([ toChunk $ slice range source ], Just range) annotationAndSyntaxToChunks source (Info range _) (Indexed i) = (unifiedRange range i source, Just range) annotationAndSyntaxToChunks source (Info range _) (Fixed f) = (unifiedRange range f source, Just range) annotationAndSyntaxToChunks source (Info range _) (Keyed k) = (unifiedRange range (sort $ snd <$> Map.toList k) source, Just range) unifiedPatch :: Patch (Term a Info) -> [Chunk String] - unifiedPatch patch = (fore red . bold <$> beforeChunk) <> (fore green . bold <$> afterChunk) + unifiedPatch patch = (fore red . bold <$> beforeChunks) <> (fore green . bold <$> afterChunks) where - beforeChunk = maybe [] (change "-" . unifiedTerm before) $ Patch.before patch - afterChunk = maybe [] (change "+" . unifiedTerm after) $ Patch.after patch + beforeChunks = maybe [] (change "-" . unifiedTerm before) $ Patch.before patch + afterChunks = maybe [] (change "+" . unifiedTerm after) $ Patch.after patch unifiedTerm :: Source Char -> Term a Info -> [Chunk String] unifiedTerm source term = fst $ cata (annotationAndSyntaxToChunks source) term unifiedRange :: Range -> [([Chunk String], Maybe Range)] -> Source Char -> [Chunk String] - unifiedRange range children source = out <> (pure . chunk . toList $ slice Range { start = previous, end = end range } source) where - (out, previous) = foldl' accumulateContext ([], start range) children - accumulateContext (out, previous) (child, Just range) = (mconcat [ out, pure . chunk . toList $ slice Range { start = previous, end = start range } source, child ], end range) - accumulateContext (out, previous) (child, _) = (out <> child, previous) + unifiedRange range children source = out <> [ toChunk $ slice Range { start = previous, end = end range } source ] + where + (out, previous) = foldl' accumulateContext ([], start range) children + accumulateContext (out, previous) (child, Just range) = (out <> [ toChunk $ slice Range { start = previous, end = start range } source ] <> child, end range) + accumulateContext (out, previous) (child, _) = (out <> child, previous) range :: Patch (Term a Info) -> Maybe Range range patch = range . extract <$> after patch where From 0671d465906a89f0bfc898ba02faa68f5616f277 Mon Sep 17 00:00:00 2001 From: Matt Diephouse Date: Fri, 22 Jan 2016 10:27:00 -0500 Subject: [PATCH 11/13] Fix off-by-one error --- app/Parsers.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/Parsers.hs b/app/Parsers.hs index 3347b4c1b..9ef47ed6a 100644 --- a/app/Parsers.hs +++ b/app/Parsers.hs @@ -22,5 +22,5 @@ lineByLineParser input = return . root . Indexed $ case foldl' annotateLeaves ([ leaf charIndex line = Info (Range charIndex $ charIndex + T.length line) mempty :< Leaf line annotateLeaves (accum, charIndex) line = (accum ++ [ leaf charIndex (toText line) ] - , charIndex + length line + 1) + , charIndex + length line) toText = T.pack . Source.toString From 86c8bd9f2bfbd90d4b6b11fbfc486ff2dc5c13a8 Mon Sep 17 00:00:00 2001 From: Matt Diephouse Date: Wed, 27 Jan 2016 14:19:01 -0500 Subject: [PATCH 12/13] Don't sort these --- src/Unified.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Unified.hs b/src/Unified.hs index a721d9583..ca6b6eae9 100644 --- a/src/Unified.hs +++ b/src/Unified.hs @@ -24,7 +24,7 @@ unified diff (before, after) = fst $ iter g mapped annotationAndSyntaxToChunks source (Info range _) (Leaf _) = ([ toChunk $ slice range source ], Just range) annotationAndSyntaxToChunks source (Info range _) (Indexed i) = (unifiedRange range i source, Just range) annotationAndSyntaxToChunks source (Info range _) (Fixed f) = (unifiedRange range f source, Just range) - annotationAndSyntaxToChunks source (Info range _) (Keyed k) = (unifiedRange range (sort $ snd <$> Map.toList k) source, Just range) + annotationAndSyntaxToChunks source (Info range _) (Keyed k) = (unifiedRange range (snd <$> Map.toList k) source, Just range) unifiedPatch :: Patch (Term a Info) -> [Chunk String] unifiedPatch patch = (fore red . bold <$> beforeChunks) <> (fore green . bold <$> afterChunks) From f9dd0e0080cf44f8792ee840194fc37dbaf21f52 Mon Sep 17 00:00:00 2001 From: Matt Diephouse Date: Wed, 27 Jan 2016 17:38:46 -0500 Subject: [PATCH 13/13] Document Unified.hs --- src/Unified.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/Unified.hs b/src/Unified.hs index ca6b6eae9..7138e68d6 100644 --- a/src/Unified.hs +++ b/src/Unified.hs @@ -21,20 +21,25 @@ unified diff (before, after) = fst $ iter g mapped mapped = fmap (unifiedPatch &&& range) diff toChunk = chunk . toList g (Annotated (_, info) syntax) = annotationAndSyntaxToChunks after info syntax + -- | Render an annotation and syntax into a list of chunks. annotationAndSyntaxToChunks source (Info range _) (Leaf _) = ([ toChunk $ slice range source ], Just range) annotationAndSyntaxToChunks source (Info range _) (Indexed i) = (unifiedRange range i source, Just range) annotationAndSyntaxToChunks source (Info range _) (Fixed f) = (unifiedRange range f source, Just range) annotationAndSyntaxToChunks source (Info range _) (Keyed k) = (unifiedRange range (snd <$> Map.toList k) source, Just range) + -- | Render a Patch into a list of chunks. unifiedPatch :: Patch (Term a Info) -> [Chunk String] unifiedPatch patch = (fore red . bold <$> beforeChunks) <> (fore green . bold <$> afterChunks) where beforeChunks = maybe [] (change "-" . unifiedTerm before) $ Patch.before patch afterChunks = maybe [] (change "+" . unifiedTerm after) $ Patch.after patch + -- | Render the contents of a Term as a series of chunks. unifiedTerm :: Source Char -> Term a Info -> [Chunk String] unifiedTerm source term = fst $ cata (annotationAndSyntaxToChunks source) term + -- | Given a range and a list of pairs of chunks and a range, render the + -- | entire range from the source as a single list of chunks. unifiedRange :: Range -> [([Chunk String], Maybe Range)] -> Source Char -> [Chunk String] unifiedRange range children source = out <> [ toChunk $ slice Range { start = previous, end = end range } source ] where @@ -42,10 +47,12 @@ unified diff (before, after) = fst $ iter g mapped accumulateContext (out, previous) (child, Just range) = (out <> [ toChunk $ slice Range { start = previous, end = start range } source ] <> child, end range) accumulateContext (out, previous) (child, _) = (out <> child, previous) +-- | Return the range of the after side of the patch, or Nothing if it's not a replacement. range :: Patch (Term a Info) -> Maybe Range range patch = range . extract <$> after patch where extract (annotation :< _) = annotation range (Info range _) = range +-- | Add chunks to the beginning and end of the list with curly braces and the given string. change :: String -> [Chunk String] -> [Chunk String] change bound content = [ chunk "{", chunk bound ] ++ content ++ [ chunk bound, chunk "}" ]