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

spanMergeable returns left/right separately.

Browse Source
This commit is contained in:
Rob Rix 2016-04-08 14:53:52 -04:00
parent 65157c54f2
commit 338bfff7c3
1 changed files with 10 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/Alignment.hs
View File

@ -153,22 +153,23 @@ group2 ranges children | Just (headRanges, tailRanges) <- unconsThese ranges
| ([]:rest) <- children = group2 ranges rest | ([]:rest) <- children = group2 ranges rest
| otherwise = ([] <$ ranges, children, fmap (flip (,) []) <$> sequenceL ranges) | otherwise = ([] <$ ranges, children, fmap (flip (,) []) <$> sequenceL ranges)
-- | Partitions and splits a list of children into a triple consisting of: -- | 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 -- | - elements which matched; if an element matches only partially this field will contain only the matching side
-- | - the opposite sides of elements which matched only on the other 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. -- | - elements which do not intersect.
spanThese :: (Join These a -> Join These Bool) -> [[Join These a]] -> ([[Join These a]], [[Join These a]], [[Join These a]]) 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 spanThese pred children | (child:rest) <- children
, not (null child) , not (null child)
, ~(moreChildren, morePunted, moreLines) <- spanThese pred rest , ~(moreChildren, moreL, moreR, moreLines) <- spanThese pred rest
, ~(l, r) <- split (head child) , ~(l, r) <- split (head child)
= case fromThese False False (runJoin (pred (head child))) of = case fromThese False False (runJoin (pred (head child))) of
(True, True) -> (child : moreChildren, morePunted, moreLines) (True, True) -> (child : moreChildren, moreL, moreR, moreLines)
(True, False) -> (l : moreChildren, r : morePunted, moreLines) (True, False) -> (l : moreChildren, moreL, r : moreR, moreLines)
(False, True) -> (r : moreChildren, l : morePunted, moreLines) (False, True) -> (r : moreChildren, l : moreL, moreR, moreLines)
_ -> ([], [], children) _ -> ([], [], [], children)
| ([]:rest) <- children = spanThese pred rest | ([]:rest) <- children = spanThese pred rest
| otherwise = ([], [], children) | otherwise = ([], [], [], children)
pairRangesWithLine :: Monoid b => Join These a -> Join These b -> Join These (a, b) pairRangesWithLine :: Monoid b => Join These a -> Join These b -> Join These (a, b)
pairRangesWithLine headRanges childLine = fromMaybe (flip (,) mempty <$> headRanges) $ (,) <$> headRanges `applyThese` childLine pairRangesWithLine headRanges childLine = fromMaybe (flip (,) mempty <$> headRanges) $ (,) <$> headRanges `applyThese` childLine