    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE Rank2Types #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE Safe #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Control.Monad.Free.Church
    -- Copyright   :  (C) 2011-2015 Edward Kmett
    -- License     :  BSD-style (see the file LICENSE)
    --
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  provisional
    -- Portability :  non-portable (rank-2 polymorphism)
    --
    -- \"Free Monads for Less\"
    --
    -- The most straightforward way of implementing free monads is as a recursive
    -- datatype that allows for arbitrarily deep nesting of the base functor. This is
    -- akin to a tree, with the leaves containing the values, and the nodes being a
    -- level of 'Functor' over subtrees.
    --
    -- For each time that the `fmap` or `>>=` operations is used, the old tree is
    -- traversed up to the leaves, a new set of nodes is allocated, and
    -- the old ones are garbage collected. Even if the Haskell runtime
    -- optimizes some of the overhead through laziness and generational garbage
    -- collection, the asymptotic runtime is still quadratic.
    --
    -- On the other hand, if the Church encoding is used, the tree only needs to be
    -- constructed once, because:
    --
    -- * All uses of `fmap` are collapsed into a single one, so that the values on the
    --   _leaves_ are transformed in one pass.
    --
    --   prop> fmap f . fmap g == fmap (f . g)
    --
    -- * All uses of `>>=` are right associated, so that every new subtree created
    --   is final.
    --
    --   prop> (m >>= f) >>= g == m >>= (\x -> f x >>= g)
    --
    -- Asymptotically, the Church encoding supports the monadic operations more
    -- efficiently than the naïve 'Free'.
    --
    -- This is based on the \"Free Monads for Less\" series of articles by Edward Kmett:
    --
    -- * <https://ekmett.github.io/reader/2011/free-monads-for-less/   Free monads for less — Part 1>
    --
    -- * <https://ekmett.github.io/reader/2011/free-monads-for-less-2/ Free monads for less — Part 2>
    ----------------------------------------------------------------------------
    module Control.Monad.Free.Church
      ( F(..)
      , improve
      , fromF
      , iter
      , iterM
      , toF
      , retract
      , hoistF
      , foldF
      , MonadFree(..)
      , liftF
      , cutoff
      ) where

    import Control.Applicative
    import Control.Monad as Monad
    import Control.Monad.Fix
    import Control.Monad.Free hiding (retract, iter, iterM, cutoff)
    import Control.Monad.Reader.Class
    import Control.Monad.Writer.Class
    import Control.Monad.Cont.Class
    import Control.Monad.Trans.Class
    import Control.Monad.State.Class
    import Data.Foldable
    import Data.Traversable
    import Data.Functor.Bind
    import Data.Semigroup.Foldable
    import Data.Semigroup.Traversable
    import Prelude hiding (foldr)

    -- | The Church-encoded free monad for a functor @f@.
    --
    -- It is /asymptotically/ more efficient to use ('>>=') for 'F' than it is to ('>>=') with 'Free'.
    --
    -- <https://ekmett.github.io/reader/2011/free-monads-for-less-2/>
    newtype F f a = F { forall (f :: * -> *) a.
    F f a -> forall r. (a -> r) -> (f r -> r) -> r
    runF :: forall r. (a -> r) -> (f r -> r) -> r }

    -- | Tear down a 'Free' 'Monad' using iteration.
    iter :: (f a -> a) -> F f a -> a
    iter :: forall (f :: * -> *) a. (f a -> a) -> F f a -> a
    iter f a -> a
    phi F f a
    xs = F f a -> forall r. (a -> r) -> (f r -> r) -> r
    forall (f :: * -> *) a.
    F f a -> forall r. (a -> r) -> (f r -> r) -> r
    runF F f a
    xs a -> a
    forall a. a -> a
    id f a -> a
    phi

    -- | Like iter for monadic values.
    iterM :: Monad m => (f (m a) -> m a) -> F f a -> m a
    iterM :: forall (m :: * -> *) (f :: * -> *) a.
    Monad m =>
    (f (m a) -> m a) -> F f a -> m a
    iterM f (m a) -> m a
    phi F f a
    xs = F f a -> forall r. (a -> r) -> (f r -> r) -> r
    forall (f :: * -> *) a.
    F f a -> forall r. (a -> r) -> (f r -> r) -> r
    runF F f a
    xs a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return f (m a) -> m a
    phi

    instance Functor (F f) where
      fmap :: forall a b. (a -> b) -> F f a -> F f b
    fmap a -> b
    f (F forall r. (a -> r) -> (f r -> r) -> r
    g) = (forall r. (b -> r) -> (f r -> r) -> r) -> F f b
    forall (f :: * -> *) a.
    (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    F (\b -> r
    kp -> (a -> r) -> (f r -> r) -> r
    forall r. (a -> r) -> (f r -> r) -> r
    g (b -> r
    kp (b -> r) -> (a -> b) -> a -> r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    f))

    instance Apply (F f) where
      <.> :: forall a b. F f (a -> b) -> F f a -> F f b
    (<.>) = F f (a -> b) -> F f a -> F f b
    forall a b. F f (a -> b) -> F f a -> F f b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    (<*>)

    instance Applicative (F f) where
      pure :: forall a. a -> F f a
    pure a
    a = (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    forall (f :: * -> *) a.
    (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    F (\a -> r
    kp f r -> r
    _ -> a -> r
    kp a
    a)
      F forall r. ((a -> b) -> r) -> (f r -> r) -> r
    f <*> :: forall a b. F f (a -> b) -> F f a -> F f b
    <*> F forall r. (a -> r) -> (f r -> r) -> r
    g = (forall r. (b -> r) -> (f r -> r) -> r) -> F f b
    forall (f :: * -> *) a.
    (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    F (\b -> r
    kp f r -> r
    kf -> ((a -> b) -> r) -> (f r -> r) -> r
    forall r. ((a -> b) -> r) -> (f r -> r) -> r
    f (\a -> b
    a -> (a -> r) -> (f r -> r) -> r
    forall r. (a -> r) -> (f r -> r) -> r
    g (b -> r
    kp (b -> r) -> (a -> b) -> a -> r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    a) f r -> r
    kf) f r -> r
    kf)

    -- | This violates the Alternative laws, handle with care.
    instance Alternative f => Alternative (F f) where
      empty :: forall a. F f a
    empty = (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    forall (f :: * -> *) a.
    (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    F (\a -> r
    _ f r -> r
    kf -> f r -> r
    kf f r
    forall a. f a
    forall (f :: * -> *) a. Alternative f => f a
    empty)
      F forall r. (a -> r) -> (f r -> r) -> r
    f <|> :: forall a. F f a -> F f a -> F f a
    <|> F forall r. (a -> r) -> (f r -> r) -> r
    g = (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    forall (f :: * -> *) a.
    (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    F (\a -> r
    kp f r -> r
    kf -> f r -> r
    kf (r -> f r
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((a -> r) -> (f r -> r) -> r
    forall r. (a -> r) -> (f r -> r) -> r
    f a -> r
    kp f r -> r
    kf) f r -> f r -> f r
    forall a. f a -> f a -> f a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> r -> f r
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((a -> r) -> (f r -> r) -> r
    forall r. (a -> r) -> (f r -> r) -> r
    g a -> r
    kp f r -> r
    kf)))

    instance Bind (F f) where
      >>- :: forall a b. F f a -> (a -> F f b) -> F f b
    (>>-) = F f a -> (a -> F f b) -> F f b
    forall a b. F f a -> (a -> F f b) -> F f b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    (>>=)

    instance Monad (F f) where
      return :: forall a. a -> F f a
    return = a -> F f a
    forall a. a -> F f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      F forall r. (a -> r) -> (f r -> r) -> r
    m >>= :: forall a b. F f a -> (a -> F f b) -> F f b
    >>= a -> F f b
    f = (forall r. (b -> r) -> (f r -> r) -> r) -> F f b
    forall (f :: * -> *) a.
    (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    F (\b -> r
    kp f r -> r
    kf -> (a -> r) -> (f r -> r) -> r
    forall r. (a -> r) -> (f r -> r) -> r
    m (\a
    a -> F f b -> forall r. (b -> r) -> (f r -> r) -> r
    forall (f :: * -> *) a.
    F f a -> forall r. (a -> r) -> (f r -> r) -> r
    runF (a -> F f b
    f a
    a) b -> r
    kp f r -> r
    kf) f r -> r
    kf)

    instance MonadFix (F f) where
      mfix :: forall a. (a -> F f a) -> F f a
    mfix a -> F f a
    f = F f a
    a where
        a :: F f a
    a = a -> F f a
    f (F f a -> a
    forall {f :: * -> *} {r}. F f r -> r
    impure F f a
    a)
        impure :: F f r -> r
    impure (F forall r. (r -> r) -> (f r -> r) -> r
    x) = (r -> r) -> (f r -> r) -> r
    forall r. (r -> r) -> (f r -> r) -> r
    x r -> r
    forall a. a -> a
    id ([Char] -> f r -> r
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "MonadFix (F f): wrap")

    instance Foldable f => Foldable (F f) where
        foldMap :: forall m a. Monoid m => (a -> m) -> F f a -> m
    foldMap a -> m
    f F f a
    xs = F f a -> forall r. (a -> r) -> (f r -> r) -> r
    forall (f :: * -> *) a.
    F f a -> forall r. (a -> r) -> (f r -> r) -> r
    runF F f a
    xs a -> m
    f f m -> m
    forall m. Monoid m => f m -> m
    forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
    fold
        {-# INLINE foldMap #-}

        foldr :: forall a b. (a -> b -> b) -> b -> F f a -> b
    foldr a -> b -> b
    f b
    r F f a
    xs = F f a -> forall r. (a -> r) -> (f r -> r) -> r
    forall (f :: * -> *) a.
    F f a -> forall r. (a -> r) -> (f r -> r) -> r
    runF F f a
    xs a -> b -> b
    f (((b -> b) -> (b -> b) -> b -> b)
    -> (b -> b) -> f (b -> b) -> b -> b
    forall a b. (a -> b -> b) -> b -> f a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (b -> b) -> (b -> b) -> b -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) b -> b
    forall a. a -> a
    id) b
    r
        {-# INLINE foldr #-}

        foldl' :: forall b a. (b -> a -> b) -> b -> F f a -> b
    foldl' b -> a -> b
    f b
    z F f a
    xs = F f a -> forall r. (a -> r) -> (f r -> r) -> r
    forall (f :: * -> *) a.
    F f a -> forall r. (a -> r) -> (f r -> r) -> r
    runF F f a
    xs (\a
    a !b
    r -> b -> a -> b
    f b
    r a
    a) ((b -> f (b -> b) -> b) -> f (b -> b) -> b -> b
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((b -> f (b -> b) -> b) -> f (b -> b) -> b -> b)
    -> (b -> f (b -> b) -> b) -> f (b -> b) -> b -> b
    forall a b. (a -> b) -> a -> b
    $ (b -> (b -> b) -> b) -> b -> f (b -> b) -> b
    forall b a. (b -> a -> b) -> b -> f a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' ((b -> (b -> b) -> b) -> b -> f (b -> b) -> b)
    -> (b -> (b -> b) -> b) -> b -> f (b -> b) -> b
    forall a b. (a -> b) -> a -> b
    $ \b
    r b -> b
    g -> b -> b
    g b
    r) b
    z
        {-# INLINE foldl' #-}

    instance Traversable f => Traversable (F f) where
        traverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> F f a -> f (F f b)
    traverse a -> f b
    f F f a
    m = F f a -> forall r. (a -> r) -> (f r -> r) -> r
    forall (f :: * -> *) a.
    F f a -> forall r. (a -> r) -> (f r -> r) -> r
    runF F f a
    m ((b -> F f b) -> f b -> f (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 b -> F f b
    forall a. a -> F f a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (f b -> f (F f b)) -> (a -> f b) -> a -> f (F f b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> f b
    f) ((f (F f b) -> F f b) -> f (f (F f b)) -> f (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 f (F f b) -> F f b
    forall a. f (F f a) -> F f a
    forall (f :: * -> *) (m :: * -> *) a.
    MonadFree f m =>
    f (m a) -> m a
    wrap (f (f (F f b)) -> f (F f b))
    -> (f (f (F f b)) -> f (f (F f b))) -> f (f (F f b)) -> f (F f b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f (f (F f b)) -> f (f (F f b))
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    forall (f :: * -> *) a. Applicative f => f (f a) -> f (f a)
    sequenceA)
        {-# INLINE traverse #-}

    instance Foldable1 f => Foldable1 (F f) where
        foldMap1 :: forall m a. Semigroup m => (a -> m) -> F f a -> m
    foldMap1 a -> m
    f F f a
    m = F f a -> forall r. (a -> r) -> (f r -> r) -> r
    forall (f :: * -> *) a.
    F f a -> forall r. (a -> r) -> (f r -> r) -> r
    runF F f a
    m a -> m
    f f m -> m
    forall m. Semigroup m => f m -> m
    forall (t :: * -> *) m. (Foldable1 t, Semigroup m) => t m -> m
    fold1

    instance Traversable1 f => Traversable1 (F f) where
        traverse1 :: forall (f :: * -> *) a b.
    Apply f =>
    (a -> f b) -> F f a -> f (F f b)
    traverse1 a -> f b
    f F f a
    m = F f a -> forall r. (a -> r) -> (f r -> r) -> r
    forall (f :: * -> *) a.
    F f a -> forall r. (a -> r) -> (f r -> r) -> r
    runF F f a
    m ((b -> F f b) -> f b -> f (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 b -> F f b
    forall a. a -> F f a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (f b -> f (F f b)) -> (a -> f b) -> a -> f (F f b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> f b
    f) ((f (F f b) -> F f b) -> f (f (F f b)) -> f (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 f (F f b) -> F f b
    forall a. f (F f a) -> F f a
    forall (f :: * -> *) (m :: * -> *) a.
    MonadFree f m =>
    f (m a) -> m a
    wrap (f (f (F f b)) -> f (F f b))
    -> (f (f (F f b)) -> f (f (F f b))) -> f (f (F f b)) -> f (F f b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f (f (F f b)) -> f (f (F f b))
    forall (t :: * -> *) (f :: * -> *) b.
    (Traversable1 t, Apply f) =>
    t (f b) -> f (t b)
    forall (f :: * -> *) b. Apply f => f (f b) -> f (f b)
    sequence1)

    -- | This violates the MonadPlus laws, handle with care.
    instance MonadPlus f => MonadPlus (F f) where
      mzero :: forall a. F f a
    mzero = (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    forall (f :: * -> *) a.
    (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    F (\a -> r
    _ f r -> r
    kf -> f r -> r
    kf f r
    forall a. f a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero)
      F forall r. (a -> r) -> (f r -> r) -> r
    f mplus :: forall a. F f a -> F f a -> F f a
    `mplus` F forall r. (a -> r) -> (f r -> r) -> r
    g = (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    forall (f :: * -> *) a.
    (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    F (\a -> r
    kp f r -> r
    kf -> f r -> r
    kf (r -> f r
    forall a. a -> f a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((a -> r) -> (f r -> r) -> r
    forall r. (a -> r) -> (f r -> r) -> r
    f a -> r
    kp f r -> r
    kf) f r -> f r -> f r
    forall a. f a -> f a -> f a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` r -> f r
    forall a. a -> f a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((a -> r) -> (f r -> r) -> r
    forall r. (a -> r) -> (f r -> r) -> r
    g a -> r
    kp f r -> r
    kf)))

    instance MonadTrans F where
      lift :: forall (m :: * -> *) a. Monad m => m a -> F m a
    lift m a
    f = (forall r. (a -> r) -> (m r -> r) -> r) -> F m a
    forall (f :: * -> *) a.
    (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    F (\a -> r
    kp m r -> r
    kf -> m r -> r
    kf ((a -> r) -> m a -> m r
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM a -> r
    kp m a
    f))

    instance Functor f => MonadFree f (F f) where
      wrap :: forall a. f (F f a) -> F f a
    wrap f (F f a)
    f = (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    forall (f :: * -> *) a.
    (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    F (\a -> r
    kp f r -> r
    kf -> f r -> r
    kf ((F f a -> r) -> f (F f a) -> f r
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\ (F forall r. (a -> r) -> (f r -> r) -> r
    m) -> (a -> r) -> (f r -> r) -> r
    forall r. (a -> r) -> (f r -> r) -> r
    m a -> r
    kp f r -> r
    kf) f (F f a)
    f))

    instance MonadState s m => MonadState s (F m) where
      get :: F m s
    get = m s -> F m s
    forall (m :: * -> *) a. Monad m => m a -> 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
      put :: s -> F m ()
    put = m () -> F m ()
    forall (m :: * -> *) a. Monad m => m a -> F m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m () -> F m ()) -> (s -> m ()) -> s -> F m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . s -> m ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put

    instance MonadReader e m => MonadReader e (F m) where
      ask :: F m e
    ask = m e -> F m e
    forall (m :: * -> *) a. Monad m => m a -> F m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift m e
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      local :: forall a. (e -> e) -> F m a -> F m a
    local e -> e
    f = m a -> F m a
    forall (m :: * -> *) a. Monad m => m a -> F m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m a -> F m a) -> (F m a -> m a) -> F m a -> F m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (e -> e) -> m a -> m a
    forall a. (e -> e) -> m a -> m a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local e -> e
    f (m a -> m a) -> (F m a -> m a) -> F m a -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . F m a -> m a
    forall (m :: * -> *) a. Monad m => F m a -> m a
    retract

    instance MonadWriter w m => MonadWriter w (F m) where
      tell :: w -> F m ()
    tell = m () -> F m ()
    forall (m :: * -> *) a. Monad m => m a -> F m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m () -> F m ()) -> (w -> m ()) -> w -> F m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . w -> m ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell
      pass :: forall a. F m (a, w -> w) -> F m a
    pass = m a -> F m a
    forall (m :: * -> *) a. Monad m => m a -> F m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m a -> F m a)
    -> (F m (a, w -> w) -> m a) -> F m (a, w -> w) -> F m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . 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)
    -> (F m (a, w -> w) -> m (a, w -> w)) -> F m (a, w -> w) -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . F m (a, w -> w) -> m (a, w -> w)
    forall (m :: * -> *) a. Monad m => F m a -> m a
    retract
      listen :: forall a. F m a -> F m (a, w)
    listen = m (a, w) -> F m (a, w)
    forall (m :: * -> *) a. Monad m => m a -> F m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m (a, w) -> F m (a, w))
    -> (F m a -> m (a, w)) -> F m a -> F m (a, w)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m a -> m (a, w)
    forall a. m a -> m (a, w)
    forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
    listen (m a -> m (a, w)) -> (F m a -> m a) -> F m a -> m (a, w)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . F m a -> m a
    forall (m :: * -> *) a. Monad m => F m a -> m a
    retract

    instance MonadCont m => MonadCont (F m) where
      callCC :: forall a b. ((a -> F m b) -> F m a) -> F m a
    callCC (a -> F m b) -> F m a
    f = m a -> F m a
    forall (m :: * -> *) a. Monad m => m a -> F m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m a -> F m a) -> m a -> F m a
    forall a b. (a -> b) -> a -> b
    $ ((a -> m b) -> m a) -> 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 (F m a -> m a
    forall (m :: * -> *) a. Monad m => F m a -> m a
    retract (F m a -> m a) -> ((a -> m b) -> F m a) -> (a -> m b) -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> F m b) -> F m a
    f ((a -> F m b) -> F m a)
    -> ((a -> m b) -> a -> F m b) -> (a -> m b) -> F m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (m b -> F m b) -> (a -> m b) -> a -> F m b
    forall a b. (a -> b) -> (a -> a) -> a -> b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap m b -> F m b
    forall (m :: * -> *) a. Monad m => m a -> F m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift)

    -- |
    -- 'retract' is the left inverse of 'lift' and 'liftF'
    --
    -- @
    -- 'retract' . 'lift' = 'id'
    -- 'retract' . 'liftF' = 'id'
    -- @
    retract :: Monad m => F m a -> m a
    retract :: forall (m :: * -> *) a. Monad m => F m a -> m a
    retract (F forall r. (a -> r) -> (m r -> r) -> r
    m) = (a -> m a) -> (m (m a) -> m a) -> m a
    forall r. (a -> r) -> (m r -> r) -> r
    m a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return m (m a) -> m a
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    Monad.join
    {-# INLINE retract #-}

    -- | Lift a natural transformation from @f@ to @g@ into a natural transformation from @F f@ to @F g@.
    hoistF :: (forall x. f x -> g x) -> F f a -> F g a
    hoistF :: forall (f :: * -> *) (g :: * -> *) a.
    (forall x. f x -> g x) -> F f a -> F g a
    hoistF forall x. f x -> g x
    t (F forall r. (a -> r) -> (f r -> r) -> r
    m) = (forall r. (a -> r) -> (g r -> r) -> r) -> F g a
    forall (f :: * -> *) a.
    (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    F (\a -> r
    p g r -> r
    f -> (a -> r) -> (f r -> r) -> r
    forall r. (a -> r) -> (f r -> r) -> r
    m a -> r
    p (g r -> r
    f (g r -> r) -> (f r -> g r) -> f r -> r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f r -> g r
    forall x. f x -> g x
    t))

    -- | The very definition of a free monad is that given a natural transformation you get a monad homomorphism.
    foldF :: Monad m => (forall x. f x -> m x) -> F f a -> m a
    foldF :: forall (m :: * -> *) (f :: * -> *) a.
    Monad m =>
    (forall x. f x -> m x) -> F f a -> m a
    foldF forall x. f x -> m x
    f (F forall r. (a -> r) -> (f r -> r) -> r
    m) = (a -> m a) -> (f (m a) -> m a) -> m a
    forall r. (a -> r) -> (f r -> r) -> r
    m a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (m (m a) -> m a
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    Monad.join (m (m a) -> m a) -> (f (m a) -> m (m a)) -> f (m a) -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f (m a) -> m (m a)
    forall x. f x -> m x
    f)

    -- | Convert to another free monad representation.
    fromF :: MonadFree f m => F f a -> m a
    fromF :: forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
    fromF (F forall r. (a -> r) -> (f r -> r) -> r
    m) = (a -> m a) -> (f (m a) -> m a) -> m a
    forall r. (a -> r) -> (f r -> r) -> r
    m a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return f (m a) -> m a
    forall a. f (m a) -> m a
    forall (f :: * -> *) (m :: * -> *) a.
    MonadFree f m =>
    f (m a) -> m a
    wrap
    {-# INLINE fromF #-}

    -- | Generate a Church-encoded free monad from a 'Free' monad.
    toF :: Functor f => Free f a -> F f a
    toF :: forall (f :: * -> *) a. Functor f => Free f a -> F f a
    toF Free f a
    xs = (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    forall (f :: * -> *) a.
    (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    F (\a -> r
    kp f r -> r
    kf -> (a -> r) -> (f r -> r) -> Free f a -> r
    forall {f :: * -> *} {t} {b}.
    Functor f =>
    (t -> b) -> (f b -> b) -> Free f t -> b
    go a -> r
    kp f r -> r
    kf Free f a
    xs) where
      go :: (t -> b) -> (f b -> b) -> Free f t -> b
    go t -> b
    kp f b -> b
    _  (Pure t
    a) = t -> b
    kp t
    a
      go t -> b
    kp f b -> b
    kf (Free f (Free f t)
    fma) = f b -> b
    kf ((Free f t -> b) -> f (Free f t) -> f b
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((t -> b) -> (f b -> b) -> Free f t -> b
    go t -> b
    kp f b -> b
    kf) f (Free f t)
    fma)

    -- | Improve the asymptotic performance of code that builds a free monad with only binds and returns by using 'F' behind the scenes.
    --
    -- This is based on the \"Free Monads for Less\" series of articles by Edward Kmett:
    --
    -- * <https://ekmett.github.io/reader/2011/free-monads-for-less/   Free monads for less — Part 1>
    --
    -- * <https://ekmett.github.io/reader/2011/free-monads-for-less-2/ Free monads for less — Part 2>
    --
    -- and <http://www.iai.uni-bonn.de/~jv/mpc08.pdf \"Asymptotic Improvement of Computations over Free Monads\"> by Janis Voightländer.
    improve :: Functor f => (forall m. MonadFree f m => m a) -> Free f a
    improve :: forall (f :: * -> *) a.
    Functor f =>
    (forall (m :: * -> *). MonadFree f m => m a) -> Free f a
    improve forall (m :: * -> *). MonadFree f m => m a
    m = F f a -> Free f a
    forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
    fromF F f a
    forall (m :: * -> *). MonadFree f m => m a
    m
    {-# INLINE improve #-}

    -- | 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@):
    --
    -- prop> cutoff 0     _        == return Nothing
    -- prop> cutoff (n+1) . return == return . Just
    -- prop> cutoff (n+1) . lift   == lift . liftM Just
    -- prop> 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.
    {-# INLINE cutoff #-}
    cutoff :: (Functor f) => Integer -> F f a -> F f (Maybe a)
    cutoff :: forall (f :: * -> *) a.
    Functor f =>
    Integer -> F f a -> F f (Maybe a)
    cutoff Integer
    n F f a
    m
        | Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    0 = Maybe a -> F f (Maybe a)
    forall a. a -> F f a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing
        | Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int
    forall a. Bounded a => a
    maxBound :: Int) = Int -> F f a -> F f (Maybe a)
    forall (f :: * -> *) n a.
    (Functor f, Integral n) =>
    n -> F f a -> F f (Maybe a)
    cutoffI (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    n :: Int) F f a
    m
        | Bool
    otherwise = Integer -> F f a -> F f (Maybe a)
    forall (f :: * -> *) n a.
    (Functor f, Integral n) =>
    n -> F f a -> F f (Maybe a)
    cutoffI Integer
    n F f a
    m

    {-# SPECIALIZE cutoffI :: (Functor f) => Int -> F f a -> F f (Maybe a) #-}
    {-# SPECIALIZE cutoffI :: (Functor f) => Integer -> F f a -> F f (Maybe a) #-}
    cutoffI :: (Functor f, Integral n) => n -> F f a -> F f (Maybe a)
    cutoffI :: forall (f :: * -> *) n a.
    (Functor f, Integral n) =>
    n -> F f a -> F f (Maybe a)
    cutoffI n
    n F f a
    m = (forall r. (Maybe a -> r) -> (f r -> r) -> r) -> F f (Maybe a)
    forall (f :: * -> *) a.
    (forall r. (a -> r) -> (f r -> r) -> r) -> F f a
    F (Maybe a -> r) -> (f r -> r) -> r
    forall r. (Maybe a -> r) -> (f r -> r) -> r
    m' where
        m' :: (Maybe a -> t) -> (f t -> t) -> t
    m' Maybe a -> t
    kp f t -> t
    kf = F f a -> forall r. (a -> r) -> (f r -> r) -> r
    forall (f :: * -> *) a.
    F f a -> forall r. (a -> r) -> (f r -> r) -> r
    runF F f a
    m a -> n -> t
    forall {a}. (Ord a, Num a) => a -> a -> t
    kpn f (n -> t) -> n -> t
    forall {a}. (Ord a, Num a) => f (a -> t) -> a -> t
    kfn n
    n where
            kpn :: a -> a -> t
    kpn a
    a a
    i
                | a
    i a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    0 = Maybe a -> t
    kp Maybe a
    forall a. Maybe a
    Nothing
                | Bool
    otherwise = Maybe a -> t
    kp (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a)
            kfn :: f (a -> t) -> a -> t
    kfn f (a -> t)
    fr a
    i
                | a
    i a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    0 = Maybe a -> t
    kp Maybe a
    forall a. Maybe a
    Nothing
                | Bool
    otherwise = let
                    i' :: a
    i' = a
    i a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    1
                    in a
    i' a -> t -> t
    forall a b. a -> b -> b
    `seq` f t -> t
    kf (((a -> t) -> t) -> f (a -> t) -> f t
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((a -> t) -> a -> t
    forall a b. (a -> b) -> a -> b
    $ a
    i') f (a -> t)
    fr)