module Control.Monad.Co
( Co(..)
, lift0, lift1
, lower0, lower1
)where
import Control.Comonad
import Control.Applicative
import Control.Comonad.Store.Class
import Control.Monad.State.Class
import Data.Functor.Bind
newtype Co w a = Co { runCo :: forall r. w (a -> r) -> r }
instance Functor w => Functor (Co w) where
fmap f (Co w) = Co (w . fmap (. f))
instance Extend w => Apply (Co w) where
mf <.> ma = mf >>- (`fmap` ma)
instance Extend w => Bind (Co w) where
Co k >>- f = Co (k . extend (\wa a -> runCo (f a) wa))
instance Comonad w => Applicative (Co w) where
mf <*> ma = mf >>= (`fmap` ma)
pure a = Co (`extract` a)
instance Comonad w => Monad (Co w) where
return a = Co (`extract` a)
Co k >>= f = Co (k . extend (\wa a -> runCo (f a) wa))
lift0 :: Comonad w => (forall a. w a -> s) -> Co w s
lift0 f = Co (extract <*> f)
lower0 :: Functor w => Co w s -> w a -> s
lower0 (Co f) w = f (id <$ w)
lift1 :: (forall a. w a -> a) -> Co w ()
lift1 f = Co (`f` ())
lower1 :: Functor w => Co w () -> w a -> a
lower1 (Co f) w = f (fmap const w)
instance ComonadStore s m => MonadState s (Co m) where
get = lift0 pos
put s = lift1 (peek s)