module Control.Functor.Bifunctor where
import Control.Bifunctor
import Control.Bifunctor.Pair
import Control.Bifunctor.Either
import Control.Functor.Contravariant
import Control.Functor.Exponential
import Control.Functor.Full
import Control.Functor.Pointed
import Control.Arrow ((***),(&&&),(|||),(+++))
newtype BifunctorF p f g a = BifunctorF { runBifunctorF :: p (f a) (g a) }
instance (Bifunctor p, Functor f ,Functor g) => Functor (BifunctorF p f g) where
fmap f = BifunctorF . bimap (fmap f) (fmap f) . runBifunctorF
instance (Bifunctor p, ContravariantFunctor f ,ContravariantFunctor g) => ContravariantFunctor (BifunctorF p f g) where
contramap f = BifunctorF . bimap (contramap f) (contramap f) . runBifunctorF
instance (Bifunctor p, ExpFunctor f ,ExpFunctor g) => ExpFunctor (BifunctorF p f g) where
xmap f g = BifunctorF . bimap (xmap f g) (xmap f g) . runBifunctorF
#ifndef __HADDOCK__
type (f :*: g) a = BifunctorF (,) f g a
#endif
runProductF :: BifunctorF (,) f g a -> (f a, g a)
runProductF = runBifunctorF
instance (Pointed f, Pointed g) => Pointed (BifunctorF (,) f g) where
point = BifunctorF . (point &&& point)
instance (Faithful f, Faithful g) => Faithful (BifunctorF (,) f g)
#ifndef __HADDOCK__
type (f :+: g) a = BifunctorF Either f g a
#endif
runCoproductF :: BifunctorF Either f g a -> Either (f a) (g a)
runCoproductF = runBifunctorF
instance (Copointed f, Copointed g) => Copointed (BifunctorF Either f g) where
copoint = (copoint ||| copoint) . runBifunctorF