github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-03 04:51:57 +03:00
Code Issues Projects Releases Wiki Activity

Add an apThese function.

Browse Source
This commit is contained in:
Rob Rix 2016-04-14 12:04:33 -04:00
parent ec4ff0cf14
commit 50beaefa99
1 changed files with 5 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/Data/Bifunctor/These.hs
View File

@ -3,6 +3,7 @@ module Data.Bifunctor.These where
import Data.Bifunctor import Data.Bifunctor
import Data.Bifoldable import Data.Bifoldable
import Data.Bitraversable import Data.Bitraversable
import Control.Arrow
data These a b = This a | That b | These a b data These a b = This a | That b | These a b
deriving (Eq, Show) deriving (Eq, Show)
@ -32,6 +33,10 @@ maybeFst = these Just (const Nothing) ((Just .) . const)
maybeSnd :: These a b -> Maybe b maybeSnd :: These a b -> Maybe b
maybeSnd = these (const Nothing) Just ((Just .) . flip const) maybeSnd = these (const Nothing) Just ((Just .) . flip const)
apThese :: These (a -> b) (c -> d) -> These a c -> Maybe (These b d)
apThese fg ab = uncurry maybeThese $ uncurry (***) (bimap (<*>) (<*>) (unpack fg)) (unpack ab)
where unpack = fromThese Nothing Nothing . bimap Just Just
-- Instances -- Instances