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

🔥 spanThese.

Browse Source
This commit is contained in:
Rob Rix 2016-04-14 12:46:05 -04:00
parent 8a781d0edf
commit 1656f93f65
1 changed files with 0 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/Alignment.hs
View File

@ -163,23 +163,6 @@ spanAndSplitFirstLines pred = foldr go ([], [])
catThese :: [Join These a] -> Join These [a]
catThese as = maybe (Join (These [] [])) Join $ getUnion $ mconcat $ Union . Just . runJoin . fmap pure <$> as
-- | 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
-- | - the left sides of elements which matched only on the right side
-- | - the right sides of elements which matched only on the left side
-- | - elements which do not intersect.
spanThese :: (Join These a -> Join These Bool) -> [[Join These a]] -> ([[Join These a]], [[Join These a]], [[Join These a]], [[Join These a]])
spanThese pred children | (child:rest) <- children
, not (null child)
, ~(moreChildren, moreL, moreR, moreLines) <- spanThese pred rest
, ~(l, r) <- split (head child)
= case fromThese False False (runJoin (pred (head child))) of
(True, True) -> (child : moreChildren, moreL, moreR, moreLines)
(True, False) -> (l : moreChildren, moreL, r : moreR, moreLines)
(False, True) -> (r : moreChildren, l : moreL, moreR, moreLines)
_ -> ([], [], [], children)
| ([]:rest) <- children = spanThese pred rest
| otherwise = ([], [], [], children)
pairRangesWithLine :: Monoid b => Join These a -> Join These b -> Join These (a, b)
pairRangesWithLine headRanges childLine = fromMaybe (flip (,) mempty <$> headRanges) $ (,) <$> headRanges `applyThese` childLine