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

🔥 the PartialSemigroup/coalesceBy stuff for Both.

Browse Source
This commit is contained in:
Rob Rix 2016-03-08 10:24:20 -05:00
parent 50a99fe500
commit 5e32c041fb
1 changed files with 0 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Data/Functor/Both.hs
View File

@ -1,6 +1,5 @@
module Data.Functor.Both where module Data.Functor.Both where
import Data.Adjoined
import Data.Bifunctor import Data.Bifunctor
import Prelude hiding (zipWith, fst, snd) import Prelude hiding (zipWith, fst, snd)
import qualified Prelude import qualified Prelude
@ -53,13 +52,3 @@ instance Applicative Both where
instance Monoid a => Monoid (Both a) where instance Monoid a => Monoid (Both a) where
mempty = pure mempty mempty = pure mempty
mappend a b = mappend <$> a <*> b mappend a b = mappend <$> a <*> b
instance (PartialSemigroup a, Monoid a) => PartialSemigroup (Both a) where
coalesce = coalesceBy (pure coalesce)
coalesceBy :: Monoid a => Both (Coalesce a) -> Both a -> Both a -> Maybe (Both a)
coalesceBy coalesce a b = case coalesce <*> a <*> b of
Both (Just l, Just r) -> Just (both l r)
Both (Nothing, Just r) -> Just (both (fst a `mappend` fst b) r)
Both (Just l, Nothing) -> Just (both l (snd a `mappend` snd b))
Both (Nothing, Nothing) -> Nothing