module Control.Functor.Combinators.Biff
( Biff(..)
, On, runOn, mkOn
, PAp, runPAp, mkPAp
, PCofree, runPCofree, pcofree
, PFree, runPFree, pfree
) where
import Control.Category.Hask
import Control.Arrow ((|||),(&&&))
import Control.Monad.Identity
import Control.Category.Braided
import Control.Functor
import Control.Functor.Extras
import Control.Monad.Parameterized
import Control.Comonad.Parameterized
newtype Biff p f g a b = Biff { runBiff :: p (f a) (g b) }
type PAp p = Biff p Identity
runPAp :: PFunctor p Hask Hask => PAp p f a b -> p a (f b)
runPAp = first runIdentity . runBiff
mkPAp :: PFunctor p Hask Hask => p a (f b) -> PAp p f a b
mkPAp = Biff . first Identity
type PFree = PAp Either
pfree :: Either a (f b) -> PFree f a b
pfree = mkPAp
runPFree :: PFree f a b -> Either a (f b)
runPFree = runPAp
type PCofree = PAp (,)
runPCofree :: PCofree f a b -> (a, f b)
runPCofree = runPAp
pcofree :: (a, f b) -> PCofree f a b
pcofree = mkPAp
type On p f = Biff p f f
runOn :: On p f a b -> p (f a) (f b)
runOn = runBiff
mkOn :: p (f a) (f b) -> On p f a b
mkOn = Biff
instance (Functor f, PFunctor p Hask Hask) => PFunctor (Biff p f g) Hask Hask where
first f = Biff . first (fmap f) . runBiff
instance (QFunctor q Hask Hask, Functor g) => QFunctor (Biff q f g) Hask Hask where
second g = Biff . second (fmap g) . runBiff
instance (Functor f, Bifunctor p Hask Hask Hask, Functor g) => Bifunctor (Biff p f g) Hask Hask Hask where
bimap f g = Biff . bimap (fmap f) (fmap g) . runBiff
instance (Functor f, Braided Hask p) => Braided Hask (Biff p f f) where
braid = Biff . braid . runBiff
instance (Functor f, Symmetric Hask p) => Symmetric Hask (Biff p f f)
instance (Functor f, Bifunctor p Hask Hask Hask, Functor g) => Functor (Biff p f g a) where
fmap f = bimap id f
instance FunctorPlus f => PPointed (PCofree f) where
preturn a = Biff (Identity a,fzero)
instance Functor f => PPointed (PFree f) where
preturn = Biff . Left . Identity
instance Functor f => PCopointed (PCofree f) where
pextract = runIdentity . fst . runBiff
instance Functor f => PApplicative (PFree f) where
pap = papPMonad
instance Functor f => PMonad (PFree f) where
pbind k = (k . runIdentity ||| Biff . Right) . runBiff
instance FunctorPlus f => PApplicative (PCofree f) where
pap = papPMonad
instance FunctorPlus f => PMonad (PCofree f) where
pbind k (Biff ~(Identity a,as)) = Biff (ib, fplus as bs) where Biff (ib,bs) = k a
instance Functor f => PComonad (PCofree f) where
pextend f = Biff . (Identity . f &&& snd . runBiff)