1
1
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +03:00

Pair with the ranges appropriate for the intersecting elements.

This is gross.
This commit is contained in:
Rob Rix 2016-04-14 16:34:49 -04:00
parent 3d3462b98a
commit ad4d1ab9e4

View File

@ -17,7 +17,7 @@ import Control.Monad
import Control.Monad.Free import Control.Monad.Free
import Data.Adjoined import Data.Adjoined
import Data.Align import Data.Align
import Data.Bifunctor import Data.Biapplicative
import Data.Bifunctor.Join import Data.Bifunctor.Join
import Data.Bifunctor.These import Data.Bifunctor.These
import Data.Coalescent import Data.Coalescent
@ -146,7 +146,8 @@ alignChildrenInRanges ranges children
| Just headRanges <- sequenceL $ listToMaybe <$> ranges | Just headRanges <- sequenceL $ listToMaybe <$> ranges
, (intersecting, nonintersecting) <- spanAndSplitFirstLines (intersects headRanges) children , (intersecting, nonintersecting) <- spanAndSplitFirstLines (intersects headRanges) children
, (thisLine, nextLines) <- foldr (\ (this, next) (these, nexts) -> (this : these, next ++ nexts)) ([], []) intersecting , (thisLine, nextLines) <- foldr (\ (this, next) (these, nexts) -> (this : these, next ++ nexts)) ([], []) intersecting
, merged <- pairRangesWithLine headRanges (catThese thisLine) , thisRanges <- fromMaybe headRanges $ const <$> headRanges `applyThese` catThese (thisLine ++ nextLines)
, merged <- pairRangesWithLine thisRanges (modifyJoin (uncurry These . fromThese [] []) (catThese thisLine))
, advance <- fromMaybe (drop 1, drop 1) $ fromThese id id . runJoin . (drop 1 <$) <$> listToMaybe nextLines , advance <- fromMaybe (drop 1, drop 1) $ fromThese id id . runJoin . (drop 1 <$) <$> listToMaybe nextLines
, (nextRanges, nextChildren, nextLines) <- alignChildrenInRanges (modifyJoin (uncurry bimap advance) ranges) (nextLines : nonintersecting) , (nextRanges, nextChildren, nextLines) <- alignChildrenInRanges (modifyJoin (uncurry bimap advance) ranges) (nextLines : nonintersecting)
= (nextRanges, nextChildren, merged : nextLines) = (nextRanges, nextChildren, merged : nextLines)