github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 06:11:49 +03:00
Code Issues Projects Releases Wiki Activity

runLeft/runRight to construct insertion/deletion ranges.

Browse Source
This commit is contained in:
Rob Rix 2016-02-29 10:02:53 -05:00
parent 768e3fedba
commit e678c863b3
1 changed files with 2 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/Alignment.hs
View File

@ -23,15 +23,14 @@ splitDiffByLines :: Diff leaf Info -> Both Int -> Both (Source Char) -> ([Row (S
splitDiffByLines diff previous sources = case diff of splitDiffByLines diff previous sources = case diff of
Free (Annotated annotation syntax) -> (splitAnnotatedByLines sources (ranges annotation) (categories annotation) syntax, ranges annotation) Free (Annotated annotation syntax) -> (splitAnnotatedByLines sources (ranges annotation) (categories annotation) syntax, ranges annotation)
Pure (Insert term) -> let (lines, range) = splitTermByLines term (runRight sources) in Pure (Insert term) -> let (lines, range) = splitTermByLines term (runRight sources) in
(makeRow EmptyLine . fmap (Pure . SplitInsert) <$> lines, Both (rangeAt prevLeft, range)) (makeRow EmptyLine . fmap (Pure . SplitInsert) <$> lines, Both (rangeAt $ runLeft previous, range))
Pure (Delete term) -> let (lines, range) = splitTermByLines term (runLeft sources) in Pure (Delete term) -> let (lines, range) = splitTermByLines term (runLeft sources) in
(flip makeRow EmptyLine . fmap (Pure . SplitDelete) <$> lines, Both (range, rangeAt prevRight)) (flip makeRow EmptyLine . fmap (Pure . SplitDelete) <$> lines, Both (range, rangeAt $ runRight previous))
Pure (Replace leftTerm rightTerm) -> let Both ((leftLines, leftRange), (rightLines, rightRange)) = splitTermByLines <$> Both (leftTerm, rightTerm) <*> sources Pure (Replace leftTerm rightTerm) -> let Both ((leftLines, leftRange), (rightLines, rightRange)) = splitTermByLines <$> Both (leftTerm, rightTerm) <*> sources
(lines, ranges) = (Both (leftLines, rightLines), Both (leftRange, rightRange)) in (lines, ranges) = (Both (leftLines, rightLines), Both (leftRange, rightRange)) in
(uncurry (zipWithDefaults makeRow EmptyLine EmptyLine) . runBoth $ fmap (fmap (Pure . SplitReplace)) <$> lines, ranges) (uncurry (zipWithDefaults makeRow EmptyLine EmptyLine) . runBoth $ fmap (fmap (Pure . SplitReplace)) <$> lines, ranges)
where categories annotations = Diff.categories <$> Both annotations where categories annotations = Diff.categories <$> Both annotations
ranges annotations = characterRange <$> Both annotations ranges annotations = characterRange <$> Both annotations
(prevLeft, prevRight) = runBoth previous
-- | A functor that can return its content. -- | A functor that can return its content.
class Functor f => Has f where class Functor f => Has f where