module Control.Monad.Ideal
(
MonadIdeal(..)
, Ideal
, ideal
, destroyIdeal
, ComonadCoideal(..)
, Coideal
, coideal
, buildCoideal
, Mutual(..)
, (:*)
, (:+)
) where
import Prelude hiding (fst, snd)
import Control.Category.Cartesian
import Control.Category.Hask
import Control.Comonad
import Control.Functor
import Control.Functor.Algebra
import Control.Functor.Combinators.Lift
import Control.Monad.Identity
type Ideal = Ap Either
type Coideal = Ap (,)
ideal :: Either a (f a) -> Ideal f a
ideal = mkAp
coideal :: (a, f a) -> Coideal f a
coideal = mkAp
runIdeal :: Ideal f a -> Either a (f a)
runIdeal = runAp
runCoideal :: Coideal f a -> (a, f a)
runCoideal = runAp
class Functor m => MonadIdeal m where
idealize :: m (Either a (m a)) -> m a
instance Functor f => Pointed (Ideal f) where
point = Lift . Left . Identity
instance MonadIdeal m => Monad (Ideal m) where
return = point
m >>= f = ideal . (id ||| Right . idealize) . runIdeal $ fmap (runIdeal . f) m
destroyIdeal :: Algebra m a -> Ideal m a -> a
destroyIdeal phi = (id ||| phi) . runIdeal
class Functor w => ComonadCoideal w where
coidealize :: w a -> w (a, w a)
instance Functor f => Copointed (Coideal f) where
extract = runIdentity . fst . runLift
instance ComonadCoideal w => Comonad (Coideal w) where
extend f = fmap (f . coideal) . coideal . (id &&& coidealize . snd) . runCoideal
buildCoideal :: Coalgebra m a -> a -> Coideal m a
buildCoideal phi = coideal . (id &&& phi)
newtype Mutual p m n a = Mutual { runMutual :: m (p a (Mutual p n m a)) }
type Mutual' p m n = Lift p (Mutual p m n) (Mutual p n m)
type (m :+ n) = Mutual' Either m n
type (m :* n) = Mutual' (,) m n
instance (Bifunctor p Hask Hask Hask, Functor m, Functor n) => Functor (Mutual p m n) where
fmap f = Mutual . fmap (bimap f (fmap f)) . runMutual