Merge remote-tracking branch 'origin/master' into git-diff

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

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
 

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

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

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

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
+    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) = (mconcat [ out, pure . chunk . toList $ slice Range { start = previous, end = start range } source, child ], end range)
+        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 "}" ]