{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE Safe #-}

--------------------------------------------------------------------------------
-- |
-- Given an applicative, the free monad transformer.
--------------------------------------------------------------------------------

module Control.Monad.Trans.Free.Ap
  (
  -- * The base functor
    FreeF(..)
  -- * The free monad transformer
  , FreeT(..)
  -- * The free monad
  , Free, free, runFree
  -- * Operations
  , liftF
  , iterT
  , iterTM
  , hoistFreeT
  , transFreeT
  , joinFreeT
  , cutoff
  , partialIterT
  , intersperseT
  , intercalateT
  , retractT
  -- * Operations of free monad
  , retract
  , iter
  , iterM
  -- * Free Monads With Class
  , MonadFree(..)
  ) where

import Control.Applicative
import Control.Monad (liftM, MonadPlus(..), join)
import Control.Monad.Catch (MonadThrow(..), MonadCatch(..))
import Control.Monad.Trans.Class
import qualified Control.Monad.Fail as Fail
import Control.Monad.Free.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 Data.Functor.Bind hiding (join)
import Data.Functor.Classes
import Data.Functor.Identity
import Data.Traversable
import Data.Bifunctor
import Data.Bifoldable
import Data.Bitraversable
import Data.Data
import GHC.Generics

-- | The base functor for a free monad.
data FreeF f a b = Pure a | Free (f b)
  deriving (FreeF f a b -> FreeF f a b -> Bool
(FreeF f a b -> FreeF f a b -> Bool)
-> (FreeF f a b -> FreeF f a b -> Bool) -> Eq (FreeF f a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) a b.
(Eq a, Eq (f b)) =>
FreeF f a b -> FreeF f a b -> Bool
$c== :: forall (f :: * -> *) a b.
(Eq a, Eq (f b)) =>
FreeF f a b -> FreeF f a b -> Bool
== :: FreeF f a b -> FreeF f a b -> Bool
$c/= :: forall (f :: * -> *) a b.
(Eq a, Eq (f b)) =>
FreeF f a b -> FreeF f a b -> Bool
/= :: FreeF f a b -> FreeF f a b -> Bool
Eq,Eq (FreeF f a b)
Eq (FreeF f a b) =>
(FreeF f a b -> FreeF f a b -> Ordering)
-> (FreeF f a b -> FreeF f a b -> Bool)
-> (FreeF f a b -> FreeF f a b -> Bool)
-> (FreeF f a b -> FreeF f a b -> Bool)
-> (FreeF f a b -> FreeF f a b -> Bool)
-> (FreeF f a b -> FreeF f a b -> FreeF f a b)
-> (FreeF f a b -> FreeF f a b -> FreeF f a b)
-> Ord (FreeF f a b)
FreeF f a b -> FreeF f a b -> Bool
FreeF f a b -> FreeF f a b -> Ordering
FreeF f a b -> FreeF f a b -> FreeF f a b
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (f :: * -> *) a b. (Ord a, Ord (f b)) => Eq (FreeF f a b)
forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
FreeF f a b -> FreeF f a b -> Bool
forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
FreeF f a b -> FreeF f a b -> Ordering
forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
FreeF f a b -> FreeF f a b -> FreeF f a b
$ccompare :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
FreeF f a b -> FreeF f a b -> Ordering
compare :: FreeF f a b -> FreeF f a b -> Ordering
$c< :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
FreeF f a b -> FreeF f a b -> Bool
< :: FreeF f a b -> FreeF f a b -> Bool
$c<= :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
FreeF f a b -> FreeF f a b -> Bool
<= :: FreeF f a b -> FreeF f a b -> Bool
$c> :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
FreeF f a b -> FreeF f a b -> Bool
> :: FreeF f a b -> FreeF f a b -> Bool
$c>= :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
FreeF f a b -> FreeF f a b -> Bool
>= :: FreeF f a b -> FreeF f a b -> Bool
$cmax :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
FreeF f a b -> FreeF f a b -> FreeF f a b
max :: FreeF f a b -> FreeF f a b -> FreeF f a b
$cmin :: forall (f :: * -> *) a b.
(Ord a, Ord (f b)) =>
FreeF f a b -> FreeF f a b -> FreeF f a b
min :: FreeF f a b -> FreeF f a b -> FreeF f a b
Ord,Int -> FreeF f a b -> ShowS
[FreeF f a b] -> ShowS
FreeF f a b -> String
(Int -> FreeF f a b -> ShowS)
-> (FreeF f a b -> String)
-> ([FreeF f a b] -> ShowS)
-> Show (FreeF f a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
Int -> FreeF f a b -> ShowS
forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
[FreeF f a b] -> ShowS
forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
FreeF f a b -> String
$cshowsPrec :: forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
Int -> FreeF f a b -> ShowS
showsPrec :: Int -> FreeF f a b -> ShowS
$cshow :: forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
FreeF f a b -> String
show :: FreeF f a b -> String
$cshowList :: forall (f :: * -> *) a b.
(Show a, Show (f b)) =>
[FreeF f a b] -> ShowS
showList :: [FreeF f a b] -> ShowS
Show,ReadPrec [FreeF f a b]
ReadPrec (FreeF f a b)
Int -> ReadS (FreeF f a b)
ReadS [FreeF f a b]
(Int -> ReadS (FreeF f a b))
-> ReadS [FreeF f a b]
-> ReadPrec (FreeF f a b)
-> ReadPrec [FreeF f a b]
-> Read (FreeF f a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadPrec [FreeF f a b]
forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadPrec (FreeF f a b)
forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
Int -> ReadS (FreeF f a b)
forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadS [FreeF f a b]
$creadsPrec :: forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
Int -> ReadS (FreeF f a b)
readsPrec :: Int -> ReadS (FreeF f a b)
$creadList :: forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadS [FreeF f a b]
readList :: ReadS [FreeF f a b]
$creadPrec :: forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadPrec (FreeF f a b)
readPrec :: ReadPrec (FreeF f a b)
$creadListPrec :: forall (f :: * -> *) a b.
(Read a, Read (f b)) =>
ReadPrec [FreeF f a b]
readListPrec :: ReadPrec [FreeF f a b]
Read,Typeable (FreeF f a b)
Typeable (FreeF f a b) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> FreeF f a b -> c (FreeF f a b))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (FreeF f a b))
-> (FreeF f a b -> Constr)
-> (FreeF f a b -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (FreeF f a b)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (FreeF f a b)))
-> ((forall b. Data b => b -> b) -> FreeF f a b -> FreeF f a b)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FreeF f a b -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FreeF f a b -> r)
-> (forall u. (forall d. Data d => d -> u) -> FreeF f a b -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FreeF f a b -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FreeF f a b -> m (FreeF f a b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FreeF f a b -> m (FreeF f a b))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FreeF f a b -> m (FreeF f a b))
-> Data (FreeF f a b)
FreeF f a b -> Constr
FreeF f a b -> DataType
(forall b. Data b => b -> b) -> FreeF f a b -> FreeF f a b
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FreeF f a b -> u
forall u. (forall d. Data d => d -> u) -> FreeF f a b -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FreeF f a b -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FreeF f a b -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FreeF f a b -> m (FreeF f a b)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FreeF f a b -> m (FreeF f a b)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FreeF f a b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FreeF f a b -> c (FreeF f a b)
forall (f :: * -> *) a b.
(Typeable f, Typeable b, Data a, Data (f b)) =>
Typeable (FreeF f a b)
forall (f :: * -> *) a b.
(Typeable f, Typeable b, Data a, Data (f b)) =>
FreeF f a b -> Constr
forall (f :: * -> *) a b.
(Typeable f, Typeable b, Data a, Data (f b)) =>
FreeF f a b -> DataType
forall (f :: * -> *) a b.
(Typeable f, Typeable b, Data a, Data (f b)) =>
(forall b. Data b => b -> b) -> FreeF f a b -> FreeF f a b
forall (f :: * -> *) a b u.
(Typeable f, Typeable b, Data a, Data (f b)) =>
Int -> (forall d. Data d => d -> u) -> FreeF f a b -> u
forall (f :: * -> *) a b u.
(Typeable f, Typeable b, Data a, Data (f b)) =>
(forall d. Data d => d -> u) -> FreeF f a b -> [u]
forall (f :: * -> *) a b r r'.
(Typeable f, Typeable b, Data a, Data (f b)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FreeF f a b -> r
forall (f :: * -> *) a b r r'.
(Typeable f, Typeable b, Data a, Data (f b)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FreeF f a b -> r
forall (f :: * -> *) a b (m :: * -> *).
(Typeable f, Typeable b, Data a, Data (f b), Monad m) =>
(forall d. Data d => d -> m d) -> FreeF f a b -> m (FreeF f a b)
forall (f :: * -> *) a b (m :: * -> *).
(Typeable f, Typeable b, Data a, Data (f b), MonadPlus m) =>
(forall d. Data d => d -> m d) -> FreeF f a b -> m (FreeF f a b)
forall (f :: * -> *) a b (c :: * -> *).
(Typeable f, Typeable b, Data a, Data (f b)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FreeF f a b)
forall (f :: * -> *) a b (c :: * -> *).
(Typeable f, Typeable b, Data a, Data (f b)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FreeF f a b -> c (FreeF f a b)
forall (f :: * -> *) a b (t :: * -> *) (c :: * -> *).
(Typeable f, Typeable b, Data a, Data (f b), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FreeF f a b))
forall (f :: * -> *) a b (t :: * -> * -> *) (c :: * -> *).
(Typeable f, Typeable b, Data a, Data (f b), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FreeF f a b))
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FreeF f a b))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FreeF f a b))
$cgfoldl :: forall (f :: * -> *) a b (c :: * -> *).
(Typeable f, Typeable b, Data a, Data (f b)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FreeF f a b -> c (FreeF f a b)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FreeF f a b -> c (FreeF f a b)
$cgunfold :: forall (f :: * -> *) a b (c :: * -> *).
(Typeable f, Typeable b, Data a, Data (f b)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FreeF f a b)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FreeF f a b)
$ctoConstr :: forall (f :: * -> *) a b.
(Typeable f, Typeable b, Data a, Data (f b)) =>
FreeF f a b -> Constr
toConstr :: FreeF f a b -> Constr
$cdataTypeOf :: forall (f :: * -> *) a b.
(Typeable f, Typeable b, Data a, Data (f b)) =>
FreeF f a b -> DataType
dataTypeOf :: FreeF f a b -> DataType
$cdataCast1 :: forall (f :: * -> *) a b (t :: * -> *) (c :: * -> *).
(Typeable f, Typeable b, Data a, Data (f b), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FreeF f a b))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FreeF f a b))
$cdataCast2 :: forall (f :: * -> *) a b (t :: * -> * -> *) (c :: * -> *).
(Typeable f, Typeable b, Data a, Data (f b), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FreeF f a b))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FreeF f a b))
$cgmapT :: forall (f :: * -> *) a b.
(Typeable f, Typeable b, Data a, Data (f b)) =>
(forall b. Data b => b -> b) -> FreeF f a b -> FreeF f a b
gmapT :: (forall b. Data b => b -> b) -> FreeF f a b -> FreeF f a b
$cgmapQl :: forall (f :: * -> *) a b r r'.
(Typeable f, Typeable b, Data a, Data (f b)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FreeF f a b -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FreeF f a b -> r
$cgmapQr :: forall (f :: * -> *) a b r r'.
(Typeable f, Typeable b, Data a, Data (f b)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FreeF f a b -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FreeF f a b -> r
$cgmapQ :: forall (f :: * -> *) a b u.
(Typeable f, Typeable b, Data a, Data (f b)) =>
(forall d. Data d => d -> u) -> FreeF f a b -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FreeF f a b -> [u]
$cgmapQi :: forall (f :: * -> *) a b u.
(Typeable f, Typeable b, Data a, Data (f b)) =>
Int -> (forall d. Data d => d -> u) -> FreeF f a b -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FreeF f a b -> u
$cgmapM :: forall (f :: * -> *) a b (m :: * -> *).
(Typeable f, Typeable b, Data a, Data (f b), Monad m) =>
(forall d. Data d => d -> m d) -> FreeF f a b -> m (FreeF f a b)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FreeF f a b -> m (FreeF f a b)
$cgmapMp :: forall (f :: * -> *) a b (m :: * -> *).
(Typeable f, Typeable b, Data a, Data (f b), MonadPlus m) =>
(forall d. Data d => d -> m d) -> FreeF f a b -> m (FreeF f a b)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FreeF f a b -> m (FreeF f a b)
$cgmapMo :: forall (f :: * -> *) a b (m :: * -> *).
(Typeable f, Typeable b, Data a, Data (f b), MonadPlus m) =>
(forall d. Data d => d -> m d) -> FreeF f a b -> m (FreeF f a b)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FreeF f a b -> m (FreeF f a b)
Data,(forall x. FreeF f a b -> Rep (FreeF f a b) x)
-> (forall x. Rep (FreeF f a b) x -> FreeF f a b)
-> Generic (FreeF f a b)
forall x. Rep (FreeF f a b) x -> FreeF f a b
forall x. FreeF f a b -> Rep (FreeF f a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) a b x. Rep (FreeF f a b) x -> FreeF f a b
forall (f :: * -> *) a b x. FreeF f a b -> Rep (FreeF f a b) x
$cfrom :: forall (f :: * -> *) a b x. FreeF f a b -> Rep (FreeF f a b) x
from :: forall x. FreeF f a b -> Rep (FreeF f a b) x
$cto :: forall (f :: * -> *) a b x. Rep (FreeF f a b) x -> FreeF f a b
to :: forall x. Rep (FreeF f a b) x -> FreeF f a b
Generic,(forall a. FreeF f a a -> Rep1 (FreeF f a) a)
-> (forall a. Rep1 (FreeF f a) a -> FreeF f a a)
-> Generic1 (FreeF f a)
forall a. Rep1 (FreeF f a) a -> FreeF f a a
forall a. FreeF f a a -> Rep1 (FreeF f a) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
forall (f :: * -> *) a a. Rep1 (FreeF f a) a -> FreeF f a a
forall (f :: * -> *) a a. FreeF f a a -> Rep1 (FreeF f a) a
$cfrom1 :: forall (f :: * -> *) a a. FreeF f a a -> Rep1 (FreeF f a) a
from1 :: forall a. FreeF f a a -> Rep1 (FreeF f a) a
$cto1 :: forall (f :: * -> *) a a. Rep1 (FreeF f a) a -> FreeF f a a
to1 :: forall a. Rep1 (FreeF f a) a -> FreeF f a a
Generic1)

instance Show1 f => Show2 (FreeF f) where
  liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> FreeF f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
spa [a] -> ShowS
_sla Int -> b -> ShowS
_spb [b] -> ShowS
_slb Int
d (Pure a
a) =
    (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
spa String
"Pure" Int
d a
a
  liftShowsPrec2 Int -> a -> ShowS
_spa [a] -> ShowS
_sla Int -> b -> ShowS
spb [b] -> ShowS
slb Int
d (Free f b
as) =
    (Int -> f b -> ShowS) -> String -> Int -> f b -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> f b -> 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 -> b -> ShowS
spb [b] -> ShowS
slb) String
"Free" Int
d f b
as

instance (Show1 f, Show a) => Show1 (FreeF f a) where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> FreeF f a a -> ShowS
liftShowsPrec = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> FreeF f a a
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> FreeF f a b
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList

instance Read1 f => Read2 (FreeF f) where
  liftReadsPrec2 :: forall a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (FreeF f a b)
liftReadsPrec2 Int -> ReadS a
rpa ReadS [a]
_rla Int -> ReadS b
rpb ReadS [b]
rlb = (String -> ReadS (FreeF f a b)) -> Int -> ReadS (FreeF f a b)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (FreeF f a b)) -> Int -> ReadS (FreeF f a b))
-> (String -> ReadS (FreeF f a b)) -> Int -> ReadS (FreeF f a b)
forall a b. (a -> b) -> a -> b
$
    (Int -> ReadS a)
