Merge pull request #451 from github/git-patch-modes

Improve git patch headers

.gitmodules

@@ -6,4 +6,4 @@
 	url = https://github.com/joshvera/text-icu
 [submodule "vendor/gitlib"]
 	path = vendor/gitlib
-	url = https://github.com/jwiegley/gitlib
+	url = https://github.com/joshvera/gitlib

app/DiffOutput.hs

@@ -19,7 +19,7 @@ data Format = Unified | Split | Patch
 data DiffArguments = DiffArguments { format :: Format, output :: Maybe FilePath, outputPath :: FilePath }
 
 -- | Return a renderer from the command-line arguments that will print the diff.
-printDiff :: Parser -> DiffArguments -> (Source Char, Source Char) -> IO ()
+printDiff :: Parser -> DiffArguments -> (SourceBlob, SourceBlob) -> IO ()
 printDiff parser arguments sources = case format arguments of
   Unified -> put =<< diffFiles parser unified sources
     where

app/Main.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE RecordWildCards #-}
  module Main where
 
+import Source
 import Data.Bifunctor.Join
 import Diffing
 import Options.Applicative
@@ -20,8 +21,11 @@ arguments = Arguments
 main :: IO ()
 main = do
   arguments <- execParser opts
-  sources <- sequence $ readAndTranscodeFile <$> Join (sourceA arguments, sourceB arguments)
-  DO.printDiff (parserForFilepath $ sourceA arguments) (args arguments) (runJoin sources)
+  let (sourceAPath, sourceBPath) = (sourceA arguments, sourceB arguments)
+  sources <- sequence $ readAndTranscodeFile <$> Join (sourceAPath, sourceBPath)
+  let srcs = runJoin sources
+  let sourceBlobs = (SourceBlob (fst srcs) mempty sourceAPath, SourceBlob (snd srcs) mempty sourceBPath)
+  DO.printDiff (parserForFilepath $ sourceA arguments) (args arguments) sourceBlobs
   where opts = info (helper <*> arguments)
           (fullDesc <> progDesc "Diff some things" <> header "semantic-diff - diff semantically")
         args Arguments{..} = DO.DiffArguments { format = format, output = output, outputPath = sourceA }

app/SemanticDiff.hs

@@ -6,6 +6,9 @@ import Source
 import Options.Applicative
 import qualified Data.ByteString.Char8 as B1
 import qualified Data.Text as T
+import Control.Monad
+import Control.Arrow
+import Data.Bifunctor
 import Data.Bifunctor.Join
 import Git.Libgit2
 import Git.Types
@@ -35,15 +38,17 @@ main = do
   arguments@Arguments{..} <- execParser opts
   let shas = Join (shaA, shaB)
   forM_ filepaths $ \filepath -> do
-    sources <- sequence $ fetchFromGitRepo gitDir filepath <$> shas
-    DO.printDiff (parserForFilepath filepath) (args arguments filepath) (runJoin sources)
+    sourcesAndOids <- sequence $ fetchFromGitRepo gitDir filepath <$> shas
+    let (sources, oids)= (Join . join bimap fst $ runJoin sourcesAndOids, join bimap snd $ runJoin sourcesAndOids)
+    let sourceBlobs = (SourceBlob (fst $ runJoin sources) (fst oids) filepath, SourceBlob (snd $ runJoin sources) (snd oids) filepath)
+    DO.printDiff (parserForFilepath filepath) (args arguments filepath) sourceBlobs
     where opts = info (helper <*> arguments)
             (fullDesc <> progDesc "Diff some things" <> header "semantic-diff - diff semantically")
           args Arguments{..} filepath = DO.DiffArguments { format = format, output = output, outputPath = filepath }
 
 -- | Returns a file source given an absolute repo path, a relative file path, and the sha to look up.
