Experimental changes to Vervis.
Clone
HTTPS:
darcs clone https://vervis.peers.community/repos/KrXYo
SSH:
darcs clone USERNAME@vervis.peers.community:KrXYo
Tags
TODO
Repo.hs
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | {- This file is part of Vervis.
-
- Written in 2016, 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/>.
-}
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.Patch (Hunk (..))
import Vervis.Settings (widgetFile, appDiffContextLines)
import Vervis.Style
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 1 $ 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")
|