{-# LANGUAGE AllowAmbiguousTypes   #-}

{-# OPTIONS_HADDOCK not-home #-}

-- | Description: The basic interpreter-building combinators
module Polysemy.Internal.Combinators
  ( -- * First order
    interpret
  , intercept
  , reinterpret
  , reinterpret2
  , reinterpret3
  , rewrite
  , transform

    -- * Higher order
  , interpretH
  , interceptH
  , reinterpretH
  , reinterpret2H
  , reinterpret3H
  , interpretWeaving

  -- * Conditional
  , interceptUsing
  , interceptUsingH

    -- * Statefulness
  , stateful
  , lazilyStateful
  ) where

import           Control.Arrow ((>>>))
import           Control.Monad
import qualified Control.Monad.Trans.State.Lazy as LS
import qualified Control.Monad.Trans.State.Strict as S
import qualified Data.Tuple as S (swap)
import           Polysemy.Internal
import           Polysemy.Internal.CustomErrors
import           Polysemy.Internal.Tactics
import           Polysemy.Internal.Union


------------------------------------------------------------------------------
-- | A lazier version of 'Data.Tuple.swap'.
swap :: (a, b) -> (b, a)
swap :: forall a b. (a, b) -> (b, a)
swap ~(a
a, b
b) = (b
b, a
a)


firstOrder
    :: ((forall rInitial x. e (Sem rInitial) x ->
         Tactical e (Sem rInitial) r x) -> t)
    -> (forall rInitial x. e (Sem rInitial) x -> Sem r x)
    -> t
firstOrder :: forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) t.
((forall (rInitial :: [(* -> *) -> * -> *]) x.
  e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
 -> t)
-> (forall (rInitial :: [(* -> *) -> * -> *]) x.
    e (Sem rInitial) x -> Sem r x)
-> t
firstOrder (forall (rInitial :: [(* -> *) -> * -> *]) x.
 e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> t
higher forall (rInitial :: [(* -> *) -> * -> *]) x.
e (Sem rInitial) x -> Sem r x
f = (forall (rInitial :: [(* -> *) -> * -> *]) x.
 e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> t
higher forall a b. (a -> b) -> a -> b
$ \(e (Sem rInitial) x
e :: e (Sem rInitial) x) ->
  forall (m :: * -> *) (f :: * -> *) (r :: [(* -> *) -> * -> *])
       (e :: (* -> *) -> * -> *) a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT forall a b. (a -> b) -> a -> b
$ forall (rInitial :: [(* -> *) -> * -> *]) x.
e (Sem rInitial) x -> Sem r x
f e (Sem rInitial) x
e
{-# INLINE firstOrder #-}


------------------------------------------------------------------------------
-- | The simplest way to produce an effect handler. Interprets an effect @e@ by
-- transforming it into other effects inside of @r@.
interpret
    :: FirstOrder e "interpret"
    => (∀ rInitial x. e (Sem rInitial) x -> Sem r x)
       -- ^ A natural transformation from the handled effect to other effects
       -- already in 'Sem'.
    -> Sem (e ': r) a
    -> Sem r a
-- TODO(sandy): could probably give a `coerce` impl for `runTactics` here
interpret :: forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret = forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) t.
((forall (rInitial :: [(* -> *) -> * -> *]) x.
  e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
 -> t)
-> (forall (rInitial :: [(* -> *) -> * -> *]) x.
    e (Sem rInitial) x -> Sem r x)
-> t
firstOrder forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem (e : r) a -> Sem r a
interpretH
{-# INLINE interpret #-}


------------------------------------------------------------------------------
-- | Like 'interpret', but for higher-order effects (ie. those which make use of
-- the @m@ parameter.)
--
-- See the notes on 'Tactical' for how to use this function.
interpretH
    :: (∀ rInitial x . e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
       -- ^ A natural transformation from the handled effect to other effects
       -- already in 'Sem'.
    -> Sem (e ': r) a
    -> Sem r a
interpretH :: forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem (e : r) a -> Sem r a
interpretH forall (rInitial :: [(* -> *) -> * -> *]) x.
e (Sem rInitial) x -> Tactical e (Sem rInitial) r x
f (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union (e : r) (Sem (e : r)) x -> m x) -> m a
m) = forall (r :: [(* -> *) -> * -> *]) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem forall a b. (a -> b) -> a -> b
$ \forall x. Union r (Sem r) x -> m x
k -> forall (m :: * -> *).
Monad m =>
(forall x. Union (e : r) (Sem (e : r)) x -> m x) -> m a
m forall a b. (a -> b) -> a -> b
$ \Union (e : r) (Sem (e : r)) x
u ->
  case forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp Union (e : r) (Sem (e : r)) x
u of
    Left  Union r (Sem (e : r)) x
x -> forall x. Union r (Sem r) x -> m x
k forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist (forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem (e : r) a -> Sem r a
interpretH forall (rInitial :: [(* -> *) -> * -> *]) x.
e (Sem rInitial) x -> Tactical e (Sem rInitial) r x
f) Union r (Sem (e : r)) x
x
    Right (Weaving e (Sem rInitial) a
e f ()
s forall x. f (Sem rInitial x) -> Sem (e : r) (f x)
d f a -> x
y forall x. f x -> Maybe x
v) -> do
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> x
y forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a
usingSem forall x. Union r (Sem r) x -> m x
k forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) (r2 :: [(* -> *) -> * -> *])
       (r :: [(* -> *) -> * -> *]) a.
Functor f =>
f ()
-> (forall x. f (m x) -> Sem r2 (f x))
-> (forall x. f x -> Maybe x)
-> (forall x. f (m x) -> Sem r (f x))
-> Sem (Tactics f m r2 : r) a
-> Sem r a
runTactics f ()
s forall x. f (Sem rInitial x) -> Sem (e : r) (f x)
d forall x. f x -> Maybe x
v (forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem (e : r) a -> Sem r a
interpretH forall (rInitial :: [(* -> *) -> * -> *]) x.
e (Sem rInitial) x -> Tactical e (Sem rInitial) r x
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem (e : r) (f x)
d) forall a b. (a -> b) -> a -> b
$ forall (rInitial :: [(* -> *) -> * -> *]) x.
e (Sem rInitial) x -> Tactical e (Sem rInitial) r x
f e (Sem rInitial) a
e
{-# INLINE interpretH #-}

-- | Interpret an effect @e@ through a natural transformation from @Weaving e@
-- to @Sem r@
interpretWeaving ::
  ∀ e r .
  (∀ x . Weaving e (Sem (e : r)) x -> Sem r x) ->
  InterpreterFor e r
interpretWeaving :: forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]).
(forall x. Weaving e (Sem (e : r)) x -> Sem r x)
-> InterpreterFor e r
interpretWeaving forall x. Weaving e (Sem (e : r)) x -> Sem r x
h (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union (e : r) (Sem (e : r)) x -> m x) -> m a
m) =
  forall (r :: [(* -> *) -> * -> *]) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem \ forall x. Union r (Sem r) x -> m x
k -> forall (m :: * -> *).
Monad m =>
(forall x. Union (e : r) (Sem (e : r)) x -> m x) -> m a
m forall a b. (a -> b) -> a -> b
$ forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
    Right Weaving e (Sem (e : r)) x
wav -> forall (r :: [(* -> *) -> * -> *]) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem (forall x. Weaving e (Sem (e : r)) x -> Sem r x
h Weaving e (Sem (e : r)) x
wav) forall x. Union r (Sem r) x -> m x
k
    Left Union r (Sem (e : r)) x
g -> forall x. Union r (Sem r) x -> m x
k forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist (forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]).
(forall x. Weaving e (Sem (e : r)) x -> Sem r x)
-> InterpreterFor e r
interpretWeaving forall x. Weaving e (Sem (e : r)) x -> Sem r x
h) Union r (Sem (e : r)) x
g
{-# inline interpretWeaving #-}

------------------------------------------------------------------------------
-- | A highly-performant combinator for interpreting an effect statefully. See
-- 'stateful' for a more user-friendly variety of this function.
interpretInStateT
    :: (∀ x m. e m x -> S.StateT s (Sem r) x)
    -> s
    -> Sem (e ': r) a
    -> Sem r (s, a)
interpretInStateT :: forall (e :: (* -> *) -> * -> *) s (r :: [(* -> *) -> * -> *]) a.
(forall x (m :: * -> *). e m x -> StateT s (Sem r) x)
-> s -> Sem (e : r) a -> Sem r (s, a)
interpretInStateT forall x (m :: * -> *). e m x -> StateT s (Sem r) x
f s
s (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union (e : r) (Sem (e : r)) x -> m x) -> m a
m) = forall (r :: [(* -> *) -> * -> *]) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem forall a b. (a -> b) -> a -> b
$ \forall x. Union r (Sem r) x -> m x
k ->
  (forall a b. (a, b) -> (b, a)
S.swap forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>) forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT s
s forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
(forall x. Union (e : r) (Sem (e : r)) x -> m x) -> m a
m forall a b. (a -> b) -> a -> b
$ \Union (e : r) (Sem (e : r)) x
u ->
    case forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp Union (e : r) (Sem (e : r)) x
u of
        Left Union r (Sem (e : r)) x
x -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
S.StateT forall a b. (a -> b) -> a -> b
$ \s
s' ->
              (forall a b. (a, b) -> (b, a)
S.swap forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Union r (Sem r) x -> m x
k
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *) (n :: * -> *) (m :: * -> *)
       (r :: [(* -> *) -> * -> *]) a.
(Functor s, Functor n) =>
s ()
-> (forall x. s (m x) -> n (s x))
-> (forall x. s x -> Maybe x)
-> Union r m a
-> Union r n (s a)
weave (s
s', ())
                    (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ forall (e :: (* -> *) -> * -> *) s (r :: [(* -> *) -> * -> *]) a.
(forall x (m :: * -> *). e m x -> StateT s (Sem r) x)
-> s -> Sem (e : r) a -> Sem r (s, a)
interpretInStateT forall x (m :: * -> *). e m x -> StateT s (Sem r) x
f)
                    (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
            forall a b. (a -> b) -> a -> b
$ Union r (Sem (e : r)) x
x
        Right (Weaving e (Sem rInitial) a
e f ()
z forall x. f (Sem rInitial x) -> Sem (e : r) (f x)
_ f a -> x
y forall x. f x -> Maybe x
_) ->
          f a -> x
y forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
z) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
S.mapStateT (forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a
usingSem forall x. Union r (Sem r) x -> m x
k) (forall x (m :: * -> *). e m x -> StateT s (Sem r) x
f e (Sem rInitial) a
e)
{-# INLINE interpretInStateT #-}


------------------------------------------------------------------------------
-- | A highly-performant combinator for interpreting an effect statefully. See
-- 'stateful' for a more user-friendly variety of this function.
interpretInLazyStateT
    :: (∀ x m. e m x -> LS.StateT s (Sem r) x)
    -> s
    -> Sem (e ': r) a
    -> Sem r (s, a)
interpretInLazyStateT :: forall (e :: (* -> *) -> * -> *) s (r :: [(* -> *) -> * -> *]) a.
(forall x (m :: * -> *). e m x -> StateT s (Sem r) x)
-> s -> Sem (e : r) a -> Sem r (s, a)
interpretInLazyStateT forall x (m :: * -> *). e m x -> StateT s (Sem r) x
f s
s (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union (e : r) (Sem (e : r)) x -> m x) -> m a
m) = forall (r :: [(* -> *) -> * -> *]) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem forall a b. (a -> b) -> a -> b
$ \forall x. Union r (Sem r) x -> m x
k ->
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
LS.runStateT s
s forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
(forall x. Union (e : r) (Sem (e : r)) x -> m x) -> m a
m forall a b. (a -> b) -> a -> b
$ \Union (e : r) (Sem (e : r)) x
u ->
    case forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp Union (e : r) (Sem (e : r)) x
u of
        Left Union r (Sem (e : r)) x
x -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
LS.StateT forall a b. (a -> b) -> a -> b
$ \s
s' ->
          forall x. Union r (Sem r) x -> m x
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> (b, a)
swap
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: * -> *) (n :: * -> *) (m :: * -> *)
       (r :: [(* -> *) -> * -> *]) a.
(Functor s, Functor n) =>
s ()
-> (forall x. s (m x) -> n (s x))
-> (forall x. s x -> Maybe x)
-> Union r m a
-> Union r n (s a)
weave (s
s', ())
                    (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ forall (e :: (* -> *) -> * -> *) s (r :: [(* -> *) -> * -> *]) a.
(forall x (m :: * -> *). e m x -> StateT s (Sem r) x)
-> s -> Sem (e : r) a -> Sem r (s, a)
interpretInLazyStateT forall x (m :: * -> *). e m x -> StateT s (Sem r) x
f)
                    (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
            forall a b. (a -> b) -> a -> b
$ Union r (Sem (e : r)) x
x
        Right (Weaving e (Sem rInitial) a
e f ()
z forall x. f (Sem rInitial x) -> Sem (e : r) (f x)
_ f a -> x
y forall x. f x -> Maybe x
_) ->
          f a -> x
y forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
z) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
LS.mapStateT (forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a
usingSem forall x. Union r (Sem r) x -> m x
k) (forall x (m :: * -> *). e m x -> StateT s (Sem r) x
f e (Sem rInitial) a
e)
{-# INLINE interpretInLazyStateT #-}


------------------------------------------------------------------------------
-- | Like 'interpret', but with access to an intermediate state @s@.
stateful
    :: (∀ x m. e m x -> s -> Sem r (s, x))
    -> s
    -> Sem (e ': r) a
    -> Sem r (s, a)
stateful :: forall (e :: (* -> *) -> * -> *) s (r :: [(* -> *) -> * -> *]) a.
(forall x (m :: * -> *). e m x -> s -> Sem r (s, x))
-> s -> Sem (e : r) a -> Sem r (s, a)
stateful forall x (m :: * -> *). e m x -> s -> Sem r (s, x)
f = forall (e :: (* -> *) -> * -> *) s (r :: [(* -> *) -> * -> *]) a.
(forall x (m :: * -> *). e m x -> StateT s (Sem r) x)
-> s -> Sem (e : r) a -> Sem r (s, a)
interpretInStateT forall a b. (a -> b) -> a -> b
$ \e m x
e -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
S.StateT forall a b. (a -> b) -> a -> b
$ (forall a b. (a, b) -> (b, a)
S.swap forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x (m :: * -> *). e m x -> s -> Sem r (s, x)
f e m x
e
{-# INLINE[3] stateful #-}


------------------------------------------------------------------------------
-- | Like 'interpret', but with access to an intermediate state @s@.
lazilyStateful
    :: (∀ x m. e m x -> s -> Sem r (s, x))
    -> s
    -> Sem (e ': r) a
    -> Sem r (s, a)
lazilyStateful :: forall (e :: (* -> *) -> * -> *) s (r :: [(* -> *) -> * -> *]) a.
(forall x (m :: * -> *). e m x -> s -> Sem r (s, x))
-> s -> Sem (e : r) a -> Sem r (s, a)
lazilyStateful forall x (m :: * -> *). e m x -> s -> Sem r (s, x)
f = forall (e :: (* -> *) -> * -> *) s (r :: [(* -> *) -> * -> *]) a.
(forall x (m :: * -> *). e m x -> StateT s (Sem r) x)
-> s -> Sem (e : r) a -> Sem r (s, a)
interpretInLazyStateT forall a b. (a -> b) -> a -> b
$ \e m x
e -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
LS.StateT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x (m :: * -> *). e m x -> s -> Sem r (s, x)
f e m x
e
{-# INLINE[3] lazilyStateful #-}


------------------------------------------------------------------------------
-- | Like 'reinterpret', but for higher-order effects.
--
-- See the notes on 'Tactical' for how to use this function.
reinterpretH
    :: forall e1 e2 r a
     . (∀ rInitial x. e1 (Sem rInitial) x ->
        Tactical e1 (Sem rInitial) (e2 ': r) x)
       -- ^ A natural transformation from the handled effect to the new effect.
    -> Sem (e1 ': r) a
    -> Sem (e2 ': r) a
reinterpretH :: forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
reinterpretH forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : r) x
f Sem (e1 : r) a
sem = forall (r :: [(* -> *) -> * -> *]) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem forall a b. (a -> b) -> a -> b
$ \forall x. Union (e2 : r) (Sem (e2 : r)) x -> m x
k -> forall (r :: [(* -> *) -> * -> *]) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem Sem (e1 : r) a
sem forall a b. (a -> b) -> a -> b
$ \Union (e1 : r) (Sem (e1 : r)) x
u ->
  case forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a (f :: (* -> *) -> * -> *).
Union (e : r) m a -> Either (Union (f : r) m a) (Weaving e m a)
decompCoerce Union (e1 : r) (Sem (e1 : r)) x
u of
    Left Union (e2 : r) (Sem (e1 : r)) x
x  -> forall x. Union (e2 : r) (Sem (e2 : r)) x -> m x
k forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist (forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
reinterpretH forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : r) x
f) forall a b. (a -> b) -> a -> b
$ Union (e2 : r) (Sem (e1 : r)) x
x
    Right (Weaving e1 (Sem rInitial) a
e f ()
s forall x. f (Sem rInitial x) -> Sem (e1 : r) (f x)
d f a -> x
y forall x. f x -> Maybe x
v) -> do
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> x
y forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a
usingSem forall x. Union (e2 : r) (Sem (e2 : r)) x -> m x
k
             forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) (r2 :: [(* -> *) -> * -> *])
       (r :: [(* -> *) -> * -> *]) a.
Functor f =>
f ()
-> (forall x. f (m x) -> Sem r2 (f x))
-> (forall x. f x -> Maybe x)
-> (forall x. f (m x) -> Sem r (f x))
-> Sem (Tactics f m r2 : r) a
-> Sem r a
runTactics f ()
s (forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem (e1 : r) (f x)
d) forall x. f x -> Maybe x
v (forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
reinterpretH forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : r) x
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem (e1 : r) (f x)
d)
             forall a b. (a -> b) -> a -> b
$ forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : r) x
f e1 (Sem rInitial) a
e
{-# INLINE[3] reinterpretH #-}
-- TODO(sandy): Make this fuse in with 'stateful' directly.


------------------------------------------------------------------------------
-- | Like 'interpret', but instead of removing the effect @e@, reencodes it in
-- some new effect @f@. This function will fuse when followed by
-- 'Polysemy.State.runState', meaning it's free to 'reinterpret' in terms of
-- the 'Polysemy.State.State' effect and immediately run it.
reinterpret
    :: forall e1 e2 r a
     . FirstOrder e1 "reinterpret"
    => (∀ rInitial x. e1 (Sem rInitial) x -> Sem (e2 ': r) x)
       -- ^ A natural transformation from the handled effect to the new effect.
    -> Sem (e1 ': r) a
    -> Sem (e2 ': r) a
reinterpret :: forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
FirstOrder e1 "reinterpret" =>
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> Sem (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
reinterpret = forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) t.
((forall (rInitial :: [(* -> *) -> * -> *]) x.
  e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
 -> t)
-> (forall (rInitial :: [(* -> *) -> * -> *]) x.
    e (Sem rInitial) x -> Sem r x)
-> t
firstOrder forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
reinterpretH
{-# INLINE[3] reinterpret #-}
-- TODO(sandy): Make this fuse in with 'stateful' directly.


------------------------------------------------------------------------------
-- | Like 'reinterpret2', but for higher-order effects.
--
-- See the notes on 'Tactical' for how to use this function.
reinterpret2H
    :: forall e1 e2 e3 r a
     . (∀ rInitial x. e1 (Sem rInitial) x ->
        Tactical e1 (Sem rInitial) (e2 ': e3 ': r) x)
       -- ^ A natural transformation from the handled effect to the new effects.
    -> Sem (e1 ': r) a
    -> Sem (e2 ': e3 ': r) a
reinterpret2H :: forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (e3 :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : e3 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : r) a
reinterpret2H forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : e3 : r) x
f (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union (e1 : r) (Sem (e1 : r)) x -> m x) -> m a
m) = forall (r :: [(* -> *) -> * -> *]) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem forall a b. (a -> b) -> a -> b
$ \forall x. Union (e2 : e3 : r) (Sem (e2 : e3 : r)) x -> m x
k -> forall (m :: * -> *).
Monad m =>
(forall x. Union (e1 : r) (Sem (e1 : r)) x -> m x) -> m a
m forall a b. (a -> b) -> a -> b
$ \Union (e1 : r) (Sem (e1 : r)) x
u ->
  case forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a (f :: (* -> *) -> * -> *).
Union (e : r) m a -> Either (Union (f : r) m a) (Weaving e m a)
decompCoerce Union (e1 : r) (Sem (e1 : r)) x
u of
    Left Union (e3 : r) (Sem (e1 : r)) x
x  -> forall x. Union (e2 : e3 : r) (Sem (e2 : e3 : r)) x -> m x
k forall a b. (a -> b) -> a -> b
$ forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
Union r m a -> Union (e : r) m a
weaken forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist (forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (e3 :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : e3 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : r) a
reinterpret2H forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : e3 : r) x
f) forall a b. (a -> b) -> a -> b
$ Union (e3 : r) (Sem (e1 : r)) x
x
    Right (Weaving e1 (Sem rInitial) a
e f ()
s forall x. f (Sem rInitial x) -> Sem (e1 : r) (f x)
d f a -> x
y forall x. f x -> Maybe x
v) -> do
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> x
y forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a
usingSem forall x. Union (e2 : e3 : r) (Sem (e2 : e3 : r)) x -> m x
k
             forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) (r2 :: [(* -> *) -> * -> *])
       (r :: [(* -> *) -> * -> *]) a.
Functor f =>
f ()
-> (forall x. f (m x) -> Sem r2 (f x))
-> (forall x. f x -> Maybe x)
-> (forall x. f (m x) -> Sem r (f x))
-> Sem (Tactics f m r2 : r) a
-> Sem r a
runTactics f ()
s (forall (e2 :: (* -> *) -> * -> *) (e3 :: (* -> *) -> * -> *)
       (e1 :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : e3 : r) a
raiseUnder2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem (e1 : r) (f x)
d) forall x. f x -> Maybe x
v (forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (e3 :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : e3 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : r) a
reinterpret2H forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : e3 : r) x
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem (e1 : r) (f x)
d)
             forall a b. (a -> b) -> a -> b
$ forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : e3 : r) x
f e1 (Sem rInitial) a
e
{-# INLINE[3] reinterpret2H #-}


------------------------------------------------------------------------------
-- | Like 'reinterpret', but introduces /two/ intermediary effects.
reinterpret2
    :: forall e1 e2 e3 r a
     . FirstOrder e1 "reinterpret2"
    => (∀ rInitial x. e1 (Sem rInitial) x ->
        Sem (e2 ': e3 ': r) x)
       -- ^ A natural transformation from the handled effect to the new effects.
    -> Sem (e1 ': r) a
    -> Sem (e2 ': e3 ': r) a
reinterpret2 :: forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (e3 :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e1 "reinterpret2" =>
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> Sem (e2 : e3 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : r) a
reinterpret2 = forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) t.
((forall (rInitial :: [(* -> *) -> * -> *]) x.
  e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
 -> t)
-> (forall (rInitial :: [(* -> *) -> * -> *]) x.
    e (Sem rInitial) x -> Sem r x)
-> t
firstOrder forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (e3 :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : e3 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : r) a
reinterpret2H
{-# INLINE[3] reinterpret2 #-}


------------------------------------------------------------------------------
-- | Like 'reinterpret3', but for higher-order effects.
--
-- See the notes on 'Tactical' for how to use this function.
reinterpret3H
    :: forall e1 e2 e3 e4 r a
     . (∀ rInitial x. e1 (Sem rInitial) x ->
        Tactical e1 (Sem rInitial) (e2 ': e3 ': e4 ': r) x)
       -- ^ A natural transformation from the handled effect to the new effects.
    -> Sem (e1 ': r) a
    -> Sem (e2 ': e3 ': e4 ': r) a
reinterpret3H :: forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (e3 :: (* -> *) -> * -> *) (e4 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x
 -> Tactical e1 (Sem rInitial) (e2 : e3 : e4 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : e4 : r) a
reinterpret3H forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x
-> Tactical e1 (Sem rInitial) (e2 : e3 : e4 : r) x
f (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union (e1 : r) (Sem (e1 : r)) x -> m x) -> m a
m) = forall (r :: [(* -> *) -> * -> *]) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem forall a b. (a -> b) -> a -> b
$ \forall x.
Union (e2 : e3 : e4 : r) (Sem (e2 : e3 : e4 : r)) x -> m x
k -> forall (m :: * -> *).
Monad m =>
(forall x. Union (e1 : r) (Sem (e1 : r)) x -> m x) -> m a
m forall a b. (a -> b) -> a -> b
$ \Union (e1 : r) (Sem (e1 : r)) x
u ->
  case forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a (f :: (* -> *) -> * -> *).
Union (e : r) m a -> Either (Union (f : r) m a) (Weaving e m a)
decompCoerce Union (e1 : r) (Sem (e1 : r)) x
u of
    Left Union (e4 : r) (Sem (e1 : r)) x
x  -> forall x.
Union (e2 : e3 : e4 : r) (Sem (e2 : e3 : e4 : r)) x -> m x
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
Union r m a -> Union (e : r) m a
weaken forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
Union r m a -> Union (e : r) m a
weaken forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (n :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist (forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (e3 :: (* -> *) -> * -> *) (e4 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x
 -> Tactical e1 (Sem rInitial) (e2 : e3 : e4 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : e4 : r) a
reinterpret3H forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x
-> Tactical e1 (Sem rInitial) (e2 : e3 : e4 : r) x
f) forall a b. (a -> b) -> a -> b
$ Union (e4 : r) (Sem (e1 : r)) x
x
    Right (Weaving e1 (Sem rInitial) a
e f ()
s forall x. f (Sem rInitial x) -> Sem (e1 : r) (f x)
d f a -> x
y forall x. f x -> Maybe x
v) ->
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> x
y forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a
usingSem forall x.
Union (e2 : e3 : e4 : r) (Sem (e2 : e3 : e4 : r)) x -> m x
k
             forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) (r2 :: [(* -> *) -> * -> *])
       (r :: [(* -> *) -> * -> *]) a.
Functor f =>
f ()
-> (forall x. f (m x) -> Sem r2 (f x))
-> (forall x. f x -> Maybe x)
-> (forall x. f (m x) -> Sem r (f x))
-> Sem (Tactics f m r2 : r) a
-> Sem r a
runTactics f ()
s (forall (e2 :: (* -> *) -> * -> *) (e3 :: (* -> *) -> * -> *)
       (e4 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : e3 : e4 : r) a
raiseUnder3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem (e1 : r) (f x)
d) forall x. f x -> Maybe x
v (forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (e3 :: (* -> *) -> * -> *) (e4 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x
 -> Tactical e1 (Sem rInitial) (e2 : e3 : e4 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : e4 : r) a
reinterpret3H forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x
-> Tactical e1 (Sem rInitial) (e2 : e3 : e4 : r) x
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem (e1 : r) (f x)
d)
             forall a b. (a -> b) -> a -> b
$ forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x
-> Tactical e1 (Sem rInitial) (e2 : e3 : e4 : r) x
f e1 (Sem rInitial) a
e
{-# INLINE[3] reinterpret3H #-}


------------------------------------------------------------------------------
-- | Like 'reinterpret', but introduces /three/ intermediary effects.
reinterpret3
    :: forall e1 e2 e3 e4 r a
     . FirstOrder e1 "reinterpret3"
    => (∀ rInitial x. e1 (Sem rInitial) x -> Sem (e2 ': e3 ': e4 ': r) x)
       -- ^ A natural transformation from the handled effect to the new effects.
    -> Sem (e1 ': r) a
    -> Sem (e2 ': e3 ': e4 ': r) a
reinterpret3 :: forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (e3 :: (* -> *) -> * -> *) (e4 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
FirstOrder e1 "reinterpret3" =>
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> Sem (e2 : e3 : e4 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : e4 : r) a
reinterpret3 = forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) t.
((forall (rInitial :: [(* -> *) -> * -> *]) x.
  e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
 -> t)
-> (forall (rInitial :: [(* -> *) -> * -> *]) x.
    e (Sem rInitial) x -> Sem r x)
-> t
firstOrder forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (e3 :: (* -> *) -> * -> *) (e4 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x
 -> Tactical e1 (Sem rInitial) (e2 : e3 : e4 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : e4 : r) a
reinterpret3H
{-# INLINE[3] reinterpret3 #-}


------------------------------------------------------------------------------
-- | Like 'interpret', but instead of handling the effect, allows responding to
-- the effect while leaving it unhandled. This allows you, for example, to
-- intercept other effects and insert logic around them.
intercept
    :: ( Member e r
       , FirstOrder e "intercept"
       )
    => (∀ x rInitial. e (Sem rInitial) x -> Sem r x)
       -- ^ A natural transformation from the handled effect to other effects
       -- already in 'Sem'.
    -> Sem r a
       -- ^ Unlike 'interpret', 'intercept' does not consume any effects.
    -> Sem r a
intercept :: forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member e r, FirstOrder e "intercept") =>
(forall x (rInitial :: [(* -> *) -> * -> *]).
 e (Sem rInitial) x -> Sem r x)
-> Sem r a -> Sem r a
intercept forall x (rInitial :: [(* -> *) -> * -> *]).
e (Sem rInitial) x -> Sem r x
f = forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Member e r =>
(forall x (rInitial :: [(* -> *) -> * -> *]).
 e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem r a -> Sem r a
interceptH forall a b. (a -> b) -> a -> b
$ \(e (Sem rInitial) x
e :: e (Sem rInitial) x) ->
  forall (m :: * -> *) (f :: * -> *) (r :: [(* -> *) -> * -> *])
       (e :: (* -> *) -> * -> *) a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT @(Sem rInitial) forall a b. (a -> b) -> a -> b
$ forall x (rInitial :: [(* -> *) -> * -> *]).
e (Sem rInitial) x -> Sem r x
f e (Sem rInitial) x
e
{-# INLINE intercept #-}


------------------------------------------------------------------------------
-- | Like 'intercept', but for higher-order effects.
--
-- See the notes on 'Tactical' for how to use this function.
interceptH
    :: Member e r
    => (∀ x rInitial. e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
       -- ^ A natural transformation from the handled effect to other effects
       -- already in 'Sem'.
    -> Sem r a
       -- ^ Unlike 'interpretH', 'interceptH' does not consume any effects.
    -> Sem r a
interceptH :: forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Member e r =>
(forall x (rInitial :: [(* -> *) -> * -> *]).
 e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem r a -> Sem r a
interceptH = forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
ElemOf e r
-> (forall x (rInitial :: [(* -> *) -> * -> *]).
    e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem r a
-> Sem r a
interceptUsingH forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]).
Member e r =>
ElemOf e r
membership
{-# INLINE interceptH #-}

------------------------------------------------------------------------------
-- | A variant of 'intercept' that accepts an explicit proof that the effect
-- is in the effect stack rather then requiring a 'Member' constraint.
--
-- This is useful in conjunction with 'Polysemy.Membership.tryMembership'
-- in order to conditionally perform 'intercept'.
--
-- @since 1.3.0.0
interceptUsing
    :: FirstOrder e "interceptUsing"
    => ElemOf e r
       -- ^ A proof that the handled effect exists in @r@.
       -- This can be retrieved through 'Polysemy.Membership.membership' or
       -- 'Polysemy.Membership.tryMembership'.
    -> (∀ x rInitial. e (Sem rInitial) x -> Sem r x)
       -- ^ A natural transformation from the handled effect to other effects
       -- already in 'Sem'.
    -> Sem r a
       -- ^ Unlike 'interpret', 'intercept' does not consume any effects.
    -> Sem r a
interceptUsing :: forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interceptUsing" =>
ElemOf e r
-> (forall x (rInitial :: [(* -> *) -> * -> *]).
    e (Sem rInitial) x -> Sem r x)
-> Sem r a
-> Sem r a
interceptUsing ElemOf e r
pr forall x (rInitial :: [(* -> *) -> * -> *]).
e (Sem rInitial) x -> Sem r x
f = forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
ElemOf e r
-> (forall x (rInitial :: [(* -> *) -> * -> *]).
    e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem r a
-> Sem r a
interceptUsingH ElemOf e r
pr forall a b. (a -> b) -> a -> b
$ \(e (Sem rInitial) x
e :: e (Sem rInitial) x) ->
  forall (m :: * -> *) (f :: * -> *) (r :: [(* -> *) -> * -> *])
       (e :: (* -> *) -> * -> *) a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT @(Sem rInitial) forall a b. (a -> b) -> a -> b
$ forall x (rInitial :: [(* -> *) -> * -> *]).
e (Sem rInitial) x -> Sem r x
f e (Sem rInitial) x
e
{-# INLINE interceptUsing #-}

------------------------------------------------------------------------------
-- | A variant of 'interceptH' that accepts an explicit proof that the effect
-- is in the effect stack rather then requiring a 'Member' constraint.
--
-- This is useful in conjunction with 'Polysemy.Membership.tryMembership'
-- in order to conditionally perform 'interceptH'.
--
-- See the notes on 'Tactical' for how to use this function.
--
-- @since 1.3.0.0
interceptUsingH
    :: ElemOf e r
       -- ^ A proof that the handled effect exists in @r@.
       -- This can be retrieved through 'Polysemy.Membership.membership' or
       -- 'Polysemy.Membership.tryMembership'.
    -> (∀ x rInitial. e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
       -- ^ A natural transformation from the handled effect to other effects
       -- already in 'Sem'.
    -> Sem r a
       -- ^ Unlike 'interpretH', 'interceptUsingH' does not consume any effects.
    -> Sem r a
interceptUsingH :: forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
ElemOf e r
-> (forall x (rInitial :: [(* -> *) -> * -> *]).
    e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem r a
-> Sem r a
interceptUsingH ElemOf e r
pr forall x (rInitial :: [(* -> *) -> * -> *]).
e (Sem rInitial) x -> Tactical e (Sem rInitial) r x
f (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> m a
m) = forall (r :: [(* -> *) -> * -> *]) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem forall a b. (a -> b) -> a -> b
$ \forall x. Union r (Sem r) x -> m x
k -> forall (m :: * -> *).
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> m a
m forall a b. (a -> b) -> a -> b
$ \Union r (Sem r) x
u ->
  case forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
ElemOf e r -> Union r m a -> Maybe (Weaving e m a)
prjUsing ElemOf e r
pr Union r (Sem r) x
u of
    Just (Weaving e (Sem rInitial) a
e f ()
s forall x. f (Sem rInitial x) -> Sem r (f x)
d f a -> x
y forall x. f x -> Maybe x
v) ->
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> x
y forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a
usingSem forall x. Union r (Sem r) x -> m x
k
             forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) (r2 :: [(* -> *) -> * -> *])
       (r :: [(* -> *) -> * -> *]) a.
Functor f =>
f ()
-> (forall x. f (m x) -> Sem r2 (f x))
-> (forall x. f x -> Maybe x)
-> (forall x. f (m x) -> Sem r (f x))
-> Sem (Tactics f m r2 : r) a
-> Sem r a
runTactics f ()
s (forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem r (f x)
d) forall x. f x -> Maybe x
v (forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
ElemOf e r
-> (forall x (rInitial :: [(* -> *) -> * -> *]).
    e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem r a
-> Sem r a
interceptUsingH ElemOf e r
pr forall x (rInitial :: [(* -> *) -> * -> *]).
e (Sem rInitial) x -> Tactical e (Sem rInitial) r x
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem r (f x)
d)
             forall a b. (a -> b) -> a -> b
$ forall x (rInitial :: [(* -> *) -> * -> *]).
e (Sem rInitial) x -> Tactical e (Sem rInitial) r x
f e (Sem rInitial) a
e
    Maybe (Weaving e (Sem r) x)
Nothing -> forall x. Union r (Sem r) x -> m x
k forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist (forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
ElemOf e r
-> (forall x (rInitial :: [(* -> *) -> * -> *]).
    e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem r a
-> Sem r a
interceptUsingH ElemOf e r
pr forall x (rInitial :: [(* -> *) -> * -> *]).
e (Sem rInitial) x -> Tactical e (Sem rInitial) r x
f) Union r (Sem r) x
u
{-# INLINE interceptUsingH #-}

------------------------------------------------------------------------------
-- | Rewrite an effect @e1@ directly into @e2@, and put it on the top of the
-- effect stack.
--
-- @since 1.2.3.0
rewrite
    :: forall e1 e2 r a
     . (forall rInitial x. e1 (Sem rInitial) x -> e2 (Sem rInitial) x)
    -> Sem (e1 ': r) a
    -> Sem (e2 ': r) a
rewrite :: forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> e2 (Sem rInitial) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
rewrite forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x -> e2 (Sem rInitial) x
f (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union (e1 : r) (Sem (e1 : r)) x -> m x) -> m a
m) = forall (r :: [(* -> *) -> * -> *]) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem forall a b. (a -> b) -> a -> b
$ \forall x. Union (e2 : r) (Sem (e2 : r)) x -> m x
k -> forall (m :: * -> *).
Monad m =>
(forall x. Union (e1 : r) (Sem (e1 : r)) x -> m x) -> m a
m forall a b. (a -> b) -> a -> b
$ \Union (e1 : r) (Sem (e1 : r)) x
u ->
  forall x. Union (e2 : r) (Sem (e2 : r)) x -> m x
k forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist (forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> e2 (Sem rInitial) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
rewrite forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x -> e2 (Sem rInitial) x
f) forall a b. (a -> b) -> a -> b
$ case forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a (f :: (* -> *) -> * -> *).
Union (e : r) m a -> Either (Union (f : r) m a) (Weaving e m a)
decompCoerce Union (e1 : r) (Sem (e1 : r)) x
u of
    Left Union (e2 : r) (Sem (e1 : r)) x
x -> Union (e2 : r) (Sem (e1 : r)) x
x
    Right (Weaving e1 (Sem rInitial) a
e f ()
s forall x. f (Sem rInitial x) -> Sem (e1 : r) (f x)
d f a -> x
n forall x. f x -> Maybe x
y) ->
      forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (mWoven :: * -> *) a.
ElemOf e r -> Weaving e mWoven a -> Union r mWoven a
Union forall {k} (r :: [k]) (e :: k) (r' :: [k]).
(r ~ (e : r')) =>
ElemOf e r
Here forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (e :: (* -> *) -> * -> *)
       (rInitial :: [(* -> *) -> * -> *]) a resultType (mAfter :: * -> *).
Functor f =>
e (Sem rInitial) a
-> f ()
-> (forall x. f (Sem rInitial x) -> mAfter (f x))
-> (f a -> resultType)
-> (forall x. f x -> Maybe x)
-> Weaving e mAfter resultType
Weaving (forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x -> e2 (Sem rInitial) x
f e1 (Sem rInitial) a
e) f ()
s forall x. f (Sem rInitial x) -> Sem (e1 : r) (f x)
d f a -> x
n forall x. f x -> Maybe x
y


------------------------------------------------------------------------------
-- | Transform an effect @e1@ into an effect @e2@ that is already somewhere
-- inside of the stack.
--
-- @since 1.2.3.0
transform
    :: forall e1 e2 r a
     . Member e2 r
    => (forall rInitial x. e1 (Sem rInitial) x -> e2 (Sem rInitial) x)
    -> Sem (e1 ': r) a
    -> Sem r a
transform :: forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Member e2 r =>
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> e2 (Sem rInitial) x)
-> Sem (e1 : r) a -> Sem r a
transform forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x -> e2 (Sem rInitial) x
f (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union (e1 : r) (Sem (e1 : r)) x -> m x) -> m a
m) = forall (r :: [(* -> *) -> * -> *]) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem forall a b. (a -> b) -> a -> b
$ \forall x. Union r (Sem r) x -> m x
k -> forall (m :: * -> *).
Monad m =>
(forall x. Union (e1 : r) (Sem (e1 : r)) x -> m x) -> m a
m forall a b. (a -> b) -> a -> b
$ \Union (e1 : r) (Sem (e1 : r)) x
u ->
  forall x. Union r (Sem r) x -> m x
k forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: * -> *) (r :: [(* -> *) -> * -> *]) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist (forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Member e2 r =>
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> e2 (Sem rInitial) x)
-> Sem (e1 : r) a -> Sem r a
transform forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x -> e2 (Sem rInitial) x
f) forall a b. (a -> b) -> a -> b
$ case forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp Union (e1 : r) (Sem (e1 : r)) x
u of
    Left Union r (Sem (e1 : r)) x
g -> Union r (Sem (e1 : r)) x
g
    Right (Weaving e1 (Sem rInitial) a
e f ()
s forall x. f (Sem rInitial x) -> Sem (e1 : r) (f x)
wv f a -> x
ex forall x. f x -> Maybe x
ins) ->
      forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
Member e r =>
Weaving e m a -> Union r m a
injWeaving (forall (f :: * -> *) (e :: (* -> *) -> * -> *)
       (rInitial :: [(* -> *) -> * -> *]) a resultType (mAfter :: * -> *).
Functor f =>
e (Sem rInitial) a
-> f ()
-> (forall x. f (Sem rInitial x) -> mAfter (f x))
-> (f a -> resultType)
-> (forall x. f x -> Maybe x)
-> Weaving e mAfter resultType
Weaving (forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x -> e2 (Sem rInitial) x
f e1 (Sem rInitial) a
e) f ()
s forall x. f (Sem rInitial x) -> Sem (e1 : r) (f x)
wv f a -> x
ex forall x. f x -> Maybe x
ins)