-fetchFromGitRepo :: FilePath -> FilePath -> String -> IO (Source Char)
-fetchFromGitRepo repoPath path sha = join $ withRepository lgFactory repoPath $ do
+fetchFromGitRepo :: FilePath -> FilePath -> String -> IO (Source Char, String)
+fetchFromGitRepo repoPath path sha = withRepository lgFactory repoPath $ do
     object <- unTagged <$> parseObjOid (T.pack sha)
     commitIHope <- lookupObject object
     commit <- case commitIHope of
@@ -51,10 +56,12 @@ fetchFromGitRepo repoPath path sha = join $ withRepository lgFactory repoPath $
       _ -> error "Expected commit SHA"
     tree <- lookupTree (commitTree commit)
     entry <- treeEntry tree (B1.pack path)
-    bytestring <- case entry of
-                 Nothing -> return mempty
-                 Just BlobEntry {..} -> do
-                   blob <- lookupBlob blobEntryOid
-                   let (BlobString s) = blobContents blob
-                   return s
-    return $ transcode bytestring
+    (bytestring, oid) <- case entry of
+                                  Nothing -> return (mempty, mempty)
+                                  Just BlobEntry {..} -> do
+                                    blob <- lookupBlob blobEntryOid
+                                    let (BlobString s) = blobContents blob
+                                    let oid = renderObjOid $ blobOid blob
+                                    return (s, oid)
+    s <- liftIO $ transcode bytestring
+    return (s, T.unpack oid)

src/Diffing.hs

@@ -12,6 +12,7 @@ import Term
 import TreeSitter
 
 import Control.Comonad.Cofree
+import Control.Arrow
 import Data.Bifunctor.Join
 import qualified Data.ByteString.Char8 as B1
 import Data.Foldable
@@ -68,8 +69,9 @@ readAndTranscodeFile path = do
 
 -- | Given a parser and renderer, diff two sources and return the rendered
 -- | result.
-diffFiles :: Parser -> Renderer T.Text b -> (Source Char, Source Char) -> IO b
-diffFiles parser renderer sources = do
-  terms <- sequence $ parser <$> Join sources
-  let replaceLeaves = breakDownLeavesByWord <$> Join sources
-  return $ renderer (uncurry diffTerms $ runJoin $ replaceLeaves <*> terms) sources
+diffFiles :: Parser -> Renderer T.Text b -> (SourceBlob, SourceBlob) -> IO b
+diffFiles parser renderer sourceBlobs = do
+  let sources = Join $ (source *** source) sourceBlobs
+  terms <- sequence $ parser <$> sources
+  let replaceLeaves = breakDownLeavesByWord <$> sources
+  return $ renderer (uncurry diffTerms $ runJoin $ replaceLeaves <*> terms) sourceBlobs

src/PatchOutput.hs

@@ -10,15 +10,16 @@ import Renderer
 import Row
 import Source hiding ((++), break)
 import Split
-import Control.Arrow
 import Control.Comonad.Cofree
 import Control.Monad.Free
 import Data.Maybe
 import Data.Monoid
+import Data.Bifunctor
+import Control.Monad
 
 -- | Render a diff in the traditional patch format.
 patch :: Renderer a String
-patch diff (sourceA, sourceB) = mconcat $ showHunk (sourceA, sourceB) <$> hunks diff (sourceA, sourceB)
+patch diff sources = mconcat $ showHunk sources <$> hunks diff sources
 
 -- | A hunk in a patch, including the offset, changes, and context.
 data Hunk a = Hunk { offset :: (Sum Int, Sum Int), changes :: [Change a], trailingContext :: [Row a] }
@@ -46,8 +47,9 @@ lineLength EmptyLine = 0
 lineLength _ = 1
 
 -- | Given the before and after sources, render a hunk to a string.
