Display commit diff for Git repos

config/settings-default.yaml

@@ -58,7 +58,8 @@ database:
 # Version control repositories
 ###############################################################################
 
-repo-dir:     repos
+repo-dir:           repos
+diff-context-lines: 5
 
 ###############################################################################
 # SSH server

src/Vervis/Git.hs

@@ -23,7 +23,7 @@ where
 
 import Prelude
 
-import Control.Arrow ((&&&), (***))
+import Control.Arrow ((***))
 import Data.Algorithm.Patience (diff, Item (..))
 import Data.Byteable (toBytes)
 import Data.Foldable (find)
@@ -59,6 +59,7 @@ import qualified Data.Set as S (member, mapMonotonic)
 import qualified Data.Text as T (pack, unpack, break, strip)
 import qualified Data.Text.Encoding as TE (decodeUtf8With)
 import qualified Data.Text.Encoding.Error as TE (lenientDecode)
+import qualified Data.Vector as V (fromList)
 
 import Data.ByteString.Char8.Local (takeLine)
 import Data.EventTime.Local
@@ -216,7 +217,7 @@ ep2fp = T.unpack . decodeUtf8 . B.intercalate "/" . map toBytes
 unModePerm :: ModePerm -> Word32
 unModePerm (ModePerm w) = w
 
-mkdiff :: [Text] -> [Text] -> [(Int, Hunk)]
+mkdiff :: [Text] -> [Text] -> [(Bool, Int, Hunk)]
 mkdiff old new =
     let eitherOldNew (Old a)    = Just $ Left a
         eitherOldNew (New a)    = Just $ Right a
@@ -227,11 +228,13 @@ mkdiff old new =
             , hunkRemoveAdd  = map (stripLineNumber *** stripLineNumber) pairs
             , hunkRemoveLast = stripLineNumber rems
             }
-        line ((n, _):_, _                 , _)        = n
+        line ((n, _):_, _                 , _)        = (True, n)
-        line ([]      , ((n, _) :| _, _):_, _)        = n
+        line ([]      , ((n, _) :| _, _):_, _)        = (False, n)
-        line ([]      , []                , (n, _):_) = n
+        line ([]      , []                , (n, _):_) = (False, n)
         line ([]      , []                , [])       = error "empty hunk"
