module Polysemy.Final.More where

import Polysemy
import Polysemy.Internal
import Polysemy.Internal.Union
import Polysemy.Final

------------------------------------------------------------------------------
-- | Run a @'Final' ('Sem' r)@ effect if the remaining effect stack is @r@.
--
-- This is sometimes useful for interpreters that make use of
-- 'reinterpret', 'raiseUnder', or any of their friends.
runFinalSem :: Sem (Final (Sem r) ': r) a -> Sem r a
runFinalSem :: Sem (Final (Sem r) : r) a -> Sem r a
runFinalSem = (forall x.
 Union (Final (Sem r) : r) (Sem (Final (Sem r) : r)) x -> Sem r x)
-> Sem (Final (Sem r) : r) a -> Sem r a
forall (m :: * -> *) (r :: EffectRow) a.
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a
usingSem ((forall x.
  Union (Final (Sem r) : r) (Sem (Final (Sem r) : r)) x -> Sem r x)
 -> Sem (Final (Sem r) : r) a -> Sem r a)
-> (forall x.
    Union (Final (Sem r) : r) (Sem (Final (Sem r) : r)) x -> Sem r x)
-> Sem (Final (Sem r) : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \Union (Final (Sem r) : r) (Sem (Final (Sem r) : r)) x
u -> case Union (Final (Sem r) : r) (Sem (Final (Sem r) : r)) x
-> Either
     (Union r (Sem (Final (Sem r) : r)) x)
     (Weaving (Final (Sem r)) (Sem (Final (Sem r) : r)) x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp Union (Final (Sem r) : r) (Sem (Final (Sem r) : r)) x
u of
  Right (Weaving (WithWeavingToFinal wav) f ()
s forall x. f (Sem rInitial x) -> Sem (Final (Sem r) : r) (f x)
wv f a -> x
ex forall x. f x -> Maybe x
ins) ->
    f a -> x
ex (f a -> x) -> Sem r (f a) -> Sem r x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f ()
-> (forall x. f (Sem rInitial x) -> Sem r (f x))
-> (forall x. f x -> Maybe x)
-> Sem r (f a)
ThroughWeavingToFinal (Sem r) (Sem rInitial) a
wav f ()
s (Sem (Final (Sem r) : r) (f x) -> Sem r (f x)
forall (r :: EffectRow) a. Sem (Final (Sem r) : r) a -> Sem r a
runFinalSem (Sem (Final (Sem r) : r) (f x) -> Sem r (f x))
-> (f (Sem rInitial x) -> Sem (Final (Sem r) : r) (f x))
-> f (Sem rInitial x)
-> Sem r (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Sem rInitial x) -> Sem (Final (Sem r) : r) (f x)
forall x. f (Sem rInitial x) -> Sem (Final (Sem r) : r) (f x)
wv) forall x. f x -> Maybe x
ins
  Left Union r (Sem (Final (Sem r) : r)) x
g -> Union r (Sem r) x -> Sem r x
forall (r :: EffectRow) a. Union r (Sem r) a -> Sem r a
liftSem ((forall x. Sem (Final (Sem r) : r) x -> Sem r x)
-> Union r (Sem (Final (Sem r) : r)) x -> Union r (Sem r) x
forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist forall (r :: EffectRow) a. Sem (Final (Sem r) : r) a -> Sem r a
forall x. Sem (Final (Sem r) : r) x -> Sem r x
runFinalSem Union r (Sem (Final (Sem r) : r)) x
g)
{-# INLINE runFinalSem #-}

------------------------------------------------------------------------------
-- | Run a @'Final' m@ effect by providing an explicit lowering function.
--
-- /Beware/: The lowering function may be invoked multiple times, so
-- __don't do any initialization work inside the lowering function__:
-- it will be duplicated.
lowerFinal :: Member (Embed m) r
           => (forall x. Sem r x -> m x)
           -> Sem (Final m ': r) a
           -> Sem r a
-- TODO(KingoftheHomeless): Write everything out for efficiency?
lowerFinal :: (forall x. Sem r x -> m x) -> Sem (Final m : r) a -> Sem r a
lowerFinal forall x. Sem r x -> m x
f = Sem (Final (Sem r) : r) a -> Sem r a
forall (r :: EffectRow) a. Sem (Final (Sem r) : r) a -> Sem r a
runFinalSem (Sem (Final (Sem r) : r) a -> Sem r a)
-> (Sem (Final m : r) a -> Sem (Final (Sem r) : r) a)
-> Sem (Final m : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. m x -> Sem r x)
-> (forall x. Sem r x -> m x)
-> Sem (Final m : Final (Sem r) : r) a
-> Sem (Final (Sem r) : r) a
forall (m1 :: * -> *) (m2 :: * -> *) (r :: EffectRow) a.
Member (Final m2) r =>
(forall x. m1 x -> m2 x)
-> (forall x. m2 x -> m1 x) -> Sem (Final m1 : r) a -> Sem r a
finalToFinal forall x. m x -> Sem r x
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed forall x. Sem r x -> m x
f (Sem (Final m : Final (Sem r) : r) a -> Sem (Final (Sem r) : r) a)
-> (Sem (Final m : r) a -> Sem (Final m : Final (Sem r) : r) a)
-> Sem (Final m : r) a
-> Sem (Final (Sem r) : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Final m : r) a -> Sem (Final m : Final (Sem r) : r) a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder
{-# INLINE lowerFinal #-}