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

Return the heads/tails of children paired.

Browse Source
This commit is contained in:
Rob Rix 2016-04-13 11:47:35 -04:00
parent 747bfbf454
commit b8bc77bb7f
1 changed files with 8 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/Alignment.hs
View File

@ -153,13 +153,14 @@ group2 ranges children | Just (headRanges, tailRanges) <- unconsThese ranges
| ([]:rest) <- children = group2 ranges rest
| otherwise = ([] <$ ranges, children, fmap (flip (,) []) <$> sequenceL ranges)
spanAndSplitFirstLines :: (Join These a -> Join These Bool) -> [[Join These a]] -> ([Join These a], [[Join These a]], [[Join These a]])
spanAndSplitFirstLines pred = foldr go ([], [], [])
where go (first : rest) (fs, rs, ns) = let ~(l, r) = split first in case fromThese False False . runJoin $ pred first of
(True, True) -> (first : fs, rest : rs, ns)
(True, False) -> (head l : fs, (r ++ rest) : rs, ns)
(False, True) -> (head r : fs, (l ++ rest) : rs, ns)
_ -> (fs, rs, (first : rest) : ns)
spanAndSplitFirstLines :: (Join These a -> Join These Bool) -> [[Join These a]] -> ([(Join These a, [Join These a])], [[Join These a]])
spanAndSplitFirstLines pred = foldr go ([], [])
where go (first : rest) (intersecting, nonintersecting) =
let ~(l, r) = split first in case fromThese False False . runJoin $ pred first of
(True, True) -> ((first, rest) : intersecting, nonintersecting)
(True, False) -> ((head l, r ++ rest) : intersecting, nonintersecting)
(False, True) -> ((head r, l ++ rest) : intersecting, nonintersecting)
_ -> (intersecting, (first : rest) : nonintersecting)
-- | Partitions and splits a list of children into a tuple consisting of:
-- | - elements which matched; if an element matches only partially this field will contain only the matching side