{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Control.Monad.Free.Improve (
C(..), rep, improve
) where
import Control.Applicative
import Control.Monad
import Control.Monad.Free
import Control.Monad.Trans.Class
newtype C mu a = C (forall b. (a -> mu b) -> mu b)
rep :: Monad mu => mu a -> C mu a
rep :: forall (mu :: * -> *) a. Monad mu => mu a -> C mu a
rep mu a
m = forall (mu :: * -> *) a. (forall b. (a -> mu b) -> mu b) -> C mu a
C (mu a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)
improve :: Monad mu => C mu a -> mu a
improve :: forall (mu :: * -> *) a. Monad mu => C mu a -> mu a
improve (C forall b. (a -> mu b) -> mu b
p) = forall b. (a -> mu b) -> mu b
p forall (m :: * -> *) a. Monad m => a -> m a
return
instance Functor (C mu) where
fmap :: forall a b. (a -> b) -> C mu a -> C mu b
fmap a -> b
f (C forall b. (a -> mu b) -> mu b
m) = forall (mu :: * -> *) a. (forall b. (a -> mu b) -> mu b) -> C mu a
C (\b -> mu b
h -> forall b. (a -> mu b) -> mu b
m (b -> mu b
hforall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> b
f))
instance Monad (C mu) where
return :: forall a. a -> C mu a
return a
a = forall (mu :: * -> *) a. (forall b. (a -> mu b) -> mu b) -> C mu a
C (\a -> mu b
h -> a -> mu b
h a
a)
C forall b. (a -> mu b) -> mu b
p >>= :: forall a b. C mu a -> (a -> C mu b) -> C mu b
>>= a -> C mu b
k = forall (mu :: * -> *) a. (forall b. (a -> mu b) -> mu b) -> C mu a
C (\b -> mu b
h -> forall b. (a -> mu b) -> mu b
p (\a
a -> case a -> C mu b
k a
a of C forall b. (b -> mu b) -> mu b
q -> forall b. (b -> mu b) -> mu b
q b -> mu b
h))
instance Applicative (C mu) where
pure :: forall a. a -> C mu a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. C mu (a -> b) -> C mu a -> C mu b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Functor f => MonadFree f (C (Free f)) where
wrap :: forall a. f (C (Free f) a) -> C (Free f) a
wrap f (C (Free f) a)
t = forall (mu :: * -> *) a. (forall b. (a -> mu b) -> mu b) -> C mu a
C (\a -> Free f b
h -> forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(C forall b. (a -> Free f b) -> Free f b
p) -> forall b. (a -> Free f b) -> Free f b
p a -> Free f b
h) f (C (Free f) a)
t))
free :: forall a. C (Free f) a -> C (Free f) (Either a (f (C (Free f) a)))
free = forall (mu :: * -> *) a. Monad mu => mu a -> C mu a
rep forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) forall (mu :: * -> *) a. Monad mu => mu a -> C mu a
rep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
m a -> m (Either a (f (m a)))
free forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (mu :: * -> *) a. Monad mu => C mu a -> mu a
improve
instance (Monad m, Functor f) => MonadFree f (C (FreeT f m)) where
wrap :: forall a. f (C (FreeT f m) a) -> C (FreeT f m) a
wrap f (C (FreeT f m) a)
t = forall (mu :: * -> *) a. (forall b. (a -> mu b) -> mu b) -> C mu a
C (\a -> FreeT f m b
h -> forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(C forall b. (a -> FreeT f m b) -> FreeT f m b
p) -> forall b. (a -> FreeT f m b) -> FreeT f m b
p a -> FreeT f m b
h) f (C (FreeT f m) a)
t))
free :: forall a.
C (FreeT f m) a -> C (FreeT f m) (Either a (f (C (FreeT f m) a)))
free = forall (mu :: * -> *) a. Monad mu => mu a -> C mu a
rep forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftMforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) forall (mu :: * -> *) a. Monad mu => mu a -> C mu a
rep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
m a -> m (Either a (f (m a)))
free forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (mu :: * -> *) a. Monad mu => C mu a -> mu a
improve
instance MonadPlus mu => MonadPlus (C mu) where
mzero :: forall a. C mu a
mzero = forall (mu :: * -> *) a. Monad mu => mu a -> C mu a
rep forall (m :: * -> *) a. MonadPlus m => m a
mzero
mplus :: forall a. C mu a -> C mu a -> C mu a
mplus C mu a
p1 C mu a
p2 = forall (mu :: * -> *) a. Monad mu => mu a -> C mu a
rep (forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (forall (mu :: * -> *) a. Monad mu => C mu a -> mu a
improve C mu a
p1) (forall (mu :: * -> *) a. Monad mu => C mu a -> mu a
improve C mu a
p2))
instance MonadPlus mu => Alternative (C mu) where
empty :: forall a. C mu a
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
<|> :: forall a. C mu a -> C mu a -> C mu a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance MonadTrans C where lift :: forall (mu :: * -> *) a. Monad mu => mu a -> C mu a
lift m a
m = forall (mu :: * -> *) a. (forall b. (a -> mu b) -> mu b) -> C mu a
C (m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)