{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
{-# OPTIONS -Wno-name-shadowing #-}
module Control.Monad.Free (
module Control.Monad,
module Control.Monad.Fail,
MonadFree(..),
Free(..), isPure, isImpure,
foldFree,
evalFree, mapFree, mapFreeM, mapFreeM',
foldFreeM,
induce,
FreeT(..),
foldFreeT, foldFreeT', mapFreeT,
foldFreeA, mapFreeA,
trans, trans', untrans,liftFree
) where
import Control.Applicative
import Control.Monad hiding (fail)
import Control.Monad.Fail
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Data.Bifunctor
import Data.Foldable
import Data.Functor.Classes
import Data.Traversable as T
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
class (Functor f, Monad m) => MonadFree f m where
free :: m a -> m (Either a (f (m a)))
wrap :: f (m a) -> m a
instance Functor f => MonadFree f (Free f) where
free :: forall a. Free f a -> Free f (Either a (f (Free f a)))
free = forall a b (f :: * -> *).
(a -> b) -> (f (Free f a) -> b) -> Free f a -> b
evalFree (forall (f :: * -> *) a. a -> Free f a
Pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (forall (f :: * -> *) a. a -> Free f a
Pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)
wrap :: forall a. f (Free f a) -> Free f a
wrap = forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure
data Free f a = Impure (f (Free f a)) | Pure a deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) a x. Rep (Free f a) x -> Free f a
forall (f :: * -> *) a x. Free f a -> Rep (Free f a) x
$cto :: forall (f :: * -> *) a x. Rep (Free f a) x -> Free f a
$cfrom :: forall (f :: * -> *) a x. Free f a -> Rep (Free f a) x
Generic, Typeable)
instance (Eq1 f) => Eq1 (Free f) where
liftEq :: forall a b. (a -> b -> Bool) -> Free f a -> Free f b -> Bool
liftEq a -> b -> Bool
(==) (Pure a
a) (Pure b
b) = a
a a -> b -> Bool
== b
b
liftEq a -> b -> Bool
(==) (Impure f (Free f a)
a) (Impure f (Free f b)
b) = forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq (forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
(==)) f (Free f a)
a f (Free f b)
b
liftEq a -> b -> Bool
_ Free f a
_ Free f b
_ = Bool
False
instance (Eq a, Eq1 f) => Eq (Free f a) where == :: Free f a -> Free f a -> Bool
(==) = forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1
instance Ord1 f => Ord1 (Free f) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> Free f a -> Free f b -> Ordering
liftCompare a -> b -> Ordering
_ Impure{} Pure{} = Ordering
LT
liftCompare a -> b -> Ordering
_ Pure{} Impure{} = Ordering
GT
liftCompare a -> b -> Ordering
compare (Pure a
a) (Pure b
b) = a -> b -> Ordering
compare a
a b
b
liftCompare a -> b -> Ordering
compare (Impure f (Free f a)
a) (Impure f (Free f b)
b) = forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare (forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
compare) f (Free f a)
a f (Free f b)
b
instance (Ord a, Ord1 f) => Ord (Free f a) where
compare :: Free f a -> Free f a -> Ordering
compare = forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1
instance (Show a, Show1 f) => Show (Free f a) where
showsPrec :: Int -> Free f a -> ShowS
showsPrec Int
p (Pure a
a) = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ (String
"Pure " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
a
showsPrec Int
p (Impure f (Free f a)
a) = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ (String
"Impure " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList Int
11 f (Free f a)
a
instance Functor f => Functor (Free f) where
fmap :: forall a b. (a -> b) -> Free f a -> Free f b
fmap a -> b
f = forall {f :: * -> *}. Functor f => Free f a -> Free f b
go where
go :: Free f a -> Free f b
go (Pure a
a) = forall (f :: * -> *) a. a -> Free f a
Pure (a -> b
f a
a)
go (Impure f (Free f a)
fa) = forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Free f a -> Free f b
go f (Free f a)
fa)
{-# INLINE fmap #-}
instance (Functor f, Foldable f) => Foldable (Free f) where
foldMap :: forall m a. Monoid m => (a -> m) -> Free f a -> m
foldMap a -> m
f (Pure a
a) = a -> m
f a
a
foldMap a -> m
f (Impure f (Free f a)
fa) = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) f (Free f a)
fa
instance Traversable f => Traversable (Free f) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Free f a -> f (Free f b)
traverse a -> f b
f (Pure a
a) = forall (f :: * -> *) a. a -> Free f a
Pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
traverse a -> f b
f (Impure f (Free f a)
a) = forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) f (Free f a)
a
instance Functor f => Monad (Free f) where
return :: forall a. a -> Free f a
return = forall (f :: * -> *) a. a -> Free f a
Pure
Pure a
a >>= :: forall a b. Free f a -> (a -> Free f b) -> Free f b
>>= a -> Free f b
f = a -> Free f b
f a
a
Impure f (Free f a)
fa >>= a -> Free f b
f = forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Free f b
f) f (Free f a)
fa)
instance Functor f => Applicative (Free f) where
pure :: forall a. a -> Free f a
pure = forall (f :: * -> *) a. a -> Free f a
Pure
Pure a -> b
f <*> :: forall a b. Free f (a -> b) -> Free f a -> Free f b
<*> Free f a
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Free f a
x
Impure f (Free f (a -> b))
f <*> Free f a
x = forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Free f a
x) f (Free f (a -> b))
f)
isPure, isImpure :: Free f a -> Bool
isPure :: forall (f :: * -> *) a. Free f a -> Bool
isPure Pure{} = Bool
True; isPure Free f a
_ = Bool
False
isImpure :: forall (f :: * -> *) a. Free f a -> Bool
isImpure = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Free f a -> Bool
isPure
foldFree :: Functor f => (a -> b) -> (f b -> b) -> Free f a -> b
foldFree :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> (f b -> b) -> Free f a -> b
foldFree a -> b
pure f b -> b
_ (Pure a
x) = a -> b
pure a
x
foldFree a -> b
pure f b -> b
imp (Impure f (Free f a)
x) = f b -> b
imp (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> (f b -> b) -> Free f a -> b
foldFree a -> b
pure f b -> b
imp) f (Free f a)
x)
foldFreeM :: (Traversable f, Monad m) => (a -> m b) -> (f b -> m b) -> Free f a -> m b
foldFreeM :: forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> (f b -> m b) -> Free f a -> m b
foldFreeM a -> m b
pure f b -> m b
_ (Pure a
x) = a -> m b
pure a
x
foldFreeM a -> m b
pure f b -> m b
imp (Impure f (Free f a)
x) = f b -> m b
imp forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM (forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> (f b -> m b) -> Free f a -> m b
foldFreeM a -> m b
pure f b -> m b
imp) f (Free f a)
x
foldFreeA :: (Traversable f, Applicative m) => (a -> m b) -> m (f b -> b) -> Free f a -> m b
foldFreeA :: forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Applicative m) =>
(a -> m b) -> m (f b -> b) -> Free f a -> m b
foldFreeA a -> m b
pure m (f b -> b)
_ (Pure a
x) = a -> m b
pure a
x
foldFreeA a -> m b
pure m (f b -> b)
imp (Impure f (Free f a)
x) = m (f b -> b)
imp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Applicative m) =>
(a -> m b) -> m (f b -> b) -> Free f a -> m b
foldFreeA a -> m b
pure m (f b -> b)
imp) f (Free f a)
x
induce :: (Functor f, Monad m) => (forall a. f a -> m a) -> Free f a -> m a
induce :: forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Monad m) =>
(forall a. f a -> m a) -> Free f a -> m a
induce forall a. f a -> m a
f = forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> (f b -> b) -> Free f a -> b
foldFree forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. f a -> m a
f)
evalFree :: (a -> b) -> (f(Free f a) -> b) -> Free f a -> b
evalFree :: forall a b (f :: * -> *).
(a -> b) -> (f (Free f a) -> b) -> Free f a -> b
evalFree a -> b
p f (Free f a) -> b
_ (Pure a
x) = a -> b
p a
x
evalFree a -> b
_ f (Free f a) -> b
i (Impure f (Free f a)
x) = f (Free f a) -> b
i f (Free f a)
x
mapFree :: (Functor f, Functor g) => (f (Free g a) -> g (Free g a)) -> Free f a -> Free g a
mapFree :: forall (f :: * -> *) (g :: * -> *) a.
(Functor f, Functor g) =>
(f (Free g a) -> g (Free g a)) -> Free f a -> Free g a
mapFree f (Free g a) -> g (Free g a)
eta = forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> (f b -> b) -> Free f a -> b
foldFree forall (f :: * -> *) a. a -> Free f a
Pure (forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Free g a) -> g (Free g a)
eta)
mapFreeM :: (Traversable f, Functor g, Monad m) => (f (Free g a) -> m(g (Free g a))) -> Free f a -> m(Free g a)
mapFreeM :: forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a.
(Traversable f, Functor g, Monad m) =>
(f (Free g a) -> m (g (Free g a))) -> Free f a -> m (Free g a)
mapFreeM f (Free g a) -> m (g (Free g a))
eta = forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> (f b -> m b) -> Free f a -> m b
foldFreeM (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. a -> Free f a
Pure) (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Free g a) -> m (g (Free g a))
eta)
mapFreeA :: (Traversable f, Functor g, Applicative m) =>
m (f (Free g a) -> g (Free g a)) -> Free f a -> m(Free g a)
mapFreeA :: forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a.
(Traversable f, Functor g, Applicative m) =>
m (f (Free g a) -> g (Free g a)) -> Free f a -> m (Free g a)
mapFreeA m (f (Free g a) -> g (Free g a))
eta = forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Applicative m) =>
(a -> m b) -> m (f b -> b) -> Free f a -> m b
foldFreeA (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. a -> Free f a
Pure) (forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA (forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure forall b c a. (b -> c) -> (a -> b) -> a -> c
.) m (f (Free g a) -> g (Free g a))
eta)
mapFreeM' :: (Functor f, Traversable g, Monad m) => (forall a. f a -> m(g a)) -> Free f a -> m(Free g a)
mapFreeM' :: forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a.
(Functor f, Traversable g, Monad m) =>
(forall a. f a -> m (g a)) -> Free f a -> m (Free g a)
mapFreeM' forall a. f a -> m (g a)
eta = forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> (f b -> b) -> Free f a -> b
foldFree (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. a -> Free f a
Pure)
(forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
T.sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. f a -> m (g a)
eta)
newtype FreeT f m a = FreeT { forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (Either a (f (FreeT f m a)))
unFreeT :: m (Either a (f (FreeT f m a))) }
instance (Traversable m, Traversable f) => Foldable (FreeT f m) where foldMap :: forall m a. Monoid m => (a -> m) -> FreeT f m a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault
instance (Traversable m, Traversable f) => Traversable (FreeT f m) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FreeT f m a -> f (FreeT f m b)
traverse a -> f b
f (FreeT m (Either a (f (FreeT f m a)))
a) = forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {t :: * -> *} {t :: * -> *}.
(Traversable t, Traversable t) =>
Either a (t (t a)) -> f (Either b (t (t b)))
f' m (Either a (f (FreeT f m a)))
a) where
f' :: Either a (t (t a)) -> f (Either b (t (t b)))
f' (Left a
x) = forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
f' (Right t (t a)
x) = forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverseforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) a -> f b
f t (t a)
x
instance (Functor f, Functor m) => Functor (FreeT f m) where
fmap :: forall a b. (a -> b) -> FreeT f m a -> FreeT f m b
fmap a -> b
f = forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f ((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) a -> b
f)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (Either a (f (FreeT f m a)))
unFreeT
instance (Functor f, Functor a, Monad a) => Applicative (FreeT f a) where
pure :: forall a. a -> FreeT f a a
pure = forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
<*> :: forall a b. FreeT f a (a -> b) -> FreeT f a a -> FreeT f a b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance (Functor f, Monad m) => Monad (FreeT f m) where
return :: forall a. a -> FreeT f m a
return = forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
FreeT f m a
m >>= :: forall a b. FreeT f m a -> (a -> FreeT f m b) -> FreeT f m b
>>= a -> FreeT f m b
f = forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (Either a (f (FreeT f m a)))
unFreeT FreeT f m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either a (f (FreeT f m a))
r ->
case Either a (f (FreeT f m a))
r of
Left a
x -> forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (Either a (f (FreeT f m a)))
unFreeT forall a b. (a -> b) -> a -> b
$ a -> FreeT f m b
f a
x
Right f (FreeT f m a)
xc -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> FreeT f m b
f) f (FreeT f m a)
xc
instance (Functor f, Monad m) => MonadFree f (FreeT f m) where
wrap :: forall a. f (FreeT f m a) -> FreeT f m a
wrap = forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right
free :: forall a. FreeT f m a -> FreeT f m (Either a (f (FreeT f m a)))
free = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (Either a (f (FreeT f m a)))
unFreeT
instance (Functor f) => MonadTrans (FreeT f) where
lift :: forall (m :: * -> *) a. Monad m => m a -> FreeT f m a
lift = forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. a -> Either a b
Left
instance (Functor f, Monad m, MonadIO m) => MonadIO (FreeT f m) where
liftIO :: forall a. IO a -> FreeT f m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance (Functor f, Monad m, MonadPlus m) => MonadPlus (FreeT f m) where
mzero :: forall a. FreeT f m a
mzero = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *) a. MonadPlus m => m a
mzero
mplus :: forall a. FreeT f m a -> FreeT f m a -> FreeT f m a
mplus FreeT f m a
a FreeT f m a
b = forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT (forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (Either a (f (FreeT f m a)))
unFreeT FreeT f m a
a) (forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (Either a (f (FreeT f m a)))
unFreeT FreeT f m a
b))
instance (Functor f, Functor m, Monad m, MonadPlus m) => Alternative (FreeT f m) where
empty :: forall a. FreeT f m a
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
<|> :: forall a. FreeT f m a -> FreeT f m a -> FreeT f m a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
foldFreeT :: (Traversable f, Monad m) => (a -> m b) -> (f b -> m b) -> FreeT f m a -> m b
foldFreeT :: forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> (f b -> m b) -> FreeT f m a -> m b
foldFreeT a -> m b
p f b -> m b
i FreeT f m a
m = forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (Either a (f (FreeT f m a)))
unFreeT FreeT f m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either a (f (FreeT f m a))
r ->
case Either a (f (FreeT f m a))
r of
Left a
x -> a -> m b
p a
x
Right f (FreeT f m a)
fx -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM (forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> (f b -> m b) -> FreeT f m a -> m b
foldFreeT a -> m b
p f b -> m b
i) f (FreeT f m a)
fx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= f b -> m b
i
foldFreeT' :: (Traversable f, Monad m) => (a -> b) -> (f b -> b) -> FreeT f m a -> m b
foldFreeT' :: forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> b) -> (f b -> b) -> FreeT f m a -> m b
foldFreeT' a -> b
p f b -> b
i (FreeT m (Either a (f (FreeT f m a)))
m) = m (Either a (f (FreeT f m a)))
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *}. Monad m => Either a (f (FreeT f m a)) -> m b
f where
f :: Either a (f (FreeT f m a)) -> m b
f (Left a
x) = forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
p a
x)
f (Right f (FreeT f m a)
fx) = f b -> b
i forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM (forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> b) -> (f b -> b) -> FreeT f m a -> m b
foldFreeT' a -> b
p f b -> b
i) f (FreeT f m a)
fx
mapFreeT :: (Functor f, Functor m) => (forall a. m a -> m' a) -> FreeT f m a -> FreeT f m' a
mapFreeT :: forall (f :: * -> *) (m :: * -> *) (m' :: * -> *) a.
(Functor f, Functor m) =>
(forall a. m a -> m' a) -> FreeT f m a -> FreeT f m' a
mapFreeT forall a. m a -> m' a
f (FreeT m (Either a (f (FreeT f m a)))
m) = forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT (forall a. m a -> m' a
f ((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 (f :: * -> *) (m :: * -> *) (m' :: * -> *) a.
(Functor f, Functor m) =>
(forall a. m a -> m' a) -> FreeT f m a -> FreeT f m' a
mapFreeT forall a. m a -> m' a
f) m (Either a (f (FreeT f m a)))
m))
untrans :: (Traversable f, Monad m) => FreeT f m a -> m(Free f a)
untrans :: forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
FreeT f m a -> m (Free f a)
untrans = forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> (f b -> m b) -> FreeT f m a -> m b
foldFreeT (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. a -> Free f a
Pure) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure)
trans :: MonadFree f m => Free f a -> m a
trans :: forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
Free f a -> m a
trans = forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> (f b -> b) -> Free f a -> b
foldFree forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap
trans' :: (Functor f, Monad m) => m(Free f a) -> FreeT f m a
trans' :: forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Monad m) =>
m (Free f a) -> FreeT f m a
trans' = forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (Either a (f (FreeT f m a)))
unFreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
Free f a -> m a
trans
liftFree :: (Functor f, Monad m) => (a -> Free f b) -> (a -> FreeT f m b)
liftFree :: forall (f :: * -> *) (m :: * -> *) a b.
(Functor f, Monad m) =>
(a -> Free f b) -> a -> FreeT f m b
liftFree a -> Free f b
f = forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
Free f a -> m a
trans forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Free f b
f