mirror of
https://github.com/github/semantic.git
synced 2024-11-28 10:15:55 +03:00
Merge remote-tracking branch 'origin/master' into fall-back-to-line-by-line-diffs
This commit is contained in:
joshvera
commit
984c4615c9
@ -1,3 +1,6 @@
|
||||
table {
|
||||
width: 100%;
|
||||
}
|
||||
table.diff td {
|
||||
width: 50%;
|
||||
height: 15px;
|
||||
|
||||
175
src/Split.hs
175
src/Split.hs
@ -5,22 +5,26 @@ import Diff
|
||||
import Patch
|
||||
import Term
|
||||
import Syntax
|
||||
import Control.Monad
|
||||
|
||||
import Control.Comonad.Cofree
|
||||
import Range
|
||||
import Control.Monad
|
||||
import Control.Monad.Free
|
||||
import Data.ByteString.Lazy.Internal
|
||||
import Text.Blaze.Html5
|
||||
import Text.Blaze.Html5 hiding (map)
|
||||
import qualified Text.Blaze.Html5.Attributes as A
|
||||
import Text.Blaze.Html.Renderer.Utf8
|
||||
import qualified Data.Maybe as Maybe
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
import qualified Data.Set as Set
|
||||
import Debug.Trace
|
||||
import Data.List (intersperse)
|
||||
|
||||
type ClassName = String
|
||||
|
||||
data HTML =
|
||||
Text String
|
||||
Break
|
||||
| Text String
|
||||
| Span (Maybe ClassName) String
|
||||
| Ul (Maybe ClassName) [HTML]
|
||||
| Dl (Maybe ClassName) [HTML]
|
||||
@ -41,6 +45,7 @@ toDd (Text s) = string s
|
||||
toDd e = dd $ toMarkup e
|
||||
|
||||
instance ToMarkup HTML where
|
||||
toMarkup Break = br
|
||||
toMarkup (Text s) = string s
|
||||
toMarkup (Span className s) = classifyMarkup className . span $ string s
|
||||
toMarkup (Ul className children) = classifyMarkup className . ul $ mconcat (toLi <$> children)
|
||||
@ -48,6 +53,9 @@ instance ToMarkup HTML where
|
||||
toMarkup (Div className children) = classifyMarkup className . div $ mconcat (toMarkup <$> children)
|
||||
toMarkup (Dt key) = dt $ string key
|
||||
|
||||
trace' :: Show a => a -> a
|
||||
trace' a = traceShow a a
|
||||
|
||||
split :: Diff a Info -> String -> String -> IO ByteString
|
||||
split diff before after = return . renderHtml
|
||||
. docTypeHtml
|
||||
@ -56,78 +64,105 @@ split diff before after = return . renderHtml
|
||||
. (table ! A.class_ (stringValue "diff"))
|
||||
. mconcat $ toMarkup <$> (fst $ diffToRows diff (0, 0) before after)
|
||||
|
||||
data Row = Row [HTML] [HTML]
|
||||
deriving (Show, Eq)
|
||||
data Row = Row Line Line
|
||||
deriving Eq
|
||||
|
||||
instance Show Row where
|
||||
show (Row left right) = "\n" ++ show left ++ " | " ++ show right
|
||||
|
||||
instance ToMarkup Row where
|
||||
toMarkup (Row left right) = (tr $ (td . mconcat $ toMarkup <$> left) <> (td . mconcat $ toMarkup <$> right))
|
||||
toMarkup (Row left right) = (tr $ toMarkup left <> toMarkup right) <> string "\n"
|
||||
|
||||
bimap :: ([HTML] -> [HTML]) -> ([HTML] -> [HTML]) -> Row -> Row
|
||||
bimap f g (Row a b) = Row (f a) (g b)
|
||||
instance ToMarkup Line where
|
||||
toMarkup EmptyLine = td (string "")
|
||||
toMarkup (Line html) = td . mconcat $ toMarkup <$> html
|
||||
|
||||
data Line =
|
||||
Line [HTML]
|
||||
| EmptyLine
|
||||
deriving Eq
|
||||
|
||||
unLine :: Line -> [HTML]
|
||||
unLine EmptyLine = []
|
||||
unLine (Line htmls) = htmls
|
||||
|
||||
instance Show Line where
|
||||
show (Line elements) = "[" ++ (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)
|
||||
|
||||
instance Monoid Row where
|
||||
mempty = Row [] []
|
||||
mempty = Row EmptyLine EmptyLine
|
||||
mappend (Row x1 y1) (Row x2 y2) = Row (x1 <> x2) (y1 <> y2)
|
||||
|
||||
diffToRows :: Diff a Info -> (Int, Int) -> String -> String -> ([Row], (Range, Range))
|
||||
diffToRows (Free annotated) _ before after = annotatedToRows annotated before after
|
||||
diffToRows (Pure (Insert term)) (previousIndex, _) _ after = (rowWithInsertedLine <$> afterLines, (range, Range previousIndex previousIndex))
|
||||
diffToRows (Pure (Insert term)) (previousIndex, _) _ after = (rowWithInsertedLine <$> afterLines, (Range previousIndex previousIndex, range))
|
||||
where
|
||||
(afterLines, range) = termToLines term after
|
||||
rowWithInsertedLine (Line elements) = Row [] [ Div (Just "insert") elements ]
|
||||
rowWithInsertedLine (Line elements) = Row EmptyLine $ Line [ 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 [ Div (Just "delete") elements ] []
|
||||
rowWithDeletedLine (Line elements) = Row (Line [ 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 (join $ Maybe.maybeToList a) (join $ Maybe.maybeToList b)
|
||||
rowFromMaybeRows a b = Row (maybe EmptyLine Line a) (maybe EmptyLine Line b)
|
||||
(leftElements, leftRange) = termToLines a before
|
||||
(rightElements, rightRange) = termToLines b after
|
||||
|
||||
newtype Line = Line { unLine :: [HTML] } deriving (Show, Eq)
|
||||
|
||||
instance Monoid Line where
|
||||
mempty = Line []
|
||||
mappend (Line xs) (Line ys) = Line (xs <> ys)
|
||||
|
||||
-- | Takes a term and a `source` and returns a list of HTML lines
|
||||
-- | and their range within `source`.
|
||||
termToLines :: Term a Info -> String -> ([Line], Range)
|
||||
termToLines (Info range _ categories :< syntax) source = (rows syntax, range)
|
||||
where
|
||||
rows (Leaf _) = Line . (:[]) <$> elements
|
||||
rows (Leaf _) = reverse $ foldl adjoin2Lines [] $ Line . (:[]) <$> elements
|
||||
rows (Indexed i) = rewrapLineContentsInUl <$> childLines i
|
||||
|
||||
rewrapLineContentsInUl (Line elements) = Line [ Ul (classify categories) elements ]
|
||||
rewrapLineContentsInUl EmptyLine = EmptyLine
|
||||
lineElements r s = Line . (:[]) <$> textElements r s
|
||||
childLines i = appendRemainder $ foldl sumLines ([], start range) i
|
||||
appendRemainder (lines, previous) = adjoinLines lines $ lineElements (Range previous (end range)) source
|
||||
appendRemainder (lines, previous) = reverse . foldl adjoin2Lines [] $ lines ++ lineElements (Range previous (end range)) source
|
||||
sumLines (lines, previous) child = (allLines, end childRange)
|
||||
where
|
||||
separatorLines = lineElements (Range previous $ start childRange) source
|
||||
allLines = lines `adjoinLines` separatorLines `adjoinLines` childLines
|
||||
unadjoinedLines = lines ++ separatorLines ++ childLines
|
||||
allLines = reverse $ foldl adjoin2Lines [] unadjoinedLines
|
||||
(childLines, childRange) = termToLines child source
|
||||
elements = Span (classify categories) <$> actualLines (substring range source)
|
||||
elements = (elementAndBreak $ Span (classify categories)) =<< actualLines (substring range source)
|
||||
|
||||
-- | Given an Annotated and before/after strings, returns a list of `Row`s representing the newline-separated diff.
|
||||
annotatedToRows :: Annotated a (Info, Info) (Diff a Info) -> String -> String -> ([Row], (Range, Range))
|
||||
annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCategories) (Leaf _)) before after = (zipWithMaybe rowFromMaybeRows leftElements rightElements, (left, right))
|
||||
where
|
||||
leftElements = Span (classify leftCategories) <$> actualLines (substring left before)
|
||||
rightElements = Span (classify rightCategories) <$> actualLines (substring right after)
|
||||
leftElements = (elementAndBreak $ Span (classify leftCategories)) =<< actualLines (substring left before)
|
||||
rightElements = (elementAndBreak $ Span (classify rightCategories)) =<< actualLines (substring right after)
|
||||
|
||||
annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCategories) (Indexed i)) before after = (bimap ((:[]) . Ul (classify leftCategories)) ((:[]) . Ul (classify rightCategories)) <$> rows, ranges)
|
||||
annotatedToRows (Annotated (Info left _ leftCategories, Info right _ rightCategories) (Indexed i)) before after = (rewrap <$> rows, ranges)
|
||||
where
|
||||
wrap _ EmptyLine = EmptyLine
|
||||
wrap f (Line elements) = Line [ f elements ]
|
||||
rewrap (Row left right) = Row (wrap (Ul $ classify leftCategories) left) (wrap (Ul $ classify rightCategories) right)
|
||||
ranges = (left, right)
|
||||
rows = appendRemainder $ foldl sumRows ([], starts ranges) i
|
||||
sources = (before, after)
|
||||
appendRemainder (rows, previousIndices) = adjoinRows rows $ contextRows (ends ranges) previousIndices sources
|
||||
appendRemainder (rows, previousIndices) = reverse . foldl adjoin2 [] $ rows ++ (contextRows (ends ranges) previousIndices sources)
|
||||
sumRows (rows, previousIndices) child = (allRows, ends childRanges)
|
||||
where
|
||||
separatorRows = contextRows (starts childRanges) previousIndices sources
|
||||
allRows = rows `adjoinRows` separatorRows `adjoinRows` childRows
|
||||
allRows = rows ++ separatorRows ++ childRows
|
||||
(childRows, childRanges) = diffToRows child previousIndices before after
|
||||
|
||||
contextRows :: (Int, Int) -> (Int, Int) -> (String, String) -> [Row]
|
||||
@ -136,8 +171,15 @@ contextRows childIndices previousIndices sources = zipWithMaybe rowFromMaybeRows
|
||||
leftElements = textElements (Range (fst previousIndices) (fst childIndices)) (fst sources)
|
||||
rightElements = textElements (Range (snd previousIndices) (snd childIndices)) (snd sources)
|
||||
|
||||
elementAndBreak :: (String -> HTML) -> String -> [HTML]
|
||||
elementAndBreak _ "" = []
|
||||
elementAndBreak _ "\n" = [ Break ]
|
||||
elementAndBreak constructor x | '\n' <- last x = [ constructor $ init x, Break ]
|
||||
elementAndBreak constructor x = [ constructor x ]
|
||||
|
||||
textElements :: Range -> String -> [HTML]
|
||||
textElements range source = Text <$> actualLines (substring range source)
|
||||
textElements range source = (elementAndBreak Text) =<< actualLines s
|
||||
where s = substring range source
|
||||
|
||||
starts :: (Range , Range) -> (Int, Int)
|
||||
starts (left, right) = (start left, start right)
|
||||
@ -146,22 +188,65 @@ ends :: (Range, Range) -> (Int, Int)
|
||||
ends (left, right) = (end left, end right)
|
||||
|
||||
rowFromMaybeRows :: Maybe HTML -> Maybe HTML -> Row
|
||||
rowFromMaybeRows a b = Row (Maybe.maybeToList a) (Maybe.maybeToList b)
|
||||
rowFromMaybeRows a b = Row (maybe EmptyLine (Line . (:[])) a) (maybe EmptyLine (Line . (:[])) b)
|
||||
|
||||
-- | Adjoin a list of rows onto an existing list of rows.
|
||||
adjoinRows :: [Row] -> [Row] -> [Row]
|
||||
adjoinRows [] rows = rows
|
||||
adjoinRows rows [] = rows
|
||||
adjoinRows accum (row : rows) = reverse (adjoin2 (reverse accum) row) ++ rows
|
||||
maybeLast :: [a] -> Maybe a
|
||||
maybeLast list = listToMaybe $ reverse list
|
||||
|
||||
adjoin2 :: [Row] -> Row -> [Row]
|
||||
adjoin2 [] row = [row]
|
||||
adjoin2 (Row [] [] : init) row = adjoin2 init row
|
||||
adjoin2 (Row [] rights : Row lefts rights' : init) (Row xs ys) =
|
||||
Row [] (rights <> ys) : Row (lefts <> xs) rights' : init
|
||||
adjoin2 (Row lefts [] : Row lefts' rights : init) (Row xs ys) =
|
||||
Row (lefts <> xs) [] : Row lefts' (rights <> ys) : init
|
||||
adjoin2 (last:init) row = (last <> row) : init
|
||||
|
||||
adjoin2 rows (Row EmptyLine EmptyLine) = rows
|
||||
|
||||
adjoin2 (Row EmptyLine EmptyLine : rows) row = adjoin2 rows row
|
||||
|
||||
adjoin2 rows (Row left' right') | Just _ <- openLine $ leftLines rows, Just _ <- openLine $ rightLines rows = zipWith Row lefts rights
|
||||
where lefts = adjoin2Lines (leftLines rows) left'
|
||||
rights = adjoin2Lines (rightLines rows) right'
|
||||
|
||||
adjoin2 rows (Row left' right') | Just _ <- openLine $ leftLines rows = case right' of
|
||||
EmptyLine -> rest
|
||||
_ -> Row EmptyLine right' : rest
|
||||
where rest = zipWith Row lefts rights
|
||||
lefts = adjoin2Lines (leftLines rows) left'
|
||||
rights = rightLines rows
|
||||
|
||||
adjoin2 rows (Row left' right') | Just _ <- openLine $ rightLines rows = case left' of
|
||||
EmptyLine -> rest
|
||||
_ -> Row left' EmptyLine : rest
|
||||
where rest = zipWith Row lefts rights
|
||||
lefts = leftLines rows
|
||||
rights = adjoin2Lines (rightLines rows) right'
|
||||
|
||||
adjoin2 rows row = row : rows
|
||||
|
||||
leftLines :: [Row] -> [Line]
|
||||
leftLines rows = left <$> rows
|
||||
where
|
||||
left (Row left _) = left
|
||||
|
||||
rightLines :: [Row] -> [Line]
|
||||
rightLines rows = right <$> rows
|
||||
where
|
||||
right (Row _ right) = right
|
||||
|
||||
openElement :: HTML -> Maybe HTML
|
||||
openElement Break = Nothing
|
||||
openElement (Ul _ elements) = openElement =<< maybeLast elements
|
||||
openElement (Dl _ elements) = openElement =<< maybeLast elements
|
||||
openElement (Div _ elements) = openElement =<< maybeLast elements
|
||||
openElement h = Just h
|
||||
|
||||
openLine :: [Line] -> Maybe Line
|
||||
openLine [] = Nothing
|
||||
openLine (EmptyLine : rest) = openLine rest
|
||||
openLine (line : _) = const line <$> (openElement =<< (maybeLast $ unLine line))
|
||||
|
||||
adjoin2Lines :: [Line] -> Line -> [Line]
|
||||
adjoin2Lines [] line = [line]
|
||||
adjoin2Lines (EmptyLine : xs) line | Just _ <- openLine xs = EmptyLine : adjoin2Lines xs line
|
||||
adjoin2Lines (prev:rest) line | Just _ <- openLine [ prev ] = (prev <> line) : rest
|
||||
adjoin2Lines lines line = line : lines
|
||||
|
||||
adjoinLines :: [Line] -> [Line] -> [Line]
|
||||
adjoinLines [] lines = lines
|
||||
@ -181,6 +266,6 @@ classify = foldr (const . Just . ("category-" ++)) Nothing
|
||||
actualLines :: String -> [String]
|
||||
actualLines "" = [""]
|
||||
actualLines lines = case break (== '\n') lines of
|
||||
(l, lines') -> l : (case lines' of
|
||||
[] -> []
|
||||
_:lines' -> actualLines lines')
|
||||
(l, lines') -> (case lines' of
|
||||
[] -> [ l ]
|
||||
_:lines' -> (l ++ "\n") : actualLines lines')
|
||||
|
||||
129
test/Spec.hs
129
test/Spec.hs
@ -1,55 +1,35 @@
|
||||
module Main where
|
||||
|
||||
import Diff
|
||||
import Patch
|
||||
import Range
|
||||
import Split
|
||||
import Syntax
|
||||
import Control.Comonad.Cofree
|
||||
import Control.Monad.Free
|
||||
import qualified Data.Set as Set
|
||||
import Test.Hspec
|
||||
|
||||
main :: IO ()
|
||||
main = hspec $ do
|
||||
describe "adjoinRows" $ do
|
||||
it "empty lines are the left unit" $
|
||||
adjoinRows [ Row [] [] ] [ Row [ Text "a" ] [ Text "b" ] ] `shouldBe` [ Row [ Text "a" ] [ Text "b" ] ]
|
||||
|
||||
it "empty lines are the left unit for multiple lines" $
|
||||
adjoinRows [ Row [] [] ] [ Row [ Text "a" ] [ Text "b" ], Row [ Text "a" ] [ Text "b" ] ] `shouldBe` [ Row [ Text "a" ] [ Text "b" ], Row [ Text "a" ] [ Text "b" ] ]
|
||||
|
||||
it "two single line elements should concatenate into a single line" $
|
||||
adjoinRows [ Row [ Text "a" ] [ Text "b" ] ] [ Row [ Text "a" ] [ Text "b" ] ] `shouldBe` [ Row [ Text "a", Text "a" ] [ Text "b", Text "b" ] ]
|
||||
|
||||
it "single line elements on the left concatenate onto the first of multiple lines on the right" $
|
||||
adjoinRows [ Row [ Text "a1" ] [ Text "b1" ] ] [ Row [ Text "a2" ] [ Text "b2" ], Row [ Text "a3" ] [ Text "b3" ] ] `shouldBe` [ Row [ Text "a1", Text "a2" ] [ Text "b1", Text "b2" ], Row [ Text "a3" ] [ Text "b3" ] ]
|
||||
|
||||
it "the last of multiple line elements on the left concatenate onto the first of multiple lines on the right" $
|
||||
adjoinRows [ Row [ Text "a1" ] [ Text "b1" ], Row [ Text "a2" ] [ Text "b2" ] ]
|
||||
[ Row [ Text "a3" ] [ Text "b3" ], Row [ Text "a4" ] [ Text "b4" ] ]
|
||||
`shouldBe`
|
||||
[ Row [ Text "a1" ] [ Text "b1" ],
|
||||
Row [ Text "a2", Text "a3" ] [ Text "b2", Text "b3" ],
|
||||
Row [ Text "a4" ] [ Text "b4" ] ]
|
||||
|
||||
|
||||
describe "annotatedToRows" $ do
|
||||
it "outputs one row for single-line unchanged leaves" $
|
||||
annotatedToRows (unchanged "a" "leaf" (Leaf "")) "a" "a" `shouldBe` ([ Row [ span "a" ] [ span "a" ] ], (Range 0 1, Range 0 1))
|
||||
annotatedToRows (unchanged "a" "leaf" (Leaf "")) "a" "a" `shouldBe` ([ Row (Line [ span "a" ]) (Line [ span "a" ]) ], (Range 0 1, Range 0 1))
|
||||
|
||||
it "outputs one row for single-line empty unchanged indexed nodes" $
|
||||
annotatedToRows (unchanged "[]" "branch" (Indexed [])) "[]" "[]" `shouldBe` ([ Row [ Ul (Just "category-branch") [ Text "[]" ] ] [ Ul (Just "category-branch") [ Text "[]" ] ] ], (Range 0 2, Range 0 2))
|
||||
annotatedToRows (unchanged "[]" "branch" (Indexed [])) "[]" "[]" `shouldBe` ([ Row (Line [ Ul (Just "category-branch") [ Text "[]" ] ]) (Line [ Ul (Just "category-branch") [ Text "[]" ] ]) ], (Range 0 2, Range 0 2))
|
||||
|
||||
it "outputs one row for single-line non-empty unchanged indexed nodes" $
|
||||
annotatedToRows (unchanged "[ a, b ]" "branch" (Indexed [
|
||||
Free . offsetAnnotated 2 2 $ unchanged "a" "leaf" (Leaf ""),
|
||||
Free . offsetAnnotated 5 5 $ unchanged "b" "leaf" (Leaf "")
|
||||
])) "[ a, b ]" "[ a, b ]" `shouldBe` ([ Row [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ", ", span "b", Text " ]" ] ] [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ", ", span "b", Text " ]" ] ] ], (Range 0 8, Range 0 8))
|
||||
])) "[ a, b ]" "[ a, b ]" `shouldBe` ([ Row (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ", ", span "b", Text " ]" ] ]) (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ", ", span "b", Text " ]" ] ]) ], (Range 0 8, Range 0 8))
|
||||
|
||||
it "outputs one row for single-line non-empty formatted indexed nodes" $
|
||||
annotatedToRows (formatted "[ a, b ]" "[ a, b ]" "branch" (Indexed [
|
||||
Free . offsetAnnotated 2 2 $ unchanged "a" "leaf" (Leaf ""),
|
||||
Free . offsetAnnotated 5 6 $ unchanged "b" "leaf" (Leaf "")
|
||||
])) "[ a, b ]" "[ a, b ]" `shouldBe` ([ Row [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ", ", span "b", Text " ]" ] ] [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ", ", span "b", Text " ]" ] ] ], (Range 0 8, Range 0 9))
|
||||
])) "[ a, b ]" "[ a, b ]" `shouldBe` ([ Row (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ", ", span "b", Text " ]" ] ]) (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ", ", span "b", Text " ]" ] ]) ], (Range 0 8, Range 0 9))
|
||||
|
||||
it "outputs two rows for two-line non-empty unchanged indexed nodes" $
|
||||
annotatedToRows (unchanged "[ a,\nb ]" "branch" (Indexed [
|
||||
@ -57,10 +37,10 @@ main = hspec $ do
|
||||
Free . offsetAnnotated 5 5 $ unchanged "b" "leaf" (Leaf "")
|
||||
])) "[ a,\nb ]" "[ a,\nb ]" `shouldBe`
|
||||
([
|
||||
Row [ Ul (Just "category-branch") [ Text "[ ", span "a", Text "," ] ]
|
||||
[ Ul (Just "category-branch") [ Text "[ ", span "a", Text "," ] ],
|
||||
Row [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ]
|
||||
[ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ]
|
||||
Row (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ",", Break ] ])
|
||||
(Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ",", Break] ]),
|
||||
Row (Line [ Ul (Just "category-branch") [ span "b", Text " ]" ] ])
|
||||
(Line [ Ul (Just "category-branch") [ span "b", Text " ]" ] ])
|
||||
], (Range 0 8, Range 0 8))
|
||||
|
||||
it "outputs two rows for two-line non-empty formatted indexed nodes" $
|
||||
@ -69,15 +49,92 @@ main = hspec $ do
|
||||
Free . offsetAnnotated 5 5 $ unchanged "b" "leaf" (Leaf "")
|
||||
])) "[ a,\nb ]" "[\na,\nb ]" `shouldBe`
|
||||
([
|
||||
Row [ Ul (Just "category-branch") [ Text "[ ", span "a", Text "," ] ]
|
||||
[ Ul (Just "category-branch") [ Text "[" ] ],
|
||||
Row [ Ul (Just "category-branch") [] ]
|
||||
[ Ul (Just "category-branch") [ Text "", span "a", Text "," ] ],
|
||||
Row [ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ]
|
||||
[ Ul (Just "category-branch") [ Text "", span "b", Text " ]" ] ]
|
||||
Row (Line [ Ul (Just "category-branch") [ Text "[ ", span "a", Text ",", Break ] ])
|
||||
(Line [ Ul (Just "category-branch") [ Text "[", Break ] ]),
|
||||
Row EmptyLine
|
||||
(Line [ Ul (Just "category-branch") [ span "a", Text ",", Break ] ]),
|
||||
Row (Line [ Ul (Just "category-branch") [ span "b", Text " ]" ] ])
|
||||
(Line [ Ul (Just "category-branch") [ span "b", Text " ]" ] ])
|
||||
], (Range 0 8, Range 0 8))
|
||||
|
||||
it "" $
|
||||
let (sourceA, sourceB) = ("[\na\n,\nb]", "[a,b]") in
|
||||
annotatedToRows (formatted sourceA sourceB "branch" (Indexed [
|
||||
Free . offsetAnnotated 2 1 $ unchanged "a" "leaf" (Leaf ""),
|
||||
Free . offsetAnnotated 6 3 $ unchanged "b" "leaf" (Leaf "")
|
||||
])) sourceA sourceB `shouldBe`
|
||||
([
|
||||
Row (Line [ Ul (Just "category-branch") [ Text "[", Break ] ])
|
||||
(Line [ Ul (Just "category-branch") [ Text "[", span "a", Text ",", span "b", Text "]" ] ]),
|
||||
Row (Line [ Ul (Just "category-branch") [ span "a", Break ] ])
|
||||
EmptyLine,
|
||||
Row (Line [ Ul (Just "category-branch") [ Text ",", Break ] ])
|
||||
EmptyLine,
|
||||
Row (Line [ Ul (Just "category-branch") [ span "b", Text "]" ] ])
|
||||
EmptyLine
|
||||
], (Range 0 8, Range 0 5))
|
||||
|
||||
it "should split multi-line deletions across multiple rows" $
|
||||
let (sourceA, sourceB) = ("/*\n*/\na", "a") in
|
||||
annotatedToRows (formatted sourceA sourceB "branch" (Indexed [
|
||||
Pure . Delete $ (Info (Range 0 5) (Range 0 2) (Set.fromList ["leaf"]) :< (Leaf "")),
|
||||
Free . offsetAnnotated 6 0 $ unchanged "a" "leaf" (Leaf "")
|
||||
])) sourceA sourceB `shouldBe`
|
||||
([
|
||||
Row (Line [ Ul (Just "category-branch") [ Div (Just "delete") [ span "/*", Break ] ] ]) EmptyLine,
|
||||
Row (Line [ Ul (Just "category-branch") [ Div (Just "delete") [ span "*/" ], Break ] ]) EmptyLine,
|
||||
Row (Line [ Ul (Just "category-branch") [ span "a" ] ]) (Line [ Ul (Just "category-branch") [ span "a" ] ])
|
||||
], (Range 0 7, Range 0 1))
|
||||
|
||||
describe "adjoin2" $ do
|
||||
it "appends appends HTML onto incomplete lines" $
|
||||
adjoin2 [ rightRowText "[" ] (rightRowText "a") `shouldBe`
|
||||
[ rightRow [ Text "[", Text "a" ] ]
|
||||
|
||||
it "does not append HTML onto complete lines" $
|
||||
adjoin2 [ leftRow [ Break ] ] (leftRowText ",") `shouldBe`
|
||||
[ leftRowText ",", leftRow [ Break ] ]
|
||||
|
||||
it "appends breaks onto incomplete lines" $
|
||||
adjoin2 [ leftRowText "a" ] (leftRow [ Break ]) `shouldBe`
|
||||
[ leftRow [ Text "a", Break ] ]
|
||||
|
||||
it "does not promote HTML through empty lines onto complete lines" $
|
||||
adjoin2 [ rightRowText "b", leftRow [ Break ] ] (leftRowText "a") `shouldBe`
|
||||
[ leftRowText "a", rightRowText "b", leftRow [ Break ] ]
|
||||
|
||||
it "promotes breaks through empty lines onto incomplete lines" $
|
||||
adjoin2 [ rightRowText "c", rowText "a" "b" ] (leftRow [ Break ]) `shouldBe`
|
||||
[ rightRowText "c", Row (Line [ Text "a", Break ]) (Line [ Text "b" ]) ]
|
||||
|
||||
describe "termToLines" $ do
|
||||
it "splits multi-line terms into multiple lines" $
|
||||
termToLines (Info (Range 0 5) (Range 0 2) (Set.singleton "leaf") :< (Leaf "")) "/*\n*/"
|
||||
`shouldBe`
|
||||
([
|
||||
Line [ span "/*", Break ],
|
||||
Line [ span "*/" ]
|
||||
], Range 0 5)
|
||||
|
||||
describe "openLine" $ do
|
||||
it "should produce the earliest non-empty line in a list, if open" $
|
||||
openLine [
|
||||
Line [ Div (Just "delete") [ span "*/" ] ],
|
||||
Line [ Div (Just "delete") [ span " * Debugging", Break ] ],
|
||||
Line [ Div (Just "delete") [ span "/*", Break ] ]
|
||||
] `shouldBe` (Just $ Line [ Div (Just "delete") [ span "*/" ] ])
|
||||
|
||||
it "should return Nothing if the earliest non-empty line is closed" $
|
||||
openLine [
|
||||
Line [ Div (Just "delete") [ span " * Debugging", Break ] ]
|
||||
] `shouldBe` Nothing
|
||||
|
||||
where
|
||||
rightRowText text = rightRow [ Text text ]
|
||||
rightRow xs = Row EmptyLine (Line xs)
|
||||
leftRowText text = leftRow [ Text text ]
|
||||
leftRow xs = Row (Line xs) EmptyLine
|
||||
rowText a b = Row (Line [ Text a ]) (Line [ Text b ])
|
||||
info source category = Info (totalRange source) (Range 0 0) (Set.fromList [ category ])
|
||||
unchanged source category = formatted source source category
|
||||
formatted source1 source2 category = Annotated (info source1 category, info source2 category)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user