{-# LANGUAGE CPP #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
module Data.Functor.Coproduct
( Coproduct(..)
, left
, right
, coproduct
) where
import Control.Comonad
import Data.Functor.Contravariant
import Data.Foldable
import Data.Traversable
newtype Coproduct f g a = Coproduct { getCoproduct :: Either (f a) (g a) }
deriving (Eq, Ord, Read, Show)
left :: f a -> Coproduct f g a
left = Coproduct . Left
right :: g a -> Coproduct f g a
right = Coproduct . Right
coproduct :: (f a -> b) -> (g a -> b) -> Coproduct f g a -> b
coproduct f g = either f g . getCoproduct
instance (Functor f, Functor g) => Functor (Coproduct f g) where
fmap f = Coproduct . coproduct (Left . fmap f) (Right . fmap f)
instance (Foldable f, Foldable g) => Foldable (Coproduct f g) where
foldMap f = coproduct (foldMap f) (foldMap f)
instance (Traversable f, Traversable g) => Traversable (Coproduct f g) where
traverse f = coproduct
(fmap (Coproduct . Left) . traverse f)
(fmap (Coproduct . Right) . traverse f)
instance (Comonad f, Comonad g) => Comonad (Coproduct f g) where
extend f = Coproduct . coproduct
(Left . extend (f . Coproduct . Left))
(Right . extend (f . Coproduct . Right))
extract = coproduct extract extract
instance (Contravariant f, Contravariant g) => Contravariant (Coproduct f g) where
contramap f = Coproduct . coproduct (Left . contramap f) (Right . contramap f)