From 9f77ea69cb2cbee28b550cea6373c92b6b356530 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Mon, 21 May 2018 20:32:34 +0000 Subject: [PATCH] Display commit diff for Git repos --- config/settings-default.yaml | 3 +- src/Vervis/Git.hs | 17 +++-- src/Vervis/Handler/Repo/Git.hs | 1 + src/Vervis/Patch.hs | 3 +- src/Vervis/Settings.hs | 3 + src/Vervis/Widget/Repo.hs | 96 +++++++++++++++++++++++- templates/repo/patch.hamlet | 52 ++++++++++++- templates/repo/widget/inline-diff.hamlet | 37 +++++++++ vervis.cabal | 1 + 9 files changed, 201 insertions(+), 12 deletions(-) create mode 100644 templates/repo/widget/inline-diff.hamlet diff --git a/config/settings-default.yaml b/config/settings-default.yaml index 24fda87..84d9416 100644 --- a/config/settings-default.yaml +++ b/config/settings-default.yaml @@ -58,7 +58,8 @@ database: # Version control repositories ############################################################################### -repo-dir: repos +repo-dir: repos +diff-context-lines: 5 ############################################################################### # SSH server diff --git a/src/Vervis/Git.hs b/src/Vervis/Git.hs index 4cd47ca..93521e9 100644 --- a/src/Vervis/Git.hs +++ b/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, _) :| _, _):_, _) = 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 diff --git a/src/Vervis/Handler/Repo/Git.hs b/src/Vervis/Handler/Repo/Git.hs index c2440ea..da8f777 100644 --- a/src/Vervis/Handler/Repo/Git.hs +++ b/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") diff --git a/src/Vervis/Patch.hs b/src/Vervis/Patch.hs index e131d8e..adb725f 100644 --- a/src/Vervis/Patch.hs +++ b/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 diff --git a/src/Vervis/Settings.hs b/src/Vervis/Settings.hs index a523225..5fafd6a 100644 --- a/src/Vervis/Settings.hs +++ b/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" diff --git a/src/Vervis/Widget/Repo.hs b/src/Vervis/Widget/Repo.hs index 81868d9..20773f6 100644 --- a/src/Vervis/Widget/Repo.hs +++ b/src/Vervis/Widget/Repo.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016 by fr33domlover . + - Written in 2016, 2018 by fr33domlover . - - ♡ 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") diff --git a/templates/repo/patch.hamlet b/templates/repo/patch.hamlet index 1491262..ba19edf 100644 --- a/templates/repo/patch.hamlet +++ b/templates/repo/patch.hamlet @@ -32,7 +32,57 @@ $# .

#{patchDescription patch} $if null parents -

TODO display patch diff here +

    + $forall edit <- patchDiff patch +
  • + $case edit + $of AddTextFile path mode lines +

    Add file #{path} #{mode} + + $forall (n, t) <- number lines + +
    + + #{n} + #{t} + $of AddBinaryFile path mode size +

    Add binary file #{path} #{mode} #{size} + $of RemoveTextFile path mode lines +

    Remove file #{path} #{mode} + + $forall (n, t) <- number lines + +
    - + #{n} + #{t} + $of RemoveBinaryFile path mode size +

    Remove binary file #{path} #{mode} #{size} + $of MoveFile oldPath oldMode newPath newMode +

    Move file #{oldPath} #{oldMode} → #{newPath} #{newMode} + $of ChmodFile path old new +

    Change file mode #{path} #{old} → #{new} + $of EditTextFile path orig hunks oldMode newMode +

    Edit file #{path} #{oldMode} → #{newMode} + ^{inlineDiffW orig hunks} + $of EditBinaryFile path oldSize oldMode newSize newMode +

    + Edit binary file #{path} #{oldSize} #{oldMode} → + #{newSize} #{newMode} + $of TextToBinary path lines oldMode newSize newMode +

    Edit file #{path} #{oldMode} → #{newSize} #{newMode} + + $forall (n, t) <- number lines + +
    - + #{n} + #{t} + $of BinaryToText path oldSize oldMode lines newMode +

    Edit file #{path} #{oldMode} #{oldSize} → #{newMode} + + $forall (n, t) <- number lines + +
    + + #{n} + #{t} $else

    This commit has multiple parents, and to be honest, I'm unsure how exactly diff --git a/templates/repo/widget/inline-diff.hamlet b/templates/repo/widget/inline-diff.hamlet new file mode 100644 index 0000000..c946969 --- /dev/null +++ b/templates/repo/widget/inline-diff.hamlet @@ -0,0 +1,37 @@ +$# This file is part of Vervis. +$# +$# Written in 2018 by fr33domlover . +$# +$# ♡ 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 +$# . + + + $forall lines <- diffs + $forall (ln, t) <- lines + + $case ln + $of Old n + +
    - + #{n} + + $of New n + + + + #{n} + $of Both o n + + #{o} + #{n} + #{t} +
    … + … + … + … diff --git a/vervis.cabal b/vervis.cabal index 318f0c6..30d0858 100644 --- a/vervis.cabal +++ b/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