github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00
Code Issues Projects Releases Wiki Activity

Add a parameter indicating whether or not a line contains changes.

Browse Source
This commit is contained in:
Rob Rix 2015-12-16 22:54:01 -05:00
parent 3bfdbea671
commit c91b61552f
1 changed files with 27 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
src/Split.hs
View File

@ -70,12 +70,12 @@ split diff before after = return . renderHtml
numberRows :: [(Int, Line, Int, Line)] -> Row -> [(Int, Line, Int, Line)]
numberRows [] (Row EmptyLine EmptyLine) = []
numberRows [] (Row left@(Line _) EmptyLine) = [(1, left, 0, EmptyLine)]
numberRows [] (Row EmptyLine right@(Line _)) = [(0, EmptyLine, 1, right)]
numberRows [] (Row left@(Line _ _) EmptyLine) = [(1, left, 0, EmptyLine)]
numberRows [] (Row EmptyLine right@(Line _ _)) = [(0, EmptyLine, 1, right)]
numberRows [] (Row left right) = [(1, left, 1, right)]
numberRows rows@((leftCount, _, rightCount, _):_) (Row EmptyLine EmptyLine) = (leftCount, EmptyLine, rightCount, EmptyLine):rows
numberRows rows@((leftCount, _, rightCount, _):_) (Row left@(Line _) EmptyLine) = (leftCount + 1, left, rightCount, EmptyLine):rows
numberRows rows@((leftCount, _, rightCount, _):_) (Row EmptyLine right@(Line _)) = (leftCount, EmptyLine, rightCount + 1, right):rows
numberRows rows@((leftCount, _, rightCount, _):_) (Row left@(Line _ _) EmptyLine) = (leftCount + 1, left, rightCount, EmptyLine):rows
numberRows rows@((leftCount, _, rightCount, _):_) (Row EmptyLine right@(Line _ _)) = (leftCount, EmptyLine, rightCount + 1, right):rows
numberRows rows@((leftCount, _, rightCount, _):_) (Row left right) = (leftCount + 1, left, rightCount + 1, right):rows
@ -98,36 +98,37 @@ numberTd :: String -> Html
numberTd "" = td mempty ! A.class_ (stringValue "blob-num blob-num-empty empty-cell")
numberTd s = td (string s) ! A.class_ (stringValue "blob-num")
codeTd :: Maybe Html -> Html
codeTd Nothing = td mempty ! A.class_ (stringValue "blob-code blob-code-empty empty-cell")
codeTd (Just el) = td el ! A.class_ (stringValue "blob-code")
codeTd :: Bool -> Maybe Html -> Html
codeTd _ Nothing = td mempty ! A.class_ (stringValue "blob-code blob-code-empty empty-cell")
codeTd _ (Just el) = td el ! A.class_ (stringValue "blob-code")
instance ToMarkup Line where
toMarkup EmptyLine = codeTd Nothing
toMarkup (Line html) = codeTd . Just . mconcat $ toMarkup <$> html
data LineChange = None | Inserted | Deleted | Replaced
deriving (Eq, Show)
toMarkup EmptyLine = codeTd False Nothing
toMarkup (Line changed html) = codeTd changed . Just . mconcat $ toMarkup <$> html
data Line =
Line [HTML]
Line Bool [HTML]
| EmptyLine
deriving Eq
unLine :: Line -> [HTML]
unLine EmptyLine = []
unLine (Line htmls) = htmls
unLine (Line _ htmls) = htmls
isChanged :: Line -> Bool
isChanged EmptyLine = False
isChanged (Line isChanged _) = isChanged
instance Show Line where
show (Line elements) = "[" ++ (concat . intersperse ", " $ show <$> elements) ++ "]"
show (Line change elements) = show change ++ " [" ++ (concat . intersperse ", " $ show <$> elements) ++ "]"
show EmptyLine = "EmptyLine"
instance Monoid Line where
mempty = EmptyLine
mappend EmptyLine EmptyLine = EmptyLine
mappend EmptyLine (Line ys) = Line ys
mappend (Line xs) EmptyLine = Line xs
mappend (Line xs) (Line ys) = Line (xs <> ys)
mappend EmptyLine (Line c ys) = Line c ys
mappend (Line c xs) EmptyLine = Line c xs
mappend (Line c1 xs) (Line c2 ys) = Line (c1 || c2) (xs <> ys)
instance Monoid Row where
mempty = Row EmptyLine EmptyLine
@ -138,19 +139,19 @@ diffToRows (Free annotated) _ before after = annotatedToRows annotated before af
diffToRows (Pure (Insert term)) (previousIndex, _) _ after = (rowWithInsertedLine <$> afterLines, (Range previousIndex previousIndex, range))
where
(afterLines, range) = termToLines term after
rowWithInsertedLine (Line elements) = Row EmptyLine $ Line [ Div (Just "insert") elements ]
rowWithInsertedLine (Line _ elements) = Row EmptyLine $ Line True [ Div (Just "insert") elements ]
rowWithInsertedLine EmptyLine = mempty
diffToRows (Pure (Delete term)) (_, previousIndex) before _ = (rowWithDeletedLine <$> lines, (range, Range previousIndex previousIndex))
where
(lines, range) = termToLines term before
rowWithDeletedLine (Line elements) = Row (Line [ Div (Just "delete") elements ]) EmptyLine
rowWithDeletedLine (Line _ elements) = Row (Line True [ Div (Just "delete") elements ]) EmptyLine
rowWithDeletedLine EmptyLine = mempty
diffToRows (Pure (Replace a b)) _ before after = (replacedRows, (leftRange, rightRange))
where
replacedRows = zipWithMaybe rowFromMaybeRows (replace <$> leftElements) (replace <$> rightElements)
replace = (:[]) . Div (Just "replace") . unLine
rowFromMaybeRows :: Maybe [HTML] -> Maybe [HTML] -> Row
rowFromMaybeRows a b = Row (maybe EmptyLine Line a) (maybe EmptyLine Line b)
rowFromMaybeRows a b = Row (maybe EmptyLine (Line True) a) (maybe EmptyLine (Line True) b)
(leftElements, leftRange) = termToLines a before
(rightElements, rightRange) = termToLines b after
@ -159,14 +160,14 @@ diffToRows (Pure (Replace a b)) _ before after = (replacedRows, (leftRange, righ
termToLines :: Term a Info -> String -> ([Line], Range)
termToLines (Info range categories :< syntax) source = (rows syntax, range)
where
rows (Leaf _) = reverse $ foldl adjoin2Lines [] $ Line . (:[]) <$> elements
rows (Leaf _) = reverse $ foldl adjoin2Lines [] $ Line True . (:[]) <$> elements
rows (Indexed i) = rewrapLineContentsIn Ul <$> childLines i
rows (Fixed f) = rewrapLineContentsIn Ul <$> childLines f
rows (Keyed k) = rewrapLineContentsIn Dl <$> childLines k
rewrapLineContentsIn f (Line elements) = Line [ f (classify categories) elements ]
rewrapLineContentsIn f (Line _ elements) = Line True [ f (classify categories) elements ]
rewrapLineContentsIn _ EmptyLine = EmptyLine
lineElements r s = Line . (:[]) <$> textElements r s
lineElements r s = Line True . (:[]) <$> textElements r s
childLines i = appendRemainder $ foldl sumLines ([], start range) i
appendRemainder (lines, previous) = reverse . foldl adjoin2Lines [] $ lines ++ lineElements (Range previous (end range)) source
sumLines (lines, previous) child = (allLines, end childRange)
@ -190,7 +191,7 @@ annotatedToRows (Annotated (Info left leftCategories, Info right rightCategories
rightElements = (elementAndBreak $ Span (classify rightCategories)) =<< actualLines (substring right after)
wrap _ EmptyLine = EmptyLine
wrap f (Line elements) = Line [ f elements ]
wrap f (Line c elements) = Line c [ f elements ]
rewrapRowContentsIn f (Row left right) = Row (wrap (f $ classify leftCategories) left) (wrap (f $ classify rightCategories) right)
ranges = (left, right)
sources = (before, after)
@ -225,7 +226,7 @@ ends :: (Range, Range) -> (Int, Int)
ends (left, right) = (end left, end right)
rowFromMaybeRows :: Maybe HTML -> Maybe HTML -> Row
rowFromMaybeRows a b = Row (maybe EmptyLine (Line . (:[])) a) (maybe EmptyLine (Line . (:[])) b)
rowFromMaybeRows a b = Row (maybe EmptyLine (Line False . (:[])) a) (maybe EmptyLine (Line False . (:[])) b)
maybeLast :: [a] -> Maybe a
maybeLast list = listToMaybe $ reverse list