github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-24 23:42:31 +03:00
Code Issues Projects Releases Wiki Activity

Adjoin in line.

Browse Source
This commit is contained in:
Rob Rix 2016-03-07 15:43:48 -05:00
parent 3015c409cc
commit 4b3bdb184e
1 changed files with 10 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/Alignment.hs
View File

@ -57,11 +57,9 @@ splitAbstractedTerm makeTerm source (Info range categories) syntax = case syntax
Indexed children -> adjoinChildLines (Indexed . fmap (Prelude.fst . copoint)) (Identity <$> children)
Fixed children -> adjoinChildLines (Fixed . fmap (Prelude.fst . copoint)) (Identity <$> children)
Keyed children -> adjoinChildLines (Keyed . fmap Prelude.fst . Map.fromList) (Map.toList children)
where adjoin = reverse . foldl' (adjoinLinesBy (openRangePair source)) []
adjoinChildLines constructor children = let (lines, previous) = foldl' childLines ([], start range) children in
fmap (wrapLineContents (makeBranchTerm (\ info -> makeTerm info . constructor) categories previous))
. adjoin $ lines
where adjoinChildLines constructor children = let (lines, previous) = foldl' childLines ([], start range) children in
fmap (wrapLineContents (makeBranchTerm (\ info -> makeTerm info . constructor) categories previous)) . reverse . foldl' (adjoinLinesBy (openRangePair source)) []
$ lines
++ (pure . (,) Nothing <$> actualLineRanges (Range previous $ end range) source)
childLines (lines, previous) child = let childRange = unionLineRangesFrom (rangeAt previous) (copoint child) in
@ -79,13 +77,10 @@ splitAnnotatedByLines sources infos syntax = case syntax of
where ranges = characterRange <$> infos
categories = Diff.categories <$> infos
adjoin :: [Row (Maybe (f (SplitDiff leaf Info)), Range)] -> [Row (Maybe (f (SplitDiff leaf Info)), Range)]
adjoin = reverse . foldl' (adjoinRowsBy (openRangePair <$> sources)) []
adjoinChildRows :: (Copointed f, Functor f) => ([f (SplitDiff leaf Info)] -> Syntax leaf (SplitDiff leaf Info)) -> [f [Row (SplitDiff leaf Info, Range)]] -> [Row (SplitDiff leaf Info, Range)]
adjoinChildRows constructor children = let (rows, previous) = foldl' childRows ([], start <$> ranges) children in
fmap (Row . (wrapLineContents <$> (makeBranchTerm (\ info -> Free . Annotated info . constructor) <$> categories <*> previous) <*>) . unRow)
. adjoin $ rows
fmap (Row . (wrapLineContents <$> (makeBranchTerm (\ info -> Free . Annotated info . constructor) <$> categories <*> previous) <*>) . unRow) . reverse . foldl' (adjoinRowsBy (openRangePair <$> sources)) []
$ rows
++ zipWithDefaults makeRow (pure mempty) (fmap (pure . (,) Nothing) <$> (actualLineRanges <$> (Range <$> previous <*> (end <$> ranges)) <*> sources))
childRows :: (Copointed f, Functor f) => ([Row (Maybe (f (SplitDiff leaf Info)), Range)], Both Int) -> f [Row (SplitDiff leaf Info, Range)] -> ([Row (Maybe (f (SplitDiff leaf Info)), Range)], Both Int)
@ -93,7 +88,7 @@ splitAnnotatedByLines sources infos syntax = case syntax of
-- We depend on source ranges increasing monotonically. If a child invalidates that, e.g. if it’s a move in a Keyed node, we don’t output rows for it in this iteration. (It will still show up in the diff as context rows.) This works around https://github.com/github/semantic-diff/issues/488.
if or $ (<) . start <$> childRanges <*> previous
then (rows, previous)
else (adjoin $ rows
else (rows
++ zipWithDefaults makeRow (pure mempty) (fmap (pure . (,) Nothing) <$> (actualLineRanges <$> (Range <$> previous <*> (start <$> childRanges)) <*> sources))
++ (fmap (first (Just . (<$ child))) <$> copoint child), end <$> childRanges)