forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Display commit diff for Git repos

Browse source
This commit is contained in:
fr33domlover 2018-05-21 20:32:34 +00:00
parent dbec638415
commit 9f77ea69cb
9 changed files with 201 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
config/settings-default.yaml
View file

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

17
src/Vervis/Git.hs
View file

@ -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, _) :| _, _):_, _) = n
line ([] , [] , (n, _):_) = n
line ((n, _):_, _ , _) = (True, n)
line ([] , ((n, _) :| _, _):_, _) = (False, 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

1
src/Vervis/Handler/Repo/Git.hs
View file

@ -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")

3
src/Vervis/Patch.hs
View file

@ -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

3
src/Vervis/Settings.hs
View file

@ -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"

96
src/Vervis/Widget/Repo.hs
View file

@ -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")

52
templates/repo/patch.hamlet
View file

@ -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

37
templates/repo/widget/inline-diff.hamlet Normal file
View file

@ -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>…

1
vervis.cabal
View file

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