Display commit diff for Git repos
This commit is contained in:
parent
dbec638415
commit
9f77ea69cb
9 changed files with 201 additions and 12 deletions
|
@ -59,6 +59,7 @@ database:
|
|||
###############################################################################
|
||||
|
||||
repo-dir: repos
|
||||
diff-context-lines: 5
|
||||
|
||||
###############################################################################
|
||||
# SSH server
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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")
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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")
|
||||
|
|
|
@ -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
37
templates/repo/widget/inline-diff.hamlet
Normal 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>…
|
|
@ -306,6 +306,7 @@ library
|
|||
-- probably should be replaced with lenses once I learn
|
||||
, tuple
|
||||
, unordered-containers
|
||||
, vector
|
||||
, wai
|
||||
, wai-extra
|
||||
, wai-logger
|
||||
|
|
Loading…
Reference in a new issue