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

🔥 linesOf.

Browse Source
This commit is contained in:
Rob Rix 2016-05-26 19:14:17 -04:00
parent e72cbd1f60
commit da8a911142
1 changed files with 0 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Alignment.hs
View File

@ -169,19 +169,6 @@ advancePast children = fromThese identity identity . runJoin . (drop 1 <$) $ uni
headRangesOf :: Both [Range] -> Maybe (Join These Range)
headRangesOf ranges = sequenceL (listToMaybe <$> Join (runBothWith These ranges))
linesOf :: (Copointed c, Functor c) => (term -> Range) -> [c [Join These term]] -> Both [Range] -> ([c [Join These term]], Both [Range], [Join These (Range, [c term])])
linesOf getRange children ranges
| Join ([], []) <- ranges = (children, ranges, [])
| [] <- children = (children, ranges, [])
| (first:rest) <- children
, null (copoint first) = linesOf getRange rest ranges
| otherwise = let (intersections, remaining) = alignChildren getRange children headRanges
Just headRanges = headRangesOf ranges
joined = Join (runBothWith These intersections)
line = fromJust ((,) <$> headRanges `applyThese` joined)
(nextChildren, nextRanges, lines) = linesOf getRange remaining (modifyJoin (uncurry bimap (advancePast [ line ])) ranges) in
(nextChildren, nextRanges, line : lines)
-- | 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 [] [], [])