{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Monad.Trans.Free.Church
(
FT(..)
, F, free, runF
, improveT
, toFT, fromFT
, iterT
, iterTM
, hoistFT
, transFT
, joinFT
, cutoff
, improve
, fromF, toF
, retract
, retractT
, iter
, iterM
, MonadFree(..)
, liftF
) where
import Control.Applicative
import Control.Category ((<<<), (>>>))
import Control.Monad
import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
import qualified Control.Monad.Fail as Fail
import Control.Monad.Identity
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Control.Monad.Reader.Class
import Control.Monad.Writer.Class
import Control.Monad.State.Class
import Control.Monad.Error.Class
import Control.Monad.Cont.Class
import Control.Monad.Free.Class
import Control.Monad.Trans.Free (FreeT(..), FreeF(..), Free)
import qualified Control.Monad.Trans.Free as FreeT
import qualified Data.Foldable as F
import qualified Data.Traversable as T
import Data.Functor.Bind hiding (join)
import Data.Functor.Classes
newtype FT f m a = FT { forall (f :: * -> *) (m :: * -> *) a.
FT f m a
-> forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
runFT :: forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r }
instance (Functor f, Monad m, Eq1 f, Eq1 m) => Eq1 (FT f m) where
liftEq :: forall a b. (a -> b -> Bool) -> FT f m a -> FT f m b -> Bool
liftEq a -> b -> Bool
eq FT f m a
x FT f m b
y = forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq (forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT FT f m a
x) (forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT FT f m b
y)
instance (Functor f, Monad m, Ord1 f, Ord1 m) => Ord1 (FT f m) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> FT f m a -> FT f m b -> Ordering
liftCompare a -> b -> Ordering
cmp FT f m a
x FT f m b
y= forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp (forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT FT f m a
x) (forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT FT f m b
y)
instance (Functor f, Monad m, Eq1 f, Eq1 m, Eq a) => Eq (FT f m a) where
== :: FT f m a -> FT f m a -> Bool
(==) = forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1
instance (Functor f, Monad m, Ord1 f, Ord1 m, Ord a) => Ord (FT f m a) where
compare :: FT f m a -> FT f m a -> Ordering
compare = forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1
instance Functor (FT f m) where
fmap :: forall a b. (a -> b) -> FT f m a -> FT f m b
fmap a -> b
f (FT forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
k) = forall (f :: * -> *) (m :: * -> *) a.
(forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r)
-> FT f m a
FT forall a b. (a -> b) -> a -> b
$ \b -> m r
a forall x. (x -> m r) -> f x -> m r
fr -> forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
k (b -> m r
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) forall x. (x -> m r) -> f x -> m r
fr
instance Apply (FT f m) where
<.> :: forall a b. FT f m (a -> b) -> FT f m a -> FT f m b
(<.>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
instance Applicative (FT f m) where
pure :: forall a. a -> FT f m a
pure a
a = forall (f :: * -> *) (m :: * -> *) a.
(forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r)
-> FT f m a
FT forall a b. (a -> b) -> a -> b
$ \a -> m r
k forall x. (x -> m r) -> f x -> m r
_ -> a -> m r
k a
a
FT forall r.
((a -> b) -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
fk <*> :: forall a b. FT f m (a -> b) -> FT f m a -> FT f m b
<*> FT forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
ak = forall (f :: * -> *) (m :: * -> *) a.
(forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r)
-> FT f m a
FT forall a b. (a -> b) -> a -> b
$ \b -> m r
b forall x. (x -> m r) -> f x -> m r
fr -> forall r.
((a -> b) -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
fk (\a -> b
e -> forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
ak (\a
d -> b -> m r
b (a -> b
e a
d)) forall x. (x -> m r) -> f x -> m r
fr) forall x. (x -> m r) -> f x -> m r
fr
instance Bind (FT f m) where
>>- :: forall a b. FT f m a -> (a -> FT f m b) -> FT f m b
(>>-) = forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
instance Monad (FT f m) where
return :: forall a. a -> FT f m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
FT forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
fk >>= :: forall a b. FT f m a -> (a -> FT f m b) -> FT f m b
>>= a -> FT f m b
f = forall (f :: * -> *) (m :: * -> *) a.
(forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r)
-> FT f m a
FT forall a b. (a -> b) -> a -> b
$ \b -> m r
b forall x. (x -> m r) -> f x -> m r
fr -> forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
fk (\a
d -> forall (f :: * -> *) (m :: * -> *) a.
FT f m a
-> forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
runFT (a -> FT f m b
f a
d) b -> m r
b forall x. (x -> m r) -> f x -> m r
fr) forall x. (x -> m r) -> f x -> m r
fr
instance Fail.MonadFail m => Fail.MonadFail (FT f m) where
fail :: forall a. String -> FT f m a
fail = 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. MonadFail m => String -> m a
Fail.fail
{-# INLINE fail #-}
instance MonadFree f (FT f m) where
wrap :: forall a. f (FT f m a) -> FT f m a
wrap f (FT f m a)
f = forall (f :: * -> *) (m :: * -> *) a.
(forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r)
-> FT f m a
FT (\a -> m r
kp forall x. (x -> m r) -> f x -> m r
kf -> forall x. (x -> m r) -> f x -> m r
kf (\FT f m a
ft -> forall (f :: * -> *) (m :: * -> *) a.
FT f m a
-> forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
runFT FT f m a
ft a -> m r
kp forall x. (x -> m r) -> f x -> m r
kf) f (FT f m a)
f)
instance MonadTrans (FT f) where
lift :: forall (m :: * -> *) a. Monad m => m a -> FT f m a
lift m a
m = forall (f :: * -> *) (m :: * -> *) a.
(forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r)
-> FT f m a
FT (\a -> m r
a forall x. (x -> m r) -> f x -> m r
_ -> m a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m r
a)
instance Alternative m => Alternative (FT f m) where
empty :: forall a. FT f m a
empty = forall (f :: * -> *) (m :: * -> *) a.
(forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r)
-> FT f m a
FT (\a -> m r
_ forall x. (x -> m r) -> f x -> m r
_ -> forall (f :: * -> *) a. Alternative f => f a
empty)
FT forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
k1 <|> :: forall a. FT f m a -> FT f m a -> FT f m a
<|> FT forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
k2 = forall (f :: * -> *) (m :: * -> *) a.
(forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r)
-> FT f m a
FT forall a b. (a -> b) -> a -> b
$ \a -> m r
a forall x. (x -> m r) -> f x -> m r
fr -> forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
k1 a -> m r
a forall x. (x -> m r) -> f x -> m r
fr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
k2 a -> m r
a forall x. (x -> m r) -> f x -> m r
fr
instance MonadPlus m => MonadPlus (FT f m) where
mzero :: forall a. FT f m a
mzero = forall (f :: * -> *) (m :: * -> *) a.
(forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r)
-> FT f m a
FT (\a -> m r
_ forall x. (x -> m r) -> f x -> m r
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero)
mplus :: forall a. FT f m a -> FT f m a -> FT f m a
mplus (FT forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
k1) (FT forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
k2) = forall (f :: * -> *) (m :: * -> *) a.
(forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r)
-> FT f m a
FT forall a b. (a -> b) -> a -> b
$ \a -> m r
a forall x. (x -> m r) -> f x -> m r
fr -> forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
k1 a -> m r
a forall x. (x -> m r) -> f x -> m r
fr forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
k2 a -> m r
a forall x. (x -> m r) -> f x -> m r
fr
instance (Foldable f, Foldable m, Monad m) => Foldable (FT f m) where
foldr :: forall a b. (a -> b -> b) -> b -> FT f m a -> b
foldr a -> b -> b
f b
r FT f m a
xs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(<<<) forall a. a -> a
id m (b -> b)
inner b
r
where
inner :: m (b -> b)
inner = forall (f :: * -> *) (m :: * -> *) a.
FT f m a
-> forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
runFT FT f m a
xs (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> b
f) (\x -> m (b -> b)
xg f x
xf -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(<<<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m (b -> b)
xg) (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id) f x
xf)
{-# INLINE foldr #-}
foldl' :: forall b a. (b -> a -> b) -> b -> FT f m a -> b
foldl' b -> a -> b
f b
z FT f m a
xs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' forall {t} {a} {b}. (t -> a) -> (a -> b) -> t -> b
(!>>>) forall a. a -> a
id m (b -> b)
inner b
z
where
!>>> :: (t -> a) -> (a -> b) -> t -> b
(!>>>) t -> a
h a -> b
g = \t
r -> a -> b
g forall a b. (a -> b) -> a -> b
$! t -> a
h t
r
inner :: m (b -> b)
inner = forall (f :: * -> *) (m :: * -> *) a.
FT f m a
-> forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
runFT FT f m a
xs (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> b
f) (\x -> m (b -> b)
xg f x
xf -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
(>>>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m (b -> b)
xg) (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id) f x
xf)
{-# INLINE foldl' #-}
instance (Monad m, Traversable m, Traversable f) => Traversable (FT f m) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FT f m a -> f (FT f m b)
traverse a -> f b
f (FT forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
k) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
T.sequenceA forall a b. (a -> b) -> a -> b
$ forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
k a -> m (f (FT f m b))
traversePure forall {f :: * -> *} {t :: (* -> *) -> * -> *} {m :: * -> *}
{m :: * -> *} {f :: * -> *} {a} {a}.
(MonadFree f (t m), MonadTrans t, Monad m, Monad m, Traversable f,
Traversable m, Applicative f) =>
(a -> m (f (t m a))) -> f a -> m (f (t m a))
traverseFree
where
traversePure :: a -> m (f (FT f m b))
traversePure = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f
traverseFree :: (a -> m (f (t m a))) -> f a -> m (f (t m a))
traverseFree a -> m (f (t m a))
xg = forall (m :: * -> *) a. Monad m => a -> m a
return forall 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 :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse (forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
T.sequenceA forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (f (t m a))
xg)
instance (MonadIO m) => MonadIO (FT f m) where
liftIO :: forall a. IO a -> FT 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
{-# INLINE liftIO #-}
instance (Functor f, MonadError e m) => MonadError e (FT f m) where
throwError :: forall a. e -> FT f m a
throwError = 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 e (m :: * -> *) a. MonadError e m => e -> m a
throwError
{-# INLINE throwError #-}
FT f m a
m catchError :: forall a. FT f m a -> (e -> FT f m a) -> FT f m a
`catchError` e -> FT f m a
f = forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
FreeT f m a -> FT f m a
toFT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT FT f m a
m forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> FT f m a
f)
instance MonadCont m => MonadCont (FT f m) where
callCC :: forall a b. ((a -> FT f m b) -> FT f m a) -> FT f m a
callCC (a -> FT f m b) -> FT f m a
f = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (\FT f m a -> m b
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (a -> FT f m b) -> FT f m a
f (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. FT f m a -> m b
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return))
instance MonadReader r m => MonadReader r (FT f m) where
ask :: FT f m r
ask = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
{-# INLINE ask #-}
local :: forall a. (r -> r) -> FT f m a -> FT f m a
local r -> r
f = forall (m :: * -> *) (n :: * -> *) (f :: * -> *) b.
(Monad m, Monad n) =>
(forall a. m a -> n a) -> FT f m b -> FT f n b
hoistFT (forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f)
{-# INLINE local #-}
instance (Functor f, MonadWriter w m) => MonadWriter w (FT f m) where
tell :: w -> FT f m ()
tell = 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 w (m :: * -> *). MonadWriter w m => w -> m ()
tell
{-# INLINE tell #-}
listen :: forall a. FT f m a -> FT f m (a, w)
listen = forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
FreeT f m a -> FT f m a
toFT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT
pass :: forall a. FT f m (a, w -> w) -> FT f m a
pass = forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
FreeT f m a -> FT f m a
toFT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT
writer :: forall a. (a, w) -> FT f m a
writer (a, w)
w = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer (a, w)
w)
{-# INLINE writer #-}
instance MonadState s m => MonadState s (FT f m) where
get :: FT f m s
get = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
get
{-# INLINE get #-}
put :: s -> FT f m ()
put = 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 s (m :: * -> *). MonadState s m => s -> m ()
put
{-# INLINE put #-}
state :: forall a. (s -> (a, s)) -> FT f m a
state s -> (a, s)
f = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state s -> (a, s)
f)
{-# INLINE state #-}
instance MonadThrow m => MonadThrow (FT f m) where
throwM :: forall e a. Exception e => e -> FT f m a
throwM = 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 :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
{-# INLINE throwM #-}
instance (Functor f, MonadCatch m) => MonadCatch (FT f m) where
catch :: forall e a. Exception e => FT f m a -> (e -> FT f m a) -> FT f m a
catch FT f m a
m e -> FT f m a
f = forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
FreeT f m a -> FT f m a
toFT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT FT f m a
m forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`Control.Monad.Catch.catch` (forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> FT f m a
f)
{-# INLINE catch #-}
toFT :: Monad m => FreeT f m a -> FT f m a
toFT :: forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
FreeT f m a -> FT f m a
toFT (FreeT m (FreeF f a (FreeT f m a))
f) = forall (f :: * -> *) (m :: * -> *) a.
(forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r)
-> FT f m a
FT forall a b. (a -> b) -> a -> b
$ \a -> m r
ka forall x. (x -> m r) -> f x -> m r
kfr -> do
FreeF f a (FreeT f m a)
freef <- m (FreeF f a (FreeT f m a))
f
case FreeF f a (FreeT f m a)
freef of
Pure a
a -> a -> m r
ka a
a
Free f (FreeT f m a)
fb -> forall x. (x -> m r) -> f x -> m r
kfr (\FreeT f m a
x -> forall (f :: * -> *) (m :: * -> *) a.
FT f m a
-> forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
runFT (forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
FreeT f m a -> FT f m a
toFT FreeT f m a
x) a -> m r
ka forall x. (x -> m r) -> f x -> m r
kfr) f (FreeT f m a)
fb
fromFT :: (Monad m, Functor f) => FT f m a -> FreeT f m a
fromFT :: forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT (FT forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
k) = forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT forall a b. (a -> b) -> a -> b
$ forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
k (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. a -> FreeF f a b
Pure) (\x -> m (FreeF f a (FreeT f m a))
xg -> forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap forall 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 :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m (FreeF f a (FreeT f m a))
xg))
type F f = FT f Identity
runF :: Functor f => F f a -> (forall r. (a -> r) -> (f r -> r) -> r)
runF :: forall (f :: * -> *) a.
Functor f =>
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF (FT forall r.
(a -> Identity r)
-> (forall x. (x -> Identity r) -> f x -> Identity r) -> Identity r
m) = \a -> r
kp f r -> r
kf -> forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall r.
(a -> Identity r)
-> (forall x. (x -> Identity r) -> f x -> Identity r) -> Identity r
m (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> r
kp) (\x -> Identity r
xg -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. f r -> r
kf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Identity r
xg))
free :: (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
free :: forall a (f :: * -> *).
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
free forall r. (a -> r) -> (f r -> r) -> r
f = forall (f :: * -> *) (m :: * -> *) a.
(forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r)
-> FT f m a
FT (\a -> Identity r
kp forall x. (x -> Identity r) -> f x -> Identity r
kf -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall r. (a -> r) -> (f r -> r) -> r
f (forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity r
kp) (forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. (x -> Identity r) -> f x -> Identity r
kf forall (m :: * -> *) a. Monad m => a -> m a
return))
iterT :: (Functor f, Monad m) => (f (m a) -> m a) -> FT f m a -> m a
iterT :: forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Monad m) =>
(f (m a) -> m a) -> FT f m a -> m a
iterT f (m a) -> m a
phi (FT forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
m) = forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
m forall (m :: * -> *) a. Monad m => a -> m a
return (\x -> m a
xg -> f (m a) -> m a
phi forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> m a
xg)
{-# INLINE iterT #-}
iterTM :: (Functor f, Monad m, MonadTrans t, Monad (t m)) => (f (t m a) -> t m a) -> FT f m a -> t m a
iterTM :: forall (f :: * -> *) (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Functor f, Monad m, MonadTrans t, Monad (t m)) =>
(f (t m a) -> t m a) -> FT f m a -> t m a
iterTM f (t m a) -> t m a
f (FT forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
m) = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
m (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return) (\x -> m (t m a)
xg -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (t m a) -> t m a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m (t m a)
xg))
hoistFT :: (Monad m, Monad n) => (forall a. m a -> n a) -> FT f m b -> FT f n b
hoistFT :: forall (m :: * -> *) (n :: * -> *) (f :: * -> *) b.
(Monad m, Monad n) =>
(forall a. m a -> n a) -> FT f m b -> FT f n b
hoistFT forall a. m a -> n a
phi (FT forall r. (b -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
m) = forall (f :: * -> *) (m :: * -> *) a.
(forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r)
-> FT f m a
FT (\b -> n r
kp forall x. (x -> n r) -> f x -> n r
kf -> forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. m a -> n a
phi forall a b. (a -> b) -> a -> b
$ forall r. (b -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
m (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> n r
kp) (\x -> m (n r)
xg -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. (x -> n r) -> f x -> n r
kf (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. m a -> n a
phi forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m (n r)
xg)))
transFT :: (forall a. f a -> g a) -> FT f m b -> FT g m b
transFT :: forall (f :: * -> *) (g :: * -> *) (m :: * -> *) b.
(forall a. f a -> g a) -> FT f m b -> FT g m b
transFT forall a. f a -> g a
phi (FT forall r. (b -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
m) = forall (f :: * -> *) (m :: * -> *) a.
(forall r.
(a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r)
-> FT f m a
FT (\b -> m r
kp forall x. (x -> m r) -> g x -> m r
kf -> forall r. (b -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
m b -> m r
kp (\x -> m r
xg -> forall x. (x -> m r) -> g x -> m r
kf x -> m r
xg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. f a -> g a
phi))
joinFT :: (Monad m, Traversable f) => FT f m a -> m (F f a)
joinFT :: forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Traversable f) =>
FT f m a -> m (F f a)
joinFT (FT forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
m) = forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
m (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return) (\x -> m (F f a)
xg -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
T.mapM x -> m (F f a)
xg)
cutoff :: (Functor f, Monad m) => Integer -> FT f m a -> FT f m (Maybe a)
cutoff :: forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Monad m) =>
Integer -> FT f m a -> FT f m (Maybe a)
cutoff Integer
n = forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
FreeT f m a -> FT f m a
toFT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Monad m) =>
Integer -> FreeT f m a -> FreeT f m (Maybe a)
FreeT.cutoff Integer
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT
retract :: Monad f => F f a -> f a
retract :: forall (f :: * -> *) a. Monad f => F f a -> f a
retract F f a
m = forall (f :: * -> *) a.
Functor f =>
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF F f a
m forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
{-# INLINE retract #-}
retractT :: (MonadTrans t, Monad (t m), Monad m) => FT (t m) m a -> t m a
retractT :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad (t m), Monad m) =>
FT (t m) m a -> t m a
retractT (FT forall r.
(a -> m r) -> (forall x. (x -> m r) -> t m x -> m r) -> m r
m) = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r.
(a -> m r) -> (forall x. (x -> m r) -> t m x -> m r) -> m r
m (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return) (\x -> m (t m a)
xg t m x
xf -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ t m x
xf forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m (t m a)
xg)
iter :: Functor f => (f a -> a) -> F f a -> a
iter :: forall (f :: * -> *) a. Functor f => (f a -> a) -> F f a -> a
iter f a -> a
phi = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Monad m) =>
(f (m a) -> m a) -> FT f m a -> m a
iterT (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> a
phi forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Identity a -> a
runIdentity)
{-# INLINE iter #-}
iterM :: (Functor f, Monad m) => (f (m a) -> m a) -> F f a -> m a
iterM :: forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Monad m) =>
(f (m a) -> m a) -> F f a -> m a
iterM f (m a) -> m a
phi = forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Monad m) =>
(f (m a) -> m a) -> FT f m a -> m a
iterT f (m a) -> m a
phi forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *) (f :: * -> *) b.
(Monad m, Monad n) =>
(forall a. m a -> n a) -> FT f m b -> FT f n b
hoistFT (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity)
fromF :: (Functor f, MonadFree f m) => F f a -> m a
fromF :: forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
F f a -> m a
fromF F f a
m = forall (f :: * -> *) a.
Functor f =>
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF F f a
m forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap
{-# INLINE fromF #-}
toF :: Free f a -> F f a
toF :: forall (f :: * -> *) a. Free f a -> F f a
toF = forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
FreeT f m a -> FT f m a
toFT
{-# INLINE toF #-}
improve :: Functor f => (forall m. MonadFree f m => m a) -> Free f a
improve :: forall (f :: * -> *) a.
Functor f =>
(forall (m :: * -> *). MonadFree f m => m a) -> Free f a
improve forall (m :: * -> *). MonadFree f m => m a
m = forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
F f a -> m a
fromF forall (m :: * -> *). MonadFree f m => m a
m
{-# INLINE improve #-}
improveT :: (Functor f, Monad m) => (forall t. MonadFree f (t m) => t m a) -> FreeT f m a
improveT :: forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Monad m) =>
(forall (t :: (* -> *) -> * -> *). MonadFree f (t m) => t m a)
-> FreeT f m a
improveT forall (t :: (* -> *) -> * -> *). MonadFree f (t m) => t m a
m = forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT forall (t :: (* -> *) -> * -> *). MonadFree f (t m) => t m a
m
{-# INLINE improveT #-}