Merge branch 'source-blobs' into git-patch-modes

app/DiffOutput.hs

@@ -51,6 +51,7 @@ readAndTranscodeFile path = do
   text <- B1.readFile path
   transcode text
 
+-- <<<<<<< HEAD
 -- | Return a renderer from the command-line arguments that will print the diff.
 printDiff :: DiffArguments -> Renderer T.Text (IO ())
 printDiff arguments diff sources = case format arguments of
@@ -63,6 +64,17 @@ printDiff arguments diff sources = case format arguments of
     where
       put Nothing rendered = TextIO.putStr rendered
       put (Just path) rendered = do
+-- =======
+-- printDiff :: DiffArguments -> (SourceBlob, SourceBlob) -> (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
+--   Split -> do
+--     rendered <- split diff (aSource, bSource)
+--     case output arguments of
+--       Just path -> do
+-- >>>>>>> source-blobs
         isDir <- doesDirectoryExist path
         let outputPath = if isDir
                          then path </> (takeFileName outputPath -<.> ".html")

app/Main.hs

@@ -2,6 +2,7 @@
  module Main where
 
 import Interpreter
+import Source
 import Options.Applicative
 import Data.Bifunctor.Join
 import qualified DiffOutput as DO
@@ -25,7 +26,8 @@ main = do
   let parse = DO.parserForFilepath sourceAPath
   terms <- sequence $ parse <$> sources
   let replaceLeaves = DO.breakDownLeavesByWord <$> sources
-  DO.printDiff (args arguments) (uncurry diffTerms $ runJoin $ replaceLeaves <*> terms) (runJoin sources)
+  let sourceBlobs = runJoin $ (\s -> SourceBlob s mempty) <$> sources
+  DO.printDiff (args arguments) (uncurry diffTerms . runJoin $ replaceLeaves <*> terms) 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,18 +38,20 @@ main = do
   arguments@Arguments{..} <- execParser opts
   let shas = Join (shaA, shaB)
   forM_ filepaths $ \filepath -> do
-    sources <- sequence $ fetchFromGitRepo gitDir filepath <$> shas
+    sourcesAndOids <- sequence $ fetchFromGitRepo gitDir filepath <$> shas
+    let (sources, oids)= (Join . join bimap fst $ runJoin sourcesAndOids, join bimap snd $ runJoin sourcesAndOids)
     let parse = DO.parserForFilepath filepath
     terms <- sequence $ parse <$> sources
     let replaceLeaves = DO.breakDownLeavesByWord <$> sources
-    DO.printDiff (args arguments filepath) (uncurry diffTerms $ runJoin $ replaceLeaves <*> terms) (runJoin sources)
+    let sourceBlobs = ((SourceBlob (fst $ runJoin sources) *** SourceBlob (snd $ runJoin sources)) oids)
+    DO.printDiff (args arguments filepath) (uncurry diffTerms . runJoin $ replaceLeaves <*> terms) 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
@@ -54,10 +59,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 $ DO.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 $ DO.transcode bytestring
+    return (s, T.unpack oid)

src/PatchOutput.hs

@@ -14,12 +14,12 @@ import Control.Comonad.Cofree
 import Control.Monad.Free
 import Data.Maybe
 import Data.Monoid
-import Control.Monad
 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,9 +46,9 @@ lineLength :: Line a -> Sum Int
 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
@@ -68,17 +68,19 @@ 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 = "diff --git a/path.txt b/path.txt\n" ++
+header :: (SourceBlob, SourceBlob) -> Hunk a -> String
+header blobs hunk = "diff --git a/path.txt b/path.txt\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

@@ -5,6 +5,8 @@ import Range
 import qualified Data.Vector as Vector
 import qualified Data.Text as T
 
+data SourceBlob = SourceBlob { source :: Source Char, oid :: String }
+
 -- | 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

@@ -35,7 +35,7 @@ classifyMarkup categories element = maybe element ((element !) . A.class_ . stri
 
 -- | 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
@@ -43,6 +43,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]