{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE UndecidableInstances #-}

-- SPDX-License-Identifier: MPL-2.0

{- |
Copyright   :  (c) 2023-2025 Sayo contributors
License     :  MPL-2.0 (see the file LICENSE)
Maintainer  :  ymdfield@outlook.jp
-}
module Control.Effect where

import Control.Alternative.Free qualified as Tree
import Control.Alternative.Free.Final qualified as Final
import Control.Applicative (Alternative, empty, (<|>))
import Control.Applicative.Free qualified as Tree
import Control.Applicative.Free.Fast qualified as Fast
import Control.Applicative.Free.Final qualified as Final
import Control.Monad (MonadPlus)
import Control.Monad.Cont qualified as Cont
import Control.Monad.Except (MonadError, catchError, throwError)
import Control.Monad.Fix (MonadFix, mfix)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.RWS (MonadRWS)
import Control.Monad.Reader (MonadReader (ask), local)
import Control.Monad.State (MonadState, get, put)
import Control.Monad.Writer (MonadWriter, listen, tell)
import Control.Monad.Writer qualified as Writer
import Data.Effect (
    Ask (Ask),
    AskLabel,
    CC (Jump, SubFork),
    Catch (Catch),
    ChooseH (ChooseH),
    Emb (Emb),
    Empty (Empty),
    Fail (Fail),
    Fix (Efix),
    Local (Local),
    State (Get, Put),
    StateLabel,
    Tell (Tell),
    TellLabel,
    Throw (Throw),
    ThrowLabel,
    UnliftBase (WithRunInBase),
    UnliftIO,
    WriterH (Listen),
 )
import Data.Effect.OpenUnion (
    At,
    FindByLabel,
    Has,
    IdentityResolver,
    In,
    KeyDiscriminator,
    KeyResolver,
    KnownIndex,
    KnownOrder,
    LabelResolver,
    Membership,
    Union,
    hfmapUnion,
    inject,
    membership,
    membershipAt,
    type (:>),
 )
import Data.Effect.Tag (Tagged (Tag), type (#))
import Data.Functor.Coyoneda (Coyoneda (Coyoneda), hoistCoyoneda, liftCoyoneda, lowerCoyoneda)
import Data.Kind (Type)
import Data.Tuple (swap)
import UnliftIO qualified as IO

newtype Eff ff es a = Eff {forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
Eff ff es a -> ff (Union es (Eff ff es)) a
unEff :: ff (Union es (Eff ff es)) a}

perform :: forall e es ff a c. (e :> es, Free c ff) => e (Eff ff es) a -> Eff ff es a
perform :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform = Membership e es -> e (Eff ff es) a -> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
Membership e es -> e (Eff ff es) a -> Eff ff es a
sendFor (Membership e es -> e (Eff ff es) a -> Eff ff es a)
-> Membership e es -> e (Eff ff es) a -> Eff ff es a
forall a b. (a -> b) -> a -> b
$ forall resolver dscr (e :: (* -> *) -> * -> *)
       (es :: [(* -> *) -> * -> *]).
FindBy resolver dscr (Discriminator resolver (HeadOf es)) e es =>
Membership e es
membership @LabelResolver
{-# INLINE perform #-}

perform' :: forall key e es ff a c. (Has key e es, Free c ff) => e (Eff ff es) a -> Eff ff es a
perform' :: forall {k} (key :: k) (e :: (* -> *) -> * -> *)
       (es :: [(* -> *) -> * -> *]) (ff :: (* -> *) -> * -> *) a
       (c :: (* -> *) -> Constraint).
(Has key e es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform' = Membership (Tagged key e) es
-> Tagged key e (Eff ff es) a -> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
Membership e es -> e (Eff ff es) a -> Eff ff es a
sendFor (forall resolver dscr (e :: (* -> *) -> * -> *)
       (es :: [(* -> *) -> * -> *]).
FindBy resolver dscr (Discriminator resolver (HeadOf es)) e es =>
Membership e es
membership @KeyResolver @(KeyDiscriminator key)) (Tagged key e (Eff ff es) a -> Eff ff es a)
-> (e (Eff ff es) a -> Tagged key e (Eff ff es) a)
-> e (Eff ff es) a
-> Eff ff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e (Eff ff es) a -> Tagged key e (Eff ff es) a
forall {k} (tag :: k) (e :: (* -> *) -> * -> *) (f :: * -> *) a.
e f a -> Tagged tag e f a
Tag
{-# INLINE perform' #-}

perform'' :: forall tag e es ff a c. (e # tag :> es, Free c ff) => e (Eff ff es) a -> Eff ff es a
perform'' :: forall {k} (tag :: k) (e :: (* -> *) -> * -> *)
       (es :: [(* -> *) -> * -> *]) (ff :: (* -> *) -> * -> *) a
       (c :: (* -> *) -> Constraint).
((e # tag) :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform'' = Tagged tag e (Eff ff es) a -> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform (Tagged tag e (Eff ff es) a -> Eff ff es a)
-> (e (Eff ff es) a -> Tagged tag e (Eff ff es) a)
-> e (Eff ff es) a
-> Eff ff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tag :: k) (e :: (* -> *) -> * -> *) (f :: * -> *) a.
e f a -> Tagged tag e f a
forall {k} (tag :: k) (e :: (* -> *) -> * -> *) (f :: * -> *) a.
e f a -> Tagged tag e f a
Tag @tag
{-# INLINE perform'' #-}

send :: forall e es ff a c. (e `In` es, Free c ff) => e (Eff ff es) a -> Eff ff es a
send :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(In e es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
send = Membership e es -> e (Eff ff es) a -> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
Membership e es -> e (Eff ff es) a -> Eff ff es a
sendFor (Membership e es -> e (Eff ff es) a -> Eff ff es a)
-> Membership e es -> e (Eff ff es) a -> Eff ff es a
forall a b. (a -> b) -> a -> b
$ forall resolver dscr (e :: (* -> *) -> * -> *)
       (es :: [(* -> *) -> * -> *]).
FindBy resolver dscr (Discriminator resolver (HeadOf es)) e es =>
Membership e es
membership @IdentityResolver
{-# INLINE send #-}

sendAt :: forall i es ff a c. (KnownIndex i es, Free c ff) => At i es (Eff ff es) a -> Eff ff es a
sendAt :: forall (i :: Nat) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(KnownIndex i es, Free c ff) =>
At i es (Eff ff es) a -> Eff ff es a
sendAt = Membership (At i es) es -> At i es (Eff ff es) a -> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
Membership e es -> e (Eff ff es) a -> Eff ff es a
sendFor (Membership (At i es) es -> At i es (Eff ff es) a -> Eff ff es a)
-> Membership (At i es) es -> At i es (Eff ff es) a -> Eff ff es a
forall a b. (a -> b) -> a -> b
$ forall (i :: Nat) (es :: [(* -> *) -> * -> *]).
KnownNat i =>
Membership (At i es) es
membershipAt @i
{-# INLINE sendAt #-}

sendFor
    :: forall e es ff a c
     . (KnownOrder e, Free c ff)
    => Membership e es
    -> e (Eff ff es) a
    -> Eff ff es a
sendFor :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
Membership e es -> e (Eff ff es) a -> Eff ff es a
sendFor Membership e es
i = ff (Union es (Eff ff es)) a -> Eff ff es a
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
ff (Union es (Eff ff es)) a -> Eff ff es a
Eff (ff (Union es (Eff ff es)) a -> Eff ff es a)
-> (e (Eff ff es) a -> ff (Union es (Eff ff es)) a)
-> e (Eff ff es) a
-> Eff ff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union es (Eff ff es) a -> ff (Union es (Eff ff es)) a
forall (f :: * -> *) a. f a -> ff f a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
       (f :: * -> *) a.
Free c ff =>
f a -> ff f a
liftFree (Union es (Eff ff es) a -> ff (Union es (Eff ff es)) a)
-> (e (Eff ff es) a -> Union es (Eff ff es) a)
-> e (Eff ff es) a
-> ff (Union es (Eff ff es)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Membership e es -> e (Eff ff es) a -> Union es (Eff ff es) a
forall (es :: [(* -> *) -> * -> *]) (f :: * -> *) a.
Membership e es -> e f a -> Union es f a
forall (e :: (* -> *) -> * -> *) (order :: EffectOrder)
       (es :: [(* -> *) -> * -> *]) (f :: * -> *) a.
Elem e order =>
Membership e es -> e f a -> Union es f a
inject Membership e es
i
{-# INLINE sendFor #-}

emb :: forall f es ff a c. (Emb f :> es, Free c ff) => f a -> Eff ff es a
emb :: forall (f :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(Emb f :> es, Free c ff) =>
f a -> Eff ff es a
emb = Emb f (Eff ff es) a -> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform (Emb f (Eff ff es) a -> Eff ff es a)
-> (f a -> Emb f (Eff ff es) a) -> f a -> Eff ff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Emb f (Eff ff es) a
forall (e :: * -> *) (f :: * -> *) a. e a -> Emb e f a
Emb
{-# INLINE emb #-}

-- | A natural transformation.
type f ~> g = forall (x :: Type). f x -> g x

infixr 2 ~>

type e ~~> f = e f ~> f

infix 2 ~~>

infixr 3 $
infixr 4 $$

-- | Type-level infix applcation for functors.
type (f :: Type -> Type) $ a = f a

-- | Type-level infix applcation for higher-order functors.
type (h :: (Type -> Type) -> Type -> Type) $$ f = h f

instance
    (FindByLabel AskLabel (Ask r) es, Local r :> es, Monad (Eff ff es), Free c ff)
    => MonadReader r (Eff ff es)
    where
    ask :: Eff ff es r
ask = Ask r (Eff ff es) r -> Eff ff es r
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform Ask r (Eff ff es) r
forall r (a :: * -> *). Ask r a r
Ask
    local :: forall a. (r -> r) -> Eff ff es a -> Eff ff es a
local r -> r
f Eff ff es a
a = Local r (Eff ff es) a -> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform (Local r (Eff ff es) a -> Eff ff es a)
-> Local r (Eff ff es) a -> Eff ff es a
forall a b. (a -> b) -> a -> b
$ (r -> r) -> Eff ff es a -> Local r (Eff ff es) a
forall r (a :: * -> *) b. (r -> r) -> a b -> Local r a b
Local r -> r
f Eff ff es a
a
    {-# INLINE ask #-}
    {-# INLINE local #-}

instance
    (FindByLabel TellLabel (Tell w) es, WriterH w :> es, Monoid w, Monad (Eff ff es), Free c ff)
    => MonadWriter w (Eff ff es)
    where
    tell :: w -> Eff ff es ()
tell = Tell w (Eff ff es) () -> Eff ff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform (Tell w (Eff ff es) () -> Eff ff es ())
-> (w -> Tell w (Eff ff es) ()) -> w -> Eff ff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> Tell w (Eff ff es) ()
forall w (a :: * -> *). w -> Tell w a ()
Tell
    listen :: forall a. Eff ff es a -> Eff ff es (a, w)
listen Eff ff es a
a = ((w, a) -> (a, w)) -> Eff ff es (w, a) -> Eff ff es (a, w)
forall a b. (a -> b) -> Eff ff es a -> Eff ff es b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (w, a) -> (a, w)
forall a b. (a, b) -> (b, a)
swap (Eff ff es (w, a) -> Eff ff es (a, w))
-> Eff ff es (w, a) -> Eff ff es (a, w)
forall a b. (a -> b) -> a -> b
$ WriterH w (Eff ff es) (w, a) -> Eff ff es (w, a)
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform (WriterH w (Eff ff es) (w, a) -> Eff ff es (w, a))
-> WriterH w (Eff ff es) (w, a) -> Eff ff es (w, a)
forall a b. (a -> b) -> a -> b
$ Eff ff es a -> WriterH w (Eff ff es) (w, a)
forall (a :: * -> *) a1 w. a a1 -> WriterH w a (w, a1)
Listen Eff ff es a
a
    pass :: forall a. Eff ff es (a, w -> w) -> Eff ff es a
pass = Eff ff es (w -> w, a) -> Eff ff es a
forall w a (es :: [(* -> *) -> * -> *]) (ff :: (* -> *) -> * -> *)
       (c :: (* -> *) -> Constraint).
(Tell w :> es, WriterH w :> es, Monad (Eff ff es), Free c ff) =>
Eff ff es (w -> w, a) -> Eff ff es a
pass (Eff ff es (w -> w, a) -> Eff ff es a)
-> (Eff ff es (a, w -> w) -> Eff ff es (w -> w, a))
-> Eff ff es (a, w -> w)
-> Eff ff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, w -> w) -> (w -> w, a))
-> Eff ff es (a, w -> w) -> Eff ff es (w -> w, a)
forall a b. (a -> b) -> Eff ff es a -> Eff ff es b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, w -> w) -> (w -> w, a)
forall a b. (a, b) -> (b, a)
swap
    {-# INLINE tell #-}
    {-# INLINE listen #-}

{- |
For a given scope, uses the function (the first component of the pair returned
by that scope) to modify the accumulated value of that scope, and then
accumulates the result into the current outer scope.

@
pass m = do
    (w, (f, a)) <- listen m
    tell $ f w
    pure a
@
-}
pass
    :: forall w a es ff c
     . (Tell w :> es, WriterH w :> es, Monad (Eff ff es), Free c ff)
    => Eff ff es (w -> w, a)
    -> Eff ff es a
pass :: forall w a (es :: [(* -> *) -> * -> *]) (ff :: (* -> *) -> * -> *)
       (c :: (* -> *) -> Constraint).
(Tell w :> es, WriterH w :> es, Monad (Eff ff es), Free c ff) =>
Eff ff es (w -> w, a) -> Eff ff es a
pass Eff ff es (w -> w, a)
m = do
    (w
w, (w -> w
f, a
a)) <- WriterH w (Eff ff es) (w, (w -> w, a))
-> Eff ff es (w, (w -> w, a))
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform (WriterH w (Eff ff es) (w, (w -> w, a))
 -> Eff ff es (w, (w -> w, a)))
-> WriterH w (Eff ff es) (w, (w -> w, a))
-> Eff ff es (w, (w -> w, a))
forall a b. (a -> b) -> a -> b
$ Eff ff es (w -> w, a) -> WriterH w (Eff ff es) (w, (w -> w, a))
forall (a :: * -> *) a1 w. a a1 -> WriterH w a (w, a1)
Listen Eff ff es (w -> w, a)
m
    Tell w (Eff ff es) () -> Eff ff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform (Tell w (Eff ff es) () -> Eff ff es ())
-> Tell w (Eff ff es) () -> Eff ff es ()
forall a b. (a -> b) -> a -> b
$ w -> Tell w (Eff ff es) ()
forall w (a :: * -> *). w -> Tell w a ()
Tell (w -> Tell w (Eff ff es) ()) -> w -> Tell w (Eff ff es) ()
forall a b. (a -> b) -> a -> b
$ w -> w
f w
w
    a -> Eff ff es a
forall a. a -> Eff ff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
{-# INLINE pass #-}

instance (FindByLabel StateLabel (State s) es, Monad (Eff ff es), Free c ff) => MonadState s (Eff ff es) where
    get :: Eff ff es s
get = State s (Eff ff es) s -> Eff ff es s
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform State s (Eff ff es) s
forall s (a :: * -> *). State s a s
Get
    put :: s -> Eff ff es ()
put = State s (Eff ff es) () -> Eff ff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform (State s (Eff ff es) () -> Eff ff es ())
-> (s -> State s (Eff ff es) ()) -> s -> Eff ff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> State s (Eff ff es) ()
forall s (a :: * -> *). s -> State s a ()
Put
    {-# INLINE get #-}
    {-# INLINE put #-}

instance
    ( FindByLabel AskLabel (Ask r) es
    , Local r :> es
    , FindByLabel TellLabel (Tell w) es
    , WriterH w :> es
    , FindByLabel StateLabel (State s) es
    , Monoid w
    , Monad (Eff ff es)
    , Free c ff
    )
    => MonadRWS r w s (Eff ff es)

instance
    (FindByLabel ThrowLabel (Throw e) es, Catch e :> es, Monad (Eff ff es), Free c ff)
    => MonadError e (Eff ff es)
    where
    throwError :: forall a. e -> Eff ff es a
throwError = Throw e (Eff ff es) a -> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform (Throw e (Eff ff es) a -> Eff ff es a)
-> (e -> Throw e (Eff ff es) a) -> e -> Eff ff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Throw e (Eff ff es) a
forall e (a :: * -> *) b. e -> Throw e a b
Throw
    catchError :: forall a. Eff ff es a -> (e -> Eff ff es a) -> Eff ff es a
catchError Eff ff es a
a e -> Eff ff es a
hdl = Catch e (Eff ff es) a -> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform (Catch e (Eff ff es) a -> Eff ff es a)
-> Catch e (Eff ff es) a -> Eff ff es a
forall a b. (a -> b) -> a -> b
$ Eff ff es a -> (e -> Eff ff es a) -> Catch e (Eff ff es) a
forall (a :: * -> *) b e. a b -> (e -> a b) -> Catch e a b
Catch Eff ff es a
a e -> Eff ff es a
hdl
    {-# INLINE throwError #-}
    {-# INLINE catchError #-}

instance
    (Empty :> es, ChooseH :> es, Applicative (Eff ff es), Free c ff)
    => Alternative (Eff ff es)
    where
    empty :: forall a. Eff ff es a
empty = Empty (Eff ff es) a -> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform Empty (Eff ff es) a
forall (a :: * -> *) b. Empty a b
Empty
    Eff ff es a
a <|> :: forall a. Eff ff es a -> Eff ff es a -> Eff ff es a
<|> Eff ff es a
b = ChooseH (Eff ff es) a -> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform (ChooseH (Eff ff es) a -> Eff ff es a)
-> ChooseH (Eff ff es) a -> Eff ff es a
forall a b. (a -> b) -> a -> b
$ Eff ff es a -> Eff ff es a -> ChooseH (Eff ff es) a
forall (a :: * -> *) b. a b -> a b -> ChooseH a b
ChooseH Eff ff es a
a Eff ff es a
b
    {-# INLINE empty #-}
    {-# INLINE (<|>) #-}

instance (Empty :> es, ChooseH :> es, Monad (Eff ff es), Free c ff) => MonadPlus (Eff ff es)

instance (CC ref :> es, Monad (Eff ff es), Free c ff) => Cont.MonadCont (Eff ff es) where
    callCC :: forall a b. ((a -> Eff ff es b) -> Eff ff es a) -> Eff ff es a
callCC = ((a -> Eff ff es b) -> Eff ff es a) -> Eff ff es a
forall (ref :: * -> *) a b (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(CC ref :> es, Monad (Eff ff es), Free c ff) =>
((a -> Eff ff es b) -> Eff ff es a) -> Eff ff es a
callCC_
    {-# INLINE callCC #-}

sub
    :: forall ref a b es ff c
     . (CC ref :> es, Monad (Eff ff es), Free c ff)
    => (ref a -> Eff ff es b)
    -> (a -> Eff ff es b)
    -> Eff ff es b
sub :: forall (ref :: * -> *) a b (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(CC ref :> es, Monad (Eff ff es), Free c ff) =>
(ref a -> Eff ff es b) -> (a -> Eff ff es b) -> Eff ff es b
sub ref a -> Eff ff es b
p a -> Eff ff es b
q = CC ref (Eff ff es) (Either (ref a) a)
-> Eff ff es (Either (ref a) a)
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform CC ref (Eff ff es) (Either (ref a) a)
forall (ref :: * -> *) (a :: * -> *) a1.
CC ref a (Either (ref a1) a1)
SubFork Eff ff es (Either (ref a) a)
-> (Either (ref a) a -> Eff ff es b) -> Eff ff es b
forall a b. Eff ff es a -> (a -> Eff ff es b) -> Eff ff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ref a -> Eff ff es b)
-> (a -> Eff ff es b) -> Either (ref a) a -> Eff ff es b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ref a -> Eff ff es b
p a -> Eff ff es b
q
{-# INLINE sub #-}

callCC_
    :: forall ref a b es ff c
     . (CC ref :> es, Monad (Eff ff es), Free c ff)
    => ((a -> Eff ff es b) -> Eff ff es a)
    -> Eff ff es a
callCC_ :: forall (ref :: * -> *) a b (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(CC ref :> es, Monad (Eff ff es), Free c ff) =>
((a -> Eff ff es b) -> Eff ff es a) -> Eff ff es a
callCC_ (a -> Eff ff es b) -> Eff ff es a
f = (ref a -> Eff ff es a) -> (a -> Eff ff es a) -> Eff ff es a
forall (ref :: * -> *) a b (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) (c :: (* -> *) -> Constraint).
(CC ref :> es, Monad (Eff ff es), Free c ff) =>
(ref a -> Eff ff es b) -> (a -> Eff ff es b) -> Eff ff es b
sub ((a -> Eff ff es b) -> Eff ff es a
f ((a -> Eff ff es b) -> Eff ff es a)
-> (ref a -> a -> Eff ff es b) -> ref a -> Eff ff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ref a -> a -> Eff ff es b
forall {es :: [(* -> *) -> * -> *]} {ref :: * -> *}
       {c :: (* -> *) -> Constraint} {ff :: (* -> *) -> * -> *} {a1} {a}.
(FindBy LabelResolver CCLabel (LabelOf (HeadOf es)) (CC ref) es,
 Free c ff) =>
ref a1 -> a1 -> Eff ff es a
jump) a -> Eff ff es a
forall a. a -> Eff ff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  where
    jump :: ref a1 -> a1 -> Eff ff es a
jump ref a1
ref a1
x = CC ref (Eff ff es) a -> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform (CC ref (Eff ff es) a -> Eff ff es a)
-> CC ref (Eff ff es) a -> Eff ff es a
forall a b. (a -> b) -> a -> b
$ ref a1 -> a1 -> CC ref (Eff ff es) a
forall (ref :: * -> *) a1 (a :: * -> *) b.
ref a1 -> a1 -> CC ref a b
Jump ref a1
ref a1
x
{-# INLINE callCC_ #-}

instance (Emb IO :> es, Monad (Eff ff es), Free c ff) => MonadIO (Eff ff es) where
    liftIO :: forall a. IO a -> Eff ff es a
liftIO = IO a -> Eff ff es a
forall (f :: * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(Emb f :> es, Free c ff) =>
f a -> Eff ff es a
emb
    {-# INLINE liftIO #-}

instance (Fail :> es, Monad (Eff ff es), Free c ff) => MonadFail (Eff ff es) where
    fail :: forall a. String -> Eff ff es a
fail = Fail (Eff ff es) a -> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform (Fail (Eff ff es) a -> Eff ff es a)
-> (String -> Fail (Eff ff es) a) -> String -> Eff ff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Fail (Eff ff es) a
forall (a :: * -> *) b. String -> Fail a b
Fail
    {-# INLINE fail #-}

instance (Fix :> es, Monad (Eff ff es), Free c ff) => MonadFix (Eff ff es) where
    mfix :: forall a. (a -> Eff ff es a) -> Eff ff es a
mfix = Fix (Eff ff es) a -> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform (Fix (Eff ff es) a -> Eff ff es a)
-> ((a -> Eff ff es a) -> Fix (Eff ff es) a)
-> (a -> Eff ff es a)
-> Eff ff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Eff ff es a) -> Fix (Eff ff es) a
forall b (a :: * -> *). (b -> a b) -> Fix a b
Efix
    {-# INLINE mfix #-}

instance
    (UnliftIO :> es, Emb IO :> es, Monad (Eff ff es), Free c ff)
    => IO.MonadUnliftIO (Eff ff es)
    where
    withRunInIO :: forall b. ((forall a. Eff ff es a -> IO a) -> IO b) -> Eff ff es b
withRunInIO (forall a. Eff ff es a -> IO a) -> IO b
f = UnliftBase IO (Eff ff es) b -> Eff ff es b
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
e (Eff ff es) a -> Eff ff es a
perform (UnliftBase IO (Eff ff es) b -> Eff ff es b)
-> UnliftBase IO (Eff ff es) b -> Eff ff es b
forall a b. (a -> b) -> a -> b
$ ((forall a. Eff ff es a -> IO a) -> IO b)
-> UnliftBase IO (Eff ff es) b
forall (f :: * -> *) (b :: * -> *) a.
((forall x. f x -> b x) -> b a) -> UnliftBase b f a
WithRunInBase (forall a. Eff ff es a -> IO a) -> IO b
f
    {-# INLINE withRunInIO #-}

-- Free

class (forall f. c (ff f)) => Free c (ff :: (Type -> Type) -> Type -> Type) | ff -> c where
    {-# MINIMAL liftFree, (runFree | (retract, hoist)) #-}

    liftFree :: f a -> ff f a
    runFree :: (c g) => (forall x. f x -> g x) -> ff f a -> g a
    retract :: (c f) => ff f a -> f a
    hoist :: (forall x. f x -> g x) -> ff f a -> ff g a

    runFree forall x. f x -> g x
f = ff g a -> g a
forall (f :: * -> *) a. c f => ff f a -> f a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
       (f :: * -> *) a.
(Free c ff, c f) =>
ff f a -> f a
retract (ff g a -> g a) -> (ff f a -> ff g a) -> ff f a -> g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. f x -> g x) -> ff f a -> ff g a
forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> ff f a -> ff g a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
       (f :: * -> *) (g :: * -> *) a.
Free c ff =>
(forall x. f x -> g x) -> ff f a -> ff g a
hoist f x -> g x
forall x. f x -> g x
f
    retract = (forall x. f x -> f x) -> ff f a -> f a
forall (g :: * -> *) (f :: * -> *) a.
c g =>
(forall x. f x -> g x) -> ff f a -> g a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
       (g :: * -> *) (f :: * -> *) a.
(Free c ff, c g) =>
(forall x. f x -> g x) -> ff f a -> g a
runFree f x -> f x
forall a. a -> a
forall x. f x -> f x
id

    default hoist :: (c (ff g)) => (forall x. f x -> g x) -> ff f a -> ff g a
    hoist forall x. f x -> g x
phi = (forall x. f x -> ff g x) -> ff f a -> ff g a
forall (g :: * -> *) (f :: * -> *) a.
c g =>
(forall x. f x -> g x) -> ff f a -> g a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
       (g :: * -> *) (f :: * -> *) a.
(Free c ff, c g) =>
(forall x. f x -> g x) -> ff f a -> g a
runFree ((forall x. f x -> ff g x) -> ff f a -> ff g a)
-> (forall x. f x -> ff g x) -> ff f a -> ff g a
forall a b. (a -> b) -> a -> b
$ g x -> ff g x
forall (f :: * -> *) a. f a -> ff f a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
       (f :: * -> *) a.
Free c ff =>
f a -> ff f a
liftFree (g x -> ff g x) -> (f x -> g x) -> f x -> ff g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> g x
forall x. f x -> g x
phi

    {-# INLINE runFree #-}
    {-# INLINE retract #-}
    {-# INLINE hoist #-}

convertEff
    :: forall ff gg es a c c'
     . (Free c ff, Free c' gg, forall r. c (gg r))
    => Eff ff es a
    -> Eff gg es a
convertEff :: forall (ff :: (* -> *) -> * -> *) (gg :: (* -> *) -> * -> *)
       (es :: [(* -> *) -> * -> *]) a (c :: (* -> *) -> Constraint)
       (c' :: (* -> *) -> Constraint).
(Free c ff, Free c' gg, forall (r :: * -> *). c (gg r)) =>
Eff ff es a -> Eff gg es a
convertEff = Eff ff es a -> Eff gg es a
Eff ff es ~> Eff gg es
go
  where
    go :: Eff ff es ~> Eff gg es
    go :: Eff ff es ~> Eff gg es
go = gg (Union es (Eff gg es)) x -> Eff gg es x
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
ff (Union es (Eff ff es)) a -> Eff ff es a
Eff (gg (Union es (Eff gg es)) x -> Eff gg es x)
-> (Eff ff es x -> gg (Union es (Eff gg es)) x)
-> Eff ff es x
-> Eff gg es x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Union es (Eff ff es) x -> Union es (Eff gg es) x)
-> gg (Union es (Eff ff es)) x -> gg (Union es (Eff gg es)) x
forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> gg f a -> gg g a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
       (f :: * -> *) (g :: * -> *) a.
Free c ff =>
(forall x. f x -> g x) -> ff f a -> ff g a
hoist ((Eff ff es ~> Eff gg es)
-> Union es (Eff ff es) x -> Union es (Eff gg es) x
forall (f :: * -> *) (g :: * -> *) (es :: [(* -> *) -> * -> *]) a.
(forall x. f x -> g x) -> Union es f a -> Union es g a
hfmapUnion Eff ff es x -> Eff gg es x
Eff ff es ~> Eff gg es
go) (gg (Union es (Eff ff es)) x -> gg (Union es (Eff gg es)) x)
-> (Eff ff es x -> gg (Union es (Eff ff es)) x)
-> Eff ff es x
-> gg (Union es (Eff gg es)) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ff (Union es (Eff ff es)) x -> gg (Union es (Eff ff es)) x
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
       (c' :: (* -> *) -> Constraint) (gg :: (* -> *) -> * -> *)
       (r :: * -> *) a.
(Free c ff, Free c' gg, c (gg r)) =>
ff r a -> gg r a
convertFree (ff (Union es (Eff ff es)) x -> gg (Union es (Eff ff es)) x)
-> (Eff ff es x -> ff (Union es (Eff ff es)) x)
-> Eff ff es x
-> gg (Union es (Eff ff es)) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff ff es x -> ff (Union es (Eff ff es)) x
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
Eff ff es a -> ff (Union es (Eff ff es)) a
unEff
{-# INLINE convertEff #-}

convertFree :: (Free c ff, Free c' gg, c (gg r)) => ff r a -> gg r a
convertFree :: forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
       (c' :: (* -> *) -> Constraint) (gg :: (* -> *) -> * -> *)
       (r :: * -> *) a.
(Free c ff, Free c' gg, c (gg r)) =>
ff r a -> gg r a
convertFree = (forall x. r x -> gg r x) -> ff r a -> gg r a
forall (g :: * -> *) (f :: * -> *) a.
c g =>
(forall x. f x -> g x) -> ff f a -> g a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
       (g :: * -> *) (f :: * -> *) a.
(Free c ff, c g) =>
(forall x. f x -> g x) -> ff f a -> g a
runFree r x -> gg r x
forall x. r x -> gg r x
forall (f :: * -> *) a. f a -> gg f a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
       (f :: * -> *) a.
Free c ff =>
f a -> ff f a
liftFree
{-# INLINE convertFree #-}

deriving instance (forall f. Functor (ff f)) => Functor (Eff ff es)
deriving instance (forall r. Applicative (ff r)) => Applicative (Eff ff es)
deriving instance (forall r. Monad (ff r)) => Monad (Eff ff es)

instance Free Functor Coyoneda where
    liftFree :: forall (f :: * -> *) a. f a -> Coyoneda f a
liftFree = f a -> Coyoneda f a
forall (f :: * -> *) a. f a -> Coyoneda f a
liftCoyoneda
    runFree :: forall (g :: * -> *) (f :: * -> *) a.
Functor g =>
(forall x. f x -> g x) -> Coyoneda f a -> g a
runFree forall x. f x -> g x
f (Coyoneda b -> a
g f b
x) = b -> a
g (b -> a) -> g b -> g a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b -> g b
forall x. f x -> g x
f f b
x
    retract :: forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
retract = Coyoneda f a -> f a
forall (f :: * -> *) a. Functor f => Coyoneda f a -> f a
lowerCoyoneda
    hoist :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Coyoneda f a -> Coyoneda g a
hoist = (forall a. f a -> g a) -> Coyoneda f a -> Coyoneda g a
forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Coyoneda f a -> Coyoneda g a
hoistCoyoneda

    {-# INLINE liftFree #-}
    {-# INLINE runFree #-}
    {-# INLINE retract #-}
    {-# INLINE hoist #-}

instance Free Applicative Tree.Ap where
    liftFree :: forall (f :: * -> *) a. f a -> Ap f a
liftFree = f a -> Ap f a
forall (f :: * -> *) a. f a -> Ap f a
Tree.liftAp
    runFree :: forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
runFree = (forall x. f x -> g x) -> Ap f a -> g a
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
Tree.runAp
    retract :: forall (f :: * -> *) a. Applicative f => Ap f a -> f a
retract = Ap f a -> f a
forall (f :: * -> *) a. Applicative f => Ap f a -> f a
Tree.retractAp
    hoist :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Ap f a -> Ap g a
hoist = (forall a. f a -> g a) -> Ap f a -> Ap g a
forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Ap f a -> Ap g a
Tree.hoistAp

    {-# INLINE liftFree #-}
    {-# INLINE runFree #-}
    {-# INLINE retract #-}
    {-# INLINE hoist #-}

instance Free Applicative Fast.Ap where
    liftFree :: forall (f :: * -> *) a. f a -> Ap f a
liftFree = f a -> Ap f a
forall (f :: * -> *) a. f a -> Ap f a
Fast.liftAp
    runFree :: forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
runFree = (forall x. f x -> g x) -> Ap f a -> g a
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
Fast.runAp
    retract :: forall (f :: * -> *) a. Applicative f => Ap f a -> f a
retract = Ap f a -> f a
forall (f :: * -> *) a. Applicative f => Ap f a -> f a
Fast.retractAp
    hoist :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Ap f a -> Ap g a
hoist = (forall x. f x -> g x) -> Ap f a -> Ap g a
forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Ap f a -> Ap g a
Fast.hoistAp

    {-# INLINE liftFree #-}
    {-# INLINE runFree #-}
    {-# INLINE retract #-}
    {-# INLINE hoist #-}

instance Free Applicative Final.Ap where
    liftFree :: forall (f :: * -> *) a. f a -> Ap f a
liftFree = f a -> Ap f a
forall (f :: * -> *) a. f a -> Ap f a
Final.liftAp
    runFree :: forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
runFree = (forall x. f x -> g x) -> Ap f a -> g a
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
Final.runAp
    retract :: forall (f :: * -> *) a. Applicative f => Ap f a -> f a
retract = Ap f a -> f a
forall (f :: * -> *) a. Applicative f => Ap f a -> f a
Final.retractAp
    hoist :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Ap f a -> Ap g a
hoist = (forall a. f a -> g a) -> Ap f a -> Ap g a
forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Ap f a -> Ap g a
Final.hoistAp

    {-# INLINE liftFree #-}
    {-# INLINE runFree #-}
    {-# INLINE retract #-}
    {-# INLINE hoist #-}

instance Free Alternative Tree.Alt where
    liftFree :: forall (f :: * -> *) a. f a -> Alt f a
liftFree = f a -> Alt f a
forall (f :: * -> *) a. f a -> Alt f a
Tree.liftAlt
    runFree :: forall (g :: * -> *) (f :: * -> *) a.
Alternative g =>
(forall x. f x -> g x) -> Alt f a -> g a
runFree = (forall x. f x -> g x) -> Alt f a -> g a
forall (f :: * -> *) (g :: * -> *) a.
Alternative g =>
(forall x. f x -> g x) -> Alt f a -> g a
Tree.runAlt
    hoist :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Alt f a -> Alt g a
hoist = (forall a. f a -> g a) -> Alt f a -> Alt g a
forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Alt f a -> Alt g a
Tree.hoistAlt

    {-# INLINE liftFree #-}
    {-# INLINE runFree #-}
    {-# INLINE hoist #-}

instance Free Alternative Final.Alt where
    liftFree :: forall (f :: * -> *) a. f a -> Alt f a
liftFree = f a -> Alt f a
forall (f :: * -> *) a. f a -> Alt f a
Final.liftAlt
    runFree :: forall (g :: * -> *) (f :: * -> *) a.
Alternative g =>
(forall x. f x -> g x) -> Alt f a -> g a
runFree = (forall x. f x -> g x) -> Alt f a -> g a
forall (f :: * -> *) (g :: * -> *) a.
Alternative g =>
(forall x. f x -> g x) -> Alt f a -> g a
Final.runAlt
    hoist :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Alt f a -> Alt g a
hoist = (forall a. f a -> g a) -> Alt f a -> Alt g a
forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> Alt f a -> Alt g a
Final.hoistAlt

    {-# INLINE liftFree #-}
    {-# INLINE runFree #-}
    {-# INLINE hoist #-}