github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-01 03:32:40 +03:00
Code Issues Projects Releases Wiki Activity

Define splitAbstractedTerm by catamorphism (more or less).

Browse Source
This commit is contained in:
Rob Rix 2016-03-04 21:07:26 -05:00
parent e979a40087
commit 5c06ecc6d0
2 changed files with 5 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Alignment.hs
View File

@ -45,13 +45,14 @@ splitDiffByLines sources = iter (\ (Annotated info syntax) -> (splitAnnotatedByL
-- | Split a patch, which may span multiple lines, into rows of split diffs.
splitPatchByLines :: Both (Source Char) -> Patch (Term leaf Info) -> [Row (SplitDiff leaf Info, Range)]
splitPatchByLines sources patch = zipWithDefaults makeRow (pure mempty) $ fmap (fmap (first (Pure . constructor patch))) <$> lines
where lines = maybe [] . splitAbstractedTerm copoint unwrap (:<) <$> sources <*> unPatch patch
where lines = (\ source -> maybe [] $ cata (tearDown source)) <$> sources <*> unPatch patch
tearDown source info syntax = splitAbstractedTerm (const info) (const syntax) (:<) source ()
constructor (Replace _ _) = SplitReplace
constructor (Insert _) = SplitInsert
constructor (Delete _) = SplitDelete
-- | Split an `inTerm` (abstracted by two destructors) up into one `outTerm` (abstracted by a constructor) per line in `Source`.
splitAbstractedTerm :: (inTerm -> Info) -> (inTerm -> Syntax leaf inTerm) -> (Info -> Syntax leaf outTerm -> outTerm) -> Source Char -> inTerm -> [Line (outTerm, Range)]
splitAbstractedTerm :: (inTerm -> Info) -> (inTerm -> Syntax leaf [Line (outTerm, Range)]) -> (Info -> Syntax leaf outTerm -> outTerm) -> Source Char -> inTerm -> [Line (outTerm, Range)]
splitAbstractedTerm getInfo getSyntax makeTerm source term = case getSyntax term of
Leaf a -> pure . ((`makeTerm` Leaf a) . (`Info` (Diff.categories (getInfo term))) &&& id) <$> actualLineRanges (characterRange (getInfo term)) source
Indexed children -> adjoinChildLines (Indexed . fmap (Prelude.fst . copoint)) (Identity <$> children)
@ -62,7 +63,7 @@ splitAbstractedTerm getInfo getSyntax makeTerm source term = case getSyntax term
adjoinChildLines constructor children = let (lines, previous) = foldl' childLines ([], start (characterRange (getInfo term))) children in
fmap (wrapLineContents (makeBranchTerm (\ info -> makeTerm info . constructor) (Diff.categories (getInfo term)) previous)) . adjoin $ lines ++ (pure . (,) Nothing <$> actualLineRanges (Range previous $ end (characterRange (getInfo term))) source)
childLines (lines, previous) child = let childLines = splitAbstractedTerm getInfo getSyntax makeTerm source (copoint child) in
childLines (lines, previous) child = let childLines = copoint child in
(adjoin $ lines ++ (pure . (,) Nothing <$> actualLineRanges (Range previous $ start (unionLineRangesFrom (rangeAt previous) childLines)) source) ++ (fmap (flip (,) (unionLineRangesFrom (rangeAt previous) childLines) . Just . (<$ child)) <$> childLines), end (unionLineRangesFrom (rangeAt previous) childLines))
-- | Split a annotated diff into rows of split diffs.

2
test/AlignmentSpec.hs
View File

@ -95,7 +95,7 @@ spec = parallel $ do
describe "splitAbstractedTerm" $ do
prop "preserves line count" $
\ source -> let range = getTotalRange source in
splitAbstractedTerm copoint unwrap (:<) source (Info range mempty :< Leaf source) `shouldBe` (pure . ((:< Leaf source) . (`Info` mempty) &&& id) <$> actualLineRanges range source)
splitAbstractedTerm copoint (([] <$) . unwrap) (:<) source (Info range mempty :< Leaf source) `shouldBe` (pure . ((:< Leaf source) . (`Info` mempty) &&& id) <$> actualLineRanges range source)
describe "splitPatchByLines" $ do
prop "starts at initial indices" $