-showHunk :: (Source Char, Source Char) -> Hunk (SplitDiff a Info) -> String
-showHunk sources hunk = header hunk ++ concat (showChange sources <$> changes hunk) ++ showLines (snd sources) ' ' (unRight <$> trailingContext hunk)
+showHunk :: (SourceBlob, SourceBlob) -> Hunk (SplitDiff a Info) -> String
+showHunk blobs@(beforeBlob, afterBlob) hunk = header blobs hunk ++ concat (showChange sources <$> changes hunk) ++ showLines (snd sources) ' ' (unRight <$> trailingContext hunk)
+  where sources = (source beforeBlob, source afterBlob)
 
 -- | Given the before and after sources, render a change to a string.
 showChange :: (Source Char, Source Char) -> Change (SplitDiff a Info) -> String
@@ -69,16 +71,20 @@ getRange :: SplitDiff leaf Info -> Range
 getRange (Free (Annotated (Info range _) _)) = range
 getRange (Pure (Info range _ :< _)) = range
 
--- | Return the header for a hunk as a string.
-header :: Hunk a -> String
-header hunk = "@@ -" ++ show offsetA ++ "," ++ show lengthA ++ " +" ++ show offsetB ++ "," ++ show lengthB ++ " @@\n"
-  where (lengthA, lengthB) = getSum *** getSum $ hunkLength hunk
-        (offsetA, offsetB) = getSum *** getSum $ offset hunk
+-- | Returns the header given two source blobs and a hunk.
+header :: (SourceBlob, SourceBlob) -> Hunk a -> String
+header blobs hunk = "diff --git a/" ++ path (fst blobs) ++ " b/" ++ path (snd blobs) ++ "\n" ++
+  "index " ++ oid (fst blobs) ++ ".." ++ oid (snd blobs) ++ "\n" ++
+  "@@ -" ++ show offsetA ++ "," ++ show lengthA ++ " +" ++ show offsetB ++ "," ++ show lengthB ++ " @@\n"
+  where (lengthA, lengthB) = join bimap getSum $ hunkLength hunk
+        (offsetA, offsetB) = join bimap getSum $ offset hunk
 
 -- | Render a diff as a series of hunks.
 hunks :: Renderer a [Hunk (SplitDiff a Info)]
-hunks diff sources = hunksInRows (1, 1) . fst $ splitDiffByLines diff (0, 0) sources
-
+hunks diff (beforeBlob, afterBlob) = hunksInRows (1, 1) . fst $ splitDiffByLines diff (0, 0) (before, after)
+  where
+    before = source beforeBlob
+    after = source afterBlob
 -- | Given beginning line numbers, turn rows in a split diff into hunks in a
 -- | patch.
 hunksInRows :: (Sum Int, Sum Int) -> [Row (SplitDiff a Info)] -> [Hunk (SplitDiff a Info)]

src/Renderer.hs

@@ -4,4 +4,4 @@ import Diff
 import Source
 
 -- | A function that will render a diff, given the two source files.
-type Renderer a b = Diff a Info -> (Source Char, Source Char) -> b
+type Renderer a b = Diff a Info -> (SourceBlob, SourceBlob) -> b

src/Source.hs

@@ -4,6 +4,8 @@ import Range
 import qualified Data.Vector as Vector
 import qualified Data.Text as T
 
+data SourceBlob = SourceBlob { source :: Source Char, oid :: String, path :: FilePath }
+
 -- | The contents of a source file, backed by a vector for efficient slicing.
 newtype Source a = Source { getVector :: Vector.Vector a  }
   deriving (Eq, Show, Functor, Foldable, Traversable)

src/Split.hs

@@ -45,7 +45,7 @@ styleName category = "category-" ++ case category of
 
 -- | Render a diff as an HTML split diff.
 split :: Renderer leaf TL.Text
-split diff (before, after) = renderHtml
+split diff (beforeBlob, afterBlob) = renderHtml
   . docTypeHtml
     . ((head $ link ! A.rel "stylesheet" ! A.href "style.css") <>)
     . body
@@ -53,6 +53,8 @@ split diff (before, after) = renderHtml
         ((colgroup $ (col ! A.width (stringValue . show $ columnWidth)) <> col <> (col ! A.width (stringValue . show $ columnWidth)) <> col) <>)
         . mconcat $ numberedLinesToMarkup <$> reverse numbered
   where
