module Data.Karakuri (
Karakuri(..)
, Karakuri'
, step
, transKarakuri
, stateful
, stateful'
, effective
) where
import Control.Monad.Trans.State
import Control.Applicative
import Control.Comonad
import Data.Functor.Identity
import Control.Monad
data Karakuri m a = forall s. Karakuri (s -> m s) (s -> a) s
step :: Monad m => Karakuri m a -> m (Karakuri m a)
step (Karakuri m f s) = Karakuri m f `liftM` m s
instance Functor (Karakuri m) where
fmap f (Karakuri m g s) = Karakuri m (f . g) s
instance Monad m => Applicative (Karakuri m) where
pure a = Karakuri return (const a) ()
Karakuri m f s <*> Karakuri n g t = Karakuri
(\(a, b) -> m a >>= \r -> n b >>= \s -> return (r, s))
(\(x, y) -> f x (g y))
(s, t)
instance Comonad (Karakuri m) where
extract (Karakuri _ f s) = f s
extend k (Karakuri m f s) = Karakuri m (k . Karakuri m f) s
instance Monad m => ComonadApply (Karakuri m) where
(<@>) = (<*>)
transKarakuri :: (forall s. m s -> n s) -> Karakuri m a -> Karakuri n a
transKarakuri t (Karakuri f e s) = Karakuri (t . f) e s
stateful :: Monad m => StateT s m () -> s -> Karakuri m s
stateful m s = Karakuri (execStateT m) id s
type Karakuri' = Karakuri Identity
stateful' :: Monad m => State s () -> s -> Karakuri m s
stateful' m s = Karakuri (return . execState m) id s
effective :: Monad m => a -> m a -> Karakuri m a
effective a m = Karakuri (const m) id a