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

Define catThese over Alternative Foldable functors.

Browse Source
This commit is contained in:
Rob Rix 2016-04-15 12:44:04 -04:00
parent 2974e5f42d
commit c54924f3ea
1 changed files with 3 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/Alignment.hs
View File

@ -7,6 +7,7 @@ module Alignment
, groupChildrenByLine , groupChildrenByLine
) where ) where
import Control.Applicative
import Control.Arrow ((&&&), (***)) import Control.Arrow ((&&&), (***))
import Control.Comonad.Cofree import Control.Comonad.Cofree
import Control.Monad import Control.Monad
@ -95,8 +96,8 @@ spanAndSplitFirstLines pred = foldr go ([], [])
_ -> (intersecting, (first : rest) : nonintersecting) _ -> (intersecting, (first : rest) : nonintersecting)
| otherwise = (intersecting, nonintersecting) | otherwise = (intersecting, nonintersecting)
catThese :: [Join These a] -> Join These [a] catThese :: (Alternative f, Foldable f, Monoid (f a)) => f (Join These a) -> Join These (f a)
catThese as = fromMaybe (Join (These [] [])) . getUnion . mconcat $ Union . Just . fmap pure <$> as catThese as = fromMaybe (Join (These empty empty)) . getUnion . fold $ Union . Just . fmap pure <$> as
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