{-# 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,
-- * Free Monads
   MonadFree(..),
   Free(..), isPure, isImpure,
   foldFree,
   evalFree, mapFree, mapFreeM, mapFreeM',
-- * Monad Morphisms
   foldFreeM,
   induce,
-- * Free Monad Transformers
   FreeT(..),
   foldFreeT, foldFreeT', mapFreeT,
   foldFreeA, mapFreeA,
-- * Translate between Free monad and Free monad transformer computations
   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)

-- | This type class generalizes over encodings of Free Monads.
class (Functor f, Monad m) => MonadFree f m where
    free :: m a -> m (Either a (f (m a)))  -- ^ 'Opens' a computation and allows to observe the side effects
    wrap :: f (m a) -> m a                 -- ^  Wraps a side effect into a monadic computation

instance Functor f => MonadFree f (Free f) where
    free :: forall a. Free f a -> Free f (Either a (f (Free f a)))
free = (a -> Free f (Either a (f (Free f a))))
-> (f (Free f a) -> Free f (Either a (f (Free f a))))
-> Free f a
-> Free f (Either a (f (Free f a)))
forall a b (f :: * -> *).
(a -> b) -> (f (Free f a) -> b) -> Free f a -> b
evalFree (Either a (f (Free f a)) -> Free f (Either a (f (Free f a)))
forall (f :: * -> *) a. a -> Free f a
Pure (Either a (f (Free f a)) -> Free f (Either a (f (Free f a))))
-> (a -> Either a (f (Free f a)))
-> a
-> Free f (Either a (f (Free f a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a (f (Free f a))
forall a b. a -> Either a b
Left) (Either a (f (Free f a)) -> Free f (Either a (f (Free f a)))
forall (f :: * -> *) a. a -> Free f a
Pure (Either a (f (Free f a)) -> Free f (Either a (f (Free f a))))
-> (f (Free f a) -> Either a (f (Free f a)))
-> f (Free f a)
-> Free f (Either a (f (Free f a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Free f a) -> Either a (f (Free f a))
forall a b. b -> Either a b
Right)
    wrap :: forall a. f (Free f a) -> Free f a
wrap = f (Free f a) -> Free f a
forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure

data Free f a = Impure (f (Free f a)) | Pure a deriving ((forall x. Free f a -> Rep (Free f a) x)
-> (forall x. Rep (Free f a) x -> Free f a) -> Generic (Free f a)
forall x. Rep (Free f a) x -> Free f a
forall x. Free f a -> Rep (Free f a) x
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
$cfrom :: forall (f :: * -> *) a x. Free f a -> Rep (Free f a) x
from :: forall x. Free f a -> Rep (Free f a) x
$cto :: forall (f :: * -> *) a x. Rep (Free f a) x -> Free f a
to :: forall x. Rep (Free f a) x -> Free f a
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) = (Free f a -> Free f b -> Bool)
-> f (Free f a) -> f (Free f b) -> Bool
forall a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq ((a -> b -> Bool) -> Free f a -> Free f b -> Bool
forall a b. (a -> b -> Bool) -> Free f a -> Free f b -> Bool
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
(==) = 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) = (Free f a -> Free f b -> Ordering)
-> f (Free f a) -> f (Free f b) -> Ordering
forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare ((a -> b -> Ordering) -> Free f a -> Free f b -> Ordering
forall a b.
(a -> b -> Ordering) -> Free f a -> Free f b -> Ordering
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 = Free f a -> Free f a -> Ordering
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String
"Pure "   String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String
"Impure " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Free f a -> ShowS)
-> ([Free f a] -> ShowS) -> Int -> f (Free f a) -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> Free f a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [Free f a] -> ShowS
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 = Free f a -> Free f b
forall {f :: * -> *}. Functor f => Free f a -> Free f b
go where
    go :: Free f a -> Free f b
go (Pure    a
a) = b -> Free f b
forall (f :: * -> *) a. a -> Free f a
Pure (a -> b
f a
a)
    go (Impure f (Free f a)
fa) = f (Free f b) -> Free f b
forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure ((Free f a -> Free f b) -> f (Free f a) -> f (Free f b)
forall a b. (a -> b) -> f a -> f b
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) = f m -> m
forall m. Monoid m => f m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (f m -> m) -> f m -> m
forall a b. (a -> b) -> a -> b
$ (Free f a -> m) -> f (Free f a) -> f m
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> m) -> Free f a -> m
forall m a. Monoid m => (a -> m) -> Free f a -> m
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)   = b -> Free f b
forall (f :: * -> *) a. a -> Free f a
Pure   (b -> Free f b) -> f b -> f (Free f b)
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) = f (Free f b) -> Free f b
forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure (f (Free f b) -> Free f b) -> f (f (Free f b)) -> f (Free f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Free f a -> f (Free f b)) -> f (Free f a) -> f (f (Free f b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse ((a -> f b) -> Free f a -> f (Free f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Free f a -> f (Free f 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          = a -> Free f a
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 = f (Free f b) -> Free f b
forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure ((Free f a -> Free f b) -> f (Free f a) -> f (Free f b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Free f a -> (a -> Free f b) -> Free f b
forall a b. Free f a -> (a -> Free f b) -> Free f b
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 = a -> Free f a
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 = (a -> b) -> Free f a -> Free f b
forall a b. (a -> b) -> Free f a -> Free f b
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 = f (Free f b) -> Free f b
forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure ((Free f (a -> b) -> Free f b)
-> f (Free f (a -> b)) -> f (Free f b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Free f (a -> b) -> Free f a -> Free f b
forall a b. Free f (a -> b) -> Free f a -> Free f b
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 (Bool -> Bool) -> (Free f a -> Bool) -> Free f a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Free f a -> Bool
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 ((Free f a -> b) -> f (Free f a) -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (f b -> b) -> Free f a -> b
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 (f b -> m b) -> m (f b) -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Free f a -> m b) -> f (Free f a) -> m (f b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> f a -> m (f b)
T.mapM ((a -> m b) -> (f b -> m b) -> Free f a -> m b
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 m (f b -> b) -> m (f b) -> m b
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Free f a -> m b) -> f (Free f a) -> m (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse ((a -> m b) -> m (f b -> b) -> Free f a -> m b
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 = (a -> m a) -> (f (m a) -> m a) -> Free f a -> m a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> (f b -> b) -> Free f a -> b
foldFree a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (m (m a) -> m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m a) -> m a) -> (f (m a) -> m (m a)) -> f (m a) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (m a) -> m (m a)
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 = (a -> Free g a)
-> (f (Free g a) -> Free g a) -> Free f a -> Free g a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> (f b -> b) -> Free f a -> b
foldFree a -> Free g a
forall (f :: * -> *) a. a -> Free f a
Pure (g (Free g a) -> Free g a
forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure (g (Free g a) -> Free g a)
-> (f (Free g a) -> g (Free g a)) -> f (Free g a) -> Free g a
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 = (a -> m (Free g a))
-> (f (Free g a) -> m (Free g a)) -> Free f a -> m (Free g a)
forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> (f b -> m b) -> Free f a -> m b
foldFreeM (Free g a -> m (Free g a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Free g a -> m (Free g a)) -> (a -> Free g a) -> a -> m (Free g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Free g a
forall (f :: * -> *) a. a -> Free f a
Pure) ((g (Free g a) -> Free g a) -> m (g (Free g a)) -> m (Free g a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM g (Free g a) -> Free g a
forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure (m (g (Free g a)) -> m (Free g a))
-> (f (Free g a) -> m (g (Free g a)))
-> f (Free g a)
-> m (Free g a)
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 = (a -> m (Free g a))
-> m (f (Free g a) -> Free g a) -> Free f a -> m (Free g a)
forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Applicative m) =>
(a -> m b) -> m (f b -> b) -> Free f a -> m b
foldFreeA (Free g a -> m (Free g a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Free g a -> m (Free g a)) -> (a -> Free g a) -> a -> m (Free g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Free g a
forall (f :: * -> *) a. a -> Free f a
Pure) (((f (Free g a) -> g (Free g a)) -> f (Free g a) -> Free g a)
-> m (f (Free g a) -> g (Free g a)) -> m (f (Free g a) -> Free g a)
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA (g (Free g a) -> Free g a
forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure (g (Free g a) -> Free g a)
-> (f (Free g a) -> g (Free g a)) -> f (Free g a) -> Free g a
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 = (a -> m (Free g a))
-> (f (m (Free g a)) -> m (Free g a)) -> Free f a -> m (Free g a)
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> (f b -> b) -> Free f a -> b
foldFree (Free g a -> m (Free g a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Free g a -> m (Free g a)) -> (a -> Free g a) -> a -> m (Free g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Free g a
forall (f :: * -> *) a. a -> Free f a
Pure)
                         ((g (Free g a) -> Free g a) -> m (g (Free g a)) -> m (Free g a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM g (Free g a) -> Free g a
forall (f :: * -> *) a. f (Free f a) -> Free f a
Impure (m (g (Free g a)) -> m (Free g a))
-> (f (m (Free g a)) -> m (g (Free g a)))
-> f (m (Free g a))
-> m (Free g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (m (g (Free g a))) -> m (g (Free g a))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m (g (Free g a))) -> m (g (Free g a)))
-> (f (m (Free g a)) -> m (m (g (Free g a))))
-> f (m (Free g a))
-> m (g (Free g a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g (m (Free g a)) -> m (g (Free g a)))
-> m (g (m (Free g a))) -> m (m (g (Free g a)))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM g (m (Free g a)) -> m (g (Free g a))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => g (m a) -> m (g a)
T.sequence (m (g (m (Free g a))) -> m (m (g (Free g a))))
-> (f (m (Free g a)) -> m (g (m (Free g a))))
-> f (m (Free g a))
-> m (m (g (Free g a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (m (Free g a)) -> m (g (m (Free g a)))
forall a. f a -> m (g a)
eta)

-- * Monad Transformer
--   (built upon Luke Palmer control-monad-free hackage package)
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 = (a -> m) -> FreeT f m a -> m
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) = m (Either b (f (FreeT f m b))) -> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT (m (Either b (f (FreeT f m b))) -> FreeT f m b)
-> f (m (Either b (f (FreeT f m b)))) -> f (FreeT f m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (Either a (f (FreeT f m a)) -> f (Either b (f (FreeT f m b))))
-> m (Either a (f (FreeT f m a)))
-> f (m (Either b (f (FreeT f m b))))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> m a -> f (m b)
traverse Either a (f (FreeT f m a)) -> f (Either b (f (FreeT f m b)))
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) = b -> Either b (t (t b))
forall a b. a -> Either a b
Left  (b -> Either b (t (t b))) -> f b -> f (Either b (t (t b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
      f' (Right t (t a)
x) = t (t b) -> Either b (t (t b))
forall a b. b -> Either a b
Right (t (t b) -> Either b (t (t b)))
-> f (t (t b)) -> f (Either b (t (t b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((t a -> f (t b)) -> t (t a) -> f (t (t b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse((t a -> f (t b)) -> t (t a) -> f (t (t b)))
-> ((a -> f b) -> t a -> f (t b))
-> (a -> f b)
-> t (t a)
-> f (t (t b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> f b) -> t a -> f (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
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 = m (Either b (f (FreeT f m b))) -> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT (m (Either b (f (FreeT f m b))) -> FreeT f m b)
-> (FreeT f m a -> m (Either b (f (FreeT f m b))))
-> FreeT f m a
-> FreeT f m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either a (f (FreeT f m a)) -> Either b (f (FreeT f m b)))
-> m (Either a (f (FreeT f m a))) -> m (Either b (f (FreeT f m b)))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b)
-> (f (FreeT f m a) -> f (FreeT f m b))
-> Either a (f (FreeT f m a))
-> Either b (f (FreeT f m b))
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f (((FreeT f m a -> FreeT f m b) -> f (FreeT f m a) -> f (FreeT f m b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((FreeT f m a -> FreeT f m b)
 -> f (FreeT f m a) -> f (FreeT f m b))
-> ((a -> b) -> FreeT f m a -> FreeT f m b)
-> (a -> b)
-> f (FreeT f m a)
-> f (FreeT f m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> b) -> FreeT f m a -> FreeT f m b
forall a b. (a -> b) -> FreeT f m a -> FreeT f m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f)) (m (Either a (f (FreeT f m a))) -> m (Either b (f (FreeT f m b))))
-> (FreeT f m a -> m (Either a (f (FreeT f m a))))
-> FreeT f m a
-> m (Either b (f (FreeT f m b)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeT f m a -> m (Either a (f (FreeT f m a)))
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 = a (Either a (f (FreeT f a a))) -> FreeT f a a
forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT (a (Either a (f (FreeT f a a))) -> FreeT f a a)
-> (a -> a (Either a (f (FreeT f a a)))) -> a -> FreeT f a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a (f (FreeT f a a)) -> a (Either a (f (FreeT f a a)))
forall a. a -> a a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (f (FreeT f a a)) -> a (Either a (f (FreeT f a a))))
-> (a -> Either a (f (FreeT f a a)))
-> a
-> a (Either a (f (FreeT f a a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a (f (FreeT f a a))
forall a b. a -> Either a b
Left
    <*> :: forall a b. FreeT f a (a -> b) -> FreeT f a a -> FreeT f 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 = m (Either a (f (FreeT f m a))) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT (m (Either a (f (FreeT f m a))) -> FreeT f m a)
-> (a -> m (Either a (f (FreeT f m a)))) -> a -> FreeT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a (f (FreeT f m a)) -> m (Either a (f (FreeT f m a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (f (FreeT f m a)) -> m (Either a (f (FreeT f m a))))
-> (a -> Either a (f (FreeT f m a)))
-> a
-> m (Either a (f (FreeT f m a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a (f (FreeT f m a))
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 = m (Either b (f (FreeT f m b))) -> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT (m (Either b (f (FreeT f m b))) -> FreeT f m b)
-> m (Either b (f (FreeT f m b))) -> FreeT f m b
forall a b. (a -> b) -> a -> b
$ FreeT f m a -> m (Either a (f (FreeT f m a)))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (Either a (f (FreeT f m a)))
unFreeT FreeT f m a
m m (Either a (f (FreeT f m a)))
-> (Either a (f (FreeT f m a)) -> m (Either b (f (FreeT f m b))))
-> m (Either b (f (FreeT f m b)))
forall a b. m a -> (a -> m b) -> m b
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  -> FreeT f m b -> m (Either b (f (FreeT f m b)))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (Either a (f (FreeT f m a)))
unFreeT (FreeT f m b -> m (Either b (f (FreeT f m b))))
-> FreeT f m b -> m (Either b (f (FreeT f m b)))
forall a b. (a -> b) -> a -> b
$ a -> FreeT f m b
f a
x
             Right f (FreeT f m a)
xc -> Either b (f (FreeT f m b)) -> m (Either b (f (FreeT f m b)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either b (f (FreeT f m b)) -> m (Either b (f (FreeT f m b))))
-> (f (FreeT f m b) -> Either b (f (FreeT f m b)))
-> f (FreeT f m b)
-> m (Either b (f (FreeT f m b)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (FreeT f m b) -> Either b (f (FreeT f m b))
forall a b. b -> Either a b
Right (f (FreeT f m b) -> m (Either b (f (FreeT f m b))))
-> f (FreeT f m b) -> m (Either b (f (FreeT f m b)))
forall a b. (a -> b) -> a -> b
$ (FreeT f m a -> FreeT f m b) -> f (FreeT f m a) -> f (FreeT f m b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FreeT f m a -> (a -> FreeT f m b) -> FreeT f m b
forall a b. FreeT f m a -> (a -> FreeT f m b) -> FreeT f m b
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 = m (Either a (f (FreeT f m a))) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT (m (Either a (f (FreeT f m a))) -> FreeT f m a)
-> (f (FreeT f m a) -> m (Either a (f (FreeT f m a))))
-> f (FreeT f m a)
-> FreeT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a (f (FreeT f m a)) -> m (Either a (f (FreeT f m a)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (f (FreeT f m a)) -> m (Either a (f (FreeT f m a))))
-> (f (FreeT f m a) -> Either a (f (FreeT f m a)))
-> f (FreeT f m a)
-> m (Either a (f (FreeT f m a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (FreeT f m a) -> Either a (f (FreeT f m a))
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 = m (Either a (f (FreeT f m a)))
-> FreeT f m (Either a (f (FreeT f m a)))
forall (m :: * -> *) a. Monad m => m a -> FreeT f m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either a (f (FreeT f m a)))
 -> FreeT f m (Either a (f (FreeT f m a))))
-> (FreeT f m a -> m (Either a (f (FreeT f m a))))
-> FreeT f m a
-> FreeT f m (Either a (f (FreeT f m a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeT f m a -> m (Either a (f (FreeT f m a)))
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 = m (Either a (f (FreeT f m a))) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT (m (Either a (f (FreeT f m a))) -> FreeT f m a)
-> (m a -> m (Either a (f (FreeT f m a)))) -> m a -> FreeT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either a (f (FreeT f m a)))
-> m a -> m (Either a (f (FreeT f m a)))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Either a (f (FreeT f m a))
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 = m a -> FreeT f m a
forall (m :: * -> *) a. Monad m => m a -> FreeT f m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> FreeT f m a) -> (IO a -> m a) -> IO a -> FreeT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall a. IO a -> m a
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 = m a -> FreeT f m a
forall (m :: * -> *) a. Monad m => m a -> FreeT f m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
forall a. m a
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 = m (Either a (f (FreeT f m a))) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT (m (Either a (f (FreeT f m a)))
-> m (Either a (f (FreeT f m a))) -> m (Either a (f (FreeT f m a)))
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (FreeT f m a -> m (Either a (f (FreeT f m a)))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (Either a (f (FreeT f m a)))
unFreeT FreeT f m a
a) (FreeT f m a -> m (Either a (f (FreeT f m 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 = FreeT f m a
forall a. FreeT f m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    <|> :: forall a. FreeT f m a -> FreeT f m a -> FreeT f m a
(<|>) = FreeT f m a -> FreeT f m a -> FreeT f m a
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 = FreeT f m a -> m (Either a (f (FreeT f m a)))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (Either a (f (FreeT f m a)))
unFreeT FreeT f m a
m m (Either a (f (FreeT f m a)))
-> (Either a (f (FreeT f m a)) -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
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 -> (FreeT f m a -> m b) -> f (FreeT f m a) -> m (f b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> f a -> m (f b)
T.mapM ((a -> m b) -> (f b -> m b) -> FreeT f m a -> m b
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 m (f b) -> (f b -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
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 m (Either a (f (FreeT f m a)))
-> (Either a (f (FreeT f m a)) -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either a (f (FreeT f m a)) -> 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)   = b -> m b
forall a. a -> m a
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 (f b -> b) -> m (f b) -> m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (FreeT f m a -> m b) -> f (FreeT f m a) -> m (f b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> f a -> m (f b)
T.mapM ((a -> b) -> (f b -> b) -> FreeT f m a -> m b
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) = m' (Either a (f (FreeT f m' a))) -> FreeT f m' a
forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT (m (Either a (f (FreeT f m' a))) -> m' (Either a (f (FreeT f m' a)))
forall a. m a -> m' a
f (((Either a (f (FreeT f m a)) -> Either a (f (FreeT f m' a)))
-> m (Either a (f (FreeT f m a)))
-> m (Either a (f (FreeT f m' a)))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Either a (f (FreeT f m a)) -> Either a (f (FreeT f m' a)))
 -> m (Either a (f (FreeT f m a)))
 -> m (Either a (f (FreeT f m' a))))
-> ((FreeT f m a -> FreeT f m' a)
    -> Either a (f (FreeT f m a)) -> Either a (f (FreeT f m' a)))
-> (FreeT f m a -> FreeT f m' a)
-> m (Either a (f (FreeT f m a)))
-> m (Either a (f (FreeT f m' a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(f (FreeT f m a) -> f (FreeT f m' a))
-> Either a (f (FreeT f m a)) -> Either a (f (FreeT f m' a))
forall a b. (a -> b) -> Either a a -> Either a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((f (FreeT f m a) -> f (FreeT f m' a))
 -> Either a (f (FreeT f m a)) -> Either a (f (FreeT f m' a)))
-> ((FreeT f m a -> FreeT f m' a)
    -> f (FreeT f m a) -> f (FreeT f m' a))
-> (FreeT f m a -> FreeT f m' a)
-> Either a (f (FreeT f m a))
-> Either a (f (FreeT f m' a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FreeT f m a -> FreeT f m' a)
-> f (FreeT f m a) -> f (FreeT f m' a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ((forall a. m a -> m' a) -> FreeT f m a -> FreeT f m' a
forall (f :: * -> *) (m :: * -> *) (m' :: * -> *) a.
(Functor f, Functor m) =>
(forall a. m a -> m' a) -> FreeT f m a -> FreeT f m' a
mapFreeT m a -> m' a
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 = (a -> m (Free f a))
-> (f (Free f a) -> m (Free f a)) -> FreeT f m a -> m (Free f a)
forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> (f b -> m b) -> FreeT f m a -> m b
foldFreeT (Free f a -> m (Free f a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Free f a -> m (Free f a)) -> (a -> Free f a) -> a -> m (Free f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Free f a
forall (f :: * -> *) a. a -> Free f a
Pure) (Free f a -> m (Free f a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Free f a -> m (Free f a))
-> (f (Free f a) -> Free f a) -> f (Free f a) -> m (Free f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Free f a) -> Free f a
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  = (a -> m a) -> (f (m a) -> m a) -> Free f a -> m a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> (f b -> b) -> Free f a -> b
foldFree a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return f (m a) -> m a
forall a. f (m a) -> m a
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' = m (Either a (f (FreeT f m a))) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (Either a (f (FreeT f m a))) -> FreeT f m a
FreeT (m (Either a (f (FreeT f m a))) -> FreeT f m a)
-> (m (Free f a) -> m (Either a (f (FreeT f m a))))
-> m (Free f a)
-> FreeT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (m (Either a (f (FreeT f m a))))
-> m (Either a (f (FreeT f m a)))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m (Either a (f (FreeT f m a))))
 -> m (Either a (f (FreeT f m a))))
-> (m (Free f a) -> m (m (Either a (f (FreeT f m a)))))
-> m (Free f a)
-> m (Either a (f (FreeT f m a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FreeT f m a -> m (Either a (f (FreeT f m a))))
-> m (FreeT f m a) -> m (m (Either a (f (FreeT f m a))))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM FreeT f m a -> m (Either a (f (FreeT f m a)))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (Either a (f (FreeT f m a)))
unFreeT (m (FreeT f m a) -> m (m (Either a (f (FreeT f m a)))))
-> (m (Free f a) -> m (FreeT f m a))
-> m (Free f a)
-> m (m (Either a (f (FreeT f m a))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Free f a -> FreeT f m a) -> m (Free f a) -> m (FreeT f m a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Free f a -> FreeT f m a
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 = Free f b -> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
Free f a -> m a
trans (Free f b -> FreeT f m b) -> (a -> Free f b) -> a -> FreeT f m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Free f b
f