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

Extract intersectsAnyLine to the top level.

Browse Source
This commit is contained in:
Rob Rix 2016-05-26 19:18:11 -04:00
parent 0925285816
commit bcbc28937b
1 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Alignment.hs
View File

@ -140,7 +140,7 @@ alignBranch getRange children ranges = case intersectingChildren of
-- No child intersects the current ranges on either side, so advance.
[] -> (flip (,) [] <$> headRanges) : alignBranch getRange children (drop 1 <$> ranges)
-- At least one child intersects on at least one side.
_ -> case fromThese True True . runJoin . intersectsAnyLine headRanges <$> listToMaybe remainingIntersectingChildren of
_ -> case fromThese True True . runJoin . intersectsAnyLine getRange headRanges . copoint <$> listToMaybe remainingIntersectingChildren of
-- At least one child intersects on both sides, so align symmetrically.
Just (True, True) -> let (line, remaining) = lineAndRemaining intersectingChildren headRanges in
line : alignBranch getRange (remaining ++ nonIntersectingChildren) (drop 1 <$> ranges)
@ -154,10 +154,8 @@ alignBranch getRange children ranges = case intersectingChildren of
_ -> let (leftLine, remainingAtLeft) = maybe (identity, []) (first (:)) $ leftRange >>= lineAndRemainingWhere (isThis . runJoin . fromJust . head . copoint) asymmetricalChildren
(rightLine, remainingAtRight) = maybe (identity, []) (first (:)) $ rightRange >>= lineAndRemainingWhere (isThat . runJoin . fromJust . head . copoint) asymmetricalChildren in
leftLine $ rightLine $ alignBranch getRange (remainingAtLeft ++ remainingAtRight ++ nonIntersectingChildren) (modifyJoin (uncurry bimap (advancePast (fromJust . head . copoint <$> asymmetricalChildren))) ranges)
where (intersectingChildren, nonIntersectingChildren) = partition (or . intersectsAnyLine headRanges) children
where (intersectingChildren, nonIntersectingChildren) = partition (or . intersectsAnyLine getRange headRanges . copoint) children
(remainingIntersectingChildren, asymmetricalChildren) = partition (isThese . runJoin . fromJust . head . copoint) intersectingChildren
intersectsAnyLine ranges = foldr (orIntersects ranges) (False <$ ranges) . copoint
orIntersects ranges line next = fromMaybe (False <$ ranges) ((||) <$> intersects getRange ranges line `applyThese` next)
Just headRanges = headRangesOf ranges
(leftRange, rightRange) = splitThese headRanges
lineAndRemaining children ranges = let (intersections, remaining) = alignChildren getRange children ranges in
@ -170,6 +168,10 @@ advancePast children = fromThese identity identity . runJoin . (drop 1 <$) $ uni
headRangesOf :: Both [Range] -> Maybe (Join These Range)
headRangesOf ranges = sequenceL (listToMaybe <$> Join (runBothWith These ranges))
intersectsAnyLine :: (term -> Range) -> Join These Range -> [Join These term] -> Join These Bool
intersectsAnyLine getRange ranges = foldr (orIntersects ranges) (False <$ ranges)
where orIntersects ranges line next = fromMaybe (False <$ ranges) ((||) <$> intersects getRange ranges line `applyThese` next)
-- | Given a list of aligned children, produce lists of their intersecting first lines, and a list of the remaining lines/nonintersecting first lines.
alignChildren :: (Copointed c, Functor c) => (term -> Range) -> [c [Join These term]] -> Join These Range -> (Both [c term], [c [Join These term]])
alignChildren _ [] _ = (both [] [], [])