-> String -> (a -> FreeF f a b) -> String -> ReadS (FreeF f a b)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith Int -> ReadS a
rpa String
"Pure" a -> FreeF f a b
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (String -> ReadS (FreeF f a b))
-> (String -> ReadS (FreeF f a b)) -> String -> ReadS (FreeF f a b)
forall a. Monoid a => a -> a -> a
`mappend`
    (Int -> ReadS (f b))
-> String -> (f b -> FreeF f a b) -> String -> ReadS (FreeF f a b)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith ((Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (f b)
forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS b
rpb ReadS [b]
rlb) String
"Free" f b -> FreeF f a b
forall (f :: * -> *) a b. f b -> FreeF f a b
Free

instance (Read1 f, Read a) => Read1 (FreeF f a) where
  liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (FreeF f a a)
liftReadsPrec = (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS a)
-> ReadS [a]
-> Int
-> ReadS (FreeF f a a)
forall a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (FreeF f a b)
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec ReadS [a]
forall a. Read a => ReadS [a]
readList

instance Eq1 f => Eq2 (FreeF f) where
  liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> FreeF f a c -> FreeF f b d -> Bool
liftEq2 a -> b -> Bool
eq c -> d -> Bool
_ (Pure a
a) (Pure b
b) = a -> b -> Bool
eq a
a b
b
  liftEq2 a -> b -> Bool
_ c -> d -> Bool
eq (Free f c
as) (Free f d
bs) = (c -> d -> Bool) -> f c -> f d -> 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 c -> d -> Bool
eq f c
as f d
bs
  liftEq2 a -> b -> Bool
_ c -> d -> Bool
_ FreeF f a c
_ FreeF f b d
_ = Bool
False

instance (Eq1 f, Eq a) => Eq1 (FreeF f a) where
  liftEq :: forall a b. (a -> b -> Bool) -> FreeF f a a -> FreeF f a b -> Bool
liftEq = (a -> a -> Bool)
-> (a -> b -> Bool) -> FreeF f a a -> FreeF f a b -> Bool
forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> FreeF f a c -> FreeF f b d -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

instance Ord1 f => Ord2 (FreeF f) where
  liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> FreeF f a c -> FreeF f b d -> Ordering
liftCompare2 a -> b -> Ordering
cmp c -> d -> Ordering
_ (Pure a
a) (Pure b
b) = a -> b -> Ordering
cmp a
a b
b
  liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ (Pure a
_) (Free f d
_) = Ordering
LT
  liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
_ (Free f c
_) (Pure b
_) = Ordering
GT
  liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
cmp (Free f c
fa) (Free f d
fb) = (c -> d -> Ordering) -> f c -> f d -> 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 c -> d -> Ordering
cmp f c
fa f d
fb

instance (Ord1 f, Ord a) => Ord1 (FreeF f a) where
  liftCompare :: forall a b.
(a -> b -> Ordering) -> FreeF f a a -> FreeF f a b -> Ordering
liftCompare = (a -> a -> Ordering)
-> (a -> b -> Ordering) -> FreeF f a a -> FreeF f a b -> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> FreeF f a c -> FreeF f b d -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

instance Functor f => Functor (FreeF f a) where
  fmap :: forall a b. (a -> b) -> FreeF f a a -> FreeF f a b
fmap a -> b
_ (Pure a
a)  = a -> FreeF f a b
forall (f :: * -> *) a b. a -> FreeF f a b
Pure a
a
  fmap a -> b
f (Free f a
as) = f b -> FreeF f a b
forall (f :: * -> *) a b. f b -> FreeF f a b
Free ((a -> b) -> 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 f a
as)
  {-# INLINE fmap #-}

instance Foldable f => Foldable (FreeF f a) where
  foldMap :: forall m a. Monoid m => (a -> m) -> FreeF f a a -> m
foldMap a -> m
f (Free f a
as) = (a -> m) -> f a -> m
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f f a
as
  foldMap a -> m
_ FreeF f a a
_         = m
forall a. Monoid a => a
mempty
  {-# INLINE foldMap #-}

instance Traversable f => Traversable (FreeF f a) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FreeF f a a -> f (FreeF f a b)
traverse a -> f b
_ (Pure a
a)  = FreeF f a b -> f (FreeF f a b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> FreeF f a b
forall (f :: * -> *) a b. a -> FreeF f a b
Pure a
a)
  traverse a -> f b
f (Free f a
as) = f b -> FreeF f a b
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f b -> FreeF f a b) -> f (f b) -> f (FreeF f a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> f a -> f (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
f f a
as
  {-# INLINE traverse #-}

instance Functor f => Bifunctor (FreeF f) where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> FreeF f a c -> FreeF f b d
bimap a -> b
f c -> d
_ (Pure a
a)  = b -> FreeF f b d
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (a -> b
f a
a)
  bimap a -> b
_ c -> d
g (Free f c
as) = f d -> FreeF f b d
forall (f :: * -> *) a b. f b -> FreeF f a b
Free ((c -> d) -> f c -> f d
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g f c
as)
  {-# INLINE bimap #-}

instance Foldable f => Bifoldable (FreeF f) where
  bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> FreeF f a b -> m
bifoldMap a -> m
f b -> m
_ (Pure a
a)  = a -> m
f a
a
  bifoldMap a -> m
_ b -> m
g (Free f b
as) = (b -> m) -> f b -> m
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g f b
as
  {-# INLINE bifoldMap #-}

instance Traversable f => Bitraversable (FreeF f) where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> FreeF f a b -> f (FreeF f c d)
bitraverse a -> f c
f b -> f d
_ (Pure a
a)  = c -> FreeF f c d
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (c -> FreeF f c d) -> f c -> f (FreeF f c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a
  bitraverse a -> f c
_ b -> f d
g (Free f b
as) = f d -> FreeF f c d
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f d -> FreeF f c d) -> f (f d) -> f (FreeF f c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (b -> f d) -> f b -> f (f d)
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 b -> f d
g f b
as
  {-# INLINE bitraverse #-}

transFreeF :: (forall x. f x -> g x) -> FreeF f a b -> FreeF g a b
transFreeF :: forall (f :: * -> *) (g :: * -> *) a b.
(forall x. f x -> g x) -> FreeF f a b -> FreeF g a b
transFreeF forall x. f x -> g x
_ (Pure a
a) = a -> FreeF g a b
forall (f :: * -> *) a b. a -> FreeF f a b
Pure a
a
transFreeF forall x. f x -> g x
t (Free f b
as) = g b -> FreeF g a b
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f b -> g b
forall x. f x -> g x
t f b
as)
{-# INLINE transFreeF #-}

-- | The \"free monad transformer\" for an applicative @f@
newtype FreeT f m a = FreeT { forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT :: m (FreeF f a (FreeT f m a)) }

-- | The \"free monad\" for an applicative @f@.
type Free f = FreeT f Identity

-- | Evaluates the first layer out of a free monad value.
runFree :: Free f a -> FreeF f a (Free f a)
runFree :: forall (f :: * -> *) a. Free f a -> FreeF f a (Free f a)
runFree = Identity (FreeF f a (Free f a)) -> FreeF f a (Free f a)
forall a. Identity a -> a
runIdentity (Identity (FreeF f a (Free f a)) -> FreeF f a (Free f a))
-> (Free f a -> Identity (FreeF f a (Free f a)))
-> Free f a
-> FreeF f a (Free f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Free f a -> Identity (FreeF f a (Free f a))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT
{-# INLINE runFree #-}

-- | Pushes a layer into a free monad value.
free :: FreeF f a (Free f a) -> Free f a
free :: forall (f :: * -> *) a. FreeF f a (Free f a) -> Free f a
free = Identity (FreeF f a (FreeT f Identity a)) -> FreeT f Identity a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (Identity (FreeF f a (FreeT f Identity a)) -> FreeT f Identity a)
-> (FreeF f a (FreeT f Identity a)
    -> Identity (FreeF f a (FreeT f Identity a)))
-> FreeF f a (FreeT f Identity a)
-> FreeT f Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeF f a (FreeT f Identity a)
-> Identity (FreeF f a (FreeT f Identity a))
forall a. a -> Identity a
Identity
{-# INLINE free #-}

deriving instance
  ( Typeable f, Typeable m
  , Data (m (FreeF f a (FreeT f m a)))
  , Data a
  ) => Data (FreeT f m a)

instance (Eq1 f, Eq1 m, Eq a) => Eq (FreeT f m a) where
    == :: FreeT f m a -> FreeT f m a -> Bool
(==) = FreeT f m a -> FreeT f m a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1

instance (Eq1 f, Eq1 m) => Eq1 (FreeT f m) where
  liftEq :: forall a b. (a -> b -> Bool) -> FreeT f m a -> FreeT f m b -> Bool
liftEq a -> b -> Bool
eq = FreeT f m a -> FreeT f m b -> Bool
forall {f :: * -> *} {f :: * -> *}.
(Eq1 f, Eq1 f) =>
FreeT f f a -> FreeT f f b -> Bool
go
    where
      go :: FreeT f f a -> FreeT f f b -> Bool
go (FreeT f (FreeF f a (FreeT f f a))
x) (FreeT f (FreeF f b (FreeT f f b))
y) = (FreeF f a (FreeT f f a) -> FreeF f b (FreeT f f b) -> Bool)
-> f (FreeF f a (FreeT f f a))
-> f (FreeF f b (FreeT f 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)
-> (FreeT f f a -> FreeT f f b -> Bool)
-> FreeF f a (FreeT f f a)
-> FreeF f b (FreeT f f b)
-> Bool
forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> FreeF f a c -> FreeF f b d -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> b -> Bool
eq FreeT f f a -> FreeT f f b -> Bool
go) f (FreeF f a (FreeT f f a))
x f (FreeF f b (FreeT f f b))
y

instance (Ord1 f, Ord1 m, Ord a) => Ord (FreeT f m a) where
    compare :: FreeT f m a -> FreeT f m a -> Ordering
compare = FreeT f m a -> FreeT f m a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1

instance (Ord1 f, Ord1 m) => Ord1 (FreeT f m) where
  liftCompare :: forall a b.
(a -> b -> Ordering) -> FreeT f m a -> FreeT f m b -> Ordering
liftCompare a -> b -> Ordering
cmp = FreeT f m a -> FreeT f m b -> Ordering
forall {f :: * -> *} {f :: * -> *}.
(Ord1 f, Ord1 f) =>
FreeT f f a -> FreeT f f b -> Ordering
go
    where
      go :: FreeT f f a -> FreeT f f b -> Ordering
go (FreeT f (FreeF f a (FreeT f f a))
x) (FreeT f (FreeF f b (FreeT f f b))
y) = (FreeF f a (FreeT f f a) -> FreeF f b (FreeT f f b) -> Ordering)
-> f (FreeF f a (FreeT f f a))
-> f (FreeF f b (FreeT f 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)
-> (FreeT f f a -> FreeT f f b -> Ordering)
-> FreeF f a (FreeT f f a)
-> FreeF f b (FreeT f f b)
-> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> FreeF f a c -> FreeF f b d -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> b -> Ordering
cmp FreeT f f a -> FreeT f f b -> Ordering
go) f (FreeF f a (FreeT f f a))
x f (FreeF f b (FreeT f f b))
y

instance (Show1 f, Show1 m) => Show1 (FreeT f m) where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> FreeT f m a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl = Int -> FreeT f m a -> ShowS
go
    where
      goList :: [FreeT f m a] -> ShowS
goList = (Int -> a -> ShowS) -> ([a] -> ShowS) -> [FreeT f m a] -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [FreeT f m a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl
      go :: Int -> FreeT f m a -> ShowS
go Int
d (FreeT m (FreeF f a (FreeT f m a))
x) = (Int -> m (FreeF f a (FreeT f m a)) -> ShowS)
-> String -> Int -> m (FreeF f a (FreeT f m a)) -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith
        ((Int -> FreeF f a (FreeT f m a) -> ShowS)
-> ([FreeF f a (FreeT f m a)] -> ShowS)
-> Int
-> m (FreeF f a (FreeT f m a))
-> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> m a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec ((Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> FreeT f m a -> ShowS)
-> ([FreeT f m a] -> ShowS)
-> Int
-> FreeF f a (FreeT f m a)
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> FreeF f a b
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp [a] -> ShowS
sl Int -> FreeT f m a -> ShowS
go [FreeT f m a] -> ShowS
goList) ((Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> FreeT f m a -> ShowS)
-> ([FreeT f m a] -> ShowS)
-> [FreeF f a (FreeT f m a)]
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [FreeF f a b]
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [f a b]
-> ShowS
liftShowList2 Int -> a -> ShowS
sp [a] -> ShowS
sl Int -> FreeT f m a -> ShowS
go [FreeT f m a] -> ShowS
goList))
        String
"FreeT" Int
d m (FreeF f a (FreeT f m a))
x

instance (Show1 f, Show1 m, Show a) => Show (FreeT f m a) where
  showsPrec :: Int -> FreeT f m a -> ShowS
showsPrec = Int -> FreeT f m a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1

instance (Read1 f, Read1 m) => Read1 (FreeT f m) where
  liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (FreeT f m a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = Int -> ReadS (FreeT f m a)
go
    where
      goList :: ReadS [FreeT f m a]
goList = (Int -> ReadS a) -> ReadS [a] -> ReadS [FreeT f m a]
forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [FreeT f m a]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadList Int -> ReadS a
rp ReadS [a]
rl
      go :: Int -> ReadS (FreeT f m a)
go = (String -> ReadS (FreeT f m a)) -> Int -> ReadS (FreeT f m a)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (FreeT f m a)) -> Int -> ReadS (FreeT f m a))
-> (String -> ReadS (FreeT f m a)) -> Int -> ReadS (FreeT f m a)
forall a b. (a -> b) -> a -> b
$ (Int -> ReadS (m (FreeF f a (FreeT f m a))))
-> String
-> (m (FreeF f a (FreeT f m a)) -> FreeT f m a)
-> String
-> ReadS (FreeT f m a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith
        ((Int -> ReadS (FreeF f a (FreeT f m a)))
-> ReadS [FreeF f a (FreeT f m a)]
-> Int
-> ReadS (m (FreeF f a (FreeT f m a)))
forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (m a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec ((Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS (FreeT f m a))
-> ReadS [FreeT f m a]
-> Int
-> ReadS (FreeF f a (FreeT f m a))
forall a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (FreeF f a b)
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 Int -> ReadS a
rp ReadS [a]
rl Int -> ReadS (FreeT f m a)
go ReadS [FreeT f m a]
goList) ((Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS (FreeT f m a))
-> ReadS [FreeT f m a]
-> ReadS [FreeF f a (FreeT f m a)]
forall a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> ReadS [FreeF f a b]
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
liftReadList2 Int -> ReadS a
rp ReadS [a]
rl Int -> ReadS (FreeT f m a)
go ReadS [FreeT f m a]
goList))
        String
"FreeT" m (FreeF f a (FreeT f m a)) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT

instance (Read1 f, Read1 m, Read a) => Read (FreeT f m a) where
  readsPrec :: Int -> ReadS (FreeT f m a)
readsPrec = Int -> ReadS (FreeT f m a)
forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1

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 (FreeT m (FreeF f a (FreeT f m a))
m) = m (FreeF f b (FreeT f m b)) -> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT ((FreeF f a (FreeT f m a) -> FreeF f b (FreeT f m b))
-> m (FreeF f a (FreeT f m a)) -> m (FreeF f b (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 FreeF f a (FreeT f m a) -> FreeF f b (FreeT f m b)
forall {f :: * -> *} {f :: * -> *}.
(Functor f, Functor f) =>
FreeF f a (f a) -> FreeF f b (f b)
f' m (FreeF f a (FreeT f m a))
m) where
    f' :: FreeF f a (f a) -> FreeF f b (f b)
f' (Pure a
a)  = b -> FreeF f b (f b)
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (a -> b
f a
a)
    f' (Free f (f a)
as) = f (f b) -> FreeF f b (f b)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free ((f a -> f b) -> f (f a) -> f (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 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) f (f a)
as)

instance (Applicative f, Applicative m) => Applicative (FreeT f m) where
  pure :: forall a. a -> FreeT f m a
pure a
a = m (FreeF f a (FreeT f m a)) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (FreeF f a (FreeT f m a) -> m (FreeF f a (FreeT f m a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> FreeF f a (FreeT f m a)
forall (f :: * -> *) a b. a -> FreeF f a b
Pure a
a))
  {-# INLINE pure #-}
  FreeT m (FreeF f (a -> b) (FreeT f m (a -> b)))
f <*> :: forall a b. FreeT f m (a -> b) -> FreeT f m a -> FreeT f m b
<*> FreeT m (FreeF f a (FreeT f m a))
a = m (FreeF f b (FreeT f m b)) -> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f b (FreeT f m b)) -> FreeT f m b)
-> m (FreeF f b (FreeT f m b)) -> FreeT f m b
forall a b. (a -> b) -> a -> b
$ FreeF f (a -> b) (FreeT f m (a -> b))
-> FreeF f a (FreeT f m a) -> FreeF f b (FreeT f m b)
forall {f :: * -> *} {f :: * -> *} {a} {b}.
(Applicative f, Applicative f) =>
FreeF f (a -> b) (f (a -> b)) -> FreeF f a (f a) -> FreeF f b (f b)
g (FreeF f (a -> b) (FreeT f m (a -> b))
 -> FreeF f a (FreeT f m a) -> FreeF f b (FreeT f m b))
-> m (FreeF f (a -> b) (FreeT f m (a -> b)))
-> m (FreeF f a (FreeT f m a) -> FreeF f b (FreeT f m b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (FreeF f (a -> b) (FreeT f m (a -> b)))
f m (FreeF f a (FreeT f m a) -> FreeF f b (FreeT f m b))
-> m (FreeF f a (FreeT f m a)) -> m (FreeF f b (FreeT f 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
<*> m (FreeF f a (FreeT f m a))
a where
    g :: FreeF f (a -> b) (f (a -> b)) -> FreeF f a (f a) -> FreeF f b (f b)
g (Pure a -> b
f') (Pure a
a') = b -> FreeF f b (f b)
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (a -> b
f' a
a')
    g (Pure a -> b
f') (Free f (f a)
as) = f (f b) -> FreeF f b (f b)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f (f b) -> FreeF f b (f b)) -> f (f b) -> FreeF f b (f b)
forall a b. (a -> b) -> a -> b
$ (a -> b) -> 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' (f a -> f b) -> f (f a) -> f (f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f a)
as
    g (Free f (f (a -> b))
fs) (Pure a
a') = f (f b) -> FreeF f b (f b)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f (f b) -> FreeF f b (f b)) -> f (f b) -> FreeF f b (f b)
forall a b. (a -> b) -> a -> b
$ ((a -> b) -> b) -> f (a -> b) -> 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) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
a') (f (a -> b) -> f b) -> f (f (a -> b)) -> f (f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f (a -> b))
fs
    g (Free f (f (a -> b))
fs) (Free f (f a)
as) = f (f b) -> FreeF f b (f b)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f (f b) -> FreeF f b (f b)) -> f (f b) -> FreeF f b (f b)
forall a b. (a -> b) -> a -> b
$ f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (f (a -> b) -> f a -> f b) -> f (f (a -> b)) -> f (f a -> f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f (a -> b))
fs f (f a -> f b) -> f (f a) -> f (f b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (f a)
as
  {-# INLINE (<*>) #-}

instance (Apply f, Apply m) => Apply (FreeT f m) where
  FreeT m (FreeF f (a -> b) (FreeT f m (a -> b)))
f <.> :: forall a b. FreeT f m (a -> b) -> FreeT f m a -> FreeT f m b
<.> FreeT m (FreeF f a (FreeT f m a))
a = m (FreeF f b (FreeT f m b)) -> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f b (FreeT f m b)) -> FreeT f m b)
-> m (FreeF f b (FreeT f m b)) -> FreeT f m b
forall a b. (a -> b) -> a -> b
$ FreeF f (a -> b) (FreeT f m (a -> b))
-> FreeF f a (FreeT f m a) -> FreeF f b (FreeT f m b)
forall {f :: * -> *} {f :: * -> *} {a} {b}.
(Apply f, Apply f) =>
FreeF f (a -> b) (f (a -> b)) -> FreeF f a (f a) -> FreeF f b (f b)
g (FreeF f (a -> b) (FreeT f m (a -> b))
 -> FreeF f a (FreeT f m a) -> FreeF f b (FreeT f m b))
-> m (FreeF f (a -> b) (FreeT f m (a -> b)))
-> m (FreeF f a (FreeT f m a) -> FreeF f b (FreeT f m b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (FreeF f (a -> b) (FreeT f m (a -> b)))
f m (FreeF f a (FreeT f m a) -> FreeF f b (FreeT f m b))
-> m (FreeF f a (FreeT f m a)) -> m (FreeF f b (FreeT f m b))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> m (FreeF f a (FreeT f m a))
a where
    g :: FreeF f (a -> b) (f (a -> b)) -> FreeF f a (f a) -> FreeF f b (f b)
g (Pure a -> b
f') (Pure a
a') = b -> FreeF f b (f b)
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (a -> b
f' a
a')
    g (Pure a -> b
f') (Free f (f a)
as) = f (f b) -> FreeF f b (f b)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f (f b) -> FreeF f b (f b)) -> f (f b) -> FreeF f b (f b)
forall a b. (a -> b) -> a -> b
$ (a -> b) -> 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' (f a -> f b) -> f (f a) -> f (f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f a)
as
    g (Free f (f (a -> b))
fs) (Pure a
a') = f (f b) -> FreeF f b (f b)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f (f b) -> FreeF f b (f b)) -> f (f b) -> FreeF f b (f b)
forall a b. (a -> b) -> a -> b
$ ((a -> b) -> b) -> f (a -> b) -> 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) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
a') (f (a -> b) -> f b) -> f (f (a -> b)) -> f (f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f (a -> b))
fs
    g (Free f (f (a -> b))
fs) (Free f (f a)
as) = f (f b) -> FreeF f b (f b)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f (f b) -> FreeF f b (f b)) -> f (f b) -> FreeF f b (f b)
forall a b. (a -> b) -> a -> b
$ f (a -> b) -> f a -> f b
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>) (f (a -> b) -> f a -> f b) -> f (f (a -> b)) -> f (f a -> f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f (a -> b))
fs f (f a -> f b) -> f (f a) -> f (f b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f (f a)
as

instance (Apply f, Apply m, Monad m) => Bind (FreeT f m) where
  FreeT m (FreeF f a (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 (FreeF f b (FreeT f m b)) -> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f b (FreeT f m b)) -> FreeT f m b)
-> m (FreeF f b (FreeT f m b)) -> FreeT f m b
forall a b. (a -> b) -> a -> b
$ m (FreeF f a (FreeT f m a))
m m (FreeF f a (FreeT f m a))
-> (FreeF f a (FreeT f m a) -> m (FreeF f b (FreeT f m b)))
-> m (FreeF f b (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
>>= \FreeF f a (FreeT f m a)
v -> case FreeF f a (FreeT f m a)
v of
    Pure a
a -> FreeT f m b -> m (FreeF f b (FreeT f m b))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT (a -> FreeT f m b
f a
a)
    Free f (FreeT f m a)
w -> FreeF f b (FreeT f m b) -> m (FreeF f b (FreeT f m b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f (FreeT f m b) -> FreeF f b (FreeT f m b)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free ((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. Bind m => m a -> (a -> m b) -> m b
>>- a -> FreeT f m b
f) f (FreeT f m a)
w))

instance (Applicative f, Monad m) => Monad (FreeT f m) where
  return :: forall a. a -> FreeT f m a
return = a -> FreeT f m a
forall a. a -> FreeT f m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE return #-}
  FreeT m (FreeF f a (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 (FreeF f b (FreeT f m b)) -> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f b (FreeT f m b)) -> FreeT f m b)
-> m (FreeF f b (FreeT f m b)) -> FreeT f m b
forall a b. (a -> b) -> a -> b
$ m (FreeF f a (FreeT f m a))
m m (FreeF f a (FreeT f m a))
-> (FreeF f a (FreeT f m a) -> m (FreeF f b (FreeT f m b)))
-> m (FreeF f b (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
>>= \FreeF f a (FreeT f m a)
v -> case FreeF f a (FreeT f m a)
v of
    Pure a
a -> FreeT f m b -> m (FreeF f b (FreeT f m b))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT (a -> FreeT f m b
f a
a)
    Free f (FreeT f m a)
w -> FreeF f b (FreeT f m b) -> m (FreeF f b (FreeT f m b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (f (FreeT f m b) -> FreeF f b (FreeT f m b)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free ((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)
w))
#if !MIN_VERSION_base(4,13,0)
  fail e = FreeT (fail e)
#endif

instance (Applicative f, Fail.MonadFail m) => Fail.MonadFail (FreeT f m) where
  fail :: forall a. String -> FreeT f m a
fail String
e = m (FreeF f a (FreeT f m a)) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (String -> m (FreeF f a (FreeT f m a))
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
e)

instance Applicative f => MonadTrans (FreeT f) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> FreeT f m a
lift = m (FreeF f a (FreeT f m a)) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f a (FreeT f m a)) -> FreeT f m a)
-> (m a -> m (FreeF f a (FreeT f m a))) -> m a -> FreeT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> FreeF f a (FreeT f m a))
-> m a -> m (FreeF f a (FreeT f m a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> FreeF f a (FreeT f m a)
forall (f :: * -> *) a b. a -> FreeF f a b
Pure
  {-# INLINE lift #-}

instance (Applicative f, 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
  {-# INLINE liftIO #-}

instance (Applicative f, MonadReader r m) => MonadReader r (FreeT f m) where
  ask :: FreeT f m r
ask = m r -> FreeT f m r
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 r
forall r (m :: * -> *). MonadReader r m => m r
ask
  {-# INLINE ask #-}
  local :: forall a. (r -> r) -> FreeT f m a -> FreeT f m a
local r -> r
f = (forall a. m a -> m a) -> FreeT f m a -> FreeT f m a
forall (m :: * -> *) (f :: * -> *) (n :: * -> *) b.
(Functor m, Applicative f) =>
(forall a. m a -> n a) -> FreeT f m b -> FreeT f n b
hoistFreeT ((r -> r) -> m a -> m a
forall a. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f)
  {-# INLINE local #-}

instance (Applicative f, MonadWriter w m) => MonadWriter w (FreeT f m) where
  tell :: w -> FreeT f m ()
tell = m () -> FreeT f m ()
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 () -> FreeT f m ()) -> (w -> m ()) -> w -> FreeT f m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  {-# INLINE tell #-}
  listen :: forall a. FreeT f m a -> FreeT f m (a, w)
listen (FreeT m (FreeF f a (FreeT f m a))
m) = m (FreeF f (a, w) (FreeT f m (a, w))) -> FreeT f m (a, w)
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f (a, w) (FreeT f m (a, w))) -> FreeT f m (a, w))
-> m (FreeF f (a, w) (FreeT f m (a, w))) -> FreeT f m (a, w)
forall a b. (a -> b) -> a -> b
$ ((FreeF f a (FreeT f m (a, w)), w)
 -> FreeF f (a, w) (FreeT f m (a, w)))
-> m (FreeF f a (FreeT f m (a, w)), w)
-> m (FreeF f (a, w) (FreeT f m (a, w)))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (FreeF f a (FreeT f m (a, w)), w)
-> FreeF f (a, w) (FreeT f m (a, w))
forall {f :: * -> *} {f :: * -> *} {p :: * -> * -> *} {c} {a} {a}.
(Functor f, Functor f, Bifunctor p, Monoid c) =>
(FreeF f a (f (p a c)), c) -> FreeF f (a, c) (f (p a c))
concat' (m (FreeF f a (FreeT f m (a, w)), w)
 -> m (FreeF f (a, w) (FreeT f m (a, w))))
-> m (FreeF f a (FreeT f m (a, w)), w)
-> m (FreeF f (a, w) (FreeT f m (a, w)))
forall a b. (a -> b) -> a -> b
$ m (FreeF f a (FreeT f m (a, w)))
-> m (FreeF f a (FreeT f m (a, w)), w)
forall a. m a -> m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen ((FreeT f m a -> FreeT f m (a, w))
-> FreeF f a (FreeT f m a) -> FreeF f a (FreeT f m (a, w))
forall a b. (a -> b) -> FreeF f a a -> FreeF f a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FreeT f m a -> FreeT f m (a, w)
forall a. FreeT f m a -> FreeT f m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen (FreeF f a (FreeT f m a) -> FreeF f a (FreeT f m (a, w)))
-> m (FreeF f a (FreeT f m a)) -> m (FreeF f a (FreeT f m (a, w)))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (FreeF f a (FreeT f m a))
m)
    where
      concat' :: (FreeF f a (f (p a c)), c) -> FreeF f (a, c) (f (p a c))
concat' (Pure a
x, c
w) = (a, c) -> FreeF f (a, c) (f (p a c))
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (a
x, c
w)
      concat' (Free f (f (p a c))
y, c
w) = f (f (p a c)) -> FreeF f (a, c) (f (p a c))
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f (f (p a c)) -> FreeF f (a, c) (f (p a c)))
-> f (f (p a c)) -> FreeF f (a, c) (f (p a c))
forall a b. (a -> b) -> a -> b
$ (p a c -> p a c) -> f (p a c) -> f (p a c)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((c -> c) -> p a c -> p a c
forall b c a. (b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (c
w c -> c -> c
forall a. Monoid a => a -> a -> a
`mappend`)) (f (p a c) -> f (p a c)) -> f (f (p a c)) -> f (f (p a c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f (p a c))
y
  pass :: forall a. FreeT f m (a, w -> w) -> FreeT f m a
pass FreeT f m (a, w -> w)
m = m (FreeF f a (FreeT f m a)) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f a (FreeT f m a)) -> FreeT f m a)
-> (FreeT f m ((a, w -> w), w) -> m (FreeF f a (FreeT f m a)))
-> FreeT f m ((a, w -> w), w)
-> FreeT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (FreeF f ((a, w -> w), w) (FreeT f m ((a, w -> w), w)))
-> m (FreeF f a (FreeT f m a))
forall {a} {t}.
m (FreeF f ((a, t -> w), t) (FreeT f m ((a, t -> w), t)))
-> m (FreeF f a (FreeT f m a))
pass' (m (FreeF f ((a, w -> w), w) (FreeT f m ((a, w -> w), w)))
 -> m (FreeF f a (FreeT f m a)))
-> (FreeT f m ((a, w -> w), w)
    -> m (FreeF f ((a, w -> w), w) (FreeT f m ((a, w -> w), w))))
-> FreeT f m ((a, w -> w), w)
-> m (FreeF f a (FreeT f m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeT f m ((a, w -> w), w)
-> m (FreeF f ((a, w -> w), w) (FreeT f m ((a, w -> w), w)))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT (FreeT f m ((a, w -> w), w)
 -> m (FreeF f ((a, w -> w), w) (FreeT f m ((a, w -> w), w))))
-> (FreeT f m ((a, w -> w), w) -> FreeT f m ((a, w -> w), w))
-> FreeT f m ((a, w -> w), w)
-> m (FreeF f ((a, w -> w), w) (FreeT f m ((a, w -> w), w)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. m a -> m a)
-> FreeT f m ((a, w -> w), w) -> FreeT f m ((a, w -> w), w)
forall (m :: * -> *) (f :: * -> *) (n :: * -> *) b.
(Functor m, Applicative f) =>
(forall a. m a -> n a) -> FreeT f m b -> FreeT f n b
hoistFreeT m a -> m a
forall a. m a -> m a
clean (FreeT f m ((a, w -> w), w) -> FreeT f m a)
-> FreeT f m ((a, w -> w), w) -> FreeT f m a
forall a b. (a -> b) -> a -> b
$ FreeT f m (a, w -> w) -> FreeT f m ((a, w -> w), w)
forall a. FreeT f m a -> FreeT f m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen FreeT f m (a, w -> w)
m
    where
      clean :: m a -> m a
clean = m (a, w -> w) -> m a
forall a. m (a, w -> w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (m (a, w -> w) -> m a) -> (m a -> m (a, w -> w)) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, w -> w)) -> m a -> m (a, w -> w)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\a
x -> (a
x, w -> w -> w
forall a b. a -> b -> a
const w
forall a. Monoid a => a
mempty))
      pass' :: m (FreeF f ((a, t -> w), t) (FreeT f m ((a, t -> w), t)))
-> m (FreeF f a (FreeT f m a))
pass' = m (m (FreeF f a (FreeT f m a))) -> m (FreeF f a (FreeT f m a))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m (FreeF f a (FreeT f m a))) -> m (FreeF f a (FreeT f m a)))
-> (m (FreeF f ((a, t -> w), t) (FreeT f m ((a, t -> w), t)))
    -> m (m (FreeF f a (FreeT f m a))))
-> m (FreeF f ((a, t -> w), t) (FreeT f m ((a, t -> w), t)))
-> m (FreeF f a (FreeT f m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FreeF f ((a, t -> w), t) (FreeT f m ((a, t -> w), t))
 -> m (FreeF f a (FreeT f m a)))
-> m (FreeF f ((a, t -> w), t) (FreeT f m ((a, t -> w), t)))
-> m (m (FreeF f a (FreeT f m a)))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM FreeF f ((a, t -> w), t) (FreeT f m ((a, t -> w), t))
-> m (FreeF f a (FreeT f m a))
g
      g :: FreeF f ((a, t -> w), t) (FreeT f m ((a, t -> w), t))
-> m (FreeF f a (FreeT f m a))
g (Pure ((a
x, t -> w
f), t
w)) = w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (t -> w
f t
w) m () -> m (FreeF f a (FreeT f m a)) -> m (FreeF f a (FreeT f m a))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FreeF f a (FreeT f m a) -> m (FreeF f a (FreeT f m a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> FreeF f a (FreeT f m a)
forall (f :: * -> *) a b. a -> FreeF f a b
Pure a
x)
      g (Free f (FreeT f m ((a, t -> w), t))
f)           = FreeF f a (FreeT f m a) -> m (FreeF f a (FreeT f m a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FreeF f a (FreeT f m a) -> m (FreeF f a (FreeT f m a)))
-> (f (FreeT f m ((a, t -> w), t)) -> FreeF f a (FreeT f m a))
-> f (FreeT f m ((a, t -> w), t))
-> m (FreeF f a (FreeT f m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (FreeT f m a) -> FreeF f a (FreeT f m a)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f (FreeT f m a) -> FreeF f a (FreeT f m a))
-> (f (FreeT f m ((a, t -> w), t)) -> f (FreeT f m a))
-> f (FreeT f m ((a, t -> w), t))
-> FreeF f a (FreeT f m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FreeT f m ((a, t -> w), t) -> FreeT f m a)
-> f (FreeT f m ((a, t -> w), t)) -> 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 (m (FreeF f a (FreeT f m a)) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f a (FreeT f m a)) -> FreeT f m a)
-> (FreeT f m ((a, t -> w), t) -> m (FreeF f a (FreeT f m a)))
-> FreeT f m ((a, t -> w), t)
-> FreeT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (FreeF f ((a, t -> w), t) (FreeT f m ((a, t -> w), t)))
-> m (FreeF f a (FreeT f m a))
pass' (m (FreeF f ((a, t -> w), t) (FreeT f m ((a, t -> w), t)))
 -> m (FreeF f a (FreeT f m a)))
-> (FreeT f m ((a, t -> w), t)
    -> m (FreeF f ((a, t -> w), t) (FreeT f m ((a, t -> w), t))))
-> FreeT f m ((a, t -> w), t)
-> m (FreeF f a (FreeT f m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeT f m ((a, t -> w), t)
-> m (FreeF f ((a, t -> w), t) (FreeT f m ((a, t -> w), t)))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT) (f (FreeT f m ((a, t -> w), t)) -> m (FreeF f a (FreeT f m a)))
-> f (FreeT f m ((a, t -> w), t)) -> m (FreeF f a (FreeT f m a))
forall a b. (a -> b) -> a -> b
$ f (FreeT f m ((a, t -> w), t))
f
  writer :: forall a. (a, w) -> FreeT f m a
writer (a, w)
w = 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 ((a, w) -> m a
forall a. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer (a, w)
w)
  {-# INLINE writer #-}

instance (Applicative f, MonadState s m) => MonadState s (FreeT f m) where
  get :: FreeT f m s
get = m s -> FreeT f m s
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 s
forall s (m :: * -> *). MonadState s m => m s
get
  {-# INLINE get #-}
  put :: s -> FreeT f m ()
put = m () -> FreeT f m ()
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 () -> FreeT f m ()) -> (s -> m ()) -> s -> FreeT f m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
  {-# INLINE put #-}
  state :: forall a. (s -> (a, s)) -> FreeT f m a
state s -> (a, s)
f = 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 ((s -> (a, s)) -> m a
forall a. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state s -> (a, s)
f)
  {-# INLINE state #-}

instance (Applicative f, MonadError e m) => MonadError e (FreeT f m) where
  throwError :: forall a. e -> FreeT f m a
throwError = 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) -> (e -> m a) -> e -> FreeT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall a. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  {-# INLINE throwError #-}
  FreeT m (FreeF f a (FreeT f m a))
m catchError :: forall a. FreeT f m a -> (e -> FreeT f m a) -> FreeT f m a
`catchError` e -> FreeT f m a
f = m (FreeF f a (FreeT f m a)) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f a (FreeT f m a)) -> FreeT f m a)
-> m (FreeF f a (FreeT f m a)) -> FreeT f m a
forall a b. (a -> b) -> a -> b
$ (FreeF f a (FreeT f m a) -> FreeF f a (FreeT f m a))
-> m (FreeF f a (FreeT f m a)) -> m (FreeF f a (FreeT f m a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((FreeT f m a -> FreeT f m a)
-> FreeF f a (FreeT f m a) -> FreeF f a (FreeT f m a)
forall a b. (a -> b) -> FreeF f a a -> FreeF f a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FreeT f m a -> (e -> FreeT f m a) -> FreeT f m a
forall a. FreeT f m a -> (e -> FreeT f m a) -> FreeT f m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` e -> FreeT f m a
f)) m (FreeF f a (FreeT f m a))
m m (FreeF f a (FreeT f m a))
-> (e -> m (FreeF f a (FreeT f m a)))
-> m (FreeF f a (FreeT f m a))
forall a. m a -> (e -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (FreeT f m a -> m (FreeF f a (FreeT f m a))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT (FreeT f m a -> m (FreeF f a (FreeT f m a)))
-> (e -> FreeT f m a) -> e -> m (FreeF f a (FreeT f m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> FreeT f m a
f)

instance (Applicative f, MonadCont m) => MonadCont (FreeT f m) where
  callCC :: forall a b. ((a -> FreeT f m b) -> FreeT f m a) -> FreeT f m a
callCC (a -> FreeT f m b) -> FreeT f m a
f = m (FreeF f a (FreeT f m a)) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f a (FreeT f m a)) -> FreeT f m a)
-> m (FreeF f a (FreeT f m a)) -> FreeT f m a
forall a b. (a -> b) -> a -> b
$ ((FreeF f a (FreeT f m a) -> m b) -> m (FreeF f a (FreeT f m a)))
-> m (FreeF f a (FreeT f m a))
forall a b. ((a -> m b) -> m a) -> m a
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (\FreeF f a (FreeT f m a) -> m b
k -> FreeT f m a -> m (FreeF f a (FreeT f m a))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT (FreeT f m a -> m (FreeF f a (FreeT f m a)))
-> FreeT f m a -> m (FreeF f a (FreeT f m a))
forall a b. (a -> b) -> a -> b
$ (a -> FreeT f m b) -> FreeT f m a
f (m b -> FreeT f m b
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 b -> FreeT f m b) -> (a -> m b) -> a -> FreeT f m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeF f a (FreeT f m a) -> m b
k (FreeF f a (FreeT f m a) -> m b)
-> (a -> FreeF f a (FreeT f m a)) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FreeF f a (FreeT f m a)
forall (f :: * -> *) a b. a -> FreeF f a b
Pure))

instance (Applicative f, MonadPlus m) => Alternative (FreeT f m) where
  empty :: forall a. FreeT f m a
empty = m (FreeF f a (FreeT f m a)) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT m (FreeF f a (FreeT f m a))
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  FreeT m (FreeF f a (FreeT f m a))
ma <|> :: forall a. FreeT f m a -> FreeT f m a -> FreeT f m a
<|> FreeT m (FreeF f a (FreeT f m a))
mb = m (FreeF f a (FreeT f m a)) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f a (FreeT f m a))
-> m (FreeF f a (FreeT f m a)) -> m (FreeF f a (FreeT f m a))
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus m (FreeF f a (FreeT f m a))
ma m (FreeF f a (FreeT f m a))
mb)
  {-# INLINE (<|>) #-}

instance (Applicative f, MonadPlus m) => MonadPlus (FreeT f m) where
  mzero :: forall a. FreeT f m a
mzero = m (FreeF f a (FreeT f m a)) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT m (FreeF f a (FreeT f m a))
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  {-# INLINE mzero #-}
  mplus :: forall a. FreeT f m a -> FreeT f m a -> FreeT f m a
mplus (FreeT m (FreeF f a (FreeT f m a))
ma) (FreeT m (FreeF f a (FreeT f m a))
mb) = m (FreeF f a (FreeT f m a)) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f a (FreeT f m a))
-> m (FreeF f a (FreeT f m a)) -> m (FreeF f a (FreeT f m a))
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus m (FreeF f a (FreeT f m a))
ma m (FreeF f a (FreeT f m a))
mb)
  {-# INLINE mplus #-}

instance (Applicative f, Monad m) => MonadFree f (FreeT f m) where
  wrap :: forall a. f (FreeT f m a) -> FreeT f m a
wrap = m (FreeF f a (FreeT f m a)) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f a (FreeT f m a)) -> FreeT f m a)
-> (f (FreeT f m a) -> m (FreeF f a (FreeT f m a)))
-> f (FreeT f m a)
-> FreeT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeF f a (FreeT f m a) -> m (FreeF f a (FreeT f m a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FreeF f a (FreeT f m a) -> m (FreeF f a (FreeT f m a)))
-> (f (FreeT f m a) -> FreeF f a (FreeT f m a))
-> f (FreeT f m a)
-> m (FreeF f a (FreeT f m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (FreeT f m a) -> FreeF f a (FreeT f m a)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free
  {-# INLINE wrap #-}

instance (Applicative f, MonadThrow m) => MonadThrow (FreeT f m) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> FreeT f m a
throwM = 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) -> (e -> m a) -> e -> FreeT f m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM
  {-# INLINE throwM #-}

instance (Applicative f, MonadCatch m) => MonadCatch (FreeT f m) where
  FreeT m (FreeF f a (FreeT f m a))
m catch :: forall e a.
(HasCallStack, Exception e) =>
FreeT f m a -> (e -> FreeT f m a) -> FreeT f m a
`catch` e -> FreeT f m a
f = m (FreeF f a (FreeT f m a)) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f a (FreeT f m a)) -> FreeT f m a)
-> m (FreeF f a (FreeT f m a)) -> FreeT f m a
forall a b. (a -> b) -> a -> b
$ (FreeF f a (FreeT f m a) -> FreeF f a (FreeT f m a))
-> m (FreeF f a (FreeT f m a)) -> m (FreeF f a (FreeT f m a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((FreeT f m a -> FreeT f m a)
-> FreeF f a (FreeT f m a) -> FreeF f a (FreeT f m a)
forall a b. (a -> b) -> FreeF f a a -> FreeF f a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FreeT f m a -> (e -> FreeT f m a) -> FreeT f m a
forall e a.
(HasCallStack, Exception e) =>
FreeT f m a -> (e -> FreeT f m a) -> FreeT f m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`Control.Monad.Catch.catch` e -> FreeT f m a
f)) m (FreeF f a (FreeT f m a))
m
                                m (FreeF f a (FreeT f m a))
-> (e -> m (FreeF f a (FreeT f m a)))
-> m (FreeF f a (FreeT f m a))
forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`Control.Monad.Catch.catch` (FreeT f m a -> m (FreeF f a (FreeT f m a))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT (FreeT f m a -> m (FreeF f a (FreeT f m a)))
-> (e -> FreeT f m a) -> e -> m (FreeF f a (FreeT f m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> FreeT f m a
f)
  {-# INLINE catch #-}

-- | Given an applicative homomorphism from @f (m a)@ to @m a@,
-- tear down a free monad transformer using iteration.
iterT :: (Applicative f, Monad m) => (f (m a) -> m a) -> FreeT f m a -> m a
iterT :: forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, Monad m) =>
(f (m a) -> m a) -> FreeT f m a -> m a
iterT f (m a) -> m a
f (FreeT m (FreeF f a (FreeT f m a))
m) = do
    FreeF f a (FreeT f m a)
val <- m (FreeF f a (FreeT f m a))
m
    case (FreeT f m a -> m a) -> FreeF f a (FreeT f m a) -> FreeF f a (m a)
forall a b. (a -> b) -> FreeF f a a -> FreeF f a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f (m a) -> m a) -> FreeT f m a -> m a
forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, Monad m) =>
(f (m a) -> m a) -> FreeT f m a -> m a
iterT f (m a) -> m a
f) FreeF f a (FreeT f m a)
val of
        Pure a
x -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
        Free f (m a)
y -> f (m a) -> m a
f f (m a)
y

-- | Given an applicative homomorphism from @f (t m a)@ to @t m a@,
-- tear down a free monad transformer using iteration over a transformer.
iterTM :: (Applicative f, Monad m, MonadTrans t, Monad (t m)) => (f (t m a) -> t m a) -> FreeT f m a -> t m a
iterTM :: forall (f :: * -> *) (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Applicative f, Monad m, MonadTrans t, Monad (t m)) =>
(f (t m a) -> t m a) -> FreeT f m a -> t m a
iterTM f (t m a) -> t m a
f (FreeT m (FreeF f a (FreeT f m a))
m) = do
    FreeF f a (FreeT f m a)
val <- m (FreeF f a (FreeT f m a)) -> t m (FreeF f a (FreeT f m a))
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (FreeF f a (FreeT f m a))
m
    case (FreeT f m a -> t m a)
-> FreeF f a (FreeT f m a) -> FreeF f a (t m a)
forall a b. (a -> b) -> FreeF f a a -> FreeF f a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f (t m a) -> t m a) -> FreeT f m a -> t m a
forall (f :: * -> *) (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Applicative f, Monad m, MonadTrans t, Monad (t m)) =>
(f (t m a) -> t m a) -> FreeT f m a -> t m a
iterTM f (t m a) -> t m a
f) FreeF f a (FreeT f m a)
val of
        Pure a
x -> a -> t m a
forall a. a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
        Free f (t m a)
y -> f (t m a) -> t m a
f f (t m a)
y

instance (Foldable m, Foldable f) => Foldable (FreeT f m) where
  foldMap :: forall m a. Monoid m => (a -> m) -> FreeT f m a -> m
foldMap a -> m
f (FreeT m (FreeF f a (FreeT f m a))
m) = (FreeF f a (FreeT f m a) -> m) -> m (FreeF f a (FreeT f m a)) -> m
forall m a. Monoid m => (a -> m) -> m a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (FreeT f m a -> m) -> FreeF f a (FreeT f m a) -> m
forall m a b. Monoid m => (a -> m) -> (b -> m) -> FreeF f a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f ((a -> m) -> FreeT f m a -> m
forall m a. Monoid m => (a -> m) -> FreeT f m a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f)) m (FreeF f a (FreeT f m a))
m

instance (Monad m, 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 (FreeF f a (FreeT f m a))
m) = m (FreeF f b (FreeT f m b)) -> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f b (FreeT f m b)) -> FreeT f m b)
-> f (m (FreeF f b (FreeT f m b))) -> f (FreeT f m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FreeF f a (FreeT f m a) -> f (FreeF f b (FreeT f m b)))
-> m (FreeF f a (FreeT f m a)) -> f (m (FreeF f b (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 ((a -> f b)
-> (FreeT f m a -> f (FreeT f m b))
-> FreeF f a (FreeT f m a)
-> f (FreeF f b (FreeT f m b))
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> FreeF f a b -> f (FreeF f c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f b
f ((a -> f b) -> FreeT f m a -> 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) -> FreeT f m a -> f (FreeT f m b)
traverse a -> f b
f)) m (FreeF f a (FreeT f m a))
m

-- | Lift a monad homomorphism from @m@ to @n@ into a monad homomorphism from @'FreeT' f m@ to @'FreeT' f n@
--
-- @'hoistFreeT' :: ('Functor' m, 'Applicative' f) => (m ~> n) -> 'FreeT' f m ~> 'FreeT' f n@
hoistFreeT :: (Functor m, Applicative f) => (forall a. m a -> n a) -> FreeT f m b -> FreeT f n b
hoistFreeT :: forall (m :: * -> *) (f :: * -> *) (n :: * -> *) b.
(Functor m, Applicative f) =>
(forall a. m a -> n a) -> FreeT f m b -> FreeT f n b
hoistFreeT forall a. m a -> n a
mh = n (FreeF f b (FreeT f n b)) -> FreeT f n b
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (n (FreeF f b (FreeT f n b)) -> FreeT f n b)
-> (FreeT f m b -> n (FreeF f b (FreeT f n b)))
-> FreeT f m b
-> FreeT f n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (FreeF f b (FreeT f n b)) -> n (FreeF f b (FreeT f n b))
forall a. m a -> n a
mh (m (FreeF f b (FreeT f n b)) -> n (FreeF f b (FreeT f n b)))
-> (FreeT f m b -> m (FreeF f b (FreeT f n b)))
-> FreeT f m b
-> n (FreeF f b (FreeT f n b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FreeF f b (FreeT f m b) -> FreeF f b (FreeT f n b))
-> m (FreeF f b (FreeT f m b)) -> m (FreeF f b (FreeT f n b))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FreeT f m b -> FreeT f n b)
-> FreeF f b (FreeT f m b) -> FreeF f b (FreeT f n b)
forall a b. (a -> b) -> FreeF f b a -> FreeF f b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. m a -> n a) -> FreeT f m b -> FreeT f n b
forall (m :: * -> *) (f :: * -> *) (n :: * -> *) b.
(Functor m, Applicative f) =>
(forall a. m a -> n a) -> FreeT f m b -> FreeT f n b
hoistFreeT m a -> n a
forall a. m a -> n a
mh)) (m (FreeF f b (FreeT f m b)) -> m (FreeF f b (FreeT f n b)))
-> (FreeT f m b -> m (FreeF f b (FreeT f m b)))
-> FreeT f m b
-> m (FreeF f b (FreeT f n b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeT f m b -> m (FreeF f b (FreeT f m b))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT

-- | Lift an applicative homomorphism from @f@ to @g@ into a monad homomorphism from @'FreeT' f m@ to @'FreeT' g m@
transFreeT :: (Monad m, Applicative g) => (forall a. f a -> g a) -> FreeT f m b -> FreeT g m b
transFreeT :: forall (m :: * -> *) (g :: * -> *) (f :: * -> *) b.
(Monad m, Applicative g) =>
(forall a. f a -> g a) -> FreeT f m b -> FreeT g m b
transFreeT forall a. f a -> g a
nt = m (FreeF g b (FreeT g m b)) -> FreeT g m b
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF g b (FreeT g m b)) -> FreeT g m b)
-> (FreeT f m b -> m (FreeF g b (FreeT g m b)))
-> FreeT f m b
-> FreeT g m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FreeF f b (FreeT f m b) -> FreeF g b (FreeT g m b))
-> m (FreeF f b (FreeT f m b)) -> m (FreeF g b (FreeT g m b))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((FreeT f m b -> FreeT g m b)
-> FreeF g b (FreeT f m b) -> FreeF g b (FreeT g m b)
forall a b. (a -> b) -> FreeF g b a -> FreeF g b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. f a -> g a) -> FreeT f m b -> FreeT g m b
forall (m :: * -> *) (g :: * -> *) (f :: * -> *) b.
(Monad m, Applicative g) =>
(forall a. f a -> g a) -> FreeT f m b -> FreeT g m b
transFreeT f a -> g a
forall a. f a -> g a
nt) (FreeF g b (FreeT f m b) -> FreeF g b (FreeT g m b))
-> (FreeF f b (FreeT f m b) -> FreeF g b (FreeT f m b))
-> FreeF f b (FreeT f m b)
-> FreeF g b (FreeT g m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. f a -> g a)
-> FreeF f b (FreeT f m b) -> FreeF g b (FreeT f m b)
forall (f :: * -> *) (g :: * -> *) a b.
(forall x. f x -> g x) -> FreeF f a b -> FreeF g a b
transFreeF f x -> g x
forall a. f a -> g a
nt) (m (FreeF f b (FreeT f m b)) -> m (FreeF g b (FreeT g m b)))
-> (FreeT f m b -> m (FreeF f b (FreeT f m b)))
-> FreeT f m b
-> m (FreeF g b (FreeT g m b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeT f m b -> m (FreeF f b (FreeT f m b))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT

-- | Pull out and join @m@ layers of @'FreeT' f m a@.
joinFreeT :: (Monad m, Traversable f, Applicative f) => FreeT f m a -> m (Free f a)
joinFreeT :: forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Traversable f, Applicative f) =>
FreeT f m a -> m (Free f a)
joinFreeT (FreeT m (FreeF f a (FreeT f m a))
m) = m (FreeF f a (FreeT f m a))
m m (FreeF f a (FreeT f m a))
-> (FreeF f a (FreeT f m a) -> m (Free f a)) -> m (Free f a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FreeF f a (FreeT f m a) -> m (Free f a)
forall {m :: * -> *} {f :: * -> *} {a}.
(Monad m, Traversable f, Applicative f) =>
FreeF f a (FreeT f m a) -> m (FreeT f Identity a)
joinFreeF
  where
    joinFreeF :: FreeF f a (FreeT f m a) -> m (FreeT f Identity a)
joinFreeF (Pure a
x) = FreeT f Identity a -> m (FreeT f Identity a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> FreeT f Identity a
forall a. a -> FreeT f Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x)
    joinFreeF (Free f (FreeT f m a)
f) = f (FreeT f Identity a) -> FreeT f Identity a
forall a. f (FreeT f Identity a) -> FreeT f Identity a
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap (f (FreeT f Identity a) -> FreeT f Identity a)
-> m (f (FreeT f Identity a)) -> m (FreeT f Identity a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (FreeT f m a -> m (FreeT f Identity a))
-> f (FreeT f m a) -> m (f (FreeT f Identity a))
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)
Data.Traversable.mapM FreeT f m a -> m (FreeT f Identity a)
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Traversable f, Applicative f) =>
FreeT f m a -> m (Free f a)
joinFreeT f (FreeT f m a)
f

-- |
-- 'retract' is the left inverse of 'liftF'
--
-- @
-- 'retract' . 'liftF' = 'id'
-- @
retract :: Monad f => Free f a -> f a
retract :: forall (f :: * -> *) a. Monad f => Free f a -> f a
retract Free f a
m =
  case Identity (FreeF f a (Free f a)) -> FreeF f a (Free f a)
forall a. Identity a -> a
runIdentity (Free f a -> Identity (FreeF f a (Free f a))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT Free f a
m) of
    Pure a
a  -> a -> f a
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    Free f (Free f a)
as -> f (Free f a)
as f (Free f a) -> (Free f a -> f a) -> f a
forall a b. f a -> (a -> f b) -> f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Free f a -> f a
forall (f :: * -> *) a. Monad f => Free f a -> f a
retract

-- | Given an applicative homomorphism from @f@ to 'Identity', tear down a 'Free' 'Monad' using iteration.
iter :: Applicative f => (f a -> a) -> Free f a -> a
iter :: forall (f :: * -> *) a.
Applicative f =>
(f a -> a) -> Free f a -> a
iter f a -> a
phi = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (Free f a -> Identity a) -> Free f a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (Identity a) -> Identity a) -> Free f a -> Identity a
forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, Monad m) =>
(f (m a) -> m a) -> FreeT f m a -> m a
iterT (a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a)
-> (f (Identity a) -> a) -> f (Identity a) -> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> a
phi (f a -> a) -> (f (Identity a) -> f a) -> f (Identity a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identity a -> a) -> f (Identity a) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity a -> a
forall a. Identity a -> a
runIdentity)

-- | Like 'iter' for monadic values.
iterM :: (Applicative f, Monad m) => (f (m a) -> m a) -> Free f a -> m a
iterM :: forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, Monad m) =>
(f (m a) -> m a) -> Free f a -> m a
iterM f (m a) -> m a
phi = (f (m a) -> m a) -> FreeT f m a -> m a
forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, Monad m) =>
(f (m a) -> m a) -> FreeT f m a -> m a
iterT f (m a) -> m a
phi (FreeT f m a -> m a)
-> (Free f a -> FreeT f m a) -> Free f a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Identity a -> m a) -> Free f a -> FreeT f m a
forall (m :: * -> *) (f :: * -> *) (n :: * -> *) b.
(Functor m, Applicative f) =>
(forall a. m a -> n a) -> FreeT f m b -> FreeT f n b
hoistFreeT (a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> (Identity a -> a) -> Identity a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity)

-- | Cuts off a tree of computations at a given depth.
-- If the depth is @0@ or less, no computation nor
-- monadic effects will take place.
--
-- Some examples (@n ≥ 0@):
--
-- @
-- 'cutoff' 0     _        ≡ 'return' 'Nothing'
-- 'cutoff' (n+1) '.' 'return' ≡ 'return' '.' 'Just'
-- 'cutoff' (n+1) '.' 'lift'   ≡ 'lift' '.' 'liftM' 'Just'
-- 'cutoff' (n+1) '.' 'wrap'   ≡ 'wrap' '.' 'fmap' ('cutoff' n)
-- @
--
-- Calling @'retract' '.' 'cutoff' n@ is always terminating, provided each of the
-- steps in the iteration is terminating.
cutoff :: (Applicative f, Monad m) => Integer -> FreeT f m a -> FreeT f m (Maybe a)
cutoff :: forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, Monad m) =>
Integer -> FreeT f m a -> FreeT f m (Maybe a)
cutoff Integer
n FreeT f m a
_ | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = Maybe a -> FreeT f m (Maybe a)
forall a. a -> FreeT f m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
cutoff Integer
n (FreeT m (FreeF f a (FreeT f m a))
m) = m (FreeF f (Maybe a) (FreeT f m (Maybe a))) -> FreeT f m (Maybe a)
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f (Maybe a) (FreeT f m (Maybe a)))
 -> FreeT f m (Maybe a))
-> m (FreeF f (Maybe a) (FreeT f m (Maybe a)))
-> FreeT f m (Maybe a)
forall a b. (a -> b) -> a -> b
$ (a -> Maybe a)
-> (FreeT f m a -> FreeT f m (Maybe a))
-> FreeF f a (FreeT f m a)
-> FreeF f (Maybe a) (FreeT f m (Maybe a))
forall a b c d. (a -> b) -> (c -> d) -> FreeF f a c -> FreeF f b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> Maybe a
forall a. a -> Maybe a
Just (Integer -> FreeT f m a -> FreeT f m (Maybe a)
forall (f :: * -> *) (m :: * -> *) a.
(Applicative f, Monad m) =>
Integer -> FreeT f m a -> FreeT f m (Maybe a)
cutoff (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)) (FreeF f a (FreeT f m a)
 -> FreeF f (Maybe a) (FreeT f m (Maybe a)))
-> m (FreeF f a (FreeT f m a))
-> m (FreeF f (Maybe a) (FreeT f m (Maybe a)))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (FreeF f a (FreeT f m a))
m

-- | @partialIterT n phi m@ interprets first @n@ layers of @m@ using @phi@.
-- This is sort of the opposite for @'cutoff'@.
--
-- Some examples (@n ≥ 0@):
--
-- @
-- 'partialIterT' 0 _ m              ≡ m
-- 'partialIterT' (n+1) phi '.' 'return' ≡ 'return'
-- 'partialIterT' (n+1) phi '.' 'lift'   ≡ 'lift'
-- 'partialIterT' (n+1) phi '.' 'wrap'   ≡ 'join' . 'lift' . phi
-- @
partialIterT :: Monad m => Integer -> (forall a. f a -> m a) -> FreeT f m b -> FreeT f m b
partialIterT :: forall (m :: * -> *) (f :: * -> *) b.
Monad m =>
Integer -> (forall a. f a -> m a) -> FreeT f m b -> FreeT f m b
partialIterT Integer
n forall a. f a -> m a
phi FreeT f m b
m
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = FreeT f m b
m
  | Bool
otherwise = m (FreeF f b (FreeT f m b)) -> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f b (FreeT f m b)) -> FreeT f m b)
-> m (FreeF f b (FreeT f m b)) -> FreeT f m b
forall a b. (a -> b) -> a -> b
$ do
      FreeF f b (FreeT f m b)
val <- FreeT f m b -> m (FreeF f b (FreeT f m b))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT FreeT f m b
m
      case FreeF f b (FreeT f m b)
val of
        Pure b
a -> FreeF f b (FreeT f m b) -> m (FreeF f b (FreeT f m b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> FreeF f b (FreeT f m b)
forall (f :: * -> *) a b. a -> FreeF f a b
Pure b
a)
        Free f (FreeT f m b)
f -> f (FreeT f m b) -> m (FreeT f m b)
forall a. f a -> m a
phi f (FreeT f m b)
f m (FreeT f m b)
-> (FreeT f m b -> m (FreeF f b (FreeT f m b)))
-> m (FreeF f b (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
>>= FreeT f m b -> m (FreeF f b (FreeT f m b))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT (FreeT f m b -> m (FreeF f b (FreeT f m b)))
-> (FreeT f m b -> FreeT f m b)
-> FreeT f m b
-> m (FreeF f b (FreeT f m b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> (forall a. f a -> m a) -> FreeT f m b -> FreeT f m b
forall (m :: * -> *) (f :: * -> *) b.
Monad m =>
Integer -> (forall a. f a -> m a) -> FreeT f m b -> FreeT f m b
partialIterT (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) f a -> m a
forall a. f a -> m a
phi

-- | @intersperseT f m@ inserts a layer @f@ between every two layers in
-- @m@.
--
-- @
-- 'intersperseT' f '.' 'return' ≡ 'return'
-- 'intersperseT' f '.' 'lift'   ≡ 'lift'
-- 'intersperseT' f '.' 'wrap'   ≡ 'wrap' '.' 'fmap' ('iterTM' ('wrap' '.' ('<$' f) '.' 'wrap'))
-- @
intersperseT :: (Monad m, Applicative f) => f a -> FreeT f m b -> FreeT f m b
intersperseT :: forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Applicative f) =>
f a -> FreeT f m b -> FreeT f m b
intersperseT f a
f (FreeT m (FreeF f b (FreeT f m b))
m) = m (FreeF f b (FreeT f m b)) -> FreeT f m b
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f b (FreeT f m b)) -> FreeT f m b)
-> m (FreeF f b (FreeT f m b)) -> FreeT f m b
forall a b. (a -> b) -> a -> b
$ do
  FreeF f b (FreeT f m b)
val <- m (FreeF f b (FreeT f m b))
m
  case FreeF f b (FreeT f m b)
val of
    Pure b
x -> FreeF f b (FreeT f m b) -> m (FreeF f b (FreeT f m b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FreeF f b (FreeT f m b) -> m (FreeF f b (FreeT f m b)))
-> FreeF f b (FreeT f m b) -> m (FreeF f b (FreeT f m b))
forall a b. (a -> b) -> a -> b
$ b -> FreeF f b (FreeT f m b)
forall (f :: * -> *) a b. a -> FreeF f a b
Pure b
x
    Free f (FreeT f m b)
y -> FreeF f b (FreeT f m b) -> m (FreeF f b (FreeT f m b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FreeF f b (FreeT f m b) -> m (FreeF f b (FreeT f m b)))
-> (f (FreeT f m b) -> FreeF f b (FreeT f m b))
-> f (FreeT f m b)
-> m (FreeF f b (FreeT f m b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (FreeT f m b) -> FreeF f b (FreeT f m b)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f (FreeT f m b) -> m (FreeF f b (FreeT f m b)))
-> f (FreeT f m b) -> m (FreeF f b (FreeT f m b))
forall a b. (a -> b) -> a -> b
$ (FreeT f m b -> FreeT f m b) -> f (FreeT f m b) -> 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 ((f (FreeT f m b) -> FreeT f m b) -> FreeT f m b -> FreeT f m b
forall (f :: * -> *) (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Applicative f, Monad m, MonadTrans t, Monad (t m)) =>
(f (t m a) -> t m a) -> FreeT f m a -> t m a
iterTM (f (FreeT f m b) -> FreeT f m b
forall a. f (FreeT f m a) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap (f (FreeT f m b) -> FreeT f m b)
-> (f (FreeT f m b) -> f (FreeT f m b))
-> f (FreeT f m b)
-> FreeT f m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FreeT f m b -> f a -> f (FreeT f m b)
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f a
f) (FreeT f m b -> f (FreeT f m b))
-> (f (FreeT f m b) -> FreeT f m b)
-> f (FreeT f m b)
-> f (FreeT f m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (FreeT f m b) -> FreeT f m b
forall a. f (FreeT f m a) -> FreeT f m a
forall (f :: * -> *) (m :: * -> *) a.
MonadFree f m =>
f (m a) -> m a
wrap)) f (FreeT f m b)
y

-- | Tear down a free monad transformer using Monad instance for @t m@.
retractT :: (MonadTrans t, Monad (t m), Monad m) => FreeT (t m) m a -> t m a
retractT :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad (t m), Monad m) =>
FreeT (t m) m a -> t m a
retractT (FreeT m (FreeF (t m) a (FreeT (t m) m a))
m) = do
  FreeF (t m) a (FreeT (t m) m a)
val <- m (FreeF (t m) a (FreeT (t m) m a))
-> t m (FreeF (t m) a (FreeT (t m) m a))
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (FreeF (t m) a (FreeT (t m) m a))
m
  case FreeF (t m) a (FreeT (t m) m a)
val of
    Pure a
x -> a -> t m a
forall a. a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
    Free t m (FreeT (t m) m a)
y -> t m (FreeT (t m) m a)
y t m (FreeT (t m) m a) -> (FreeT (t m) m a -> t m a) -> t m a
forall a b. t m a -> (a -> t m b) -> t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FreeT (t m) m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad (t m), Monad m) =>
FreeT (t m) m a -> t m a
retractT

-- | @intercalateT f m@ inserts a layer @f@ between every two layers in
-- @m@ and then retracts the result.
--
-- @
-- 'intercalateT' f ≡ 'retractT' . 'intersperseT' f
-- @
intercalateT :: (Monad m, MonadTrans t, Monad (t m)) => t m a -> FreeT (t m) m b -> t m b
intercalateT :: forall (m :: * -> *) (t :: (* -> *) -> * -> *) a b.
(Monad m, MonadTrans t, Monad (t m)) =>
t m a -> FreeT (t m) m b -> t m b
intercalateT t m a
f (FreeT m (FreeF (t m) b (FreeT (t m) m b))
m) = do
  FreeF (t m) b (FreeT (t m) m b)
val <- m (FreeF (t m) b (FreeT (t m) m b))
-> t m (FreeF (t m) b (FreeT (t m) m b))
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (FreeF (t m) b (FreeT (t m) m b))
m
  case FreeF (t m) b (FreeT (t m) m b)
val of
    Pure b
x -> b -> t m b
forall a. a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
    Free t m (FreeT (t m) m b)
y -> t m (FreeT (t m) m b)
y t m (FreeT (t m) m b) -> (FreeT (t m) m b -> t m b) -> t m b
forall a b. t m a -> (a -> t m b) -> t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (t m (t m b) -> t m b) -> FreeT (t m) m b -> t m b
forall (f :: * -> *) (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Applicative f, Monad m, MonadTrans t, Monad (t m)) =>
(f (t m a) -> t m a) -> FreeT f m a -> t m a
iterTM (\t m (t m b)
x -> t m a
f t m a -> t m b -> t m b
forall a b. t m a -> t m b -> t m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t m (t m b) -> t m b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join t m (t m b)
x)