    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE Rank2Types #-}
    #if __GLASGOW_HASKELL__ >= 707
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveGeneric #-}
    #endif
    #include "free-common.h"

    --------------------------------------------------------------------------------
    -- |
    -- \"Applicative Effects in Free Monads\"
    --
    -- Often times, the '(\<*\>)' operator can be more efficient than 'ap'.
    -- Conventional free monads don't provide any means of modeling this.
    -- The free monad can be modified to make use of an underlying applicative.
    -- But it does require some laws, or else the '(\<*\>)' = 'ap' law is broken.
    -- When interpreting this free monad with 'foldFree',
    -- the natural transformation must be an applicative homomorphism.
    -- An applicative homomorphism @hm :: (Applicative f, Applicative g) => f x -> g x@
    -- will satisfy these laws.
    --
    -- * @hm (pure a) = pure a@
    -- * @hm (f \<*\> a) = hm f \<*\> hm a@
    --
    -- This is based on the \"Applicative Effects in Free Monads\" series of articles by Will Fancher
    --
    -- * <http://elvishjerricco.github.io/2016/04/08/applicative-effects-in-free-monads.html Applicative Effects in Free Monads>
    --
    -- * <http://elvishjerricco.github.io/2016/04/13/more-on-applicative-effects-in-free-monads.html More on Applicative Effects in Free Monads>
    --------------------------------------------------------------------------------
    module Control.Monad.Free.Ap
      ( MonadFree(..)
      , Free(..)
      , retract
      , liftF
      , iter
      , iterA
      , iterM
      , hoistFree
      , foldFree
      , toFreeT
      , cutoff
      , unfold
      , unfoldM
      , _Pure, _Free
      ) where

    import Control.Applicative
    import Control.Arrow ((>>>))
    import Control.Monad (liftM, MonadPlus(..), (>=>))
    import Control.Monad.Fix
    import Control.Monad.Trans.Class
    import qualified Control.Monad.Trans.Free.Ap as FreeT
    import Control.Monad.Free.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
    import Data.Functor.Classes.Compat
    import Data.Foldable
    import Data.Profunctor
    import Data.Traversable
    import Data.Semigroup.Foldable
    import Data.Semigroup.Traversable
    import Data.Data
    import Prelude hiding (foldr)
    #if __GLASGOW_HASKELL__ >= 707
    import GHC.Generics
    #endif

    -- | A free monad given an applicative
    data Free f a = Pure a | Free (f (Free f a))
    #if __GLASGOW_HASKELL__ >= 707
      deriving (Typeable, (forall x. Free f a -> Rep (Free f a) x)
    -> (forall x. Rep (Free f a) x -> Free f a) -> Generic (Free f a)
    forall x. Rep (Free f a) x -> Free f a
    forall x. Free f a -> Rep (Free f a) x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    forall (f :: * -> *) a x. Rep (Free f a) x -> Free f a
    forall (f :: * -> *) a x. Free f a -> Rep (Free f a) x
    $cto :: forall (f :: * -> *) a x. Rep (Free f a) x -> Free f a
    $cfrom :: forall (f :: * -> *) a x. Free f a -> Rep (Free f a) x
    Generic, (forall a. Free f a -> Rep1 (Free f) a)
    -> (forall a. Rep1 (Free f) a -> Free f a) -> Generic1 (Free f)
    forall a. Rep1 (Free f) a -> Free f a
    forall a. Free f a -> Rep1 (Free f) 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. Functor f => Rep1 (Free f) a -> Free f a
    forall (f :: * -> *) a. Functor f => Free f a -> Rep1 (Free f) a
    $cto1 :: forall (f :: * -> *) a. Functor f => Rep1 (Free f) a -> Free f a
    $cfrom1 :: forall (f :: * -> *) a. Functor f => Free f a -> Rep1 (Free f) a
    Generic1)
    #endif

    #ifdef LIFTED_FUNCTOR_CLASSES
    instance Eq1 f => Eq1 (Free f) where
      liftEq :: (a -> b -> Bool) -> Free f a -> Free f b -> Bool
    liftEq eq :: a -> b -> Bool
    eq = Free f a -> Free f b -> Bool
    forall (f :: * -> *). Eq1 f => Free f a -> Free f b -> Bool
    go
        where
          go :: Free f a -> Free f b -> Bool
    go (Pure a :: a
    a)  (Pure b :: b
    b)  = a -> b -> Bool
    eq a
    a b
    b
          go (Free fa :: f (Free f a)
    fa) (Free fb :: f (Free f b)
    fb) = (Free f a -> Free f b -> Bool)
    -> f (Free f a) -> f (Free f b) -> Bool
    forall (f :: * -> *) a b.
    Eq1 f =>
    (a -> b -> Bool) -> f a -> f b -> Bool
    liftEq Free f a -> Free f b -> Bool
    go f (Free f a)
    fa f (Free f b)
    fb
          go _ _                 = Bool
    False
    #else
    instance (Functor f, Eq1 f) => Eq1 (Free f) where
      Pure a  `eq1` Pure b  = a == b
      Free fa `eq1` Free fb = fmap Lift1 fa `eq1` fmap Lift1 fb
      _       `eq1` _ = False
    #endif

    #ifdef LIFTED_FUNCTOR_CLASSES
    instance (Eq1 f, Eq a) => Eq (Free f a) where
    #else
    instance (Eq1 f, Functor f, Eq a) => Eq (Free f a) where
    #endif
      == :: Free f a -> Free f a -> Bool
    (==) = Free f a -> Free f a -> Bool
    forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
    eq1

    #ifdef LIFTED_FUNCTOR_CLASSES
    instance Ord1 f => Ord1 (Free f) where
      liftCompare :: (a -> b -> Ordering) -> Free f a -> Free f b -> Ordering
    liftCompare cmp :: a -> b -> Ordering
    cmp = Free f a -> Free f b -> Ordering
    forall (f :: * -> *). Ord1 f => Free f a -> Free f b -> Ordering
    go
        where
          go :: Free f a -> Free f b -> Ordering
    go (Pure a :: a
    a)  (Pure b :: b
    b)  = a -> b -> Ordering
    cmp a
    a b
    b
          go (Pure _)  (Free _)  = Ordering
    LT
          go (Free _)  (Pure _)  = Ordering
    GT
          go (Free fa :: f (Free f a)
    fa) (Free fb :: f (Free f b)
    fb) = (Free f a -> Free f b -> Ordering)
    -> f (Free f a) -> f (Free f b) -> Ordering
    forall (f :: * -> *) a b.
    Ord1 f =>
    (a -> b -> Ordering) -> f a -> f b -> Ordering
    liftCompare Free f a -> Free f b -> Ordering
    go f (Free f a)
    fa f (Free f b)
    fb
    #else
    instance (Functor f, Ord1 f) => Ord1 (Free f) where
      Pure a `compare1` Pure b = a `compare` b
      Pure _ `compare1` Free _ = LT
      Free _ `compare1` Pure _ = GT
      Free fa `compare1` Free fb = fmap Lift1 fa `compare1` fmap Lift1 fb
    #endif

    #ifdef LIFTED_FUNCTOR_CLASSES
    instance (Ord1 f, Ord a) => Ord (Free f a) where
    #else
    instance (Ord1 f, Functor f, Ord a) => Ord (Free f a) where
    #endif
      compare :: Free f a -> Free f a -> Ordering
    compare = Free f a -> Free f a -> Ordering
    forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
    compare1

    #ifdef LIFTED_FUNCTOR_CLASSES
    instance Show1 f => Show1 (Free f) where
      liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Free f a -> ShowS
    liftShowsPrec sp :: Int -> a -> ShowS
    sp sl :: [a] -> ShowS
    sl = Int -> Free f a -> ShowS
    forall (f :: * -> *). Show1 f => Int -> Free f a -> ShowS
    go
        where
          go :: Int -> Free f a -> ShowS
    go d :: Int
    d (Pure a :: a
    a) = (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
    forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
    showsUnaryWith Int -> a -> ShowS
    sp "Pure" Int
    d a
    a
          go d :: Int
    d (Free fa :: f (Free f a)
    fa) = (Int -> f (Free f a) -> ShowS)
    -> String -> Int -> f (Free f a) -> ShowS
    forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
    showsUnaryWith ((Int -> Free f a -> ShowS)
    -> ([Free f a] -> ShowS) -> Int -> f (Free f a) -> ShowS
    forall (f :: * -> *) a.
    Show1 f =>
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
    liftShowsPrec Int -> Free f a -> ShowS
    go ((Int -> a -> ShowS) -> ([a] -> ShowS) -> [Free f a] -> ShowS
    forall (f :: * -> *) a.
    Show1 f =>
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
    liftShowList Int -> a -> ShowS
    sp [a] -> ShowS
    sl)) "Free" Int
    d f (Free f a)
    fa
    #else
    instance (Functor f, Show1 f) => Show1 (Free f) where
      showsPrec1 d (Pure a) = showParen (d > 10) $
        showString "Pure " . showsPrec 11 a
      showsPrec1 d (Free m) = showParen (d > 10) $
        showString "Free " . showsPrec1 11 (fmap Lift1 m)
    #endif

    #ifdef LIFTED_FUNCTOR_CLASSES
    instance (Show1 f, Show a) => Show (Free f a) where
    #else
    instance (Show1 f, Functor f, Show a) => Show (Free f a) where
    #endif
      showsPrec :: Int -> Free f a -> ShowS
    showsPrec = Int -> Free f a -> ShowS
    forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
    showsPrec1

    #ifdef LIFTED_FUNCTOR_CLASSES
    instance Read1 f => Read1 (Free f) where
      liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Free f a)
    liftReadsPrec rp :: Int -> ReadS a
    rp rl :: ReadS [a]
    rl = Int -> ReadS (Free f a)
    go
        where
          go :: Int -> ReadS (Free f a)
    go = (String -> ReadS (Free f a)) -> Int -> ReadS (Free f a)
    forall a. (String -> ReadS a) -> Int -> ReadS a
    readsData ((String -> ReadS (Free f a)) -> Int -> ReadS (Free f a))
    -> (String -> ReadS (Free f a)) -> Int -> ReadS (Free f a)
    forall a b. (a -> b) -> a -> b
    $
            (Int -> ReadS a)
    -> String -> (a -> Free f a) -> String -> ReadS (Free f a)
    forall a t.
    (Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
    readsUnaryWith Int -> ReadS a
    rp "Pure" a -> Free f a
    forall (f :: * -> *) a. a -> Free f a
    Pure (String -> ReadS (Free f a))
    -> (String -> ReadS (Free f a)) -> String -> ReadS (Free f a)
    forall a. Monoid a => a -> a -> a
    `mappend`
            (Int -> ReadS (f (Free f a)))
    -> String
    -> (f (Free f a) -> Free f a)
    -> String
    -> ReadS (Free f a)
    forall a t.
    (Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
    readsUnaryWith ((Int -> ReadS (Free f a))
    -> ReadS [Free f a] -> Int -> ReadS (f (Free f a))
    forall (f :: * -> *) a.
    Read1 f =>
    (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
    liftReadsPrec Int -> ReadS (Free f a)
    go ((Int -> ReadS a) -> ReadS [a] -> ReadS [Free f a]
    forall (f :: * -> *) a.
    Read1 f =>
    (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
    liftReadList Int -> ReadS a
    rp ReadS [a]
    rl)) "Free" f (Free f a) -> Free f a
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free
    #else
    instance (Functor f, Read1 f) => Read1 (Free f) where
      readsPrec1 d r = readParen (d > 10)
          (\r' -> [ (Pure m, t)
                 | ("Pure", s) <- lex r'
                 , (m, t) <- readsPrec 11 s]) r
        ++ readParen (d > 10)
          (\r' -> [ (Free (fmap lower1 m), t)
                 | ("Free", s) <- lex r'
                 , (m, t) <- readsPrec1 11 s]) r
    #endif

    #ifdef LIFTED_FUNCTOR_CLASSES
    instance (Read1 f, Read a) => Read (Free f a) where
    #else
    instance (Read1 f, Functor f, Read a) => Read (Free f a) where
    #endif
      readsPrec :: Int -> ReadS (Free f a)
    readsPrec = Int -> ReadS (Free f a)
    forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
    readsPrec1

    instance Functor f => Functor (Free f) where
      fmap :: (a -> b) -> Free f a -> Free f b
    fmap f :: a -> b
    f = Free f a -> Free f b
    forall (f :: * -> *). Functor f => Free f a -> Free f b
    go where
        go :: Free f a -> Free f b
    go (Pure a :: a
    a)  = b -> Free f b
    forall (f :: * -> *) a. a -> Free f a
    Pure (a -> b
    f a
    a)
        go (Free fa :: f (Free f a)
    fa) = f (Free f b) -> Free f b
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free (Free f a -> Free f b
    go (Free f a -> Free f b) -> f (Free f a) -> f (Free f b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> f (Free f a)
    fa)
      {-# INLINE fmap #-}

    instance Apply f => Apply (Free f) where
      Pure a :: a -> b
    a  <.> :: Free f (a -> b) -> Free f a -> Free f b
    <.> Pure b :: a
    b = b -> Free f b
    forall (f :: * -> *) a. a -> Free f a
    Pure (a -> b
    a a
    b)
      Pure a :: a -> b
    a  <.> Free fb :: f (Free f a)
    fb = f (Free f b) -> Free f b
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free (f (Free f b) -> Free f b) -> f (Free f b) -> Free f b
    forall a b. (a -> b) -> a -> b
    $ (a -> b) -> Free f a -> Free f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    a (Free f a -> Free f b) -> f (Free f a) -> f (Free f b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> f (Free f a)
    fb
      Free fa :: f (Free f (a -> b))
    fa <.> Pure b :: a
    b = f (Free f b) -> Free f b
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free (f (Free f b) -> Free f b) -> f (Free f b) -> Free f b
    forall a b. (a -> b) -> a -> b
    $ ((a -> b) -> b) -> Free f (a -> b) -> Free 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
    b) (Free f (a -> b) -> Free f b)
    -> f (Free f (a -> b)) -> f (Free f b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> f (Free f (a -> b))
    fa
      Free fa :: f (Free f (a -> b))
    fa <.> Free fb :: f (Free f a)
    fb = f (Free f b) -> Free f b
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free (f (Free f b) -> Free f b) -> f (Free f b) -> Free f b
    forall a b. (a -> b) -> a -> b
    $ (Free f (a -> b) -> Free f a -> Free f b)
    -> f (Free f (a -> b)) -> f (Free f a -> Free f b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Free f (a -> b) -> Free f a -> Free f b
    forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
    (<.>) f (Free f (a -> b))
    fa f (Free f a -> Free f b) -> f (Free f a) -> f (Free f b)
    forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
    <.> f (Free f a)
    fb

    instance Applicative f => Applicative (Free f) where
      pure :: a -> Free f a
    pure = a -> Free f a
    forall (f :: * -> *) a. a -> Free f a
    Pure
      {-# INLINE pure #-}
      Pure a :: a -> b
    a <*> :: Free f (a -> b) -> Free f a -> Free f b
    <*> Pure b :: a
    b = b -> Free f b
    forall (f :: * -> *) a. a -> Free f a
    Pure (b -> Free f b) -> b -> Free f b
    forall a b. (a -> b) -> a -> b
    $ a -> b
    a a
    b
      Pure a :: a -> b
    a <*> Free mb :: f (Free f a)
    mb = f (Free f b) -> Free f b
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free (f (Free f b) -> Free f b) -> f (Free f b) -> Free f b
    forall a b. (a -> b) -> a -> b
    $ (a -> b) -> Free f a -> Free f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    a (Free f a -> Free f b) -> f (Free f a) -> f (Free f b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> f (Free f a)
    mb
      Free ma :: f (Free f (a -> b))
    ma <*> Pure b :: a
    b = f (Free f b) -> Free f b
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free (f (Free f b) -> Free f b) -> f (Free f b) -> Free f b
    forall a b. (a -> b) -> a -> b
    $ ((a -> b) -> b) -> Free f (a -> b) -> Free 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
    b) (Free f (a -> b) -> Free f b)
    -> f (Free f (a -> b)) -> f (Free f b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> f (Free f (a -> b))
    ma
      Free ma :: f (Free f (a -> b))
    ma <*> Free mb :: f (Free f a)
    mb = f (Free f b) -> Free f b
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free (f (Free f b) -> Free f b) -> f (Free f b) -> Free f b
    forall a b. (a -> b) -> a -> b
    $ (Free f (a -> b) -> Free f a -> Free f b)
    -> f (Free f (a -> b)) -> f (Free f a -> Free f b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Free f (a -> b) -> Free f a -> Free f b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    (<*>) f (Free f (a -> b))
    ma f (Free f a -> Free f b) -> f (Free f a) -> f (Free f b)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> f (Free f a)
    mb

    instance Apply f => Bind (Free f) where
      Pure a :: a
    a >>- :: Free f a -> (a -> Free f b) -> Free f b
    >>- f :: a -> Free f b
    f = a -> Free f b
    f a
    a
      Free m :: f (Free f a)
    m >>- f :: a -> Free f b
    f = f (Free f b) -> Free f b
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free ((Free f a -> (a -> Free f b) -> Free f b
    forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
    >>- a -> Free f b
    f) (Free f a -> Free f b) -> f (Free f a) -> f (Free f b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> f (Free f a)
    m)

    instance Applicative f => Monad (Free f) where
      return :: a -> Free f a
    return = a -> Free f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      {-# INLINE return #-}
      Pure a :: a
    a >>= :: Free f a -> (a -> Free f b) -> Free f b
    >>= f :: a -> Free f b
    f = a -> Free f b
    f a
    a
      Free m :: f (Free f a)
    m >>= f :: a -> Free f b
    f = f (Free f b) -> Free f b
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free ((Free f a -> (a -> Free f b) -> Free f b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= a -> Free f b
    f) (Free f a -> Free f b) -> f (Free f a) -> f (Free f b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> f (Free f a)
    m)

    instance Applicative f => MonadFix (Free f) where
      mfix :: (a -> Free f a) -> Free f a
    mfix f :: a -> Free f a
    f = Free f a
    a where a :: Free f a
    a = a -> Free f a
    f (Free f a -> a
    forall (f :: * -> *) p. Free f p -> p
    impure Free f a
    a); impure :: Free f p -> p
    impure (Pure x :: p
    x) = p
    x; impure (Free _) = String -> p
    forall a. HasCallStack => String -> a
    error "mfix (Free f): Free"

    -- | This violates the Alternative laws, handle with care.
    instance Alternative v => Alternative (Free v) where
      empty :: Free v a
    empty = v (Free v a) -> Free v a
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free v (Free v a)
    forall (f :: * -> *) a. Alternative f => f a
    empty
      {-# INLINE empty #-}
      a :: Free v a
    a <|> :: Free v a -> Free v a -> Free v a
    <|> b :: Free v a
    b = v (Free v a) -> Free v a
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free (Free v a -> v (Free v a)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Free v a
    a v (Free v a) -> v (Free v a) -> v (Free v a)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Free v a -> v (Free v a)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Free v a
    b)
      {-# INLINE (<|>) #-}

    -- | This violates the MonadPlus laws, handle with care.
    instance (Applicative v, MonadPlus v) => MonadPlus (Free v) where
      mzero :: Free v a
    mzero = v (Free v a) -> Free v a
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free v (Free v a)
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
      {-# INLINE mzero #-}
      a :: Free v a
    a mplus :: Free v a -> Free v a -> Free v a
    `mplus` b :: Free v a
    b = v (Free v a) -> Free v a
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free (Free v a -> v (Free v a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Free v a
    a v (Free v a) -> v (Free v a) -> v (Free v a)
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` Free v a -> v (Free v a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Free v a
    b)
      {-# INLINE mplus #-}

    -- | This is not a true monad transformer. It is only a monad transformer \"up to 'retract'\".
    instance MonadTrans Free where
      lift :: m a -> Free m a
    lift = m (Free m a) -> Free m a
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free (m (Free m a) -> Free m a)
    -> (m a -> m (Free m a)) -> m a -> Free m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Free m a) -> m a -> m (Free m a)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM a -> Free m a
    forall (f :: * -> *) a. a -> Free f a
    Pure
      {-# INLINE lift #-}

    instance Foldable f => Foldable (Free f) where
      foldMap :: (a -> m) -> Free f a -> m
    foldMap f :: a -> m
    f = Free f a -> m
    forall (t :: * -> *). Foldable t => Free t a -> m
    go where
        go :: Free t a -> m
    go (Pure a :: a
    a) = a -> m
    f a
    a
        go (Free fa :: t (Free t a)
    fa) = (Free t a -> m) -> t (Free t a) -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Free t a -> m
    go t (Free t a)
    fa
      {-# INLINE foldMap #-}

      foldr :: (a -> b -> b) -> b -> Free f a -> b
    foldr f :: a -> b -> b
    f = b -> Free f a -> b
    forall (t :: * -> *). Foldable t => b -> Free t a -> b
    go where
        go :: b -> Free t a -> b
    go r :: b
    r free :: Free t a
    free =
          case Free t a
    free of
            Pure a :: a
    a -> a -> b -> b
    f a
    a b
    r
            Free fa :: t (Free t a)
    fa -> (Free t a -> b -> b) -> b -> t (Free t a) -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((b -> Free t a -> b) -> Free t a -> b -> b
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip b -> Free t a -> b
    go) b
    r t (Free t a)
    fa
      {-# INLINE foldr #-}

    #if MIN_VERSION_base(4,6,0)
      foldl' :: (b -> a -> b) -> b -> Free f a -> b
    foldl' f :: b -> a -> b
    f = b -> Free f a -> b
    forall (t :: * -> *). Foldable t => b -> Free t a -> b
    go where
        go :: b -> Free t a -> b
    go r :: b
    r free :: Free t a
    free =
          case Free t a
    free of
            Pure a :: a
    a -> b -> a -> b
    f b
    r a
    a
            Free fa :: t (Free t a)
    fa -> (b -> Free t a -> b) -> b -> t (Free t a) -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' b -> Free t a -> b
    go b
    r t (Free t a)
    fa
      {-# INLINE foldl' #-}
    #endif

    instance Foldable1 f => Foldable1 (Free f) where
      foldMap1 :: (a -> m) -> Free f a -> m
    foldMap1 f :: a -> m
    f = Free f a -> m
    forall (t :: * -> *). Foldable1 t => Free t a -> m
    go where
        go :: Free t a -> m
    go (Pure a :: a
    a) = a -> m
    f a
    a
        go (Free fa :: t (Free t a)
    fa) = (Free t a -> m) -> t (Free t a) -> m
    forall (t :: * -> *) m a.
    (Foldable1 t, Semigroup m) =>
    (a -> m) -> t a -> m
    foldMap1 Free t a -> m
    go t (Free t a)
    fa
      {-# INLINE foldMap1 #-}

    instance Traversable f => Traversable (Free f) where
      traverse :: (a -> f b) -> Free f a -> f (Free f b)
    traverse f :: a -> f b
    f = Free f a -> f (Free f b)
    forall (f :: * -> *). Traversable f => Free f a -> f (Free f b)
    go where
        go :: Free f a -> f (Free f b)
    go (Pure a :: a
    a) = b -> Free f b
    forall (f :: * -> *) a. a -> Free f a
    Pure (b -> Free f b) -> f b -> f (Free f b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> f b
    f a
    a
        go (Free fa :: f (Free f a)
    fa) = f (Free f b) -> Free f b
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free (f (Free f b) -> Free f b) -> f (f (Free f b)) -> f (Free f b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Free f a -> f (Free f b)) -> f (Free f a) -> f (f (Free f b))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Free f a -> f (Free f b)
    go f (Free f a)
    fa
      {-# INLINE traverse #-}

    instance Traversable1 f => Traversable1 (Free f) where
      traverse1 :: (a -> f b) -> Free f a -> f (Free f b)
    traverse1 f :: a -> f b
    f = Free f a -> f (Free f b)
    forall (f :: * -> *). Traversable1 f => Free f a -> f (Free f b)
    go where
        go :: Free f a -> f (Free f b)
    go (Pure a :: a
    a) = b -> Free f b
    forall (f :: * -> *) a. a -> Free f a
    Pure (b -> Free f b) -> f b -> f (Free f b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> f b
    f a
    a
        go (Free fa :: f (Free f a)
    fa) = f (Free f b) -> Free f b
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free (f (Free f b) -> Free f b) -> f (f (Free f b)) -> f (Free f b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Free f a -> f (Free f b)) -> f (Free f a) -> f (f (Free f b))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable1 t, Apply f) =>
    (a -> f b) -> t a -> f (t b)
    traverse1 Free f a -> f (Free f b)
    go f (Free f a)
    fa
      {-# INLINE traverse1 #-}

    instance (Applicative m, MonadWriter e m) => MonadWriter e (Free m) where
      tell :: e -> Free m ()
    tell = m () -> Free m ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m () -> Free m ()) -> (e -> m ()) -> e -> Free m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . e -> m ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell
      {-# INLINE tell #-}
      listen :: Free m a -> Free m (a, e)
    listen = m (a, e) -> Free m (a, e)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m (a, e) -> Free m (a, e))
    -> (Free m a -> m (a, e)) -> Free m a -> Free m (a, e)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m a -> m (a, e)
    forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
    listen (m a -> m (a, e)) -> (Free m a -> m a) -> Free m a -> m (a, e)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Free m a -> m a
    forall (f :: * -> *) a. (Applicative f, Monad f) => Free f a -> f a
    retract
      {-# INLINE listen #-}
      pass :: Free m (a, e -> e) -> Free m a
    pass = m a -> Free m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m a -> Free m a)
    -> (Free m (a, e -> e) -> m a) -> Free m (a, e -> e) -> Free m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m (a, e -> e) -> m a
    forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
    pass (m (a, e -> e) -> m a)
    -> (Free m (a, e -> e) -> m (a, e -> e))
    -> Free m (a, e -> e)
    -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Free m (a, e -> e) -> m (a, e -> e)
    forall (f :: * -> *) a. (Applicative f, Monad f) => Free f a -> f a
    retract
      {-# INLINE pass #-}

    instance (Applicative m, MonadReader e m) => MonadReader e (Free m) where
      ask :: Free m e
    ask = m e -> Free m e
    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
      {-# INLINE ask #-}
      local :: (e -> e) -> Free m a -> Free m a
    local f :: e -> e
    f = m a -> Free m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m a -> Free m a) -> (Free m a -> m a) -> Free m a -> Free m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (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) -> (Free m a -> m a) -> Free m a -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Free m a -> m a
    forall (f :: * -> *) a. (Applicative f, Monad f) => Free f a -> f a
    retract
      {-# INLINE local #-}

    instance (Applicative m, MonadState s m) => MonadState s (Free m) where
      get :: Free m s
    get = m s -> Free m s
    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 -> Free m ()
    put s :: s
    s = m () -> Free m ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (s -> m ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put s
    s)
      {-# INLINE put #-}

    instance (Applicative m, MonadError e m) => MonadError e (Free m) where
      throwError :: e -> Free m a
    throwError = m a -> Free m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m a -> Free m a) -> (e -> m a) -> e -> Free m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . e -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError
      {-# INLINE throwError #-}
      catchError :: Free m a -> (e -> Free m a) -> Free m a
    catchError as :: Free m a
    as f :: e -> Free m a
    f = m a -> Free m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m a -> (e -> m a) -> m a
    forall e (m :: * -> *) a.
    MonadError e m =>
    m a -> (e -> m a) -> m a
    catchError (Free m a -> m a
    forall (f :: * -> *) a. (Applicative f, Monad f) => Free f a -> f a
    retract Free m a
    as) (Free m a -> m a
    forall (f :: * -> *) a. (Applicative f, Monad f) => Free f a -> f a
    retract (Free m a -> m a) -> (e -> Free m a) -> e -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . e -> Free m a
    f))
      {-# INLINE catchError #-}

    instance (Applicative m, MonadCont m) => MonadCont (Free m) where
      callCC :: ((a -> Free m b) -> Free m a) -> Free m a
    callCC f :: (a -> Free m b) -> Free m a
    f = m a -> Free m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (((a -> m b) -> m a) -> m a
    forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
    callCC (Free m a -> m a
    forall (f :: * -> *) a. (Applicative f, Monad f) => Free f a -> f a
    retract (Free m a -> m a) -> ((a -> m b) -> Free m a) -> (a -> m b) -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Free m b) -> Free m a
    f ((a -> Free m b) -> Free m a)
    -> ((a -> m b) -> a -> Free m b) -> (a -> m b) -> Free m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (m b -> Free m b) -> (a -> m b) -> a -> Free m b
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM m b -> Free m b
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift))
      {-# INLINE callCC #-}

    instance Applicative f => MonadFree f (Free f) where
      wrap :: f (Free f a) -> Free f a
    wrap = f (Free f a) -> Free f a
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free
      {-# INLINE wrap #-}

    -- |
    -- 'retract' is the left inverse of 'lift' and 'liftF'
    --
    -- @
    -- 'retract' . 'lift' = 'id'
    -- 'retract' . 'liftF' = 'id'
    -- @
    retract :: (Applicative f, Monad f) => Free f a -> f a
    retract :: Free f a -> f a
    retract = (forall x. f x -> f x) -> Free f a -> f a
    forall (f :: * -> *) (m :: * -> *) a.
    (Applicative f, Applicative m, Monad m) =>
    (forall x. f x -> m x) -> Free f a -> m a
    foldFree forall a. a -> a
    forall x. f x -> f x
    id

    -- | 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 :: (f a -> a) -> Free f a -> a
    iter _ (Pure a :: a
    a) = a
    a
    iter phi :: f a -> a
    phi (Free m :: f (Free f a)
    m) = f a -> a
    phi ((f a -> a) -> Free f a -> a
    forall (f :: * -> *) a.
    Applicative f =>
    (f a -> a) -> Free f a -> a
    iter f a -> a
    phi (Free f a -> a) -> f (Free f a) -> f a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> f (Free f a)
    m)

    -- | Like 'iter' for applicative values.
    iterA :: (Applicative p, Applicative f) => (f (p a) -> p a) -> Free f a -> p a
    iterA :: (f (p a) -> p a) -> Free f a -> p a
    iterA _   (Pure x :: a
    x) = a -> p a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    x
    iterA phi :: f (p a) -> p a
    phi (Free f :: f (Free f a)
    f) = f (p a) -> p a
    phi ((f (p a) -> p a) -> Free f a -> p a
    forall (p :: * -> *) (f :: * -> *) a.
    (Applicative p, Applicative f) =>
    (f (p a) -> p a) -> Free f a -> p a
    iterA f (p a) -> p a
    phi (Free f a -> p a) -> f (Free f a) -> f (p a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> f (Free f a)
    f)

    -- | Like 'iter' for monadic values.
    iterM :: (Applicative m, Monad m, Applicative f) => (f (m a) -> m a) -> Free f a -> m a
    iterM :: (f (m a) -> m a) -> Free f a -> m a
    iterM _   (Pure x :: a
    x) = a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x
    iterM phi :: f (m a) -> m a
    phi (Free f :: f (Free f a)
    f) = f (m a) -> m a
    phi ((f (m a) -> m a) -> Free f a -> m a
    forall (m :: * -> *) (f :: * -> *) a.
    (Applicative m, Monad m, Applicative f) =>
    (f (m a) -> m a) -> Free f a -> m a
    iterM f (m a) -> m a
    phi (Free f a -> m a) -> f (Free f a) -> f (m a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> f (Free f a)
    f)

    -- | Lift an applicative homomorphism from @f@ to @g@ into a monad homomorphism from @'Free' f@ to @'Free' g@.
    hoistFree :: (Applicative f, Applicative g) => (forall a. f a -> g a) -> Free f b -> Free g b
    hoistFree :: (forall a. f a -> g a) -> Free f b -> Free g b
    hoistFree f :: forall a. f a -> g a
    f = (forall x. f x -> Free g x) -> Free f b -> Free g b
    forall (f :: * -> *) (m :: * -> *) a.
    (Applicative f, Applicative m, Monad m) =>
    (forall x. f x -> m x) -> Free f a -> m a
    foldFree (g x -> Free g x
    forall (f :: * -> *) (m :: * -> *) a.
    (Functor f, MonadFree f m) =>
    f a -> m a
    liftF (g x -> Free g x) -> (f x -> g x) -> f x -> Free g x
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f x -> g x
    forall a. f a -> g a
    f)

    -- | Given an applicative homomorphism, you get a monad homomorphism.
    foldFree :: (Applicative f, Applicative m, Monad m) => (forall x . f x -> m x) -> Free f a -> m a
    foldFree :: (forall x. f x -> m x) -> Free f a -> m a
    foldFree _ (Pure a :: a
    a)  = a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a
    foldFree f :: forall x. f x -> m x
    f (Free as :: f (Free f a)
    as) = f (Free f a) -> m (Free f a)
    forall x. f x -> m x
    f f (Free f a)
    as m (Free f a) -> (Free f a -> m a) -> m a
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (forall x. f x -> m x) -> Free f a -> m a
    forall (f :: * -> *) (m :: * -> *) a.
    (Applicative f, Applicative m, Monad m) =>
    (forall x. f x -> m x) -> Free f a -> m a
    foldFree forall x. f x -> m x
    f

    -- | Convert a 'Free' monad from "Control.Monad.Free.Ap" to a 'FreeT.FreeT' monad
    -- from "Control.Monad.Trans.Free.Ap".
    -- WARNING: This assumes that 'liftF' is an applicative homomorphism.
    toFreeT :: (Applicative f, Applicative m, Monad m) => Free f a -> FreeT.FreeT f m a
    toFreeT :: Free f a -> FreeT f m a
    toFreeT = (forall x. f x -> FreeT f m x) -> Free f a -> FreeT f m a
    forall (f :: * -> *) (m :: * -> *) a.
    (Applicative f, Applicative m, Monad m) =>
    (forall x. f x -> m x) -> Free f a -> m a
    foldFree forall x. f x -> FreeT f m x
    forall (f :: * -> *) (m :: * -> *) a.
    (Functor f, MonadFree f m) =>
    f a -> m a
    liftF

    -- | 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.
    cutoff :: (Applicative f) => Integer -> Free f a -> Free f (Maybe a)
    cutoff :: Integer -> Free f a -> Free f (Maybe a)
    cutoff n :: Integer
    n _ | Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 0 = Maybe a -> Free f (Maybe a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing
    cutoff n :: Integer
    n (Free f :: f (Free f a)
    f) = f (Free f (Maybe a)) -> Free f (Maybe a)
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free (f (Free f (Maybe a)) -> Free f (Maybe a))
    -> f (Free f (Maybe a)) -> Free f (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ (Free f a -> Free f (Maybe a))
    -> f (Free f a) -> f (Free f (Maybe a))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Integer -> Free f a -> Free f (Maybe a)
    forall (f :: * -> *) a.
    Applicative f =>
    Integer -> Free f a -> Free f (Maybe a)
    cutoff (Integer
    n Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - 1)) f (Free f a)
    f
    cutoff _ m :: Free f a
    m = a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> Free f a -> Free f (Maybe a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Free f a
    m

    -- | Unfold a free monad from a seed.
    unfold :: Applicative f => (b -> Either a (f b)) -> b -> Free f a
    unfold :: (b -> Either a (f b)) -> b -> Free f a
    unfold f :: b -> Either a (f b)
    f = b -> Either a (f b)
    f (b -> Either a (f b))
    -> (Either a (f b) -> Free f a) -> b -> Free f a
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> (a -> Free f a) -> (f b -> Free f a) -> Either a (f b) -> Free f a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either a -> Free f a
    forall (f :: * -> *) a. a -> Free f a
    Pure (f (Free f a) -> Free f a
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free (f (Free f a) -> Free f a)
    -> (f b -> f (Free f a)) -> f b -> Free f a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b -> Free f a) -> f b -> f (Free f a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((b -> Either a (f b)) -> b -> Free f a
    forall (f :: * -> *) b a.
    Applicative f =>
    (b -> Either a (f b)) -> b -> Free f a
    unfold b -> Either a (f b)
    f))

    -- | Unfold a free monad from a seed, monadically.
    unfoldM :: (Applicative f, Traversable f, Applicative m, Monad m) => (b -> m (Either a (f b))) -> b -> m (Free f a)
    unfoldM :: (b -> m (Either a (f b))) -> b -> m (Free f a)
    unfoldM f :: b -> m (Either a (f b))
    f = b -> m (Either a (f b))
    f (b -> m (Either a (f b)))
    -> (Either a (f b) -> m (Free f a)) -> b -> m (Free f a)
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> (a -> m (Free f a))
    -> (f b -> m (Free f a)) -> Either a (f b) -> m (Free f a)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Free f a -> m (Free f a)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Free f a -> m (Free f a)) -> (a -> Free f a) -> a -> m (Free f a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Free f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure) ((f (Free f a) -> Free f a) -> m (f (Free f a)) -> m (Free f a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap f (Free f a) -> Free f a
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free (m (f (Free f a)) -> m (Free f a))
    -> (f b -> m (f (Free f a))) -> f b -> m (Free f a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b -> m (Free f a)) -> f b -> m (f (Free f a))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse ((b -> m (Either a (f b))) -> b -> m (Free f a)
    forall (f :: * -> *) (m :: * -> *) b a.
    (Applicative f, Traversable f, Applicative m, Monad m) =>
    (b -> m (Either a (f b))) -> b -> m (Free f a)
    unfoldM b -> m (Either a (f b))
    f))

    -- | This is @Prism' (Free f a) a@ in disguise
    --
    -- >>> preview _Pure (Pure 3)
    -- Just 3
    --
    -- >>> review _Pure 3 :: Free Maybe Int
    -- Pure 3
    _Pure :: forall f m a p. (Choice p, Applicative m)
          => p a (m a) -> p (Free f a) (m (Free f a))
    _Pure :: p a (m a) -> p (Free f a) (m (Free f a))
    _Pure = (Free f a -> Either (Free f a) a)
    -> (Either (Free f a) (m a) -> m (Free f a))
    -> p (Either (Free f a) a) (Either (Free f a) (m a))
    -> p (Free f a) (m (Free f a))
    forall (p :: * -> * -> *) a b c d.
    Profunctor p =>
    (a -> b) -> (c -> d) -> p b c -> p a d
    dimap Free f a -> Either (Free f a) a
    forall (f :: * -> *) b. Free f b -> Either (Free f b) b
    impure ((Free f a -> m (Free f a))
    -> (m a -> m (Free f a)) -> Either (Free f a) (m a) -> m (Free f a)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Free f a -> m (Free f a)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((a -> Free f a) -> m a -> m (Free f a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> Free f a
    forall (f :: * -> *) a. a -> Free f a
    Pure)) (p (Either (Free f a) a) (Either (Free f a) (m a))
     -> p (Free f a) (m (Free f a)))
    -> (p a (m a) -> p (Either (Free f a) a) (Either (Free f a) (m a)))
    -> p a (m a)
    -> p (Free f a) (m (Free f a))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . p a (m a) -> p (Either (Free f a) a) (Either (Free f a) (m a))
    forall (p :: * -> * -> *) a b c.
    Choice p =>
    p a b -> p (Either c a) (Either c b)
    right'
     where
      impure :: Free f b -> Either (Free f b) b
    impure (Pure x :: b
    x) = b -> Either (Free f b) b
    forall a b. b -> Either a b
    Right b
    x
      impure x :: Free f b
    x        = Free f b -> Either (Free f b) b
    forall a b. a -> Either a b
    Left Free f b
    x
      {-# INLINE impure #-}
    {-# INLINE _Pure #-}

    -- | This is @Prism' (Free f a) (f (Free f a))@ in disguise
    --
    -- >>> preview _Free (review _Free (Just (Pure 3)))
    -- Just (Just (Pure 3))
    --
    -- >>> review _Free (Just (Pure 3))
    -- Free (Just (Pure 3))
    _Free :: forall f m a p. (Choice p, Applicative m)
          => p (f (Free f a)) (m (f (Free f a))) -> p (Free f a) (m (Free f a))
    _Free :: p (f (Free f a)) (m (f (Free f a))) -> p (Free f a) (m (Free f a))
    _Free = (Free f a -> Either (Free f a) (f (Free f a)))
    -> (Either (Free f a) (m (f (Free f a))) -> m (Free f a))
    -> p (Either (Free f a) (f (Free f a)))
         (Either (Free f a) (m (f (Free f a))))
    -> p (Free f a) (m (Free f a))
    forall (p :: * -> * -> *) a b c d.
    Profunctor p =>
    (a -> b) -> (c -> d) -> p b c -> p a d
    dimap Free f a -> Either (Free f a) (f (Free f a))
    forall (f :: * -> *) a.
    Free f a -> Either (Free f a) (f (Free f a))
    unfree ((Free f a -> m (Free f a))
    -> (m (f (Free f a)) -> m (Free f a))
    -> Either (Free f a) (m (f (Free f a)))
    -> m (Free f a)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Free f a -> m (Free f a)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((f (Free f a) -> Free f a) -> m (f (Free f a)) -> m (Free f a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap f (Free f a) -> Free f a
    forall (f :: * -> *) a. f (Free f a) -> Free f a
    Free)) (p (Either (Free f a) (f (Free f a)))
       (Either (Free f a) (m (f (Free f a))))
     -> p (Free f a) (m (Free f a)))
    -> (p (f (Free f a)) (m (f (Free f a)))
        -> p (Either (Free f a) (f (Free f a)))
             (Either (Free f a) (m (f (Free f a)))))
    -> p (f (Free f a)) (m (f (Free f a)))
    -> p (Free f a) (m (Free f a))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . p (f (Free f a)) (m (f (Free f a)))
    -> p (Either (Free f a) (f (Free f a)))
         (Either (Free f a) (m (f (Free f a))))
    forall (p :: * -> * -> *) a b c.
    Choice p =>
    p a b -> p (Either c a) (Either c b)
    right'
     where
      unfree :: Free f a -> Either (Free f a) (f (Free f a))
    unfree (Free x :: f (Free f a)
    x) = f (Free f a) -> Either (Free f a) (f (Free f a))
    forall a b. b -> Either a b
    Right f (Free f a)
    x
      unfree x :: Free f a
    x        = Free f a -> Either (Free f a) (f (Free f a))
    forall a b. a -> Either a b
    Left Free f a
    x
      {-# INLINE unfree #-}
    {-# INLINE _Free #-}

    #if __GLASGOW_HASKELL__ < 707
    instance Typeable1 f => Typeable1 (Free f) where
      typeOf1 t = mkTyConApp freeTyCon [typeOf1 (f t)] where
        f :: Free f a -> f a
        f = undefined

    freeTyCon :: TyCon
    #if __GLASGOW_HASKELL__ < 704
    freeTyCon = mkTyCon "Control.Monad.Free.Free"
    #else
    freeTyCon = mkTyCon3 "free" "Control.Monad.Free" "Free"
    #endif
    {-# NOINLINE freeTyCon #-}

    instance
      ( Typeable1 f, Typeable a
      , Data a, Data (f (Free f a))
      ) => Data (Free f a) where
        gfoldl f z (Pure a) = z Pure `f` a
        gfoldl f z (Free as) = z Free `f` as
        toConstr Pure{} = pureConstr
        toConstr Free{} = freeConstr
        gunfold k z c = case constrIndex c of
            1 -> k (z Pure)
            2 -> k (z Free)
            _ -> error "gunfold"
        dataTypeOf _ = freeDataType
        dataCast1 f = gcast1 f

    pureConstr, freeConstr :: Constr
    pureConstr = mkConstr freeDataType "Pure" [] Prefix
    freeConstr = mkConstr freeDataType "Free" [] Prefix
    {-# NOINLINE pureConstr #-}
    {-# NOINLINE freeConstr #-}

    freeDataType :: DataType
    freeDataType = mkDataType "Control.Monad.Free.FreeF" [pureConstr, freeConstr]
    {-# NOINLINE freeDataType #-}

    #endif