diff --git a/app/DiffOutput.hs b/app/DiffOutput.hs index baf5a98b7..e13020bc3 100644 --- a/app/DiffOutput.hs +++ b/app/DiffOutput.hs @@ -19,6 +19,7 @@ import qualified Data.Text.Lazy.IO as TextIO import qualified PatchOutput import Interpreter import qualified Parsers as P +import Rainbow -- | The available types of diff rendering. data Format = Unified | Split | Patch @@ -51,9 +52,10 @@ readAndTranscodeFile path = do printDiff :: DiffArguments -> (Source Char, Source Char) -> (Term T.Text Info, Term T.Text Info) -> IO () printDiff arguments (aSource, bSource) (aTerm, bTerm) = case format arguments of - Unified -> do - rendered <- unified diff (aSource, bSource) - B1.putStr rendered + Unified -> put $ unified diff (aSource, bSource) + where put chunks = do + renderer <- byteStringMakerFromEnvironment + B1.putStr $ mconcat $ chunksToByteStrings renderer chunks Split -> do rendered <- split diff (aSource, bSource) case output arguments of diff --git a/app/Parsers.hs b/app/Parsers.hs index 7a178dd76..5b12d111a 100644 --- a/app/Parsers.hs +++ b/app/Parsers.hs @@ -22,6 +22,6 @@ 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 diff --git a/semantic-diff.cabal b/semantic-diff.cabal index abf54974e..026d7233a 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 @@ -106,6 +107,7 @@ executable semantic-diff , text-icu , gitlib , gitlib-libgit2 + , rainbow , tagged , mtl default-language: Haskell2010 diff --git a/src/Interpreter.hs b/src/Interpreter.hs index d77e2b080..686aae982 100644 --- a/src/Interpreter.hs +++ b/src/Interpreter.hs @@ -21,13 +21,15 @@ import Data.Maybe -- | Returns whether two terms are comparable type Comparable a annotation = Term a annotation -> Term a annotation -> Bool --- | Diff two terms. +-- | Diff two terms, given the default Categorizable.comparable function. diffTerms :: (Eq a, Eq annotation, Categorizable annotation) => Term a annotation -> Term a annotation -> Diff a annotation diffTerms = interpret comparable +-- | 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 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 diff --git a/src/Unified.hs b/src/Unified.hs index 104b6b9a6..7138e68d6 100644 --- a/src/Unified.hs +++ b/src/Unified.hs @@ -14,36 +14,45 @@ 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 +-- | Render a diff with the unified format. +unified :: Renderer a [Chunk String] +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) + -- | 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 (sort $ snd <$> Map.toList k) 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 <$> 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 <$> 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 <> (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) +-- | 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 "}" ]