-        mkhunk = line &&& mkhunk'
+        mkhunk h =
+            let (n, l) = line h
+            in  (n, l, mkhunk' h)
     in  map (mkhunk . groupEithers . N.toList) $
         groupJusts $
         map eitherOldNew $
@@ -256,7 +259,7 @@ accumEdits (OldAndNew old new) es =
                         (FileContent ols, FileContent nls) ->
                             case mkdiff (map (decodeUtf8 . BL.toStrict) ols) (map (decodeUtf8 . BL.toStrict) nls) of
                                 [] -> error "file ref changed, diff is empty?"
-                                h:hs -> EditTextFile (ep2fp $ bsFilename new) (h :| hs) (unModePerm $ bsMode old) (unModePerm $ bsMode new) : es
+                                h:hs -> EditTextFile (ep2fp $ bsFilename new) (V.fromList $ map (decodeUtf8 . BL.toStrict) ols) (h :| hs) (unModePerm $ bsMode old) (unModePerm $ bsMode new) : es
                         (BinaryContent b, FileContent nls) -> BinaryToText (ep2fp $ bsFilename new) (BL.length b) (unModePerm $ bsMode old) (map (decodeUtf8 . BL.toStrict) nls) (unModePerm $ bsMode new) : es
                         (FileContent ols, BinaryContent b) -> TextToBinary (ep2fp $ bsFilename new) (map (decodeUtf8 . BL.toStrict) ols) (unModePerm $ bsMode old) (BL.length b) (unModePerm $ bsMode new) : es
                         (BinaryContent from, BinaryContent to) -> EditBinaryFile (ep2fp $ bsFilename new) (BL.length from) (unModePerm $ bsMode old) (BL.length to) (unModePerm $ bsMode new) : es

src/Vervis/Handler/Repo/Git.hs

@@ -122,4 +122,5 @@ getGitPatch shr rp ref = do
     msharer <- runDB $ do
         mp <- getBy $ UniquePersonEmail $ patchAuthorEmail patch
         for mp $ \ (Entity _ person) -> get404 $ personIdent person
+    let number = zip ([1..] :: [Int])
     defaultLayout $(widgetFile "repo/patch")

src/Vervis/Patch.hs

@@ -32,6 +32,7 @@ import Data.List.NonEmpty (NonEmpty)
 import Data.Text (Text)
 import Data.Time.Clock (UTCTime)
 import Data.Word (Word32)
+import Data.Vector (Vector)
 import Text.Email.Validate (EmailAddress)
 
 data Hunk = Hunk
@@ -47,7 +48,7 @@ data Edit
     | RemoveBinaryFile FilePath Word32 Int64
     | MoveFile FilePath Word32 FilePath Word32
     | ChmodFile FilePath Word32 Word32
-    | EditTextFile FilePath (NonEmpty (Int, Hunk)) Word32 Word32
+    | EditTextFile FilePath (Vector Text) (NonEmpty (Bool, Int, Hunk)) Word32 Word32
     | EditBinaryFile FilePath Int64 Word32 Int64 Word32
     | TextToBinary FilePath [Text] Word32 Int64 Word32
     | BinaryToText FilePath Int64 Word32 [Text] Word32

src/Vervis/Settings.hs

@@ -72,6 +72,8 @@ data AppSettings = AppSettings
 
       -- | Path to the directory under which git repos are placed
     , appRepoDir                :: FilePath
+      -- | Number of context lines to display around changes in commit diff
+    , appDiffContextLines       :: Int
       -- | Port for the SSH server component to listen on
     , appSshPort                :: Int
       -- | Path to the server's SSH private key file
@@ -107,6 +109,7 @@ instance FromJSON AppSettings where
         appSkipCombining          <- o .:? "skip-combining"   .!= defaultDev
 
         appRepoDir                <- o .: "repo-dir"
+        appDiffContextLines       <- o .: "diff-context-lines"
         appSshPort                <- o .: "ssh-port"
         appSshKeyFile             <- o .: "ssh-key-file"
         appRegister               <- o .: "registration"

src/Vervis/Widget/Repo.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -16,23 +16,115 @@
 module Vervis.Widget.Repo
     ( refSelectW
     , changesW
+    , inlineDiffW
     )
 where
 
 import Prelude
 
+import Data.Foldable (foldl')
+import Data.List.NonEmpty (NonEmpty)
 import Data.Set (Set)
 import Data.Text (Text)
+import Data.Vector (Vector)
+import Yesod.Core.Handler (getsYesod)
 
+import qualified Data.List.NonEmpty as N
 import qualified Data.Text as T (take)
+import qualified Data.Vector as V
 
 import Vervis.Changes
 import Vervis.Foundation
 import Vervis.Model.Ident
-import Vervis.Settings (widgetFile)
+import Vervis.Patch (Hunk (..))
+import Vervis.Settings (widgetFile, appDiffContextLines)
 
 refSelectW :: ShrIdent -> RpIdent -> Set Text -> Set Text -> Widget
 refSelectW shar repo branches tags = $(widgetFile "repo/widget/ref-select")
 
 changesW :: Foldable f => ShrIdent -> RpIdent -> f LogEntry -> Widget
 changesW shr rp entries = $(widgetFile "repo/widget/changes")
+
+numberHunk :: Int -> Int -> Hunk -> (Int, Int, [(Bool, Int, Text)])
+numberHunk startOld startNew hunk = j $ i ((startOld, startNew), []) hunk
+    where
+    f add n line = (add, n, line)
+    g add ((o, n), l) lines =
+        ( if add
+            then (o               , n + length lines)
+            else (o + length lines, n)
+        , zipWith (f add) (if add then [n..] else [o..]) lines : l
+        )
+    h s (rems, adds) = g True (g False s $ N.toList rems) $ N.toList adds
+    i s (Hunk adds pairs rems) =
+        g False (foldl' h (g True s adds) pairs) rems
+    j ((o, n), l) = (o - 1, n - 1, concat $ reverse l)
+
+hunkLines
+    :: NonEmpty (Bool, Int, Hunk)
+    -- ^ Whether the line number is for new file; line number; text lines
+    -> NonEmpty (Int, Int, Int, Int, [(Bool, Int, Text)])
+    -- ^ First line numbers in old and new; last line numbers in old and new;
+    -- whether the line is added (otherwise removed); line number (in new if
+    -- added, in old if removed); line content text
+hunkLines = N.fromList . reverse . foldl' f []
+    where
+    f [] (_, ln, hunk) =
+        let (o, n, lines) = numberHunk ln ln hunk
+        in  [(ln, ln, o, n, lines)]
+    f l@((_, _, o, n, _) : _) (new, ln, hunk) =
+        let (oln, nln) =
+                if new
+                    then (ln - n + o, ln)
+                    else (ln        , ln + n - o)
+            (o', n', lines) = numberHunk oln nln hunk
+        in  (oln, nln, o', n', lines) : l
+
+data LineNumber = Old Int | Both Int Int | New Int
+
+diffLine :: (Bool, Int, Text) -> (LineNumber, Text)
+diffLine (True, n, t) = (New n, t)
+diffLine (False, n, t) = (Old n, t)
+
+context :: Vector Text -> Int -> Int -> Int -> [(LineNumber, Text)]
+context orig startOld startNew len =
+    let n = V.length orig
+        number i j t = (Both i j, t)
+        len' = min len $ n - startOld + 1
+    in  if startOld > n
+            then []
+            else zipWith3 number [startOld..] [startNew..] $
+                    V.toList $ V.slice (startOld - 1) len' orig
+
+addContext
+    :: Int
+    -> Vector Text
+    -> NonEmpty (Int, Int, Int, Int, [(Bool, Int, Text)])
+    -> [[(LineNumber, Text)]]
+addContext ctx orig = prepend . foldr f (undefined, [])
+    where
+    f (startOld, startNew, endOld, endNew, lines) (_, []) =
+        ( (startOld, startNew)
+        , [map diffLine lines ++ context orig (endOld + 1) (endNew + 1) ctx]
+        )
+    f (startOld, startNew, endOld, endNew, lines) ((o, n), l:ls) =
+        ( (startOld, startNew)
+        , let len = o - endOld - 1
+              ds = map diffLine lines
+              ctxCurr = context orig (endOld + 1) (endNew + 1)
+              ctxNext = context orig (o - ctx) (n - ctx) ctx
+          in  if len <= 2 * ctx
+                then (ds ++ ctxCurr len ++ l) : ls
+                else (ds ++ ctxCurr ctx)      : (ctxNext ++ l) : ls
+        )
+    prepend ((_       , _       ), [])   = []
+    prepend ((startOld, startNew), l:ls) =
+        let o = max 0 $ startOld - ctx
+            len = min (startOld - o) ctx
+        in  (context orig o (startNew - len) len ++ l) : ls
+
+inlineDiffW :: Vector Text -> NonEmpty (Bool, Int, Hunk) -> Widget
+inlineDiffW orig hunks = do
+    ctx <- getsYesod $ appDiffContextLines . appSettings
+    let diffs = addContext ctx orig $ hunkLines hunks
+    $(widgetFile "repo/widget/inline-diff")

templates/repo/patch.hamlet

@@ -32,7 +32,57 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
       <p>#{patchDescription patch}
 
 $if null parents
-  <p>TODO display patch diff here
+  <ul>
+    $forall edit <- patchDiff patch
+      <li>
+        $case edit
+          $of AddTextFile path mode lines
+            <p>Add file #{path} #{mode}
+            <table>
+              $forall (n, t) <- number lines
+                <tr>
+                  <td>+
+                  <td>#{n}
+                  <td>#{t}
+          $of AddBinaryFile path mode size
+            <p>Add binary file #{path} #{mode} #{size}
+          $of RemoveTextFile path mode lines
+            <p>Remove file #{path} #{mode}
+            <table>
+              $forall (n, t) <- number lines
+                <tr>
+                  <td>-
+                  <td>#{n}
+                  <td>#{t}
+          $of RemoveBinaryFile path mode size
+            <p>Remove binary file #{path} #{mode} #{size}
+          $of MoveFile oldPath oldMode newPath newMode
+            <p>Move file #{oldPath} #{oldMode} → #{newPath} #{newMode}
+          $of ChmodFile path old new
+            <p>Change file mode #{path} #{old} → #{new}
+          $of EditTextFile path orig hunks oldMode newMode
+            <p>Edit file #{path} #{oldMode} → #{newMode}
+            ^{inlineDiffW orig hunks}
+          $of EditBinaryFile path oldSize oldMode newSize newMode
+            <p>
+              Edit binary file #{path} #{oldSize} #{oldMode} →
+              #{newSize} #{newMode}
+          $of TextToBinary path lines oldMode newSize newMode
+            <p>Edit file #{path} #{oldMode} → #{newSize} #{newMode}
+            <table>
+              $forall (n, t) <- number lines
+                <tr>
+                  <td>-
+                  <td>#{n}
+                  <td>#{t}
+          $of BinaryToText path oldSize oldMode lines newMode
+            <p>Edit file #{path} #{oldMode} #{oldSize} → #{newMode}
+            <table>
+              $forall (n, t) <- number lines
+                <tr>
+                  <td>+
+                  <td>#{n}
+                  <td>#{t}
 $else
   <p>
     This commit has multiple parents, and to be honest, I'm unsure how exactly

templates/repo/widget/inline-diff.hamlet

@@ -0,0 +1,37 @@
+$# This file is part of Vervis.
+$#
+$# Written in 2018 by fr33domlover <fr33domlover@riseup.net>.
+$#
+$# ♡ Copying is an act of love. Please copy, reuse and share.
+$#
+$# The author(s) have dedicated all copyright and related and neighboring
+$# rights to this software to the public domain worldwide. This software is
+$# distributed without any warranty.
+$#
+$# You should have received a copy of the CC0 Public Domain Dedication along
+$# with this software. If not, see
+$# <http://creativecommons.org/publicdomain/zero/1.0/>.
+
+<table>
+  $forall lines <- diffs
+    $forall (ln, t) <- lines
+      <tr>
+        $case ln
+          $of Old n
+            <td>-
+            <td>#{n}
+            <td>
+          $of New n
+            <td>+
+            <td>
+            <td>#{n}
+          $of Both o n
+            <td>
+            <td>#{o}
+            <td>#{n}
+        <td>#{t}
+    <tr>
+      <td>…
+      <td>…
+      <td>…
+      <td>…

vervis.cabal

@@ -306,6 +306,7 @@ library
                        -- probably should be replaced with lenses once I learn
                      , tuple
                      , unordered-containers
+                     , vector
                      , wai
                      , wai-extra
                      , wai-logger