github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-01 17:59:10 +03:00
Code Issues Projects Releases Wiki Activity

fmap outside of pairRangesWithLine.

Browse Source
This commit is contained in:
Rob Rix 2016-03-31 18:15:04 -04:00
parent 24ad721189
commit a582931a52
1 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Alignment.hs
View File

@ -145,11 +145,11 @@ group2 ranges children | Just (headRanges, tailRanges) <- unconsThese ranges
, ~(l, r) <- split first
= case fromThese False False . runJoin $ intersects headRanges child of
(True, True) -> let (moreRanges, moreChildren, remainingLines) = group2 tailRanges (rest:restOfChildren) in
(moreRanges, moreChildren, pairRangesWithLine headRanges first : remainingLines)
(moreRanges, moreChildren, pairRangesWithLine headRanges (pure <$> first) : remainingLines)
(True, False) -> let (moreRanges, moreChildren, remainingLines) = group2 (advanceLeft ranges) (r:rest:restOfChildren) in
(moreRanges, moreChildren, pairRangesWithLine headRanges (head l) : remainingLines)
(moreRanges, moreChildren, pairRangesWithLine headRanges (pure <$> head l) : remainingLines)
(False, True) -> let (moreRanges, moreChildren, remainingLines) = group2 (advanceRight ranges) (l:rest:restOfChildren) in
(moreRanges, moreChildren, pairRangesWithLine headRanges (head r) : remainingLines)
(moreRanges, moreChildren, pairRangesWithLine headRanges (pure <$> head r) : remainingLines)
_ -> (tailRanges, children, [ flip (,) [] <$> headRanges ])
| ([]:rest) <- children = group2 ranges rest
| otherwise = (ranges, children, [])
@ -159,7 +159,7 @@ group2 ranges children | Just (headRanges, tailRanges) <- unconsThese ranges
advanceRight (Join (These as (_:bs))) = Join (These as bs)
advanceRight (Join (That (_:bs))) = Join (That bs)
advanceRight other = other
pairRangesWithLine headRanges childLine = case (,) <$> headRanges `applyThese` (pure <$> childLine) of
pairRangesWithLine headRanges childLine = case (,) <$> headRanges `applyThese` childLine of
Just v -> v
Nothing -> error "oh god no"