+    before = Source.source beforeBlob
+    after = Source.source afterBlob
     rows = fst (splitDiffByLines diff (0, 0) (before, after))
     numbered = foldl' numberRows [] rows
     maxNumber = case numbered of

src/Unified.hs

@@ -16,11 +16,10 @@ import Rainbow
 
 -- | Render a diff with the unified format.
 unified :: Renderer a [Chunk String]
-unified diff (before, after) = fst $ iter g mapped
-  where
+unified diff (beforeBlob, afterBlob) = fst $ iter g mapped where
     mapped = fmap (unifiedPatch &&& range) diff
     toChunk = chunk . toList
-    g (Annotated (_, info) syntax) = annotationAndSyntaxToChunks after info syntax
+    g (Annotated (_, info) syntax) = annotationAndSyntaxToChunks (source afterBlob) 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)
@@ -29,10 +28,11 @@ unified diff (before, after) = fst $ iter g mapped
 
     -- | 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
+    unifiedPatch patch = (fore red . bold <$> beforeChunk) <> (fore green . bold <$> afterChunk) where
+      before = source beforeBlob
+      after = source afterBlob
+      beforeChunk = maybe [] (change "-" . unifiedTerm before) $ Patch.before patch
+      afterChunk = 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]

test/CorpusSpec.hs

@@ -6,6 +6,7 @@ import Renderer
 import Split
 import Unified
 
+import qualified Source as S
 import Control.DeepSeq
 import Data.Bifunctor.Join
 import qualified Data.ByteString.Char8 as B1
@@ -78,7 +79,9 @@ testDiff :: Renderer T.Text String -> FilePath -> FilePath -> Maybe FilePath ->
 testDiff renderer a b diff matcher = do
   let parser = parserForFilepath a
   sources <- sequence $ readAndTranscodeFile <$> Join (a, b)
-  actual <- diffFiles parser renderer (runJoin sources)
+  let srcs = runJoin sources
+  let sourceBlobs = (S.SourceBlob (fst srcs) mempty a, S.SourceBlob (snd srcs) mempty b)
+  actual <- diffFiles parser renderer sourceBlobs
   case diff of
     Nothing -> actual `deepseq` matcher (actual, actual)
     Just file -> do

test/PatchOutputSpec.hs

@@ -9,7 +9,7 @@ import Control.Monad.Free
 import Test.Hspec
 
 spec :: Spec
-spec = parallel $ do
-  describe "hunks" $ do
+spec = parallel $
+  describe "hunks" $
     it "empty diffs have no hunks" $
-      hunks (Free . Annotated (Info (Range 0 0) mempty, Info (Range 0 0) mempty) $ Leaf "") (fromList "", fromList "") `shouldBe` []
+      hunks (Free . Annotated (Info (Range 0 0) mempty, Info (Range 0 0) mempty) $ Leaf "") (SourceBlob (fromList "") "abcde" "path2.txt", SourceBlob (fromList "") "xyz" "path2.txt") `shouldBe` []

test/diffs/newline-at-eof.patch.js

@@ -1,3 +1,5 @@
+diff --git a/test/diffs/newline-at-eof.A.js b/test/diffs/newline-at-eof.B.js
+index ..
 @@ -1,2 +1,4 @@
  console.log("hello, world");
  

test/diffs/no-newline-at-eof.patch.js

@@ -1,3 +1,5 @@
+diff --git a/test/diffs/no-newline-at-eof.A.js b/test/diffs/no-newline-at-eof.B.js
+index ..
 @@ -1,1 +1,3 @@
  console.log("hello, world");
  

vendor/gitlib

@@ -1 +1 @@
-Subproject commit b0c3ad9a7d453fce30364b4a277799c5e2f26947
+Subproject commit 3b65d9f22ef4a1bc14c3b1d35d819ef9d29878b1