{-# OPTIONS_HADDOCK not-home #-}
module Control.Effect.Internal.Intercept where

import Data.Coerce

import Control.Monad
import Control.Effect
import Control.Effect.Unlift
import Control.Effect.Carrier
import Control.Effect.State
import Control.Effect.Writer
import Control.Effect.Carrier.Internal.Stepped
import Control.Monad.Trans.Free.Church.Alternate
import Control.Monad.Trans.Reader

import Control.Effect.Type.Unravel
import Control.Effect.Type.ListenPrim

import Control.Effect.Internal.Utils


-- | An effect for intercepting actions of a first-order effect.
--
-- Even for this library, proper usage of this effect is very complicated.
-- When properly used, this can be a very useful helper effect,
-- allowing you write interpretations for a class of higher-order effects
-- that wouldn't otherwise be possible.
--
-- For more information, see the
-- [wiki](https://github.com/KingoftheHomeless/in-other-words/wiki/Advanced-Topics#effect-interception).
data Intercept (e :: Effect) :: Effect where
  Intercept :: Coercible z m
            => (forall x. e z x -> m x)
            -> m a
            -> Intercept e m a

-- | A variant of 'InterceptCont' that is significantly more powerful, allowing
-- you to capture the continuation of the program at each use-site of an
-- effect, as well as aborting execution of the parameter computation
-- early.
data InterceptCont (e :: Effect) :: Effect where
  InterceptCont :: Coercible z m
                => InterceptionMode
                -> (forall x. (x -> m a) -> e z x -> m a)
                -> m a
                -> InterceptCont e m a

data InterceptionMode
  = InterceptOne
  | InterceptAll

data InterceptB e a where
  InterceptB :: (forall q x. (x -> a) -> e q x -> a)
             -> InterceptB e a

interceptB :: forall e m q a
            . ( FirstOrder e
              , Eff (Unravel (InterceptB e)) m
              )
           => (forall x. (x -> m a) -> e q x -> m a)
           -> m a -> m a
interceptB :: (forall x. (x -> m a) -> e q x -> m a) -> m a -> m a
interceptB forall x. (x -> m a) -> e q x -> m a
h m a
m = m (m a) -> m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m a) -> m a) -> m (m a) -> m a
forall a b. (a -> b) -> a -> b
$ Unravel (InterceptB e) m (m a) -> m (m a)
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (Unravel (InterceptB e) m (m a) -> m (m a))
-> Unravel (InterceptB e) m (m a) -> m (m a)
forall a b. (a -> b) -> a -> b
$
  InterceptB e (m a)
-> (m (m a) -> m a) -> m (m a) -> Unravel (InterceptB e) m (m a)
forall (p :: * -> *) a (m :: * -> *).
p a -> (m a -> a) -> m a -> Unravel p m a
Unravel @(InterceptB e)
    ((forall (q :: * -> *) x. (x -> m a) -> e q x -> m a)
-> InterceptB e (m a)
forall k a (e :: k -> * -> *).
(forall (q :: k) x. (x -> a) -> e q x -> a) -> InterceptB e a
InterceptB (\x -> m a
c -> (x -> m a) -> e q x -> m a
forall x. (x -> m a) -> e q x -> m a
h x -> m a
c (e q x -> m a) -> (e q x -> e q x) -> e q x -> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# e q x -> e q x
coerce))
    m (m a) -> m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
    ((a -> m a) -> m a -> m (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m a
m)
{-# INLINE interceptB #-}

type InterceptContC e = CompositionC
 '[ IntroC '[InterceptCont e, Intercept e]
            '[Unravel (InterceptB e)]
  , InterpretC InterceptH (InterceptCont e)
  , InterpretC InterceptH (Intercept e)
  , InterpretPrimC InterceptH (Unravel (InterceptB e))
  , SteppedC e
  ]

data InterceptH

instance ( FirstOrder e
         , Eff (Unravel (InterceptB e)) m
         )
      => Handler InterceptH (Intercept e) m where
  effHandler :: Intercept e (Effly z) x -> Effly z x
effHandler (Intercept forall x. e z x -> Effly z x
h Effly z x
m) =
    (forall x. (x -> Effly z x) -> e z x -> Effly z x)
-> Effly z x -> Effly z x
forall (e :: Effect) (m :: * -> *) (q :: * -> *) a.
(FirstOrder e, Eff (Unravel (InterceptB e)) m) =>
(forall x. (x -> m a) -> e q x -> m a) -> m a -> m a
interceptB
      (\x -> Effly z x
c e z x
e -> e z x -> Effly z x
forall x. e z x -> Effly z x
h e z x
e Effly z x -> (x -> Effly z x) -> Effly z x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> Effly z x
c)
      Effly z x
m
  {-# INLINEABLE effHandler #-}

instance ( FirstOrder e
         , Member e (Derivs m)
         , Eff (Unravel (InterceptB e)) m
         )
      => Handler InterceptH (InterceptCont e) m where
  effHandler :: InterceptCont e (Effly z) x -> Effly z x
effHandler (InterceptCont InterceptionMode
mode forall x. (x -> Effly z x) -> e z x -> Effly z x
h Effly z x
main) = case InterceptionMode
mode of
    InterceptionMode
InterceptAll -> (forall x. (x -> Effly z x) -> e z x -> Effly z x)
-> Effly z x -> Effly z x
forall (e :: Effect) (m :: * -> *) (q :: * -> *) a.
(FirstOrder e, Eff (Unravel (InterceptB e)) m) =>
(forall x. (x -> m a) -> e q x -> m a) -> m a -> m a
interceptB forall x. (x -> Effly z x) -> e z x -> Effly z x
h Effly z x
main
    InterceptionMode
InterceptOne ->
          Unravel (InterceptB e) (Effly z) (Bool -> Effly z x)
-> Effly z (Bool -> Effly z x)
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (InterceptB e (Bool -> Effly z x)
-> (Effly z (Bool -> Effly z x) -> Bool -> Effly z x)
-> Effly z (Bool -> Effly z x)
-> Unravel (InterceptB e) (Effly z) (Bool -> Effly z x)
forall (p :: * -> *) a (m :: * -> *).
p a -> (m a -> a) -> m a -> Unravel p m a
Unravel
                  @(InterceptB e)
                  ((forall (q :: * -> *) x.
 (x -> Bool -> Effly z x) -> e q x -> Bool -> Effly z x)
-> InterceptB e (Bool -> Effly z x)
forall k a (e :: k -> * -> *).
(forall (q :: k) x. (x -> a) -> e q x -> a) -> InterceptB e a
InterceptB ((forall (q :: * -> *) x.
  (x -> Bool -> Effly z x) -> e q x -> Bool -> Effly z x)
 -> InterceptB e (Bool -> Effly z x))
-> (forall (q :: * -> *) x.
    (x -> Bool -> Effly z x) -> e q x -> Bool -> Effly z x)
-> InterceptB e (Bool -> Effly z x)
forall a b. (a -> b) -> a -> b
$ \x -> Bool -> Effly z x
c e q x
e Bool
b ->
                      if Bool
b then
                        (x -> Effly z x) -> e z x -> Effly z x
forall x. (x -> Effly z x) -> e z x -> Effly z x
h (x -> Bool -> Effly z x
`c` Bool
False) (e q x -> e z x
coerce e q x
e)
                      else
                        e (Effly z) x -> Effly z x
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send @e (e q x -> e (Effly z) x
coerce e q x
e) Effly z x -> (x -> Effly z x) -> Effly z x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (x -> Bool -> Effly z x
`c` Bool
b)
                  )
                  (\Effly z (Bool -> Effly z x)
m Bool
b -> Effly z (Bool -> Effly z x)
m Effly z (Bool -> Effly z x)
-> ((Bool -> Effly z x) -> Effly z x) -> Effly z x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool -> Effly z x
f -> Bool -> Effly z x
f Bool
b)
                  ((x -> Bool -> Effly z x)
-> Effly z x -> Effly z (Bool -> Effly z x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Effly z x -> Bool -> Effly z x
forall a b. a -> b -> a
const (Effly z x -> Bool -> Effly z x)
-> (x -> Effly z x) -> x -> Bool -> Effly z x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Effly z x
forall (f :: * -> *) a. Applicative f => a -> f a
pure) Effly z x
main)
               )
      Effly z (Bool -> Effly z x)
-> ((Bool -> Effly z x) -> Effly z x) -> Effly z x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool -> Effly z x
f -> Bool -> Effly z x
f Bool
True
  {-# INLINEABLE effHandler #-}

instance ( FirstOrder e
         , Carrier m
         , Threaders '[SteppedThreads] m p
         )
      => PrimHandler InterceptH
                     (Unravel (InterceptB e))
                     (SteppedC e m) where
  effPrimHandler :: Unravel (InterceptB e) (SteppedC e m) x -> SteppedC e m x
effPrimHandler (Unravel (InterceptB forall (q :: * -> *) x. (x -> x) -> e q x -> x
cataEff) SteppedC e m x -> x
cataM SteppedC e m x
main) =
    x -> SteppedC e m x
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> SteppedC e m x) -> x -> SteppedC e m x
forall a b. (a -> b) -> a -> b
$
      FreeT (FOEff e) m x
-> (forall x. m x -> (x -> x) -> x)
-> (forall x. FOEff e x -> (x -> x) -> x)
-> (x -> x)
-> x
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT (SteppedC e m x -> FreeT (FOEff e) m x
forall (e :: Effect) (m :: * -> *) a.
SteppedC e m a -> FreeT (FOEff e) m a
unSteppedC SteppedC e m x
main)
        (\m x
mx x -> x
c -> SteppedC e m x -> x
cataM (SteppedC e m x -> x) -> SteppedC e m x -> x
forall a b. (a -> b) -> a -> b
$ (x -> x) -> SteppedC e m x -> SteppedC e m x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> x
c (SteppedC e m x -> SteppedC e m x)
-> SteppedC e m x -> SteppedC e m x
forall a b. (a -> b) -> a -> b
$ m x -> SteppedC e m x
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m x
mx)
        (\(FOEff e q x
e) x -> x
c -> (x -> x) -> e q x -> x
forall (q :: * -> *) x. (x -> x) -> e q x -> x
cataEff x -> x
c e q x
e)
        x -> x
forall a. a -> a
id
  {-# INLINEABLE effPrimHandler #-}


-- | Run @'Intercept' e@, @'InterceptCont' e@ and @e@ effects, provided
-- that @e@ is first-order and also part of the remaining effect stack.
--
-- There are three very important things to note here:
--
-- * __@e@ must be first-order.__
-- * __Any action of @e@ made by a handler run after 'runInterceptCont'__
-- __won't get be intercepted__. What this means is __that you typically want__
-- __to run the handler for @e@ immediately after 'runInterceptCont'__.
-- * __This imposes the very restrictive primitive effect__
-- __'Control.Effect.Type.Unravel.Unravel'__. Most notably, neither
-- 'StateThreads' nor 'WriterThreads' accepts it.
-- Because of that, this module offers various alternatives
-- of several common 'State' and 'Tell' interpreters with threading
-- constraints that do accept 'Unravel'.
--
-- @'Derivs' ('InterceptContC' e m) = 'InterceptCont' e ': 'Intercept' e ': e ': Derivs m@
--
-- @'Prims'  ('InterceptContC' e m) = 'Unravel' (InterceptB e) ': 'Prims' m@
runInterceptCont :: forall e m a p
                  . ( FirstOrder e
                    , Carrier m
                    , Member e (Derivs m)
                    , Threaders '[SteppedThreads] m p
                    )
                 => InterceptContC e m a
                 -> m a
runInterceptCont :: InterceptContC e m a -> m a
runInterceptCont InterceptContC e m a
m =
       (\FreeT (FOEff e) m a
m' -> FreeT (FOEff e) m a
-> (forall x. m x -> (x -> m a) -> m a)
-> (forall x. FOEff e x -> (x -> m a) -> m a)
-> (a -> m a)
-> m a
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT FreeT (FOEff e) m a
m'
                       forall x. m x -> (x -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)
                       (\(FOEff e) x -> m a
c -> e m x -> m x
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send @e (e q x -> e m x
coerce e q x
e) m x -> (x -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> m a
c)
                       a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
       )
     (FreeT (FOEff e) m a -> m a) -> FreeT (FOEff e) m a -> m a
forall a b. (a -> b) -> a -> b
$ SteppedC e m a -> FreeT (FOEff e) m a
forall (e :: Effect) (m :: * -> *) a.
SteppedC e m a -> FreeT (FOEff e) m a
unSteppedC
     (SteppedC e m a -> FreeT (FOEff e) m a)
-> SteppedC e m a -> FreeT (FOEff e) m a
forall a b. (a -> b) -> a -> b
$ InterpretPrimC InterceptH (Unravel (InterceptB e)) (SteppedC e m) a
-> SteppedC e m a
forall h (e :: Effect) (m :: * -> *) a.
PrimHandler h e m =>
InterpretPrimC h e m a -> m a
interpretPrimViaHandler
     (InterpretPrimC
   InterceptH (Unravel (InterceptB e)) (SteppedC e m) a
 -> SteppedC e m a)
-> InterpretPrimC
     InterceptH (Unravel (InterceptB e)) (SteppedC e m) a
-> SteppedC e m a
forall a b. (a -> b) -> a -> b
$ InterpretC
  InterceptH
  (Intercept e)
  (InterpretPrimC InterceptH (Unravel (InterceptB e)) (SteppedC e m))
  a
-> InterpretPrimC
     InterceptH (Unravel (InterceptB e)) (SteppedC e m) a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
     (InterpretC
   InterceptH
   (Intercept e)
   (InterpretPrimC InterceptH (Unravel (InterceptB e)) (SteppedC e m))
   a
 -> InterpretPrimC
      InterceptH (Unravel (InterceptB e)) (SteppedC e m) a)
-> InterpretC
     InterceptH
     (Intercept e)
     (InterpretPrimC InterceptH (Unravel (InterceptB e)) (SteppedC e m))
     a
-> InterpretPrimC
     InterceptH (Unravel (InterceptB e)) (SteppedC e m) a
forall a b. (a -> b) -> a -> b
$ InterpretC
  InterceptH
  (InterceptCont e)
  (InterpretC
     InterceptH
     (Intercept e)
     (InterpretPrimC
        InterceptH (Unravel (InterceptB e)) (SteppedC e m)))
  a
-> InterpretC
     InterceptH
     (Intercept e)
     (InterpretPrimC InterceptH (Unravel (InterceptB e)) (SteppedC e m))
     a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
     (InterpretC
   InterceptH
   (InterceptCont e)
   (InterpretC
      InterceptH
      (Intercept e)
      (InterpretPrimC
         InterceptH (Unravel (InterceptB e)) (SteppedC e m)))
   a
 -> InterpretC
      InterceptH
      (Intercept e)
      (InterpretPrimC InterceptH (Unravel (InterceptB e)) (SteppedC e m))
      a)
-> InterpretC
     InterceptH
     (InterceptCont e)
     (InterpretC
        InterceptH
        (Intercept e)
        (InterpretPrimC
           InterceptH (Unravel (InterceptB e)) (SteppedC e m)))
     a
-> InterpretC
     InterceptH
     (Intercept e)
     (InterpretPrimC InterceptH (Unravel (InterceptB e)) (SteppedC e m))
     a
forall a b. (a -> b) -> a -> b
$ IntroUnderManyC
  '[InterceptCont e, Intercept e]
  '[Unravel (InterceptB e)]
  (InterpretC
     InterceptH
     (InterceptCont e)
     (InterpretC
        InterceptH
        (Intercept e)
        (InterpretPrimC
           InterceptH (Unravel (InterceptB e)) (SteppedC e m))))
  a
-> InterpretC
     InterceptH
     (InterceptCont e)
     (InterpretC
        InterceptH
        (Intercept e)
        (InterpretPrimC
           InterceptH (Unravel (InterceptB e)) (SteppedC e m)))
     a
forall (top :: [Effect]) (new :: [Effect]) (m :: * -> *) a.
(KnownList top, KnownList new, IntroConsistent top new m) =>
IntroUnderManyC top new m a -> m a
introUnderMany
     (IntroUnderManyC
   '[InterceptCont e, Intercept e]
   '[Unravel (InterceptB e)]
   (InterpretC
      InterceptH
      (InterceptCont e)
      (InterpretC
         InterceptH
         (Intercept e)
         (InterpretPrimC
            InterceptH (Unravel (InterceptB e)) (SteppedC e m))))
   a
 -> InterpretC
      InterceptH
      (InterceptCont e)
      (InterpretC
         InterceptH
         (Intercept e)
         (InterpretPrimC
            InterceptH (Unravel (InterceptB e)) (SteppedC e m)))
      a)
-> IntroUnderManyC
     '[InterceptCont e, Intercept e]
     '[Unravel (InterceptB e)]
     (InterpretC
        InterceptH
        (InterceptCont e)
        (InterpretC
           InterceptH
           (Intercept e)
           (InterpretPrimC
              InterceptH (Unravel (InterceptB e)) (SteppedC e m))))
     a
-> InterpretC
     InterceptH
     (InterceptCont e)
     (InterpretC
        InterceptH
        (Intercept e)
        (InterpretPrimC
           InterceptH (Unravel (InterceptB e)) (SteppedC e m)))
     a
forall a b. (a -> b) -> a -> b
$ InterceptContC e m a
-> CompositionBaseM
     '[IntroC '[InterceptCont e, Intercept e] '[Unravel (InterceptB e)],
       InterpretC InterceptH (InterceptCont e),
       InterpretC InterceptH (Intercept e),
       InterpretPrimC InterceptH (Unravel (InterceptB e)), SteppedC e]
     m
     a
forall (ts :: [Effect]) (m :: * -> *) a.
CompositionC ts m a -> CompositionBaseM ts m a
runComposition
     (InterceptContC e m a
 -> CompositionBaseM
      '[IntroC '[InterceptCont e, Intercept e] '[Unravel (InterceptB e)],
        InterpretC InterceptH (InterceptCont e),
        InterpretC InterceptH (Intercept e),
        InterpretPrimC InterceptH (Unravel (InterceptB e)), SteppedC e]
      m
      a)
-> InterceptContC e m a
-> CompositionBaseM
     '[IntroC '[InterceptCont e, Intercept e] '[Unravel (InterceptB e)],
       InterpretC InterceptH (InterceptCont e),
       InterpretC InterceptH (Intercept e),
       InterpretPrimC InterceptH (Unravel (InterceptB e)), SteppedC e]
     m
     a
forall a b. (a -> b) -> a -> b
$ InterceptContC e m a
m
{-# INLINE runInterceptCont #-}

-- | A variant of 'runState' with a 'SteppedThreads' threading constraint
-- instead of a 'StateThreads' threading constraint.
runStateStepped :: forall s m a p
                 . (Carrier m, Threaders '[SteppedThreads] m p)
                => s
                -> SteppedC (State s) m a
                -> m (s, a)
runStateStepped :: s -> SteppedC (State s) m a -> m (s, a)
runStateStepped s
s0 SteppedC (State s) m a
m =
  FreeT (FOEff (State s)) m a
-> (forall x. m x -> (x -> s -> m (s, a)) -> s -> m (s, a))
-> (forall x.
    FOEff (State s) x -> (x -> s -> m (s, a)) -> s -> m (s, a))
-> (a -> s -> m (s, a))
-> s
-> m (s, a)
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT
    (SteppedC (State s) m a -> FreeT (FOEff (State s)) m a
forall (e :: Effect) (m :: * -> *) a.
SteppedC e m a -> FreeT (FOEff e) m a
unSteppedC SteppedC (State s) m a
m)
    (\m x
mx x -> s -> m (s, a)
c s
s -> m x
mx m x -> (x -> m (s, a)) -> m (s, a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (x -> s -> m (s, a)
`c` s
s))
    (\(FOEff State s q x
e) x -> s -> m (s, a)
c s
s -> case State s q x
e of
        State s q x
Get -> x -> s -> m (s, a)
c s
x
s s
s
        Put s
s' -> x -> s -> m (s, a)
c () s
s'
    )
    (\a
a s
s -> (s, a) -> m (s, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, a
a))
    s
s0
{-# INLINE runStateStepped #-}

-- | A variant of 'runTell' with a 'SteppedThreads' threading constraint
-- instead of a 'StateThreads' threading constraint.
runTellListStepped :: forall o m a p
                    . ( Carrier m
                      , Threaders '[SteppedThreads] m p
                      )
                   => SteppedC (Tell o) m a
                   -> m ([o], a)
runTellListStepped :: SteppedC (Tell o) m a -> m ([o], a)
runTellListStepped SteppedC (Tell o) m a
m =
  FreeT (FOEff (Tell o)) m a
-> (forall x. m x -> (x -> [o] -> m ([o], a)) -> [o] -> m ([o], a))
-> (forall x.
    FOEff (Tell o) x -> (x -> [o] -> m ([o], a)) -> [o] -> m ([o], a))
-> (a -> [o] -> m ([o], a))
-> [o]
-> m ([o], a)
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT
    (SteppedC (Tell o) m a -> FreeT (FOEff (Tell o)) m a
forall (e :: Effect) (m :: * -> *) a.
SteppedC e m a -> FreeT (FOEff e) m a
unSteppedC SteppedC (Tell o) m a
m)
    (\m x
mx x -> [o] -> m ([o], a)
c [o]
s -> m x
mx m x -> (x -> m ([o], a)) -> m ([o], a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (x -> [o] -> m ([o], a)
`c` [o]
s))
    (\(FOEff (Tell o
o)) x -> [o] -> m ([o], a)
c [o]
s -> x -> [o] -> m ([o], a)
c () (o
o o -> [o] -> [o]
forall a. a -> [a] -> [a]
: [o]
s))
    (\a
a [o]
s -> ([o], a) -> m ([o], a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([o] -> [o]
forall a. [a] -> [a]
reverse [o]
s, a
a))
    []
{-# INLINE runTellListStepped #-}

-- | A variant of 'runTell' with a 'SteppedThreads' threading constraint
-- instead of a 'StateThreads' threading constraint.
runTellStepped :: forall w m a p
                . ( Monoid w
                  , Carrier m
                  , Threaders '[SteppedThreads] m p
                  )
               => SteppedC (Tell w) m a
               -> m (w, a)
runTellStepped :: SteppedC (Tell w) m a -> m (w, a)
runTellStepped SteppedC (Tell w) m a
m =
  FreeT (FOEff (Tell w)) m a
-> (forall x. m x -> (x -> w -> m (w, a)) -> w -> m (w, a))
-> (forall x.
    FOEff (Tell w) x -> (x -> w -> m (w, a)) -> w -> m (w, a))
-> (a -> w -> m (w, a))
-> w
-> m (w, a)
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT
    (SteppedC (Tell w) m a -> FreeT (FOEff (Tell w)) m a
forall (e :: Effect) (m :: * -> *) a.
SteppedC e m a -> FreeT (FOEff e) m a
unSteppedC SteppedC (Tell w) m a
m)
    (\m x
mx x -> w -> m (w, a)
c w
s -> m x
mx m x -> (x -> m (w, a)) -> m (w, a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (x -> w -> m (w, a)
`c` w
s))
    (\(FOEff (Tell w
o)) x -> w -> m (w, a)
c w
s -> x -> w -> m (w, a)
c () (w -> m (w, a)) -> w -> m (w, a)
forall a b. (a -> b) -> a -> b
$! w
s w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
o)
    (\a
a w
s -> (w, a) -> m (w, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (w
s, a
a))
    w
forall a. Monoid a => a
mempty
{-# INLINE runTellStepped #-}

data ListenSteppedH

instance Eff (ListenPrim w) m
      => Handler ListenSteppedH (Listen w) m where
  effHandler :: Listen w (Effly z) x -> Effly z x
effHandler (Listen Effly z a
m) = ListenPrim w (Effly z) (w, a) -> Effly z (w, a)
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (ListenPrim w (Effly z) (w, a) -> Effly z (w, a))
-> ListenPrim w (Effly z) (w, a) -> Effly z (w, a)
forall a b. (a -> b) -> a -> b
$ Effly z a -> ListenPrim w (Effly z) (w, a)
forall (m :: * -> *) a o. m a -> ListenPrim o m (o, a)
ListenPrimListen Effly z a
m
  {-# INLINEABLE effHandler #-}

instance (Monoid w, Carrier m, Threaders '[SteppedThreads] m p)
      => PrimHandler ListenSteppedH (ListenPrim w) (SteppedC (Tell w) m) where
  effPrimHandler :: ListenPrim w (SteppedC (Tell w) m) x -> SteppedC (Tell w) m x
effPrimHandler = \case
    ListenPrimTell w
w -> w -> SteppedC (Tell w) m ()
forall o (m :: * -> *). Eff (Tell o) m => o -> m ()
tell w
w
    ListenPrimListen SteppedC (Tell w) m a
m -> FreeT (FOEff (Tell w)) m x -> SteppedC (Tell w) m x
forall (e :: Effect) (m :: * -> *) a.
FreeT (FOEff e) m a -> SteppedC e m a
SteppedC (FreeT (FOEff (Tell w)) m x -> SteppedC (Tell w) m x)
-> FreeT (FOEff (Tell w)) m x -> SteppedC (Tell w) m x
forall a b. (a -> b) -> a -> b
$ (forall r.
 (forall x. m x -> (x -> r) -> r)
 -> (forall x. FOEff (Tell w) x -> (x -> r) -> r) -> (x -> r) -> r)
-> FreeT (FOEff (Tell w)) m x
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (forall x. m x -> (x -> r) -> r)
 -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r)
-> FreeT f m a
FreeT ((forall r.
  (forall x. m x -> (x -> r) -> r)
  -> (forall x. FOEff (Tell w) x -> (x -> r) -> r) -> (x -> r) -> r)
 -> FreeT (FOEff (Tell w)) m x)
-> (forall r.
    (forall x. m x -> (x -> r) -> r)
    -> (forall x. FOEff (Tell w) x -> (x -> r) -> r) -> (x -> r) -> r)
-> FreeT (FOEff (Tell w)) m x
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> (x -> r) -> r
bind forall x. FOEff (Tell w) x -> (x -> r) -> r
handler x -> r
c ->
      FreeT (FOEff (Tell w)) m a
-> (forall x. m x -> (x -> w -> r) -> w -> r)
-> (forall x. FOEff (Tell w) x -> (x -> w -> r) -> w -> r)
-> (a -> w -> r)
-> w
-> r
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a
-> forall r.
   (forall x. m x -> (x -> r) -> r)
   -> (forall x. f x -> (x -> r) -> r) -> (a -> r) -> r
unFreeT (SteppedC (Tell w) m a -> FreeT (FOEff (Tell w)) m a
forall (e :: Effect) (m :: * -> *) a.
SteppedC e m a -> FreeT (FOEff e) m a
unSteppedC SteppedC (Tell w) m a
m)
        (\m x
mx x -> w -> r
c' w
s -> m x
mx m x -> (x -> r) -> r
forall x. m x -> (x -> r) -> r
`bind` (x -> w -> r
`c'` w
s))
        (\e :: FOEff (Tell w) x
e@(FOEff (Tell w
o)) x -> w -> r
c' w
s -> FOEff (Tell w) x -> (x -> r) -> r
forall x. FOEff (Tell w) x -> (x -> r) -> r
handler FOEff (Tell w) x
e ((x -> r) -> r) -> (x -> r) -> r
forall a b. (a -> b) -> a -> b
$ \x
a -> x -> w -> r
c' x
a (w -> r) -> w -> r
forall a b. (a -> b) -> a -> b
$! w
s w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
o)
        (\a
a w
s -> x -> r
c (w
s, a
a))
        w
forall a. Monoid a => a
mempty
  {-# INLINEABLE effPrimHandler #-}

type ListenSteppedC w = CompositionC
 '[ ReinterpretC ListenSteppedH (Listen w) '[ListenPrim w]
  , InterpretPrimC ListenSteppedH (ListenPrim w)
  , SteppedC (Tell w)
  ]

-- | A variant of 'runListen' with a 'SteppedThreads' threading constraint
-- instead of a 'StateThreads' threading constraint.
--
-- @'Derivs' ('ListenSteppedC' w m) = 'Listen' w ': 'Tell' w ': Derivs m@
--
-- @'Prims' ('ListenSteppedC' w m) = 'ListenPrim' w ': Derivs m@
runListenStepped :: forall w m a p
                . ( Monoid w
                  , Carrier m
                  , Threaders '[SteppedThreads] m p
                  )
               => ListenSteppedC w m a
               -> m (w, a)
runListenStepped :: ListenSteppedC w m a -> m (w, a)
runListenStepped ListenSteppedC w m a
m =
    SteppedC (Tell w) m a -> m (w, a)
forall w (m :: * -> *) a (p :: [Effect]).
(Monoid w, Carrier m, Threaders '[SteppedThreads] m p) =>
SteppedC (Tell w) m a -> m (w, a)
runTellStepped
  (SteppedC (Tell w) m a -> m (w, a))
-> SteppedC (Tell w) m a -> m (w, a)
forall a b. (a -> b) -> a -> b
$ InterpretPrimC
  ListenSteppedH (ListenPrim w) (SteppedC (Tell w) m) a
-> SteppedC (Tell w) m a
forall h (e :: Effect) (m :: * -> *) a.
PrimHandler h e m =>
InterpretPrimC h e m a -> m a
interpretPrimViaHandler
  (InterpretPrimC
   ListenSteppedH (ListenPrim w) (SteppedC (Tell w) m) a
 -> SteppedC (Tell w) m a)
-> InterpretPrimC
     ListenSteppedH (ListenPrim w) (SteppedC (Tell w) m) a
-> SteppedC (Tell w) m a
forall a b. (a -> b) -> a -> b
$ ReinterpretC
  ListenSteppedH
  (Listen w)
  '[ListenPrim w]
  (InterpretPrimC
     ListenSteppedH (ListenPrim w) (SteppedC (Tell w) m))
  a
-> InterpretPrimC
     ListenSteppedH (ListenPrim w) (SteppedC (Tell w) m) a
forall h (e :: Effect) (new :: [Effect]) (m :: * -> *) a.
(Handler h e m, KnownList new, HeadEffs new m) =>
ReinterpretC h e new m a -> m a
reinterpretViaHandler
  (ReinterpretC
   ListenSteppedH
   (Listen w)
   '[ListenPrim w]
   (InterpretPrimC
      ListenSteppedH (ListenPrim w) (SteppedC (Tell w) m))
   a
 -> InterpretPrimC
      ListenSteppedH (ListenPrim w) (SteppedC (Tell w) m) a)
-> ReinterpretC
     ListenSteppedH
     (Listen w)
     '[ListenPrim w]
     (InterpretPrimC
        ListenSteppedH (ListenPrim w) (SteppedC (Tell w) m))
     a
-> InterpretPrimC
     ListenSteppedH (ListenPrim w) (SteppedC (Tell w) m) a
forall a b. (a -> b) -> a -> b
$ ListenSteppedC w m a
-> CompositionBaseM
     '[ReinterpretC ListenSteppedH (Listen w) '[ListenPrim w],
       InterpretPrimC ListenSteppedH (ListenPrim w), SteppedC (Tell w)]
     m
     a
forall (ts :: [Effect]) (m :: * -> *) a.
CompositionC ts m a -> CompositionBaseM ts m a
runComposition
  (ListenSteppedC w m a
 -> CompositionBaseM
      '[ReinterpretC ListenSteppedH (Listen w) '[ListenPrim w],
        InterpretPrimC ListenSteppedH (ListenPrim w), SteppedC (Tell w)]
      m
      a)
-> ListenSteppedC w m a
-> CompositionBaseM
     '[ReinterpretC ListenSteppedH (Listen w) '[ListenPrim w],
       InterpretPrimC ListenSteppedH (ListenPrim w), SteppedC (Tell w)]
     m
     a
forall a b. (a -> b) -> a -> b
$ ListenSteppedC w m a
m
{-# INLINE runListenStepped #-}



newtype ReifiedFOHandler e m = ReifiedFOHandler (forall q x. e q x -> m x)

newtype InterceptRC (e :: Effect) m a = InterceptRC {
    InterceptRC e m a -> ReaderT (ReifiedFOHandler e m) m a
unInterceptRC :: ReaderT (ReifiedFOHandler e m) m a
  }
  deriving ( a -> InterceptRC e m b -> InterceptRC e m a
(a -> b) -> InterceptRC e m a -> InterceptRC e m b
(forall a b. (a -> b) -> InterceptRC e m a -> InterceptRC e m b)
-> (forall a b. a -> InterceptRC e m b -> InterceptRC e m a)
-> Functor (InterceptRC e m)
forall a b. a -> InterceptRC e m b -> InterceptRC e m a
forall a b. (a -> b) -> InterceptRC e m a -> InterceptRC e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (e :: Effect) (m :: * -> *) a b.
Functor m =>
a -> InterceptRC e m b -> InterceptRC e m a
forall (e :: Effect) (m :: * -> *) a b.
Functor m =>
(a -> b) -> InterceptRC e m a -> InterceptRC e m b
<$ :: a -> InterceptRC e m b -> InterceptRC e m a
$c<$ :: forall (e :: Effect) (m :: * -> *) a b.
Functor m =>
a -> InterceptRC e m b -> InterceptRC e m a
fmap :: (a -> b) -> InterceptRC e m a -> InterceptRC e m b
$cfmap :: forall (e :: Effect) (m :: * -> *) a b.
Functor m =>
(a -> b) -> InterceptRC e m a -> InterceptRC e m b
Functor, Functor (InterceptRC e m)
a -> InterceptRC e m a
Functor (InterceptRC e m)
-> (forall a. a -> InterceptRC e m a)
-> (forall a b.
    InterceptRC e m (a -> b) -> InterceptRC e m a -> InterceptRC e m b)
-> (forall a b c.
    (a -> b -> c)
    -> InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m c)
-> (forall a b.
    InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m b)
-> (forall a b.
    InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m a)
-> Applicative (InterceptRC e m)
InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m b
InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m a
InterceptRC e m (a -> b) -> InterceptRC e m a -> InterceptRC e m b
(a -> b -> c)
-> InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m c
forall a. a -> InterceptRC e m a
forall a b.
InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m a
forall a b.
InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m b
forall a b.
InterceptRC e m (a -> b) -> InterceptRC e m a -> InterceptRC e m b
forall a b c.
(a -> b -> c)
-> InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (e :: Effect) (m :: * -> *).
Applicative m =>
Functor (InterceptRC e m)
forall (e :: Effect) (m :: * -> *) a.
Applicative m =>
a -> InterceptRC e m a
forall (e :: Effect) (m :: * -> *) a b.
Applicative m =>
InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m a
forall (e :: Effect) (m :: * -> *) a b.
Applicative m =>
InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m b
forall (e :: Effect) (m :: * -> *) a b.
Applicative m =>
InterceptRC e m (a -> b) -> InterceptRC e m a -> InterceptRC e m b
forall (e :: Effect) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m c
<* :: InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m a
$c<* :: forall (e :: Effect) (m :: * -> *) a b.
Applicative m =>
InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m a
*> :: InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m b
$c*> :: forall (e :: Effect) (m :: * -> *) a b.
Applicative m =>
InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m b
liftA2 :: (a -> b -> c)
-> InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m c
$cliftA2 :: forall (e :: Effect) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m c
<*> :: InterceptRC e m (a -> b) -> InterceptRC e m a -> InterceptRC e m b
$c<*> :: forall (e :: Effect) (m :: * -> *) a b.
Applicative m =>
InterceptRC e m (a -> b) -> InterceptRC e m a -> InterceptRC e m b
pure :: a -> InterceptRC e m a
$cpure :: forall (e :: Effect) (m :: * -> *) a.
Applicative m =>
a -> InterceptRC e m a
$cp1Applicative :: forall (e :: Effect) (m :: * -> *).
Applicative m =>
Functor (InterceptRC e m)
Applicative, Applicative (InterceptRC e m)
a -> InterceptRC e m a
Applicative (InterceptRC e m)
-> (forall a b.
    InterceptRC e m a -> (a -> InterceptRC e m b) -> InterceptRC e m b)
-> (forall a b.
    InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m b)
-> (forall a. a -> InterceptRC e m a)
-> Monad (InterceptRC e m)
InterceptRC e m a -> (a -> InterceptRC e m b) -> InterceptRC e m b
InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m b
forall a. a -> InterceptRC e m a
forall a b.
InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m b
forall a b.
InterceptRC e m a -> (a -> InterceptRC e m b) -> InterceptRC e m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (e :: Effect) (m :: * -> *).
Monad m =>
Applicative (InterceptRC e m)
forall (e :: Effect) (m :: * -> *) a.
Monad m =>
a -> InterceptRC e m a
forall (e :: Effect) (m :: * -> *) a b.
Monad m =>
InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m b
forall (e :: Effect) (m :: * -> *) a b.
Monad m =>
InterceptRC e m a -> (a -> InterceptRC e m b) -> InterceptRC e m b
return :: a -> InterceptRC e m a
$creturn :: forall (e :: Effect) (m :: * -> *) a.
Monad m =>
a -> InterceptRC e m a
>> :: InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m b
$c>> :: forall (e :: Effect) (m :: * -> *) a b.
Monad m =>
InterceptRC e m a -> InterceptRC e m b -> InterceptRC e m b
>>= :: InterceptRC e m a -> (a -> InterceptRC e m b) -> InterceptRC e m b
$c>>= :: forall (e :: Effect) (m :: * -> *) a b.
Monad m =>
InterceptRC e m a -> (a -> InterceptRC e m b) -> InterceptRC e m b
$cp1Monad :: forall (e :: Effect) (m :: * -> *).
Monad m =>
Applicative (InterceptRC e m)
Monad
           , Applicative (InterceptRC e m)
InterceptRC e m a
Applicative (InterceptRC e m)
-> (forall a. InterceptRC e m a)
-> (forall a.
    InterceptRC e m a -> InterceptRC e m a -> InterceptRC e m a)
-> (forall a. InterceptRC e m a -> InterceptRC e m [a])
-> (forall a. InterceptRC e m a -> InterceptRC e m [a])
-> Alternative (InterceptRC e m)
InterceptRC e m a -> InterceptRC e m a -> InterceptRC e m a
InterceptRC e m a -> InterceptRC e m [a]
InterceptRC e m a -> InterceptRC e m [a]
forall a. InterceptRC e m a
forall a. InterceptRC e m a -> InterceptRC e m [a]
forall a.
InterceptRC e m a -> InterceptRC e m a -> InterceptRC e m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (e :: Effect) (m :: * -> *).
Alternative m =>
Applicative (InterceptRC e m)
forall (e :: Effect) (m :: * -> *) a.
Alternative m =>
InterceptRC e m a
forall (e :: Effect) (m :: * -> *) a.
Alternative m =>
InterceptRC e m a -> InterceptRC e m [a]
forall (e :: Effect) (m :: * -> *) a.
Alternative m =>
InterceptRC e m a -> InterceptRC e m a -> InterceptRC e m a
many :: InterceptRC e m a -> InterceptRC e m [a]
$cmany :: forall (e :: Effect) (m :: * -> *) a.
Alternative m =>
InterceptRC e m a -> InterceptRC e m [a]
some :: InterceptRC e m a -> InterceptRC e m [a]
$csome :: forall (e :: Effect) (m :: * -> *) a.
Alternative m =>
InterceptRC e m a -> InterceptRC e m [a]
<|> :: InterceptRC e m a -> InterceptRC e m a -> InterceptRC e m a
$c<|> :: forall (e :: Effect) (m :: * -> *) a.
Alternative m =>
InterceptRC e m a -> InterceptRC e m a -> InterceptRC e m a
empty :: InterceptRC e m a
$cempty :: forall (e :: Effect) (m :: * -> *) a.
Alternative m =>
InterceptRC e m a
$cp1Alternative :: forall (e :: Effect) (m :: * -> *).
Alternative m =>
Applicative (InterceptRC e m)
Alternative, Monad (InterceptRC e m)
Alternative (InterceptRC e m)
InterceptRC e m a
Alternative (InterceptRC e m)
-> Monad (InterceptRC e m)
-> (forall a. InterceptRC e m a)
-> (forall a.
    InterceptRC e m a -> InterceptRC e m a -> InterceptRC e m a)
-> MonadPlus (InterceptRC e m)
InterceptRC e m a -> InterceptRC e m a -> InterceptRC e m a
forall a. InterceptRC e m a
forall a.
InterceptRC e m a -> InterceptRC e m a -> InterceptRC e m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
forall (e :: Effect) (m :: * -> *).
MonadPlus m =>
Monad (InterceptRC e m)
forall (e :: Effect) (m :: * -> *).
MonadPlus m =>
Alternative (InterceptRC e m)
forall (e :: Effect) (m :: * -> *) a.
MonadPlus m =>
InterceptRC e m a
forall (e :: Effect) (m :: * -> *) a.
MonadPlus m =>
InterceptRC e m a -> InterceptRC e m a -> InterceptRC e m a
mplus :: InterceptRC e m a -> InterceptRC e m a -> InterceptRC e m a
$cmplus :: forall (e :: Effect) (m :: * -> *) a.
MonadPlus m =>
InterceptRC e m a -> InterceptRC e m a -> InterceptRC e m a
mzero :: InterceptRC e m a
$cmzero :: forall (e :: Effect) (m :: * -> *) a.
MonadPlus m =>
InterceptRC e m a
$cp2MonadPlus :: forall (e :: Effect) (m :: * -> *).
MonadPlus m =>
Monad (InterceptRC e m)
$cp1MonadPlus :: forall (e :: Effect) (m :: * -> *).
MonadPlus m =>
Alternative (InterceptRC e m)
MonadPlus
           , Monad (InterceptRC e m)
Monad (InterceptRC e m)
-> (forall a. (a -> InterceptRC e m a) -> InterceptRC e m a)
-> MonadFix (InterceptRC e m)
(a -> InterceptRC e m a) -> InterceptRC e m a
forall a. (a -> InterceptRC e m a) -> InterceptRC e m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall (e :: Effect) (m :: * -> *).
MonadFix m =>
Monad (InterceptRC e m)
forall (e :: Effect) (m :: * -> *) a.
MonadFix m =>
(a -> InterceptRC e m a) -> InterceptRC e m a
mfix :: (a -> InterceptRC e m a) -> InterceptRC e m a
$cmfix :: forall (e :: Effect) (m :: * -> *) a.
MonadFix m =>
(a -> InterceptRC e m a) -> InterceptRC e m a
$cp1MonadFix :: forall (e :: Effect) (m :: * -> *).
MonadFix m =>
Monad (InterceptRC e m)
MonadFix, Monad (InterceptRC e m)
Monad (InterceptRC e m)
-> (forall a. String -> InterceptRC e m a)
-> MonadFail (InterceptRC e m)
String -> InterceptRC e m a
forall a. String -> InterceptRC e m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall (e :: Effect) (m :: * -> *).
MonadFail m =>
Monad (InterceptRC e m)
forall (e :: Effect) (m :: * -> *) a.
MonadFail m =>
String -> InterceptRC e m a
fail :: String -> InterceptRC e m a
$cfail :: forall (e :: Effect) (m :: * -> *) a.
MonadFail m =>
String -> InterceptRC e m a
$cp1MonadFail :: forall (e :: Effect) (m :: * -> *).
MonadFail m =>
Monad (InterceptRC e m)
MonadFail, Monad (InterceptRC e m)
Monad (InterceptRC e m)
-> (forall a. IO a -> InterceptRC e m a)
-> MonadIO (InterceptRC e m)
IO a -> InterceptRC e m a
forall a. IO a -> InterceptRC e m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (e :: Effect) (m :: * -> *).
MonadIO m =>
Monad (InterceptRC e m)
forall (e :: Effect) (m :: * -> *) a.
MonadIO m =>
IO a -> InterceptRC e m a
liftIO :: IO a -> InterceptRC e m a
$cliftIO :: forall (e :: Effect) (m :: * -> *) a.
MonadIO m =>
IO a -> InterceptRC e m a
$cp1MonadIO :: forall (e :: Effect) (m :: * -> *).
MonadIO m =>
Monad (InterceptRC e m)
MonadIO
           , Monad (InterceptRC e m)
e -> InterceptRC e m a
Monad (InterceptRC e m)
-> (forall e a. Exception e => e -> InterceptRC e m a)
-> MonadThrow (InterceptRC e m)
forall e a. Exception e => e -> InterceptRC e m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (e :: Effect) (m :: * -> *).
MonadThrow m =>
Monad (InterceptRC e m)
forall (e :: Effect) (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> InterceptRC e m a
throwM :: e -> InterceptRC e m a
$cthrowM :: forall (e :: Effect) (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> InterceptRC e m a
$cp1MonadThrow :: forall (e :: Effect) (m :: * -> *).
MonadThrow m =>
Monad (InterceptRC e m)
MonadThrow, MonadThrow (InterceptRC e m)
MonadThrow (InterceptRC e m)
-> (forall e a.
    Exception e =>
    InterceptRC e m a -> (e -> InterceptRC e m a) -> InterceptRC e m a)
-> MonadCatch (InterceptRC e m)
InterceptRC e m a -> (e -> InterceptRC e m a) -> InterceptRC e m a
forall e a.
Exception e =>
InterceptRC e m a -> (e -> InterceptRC e m a) -> InterceptRC e m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (e :: Effect) (m :: * -> *).
MonadCatch m =>
MonadThrow (InterceptRC e m)
forall (e :: Effect) (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
InterceptRC e m a -> (e -> InterceptRC e m a) -> InterceptRC e m a
catch :: InterceptRC e m a -> (e -> InterceptRC e m a) -> InterceptRC e m a
$ccatch :: forall (e :: Effect) (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
InterceptRC e m a -> (e -> InterceptRC e m a) -> InterceptRC e m a
$cp1MonadCatch :: forall (e :: Effect) (m :: * -> *).
MonadCatch m =>
MonadThrow (InterceptRC e m)
MonadCatch, MonadCatch (InterceptRC e m)
MonadCatch (InterceptRC e m)
-> (forall b.
    ((forall a. InterceptRC e m a -> InterceptRC e m a)
     -> InterceptRC e m b)
    -> InterceptRC e m b)
-> (forall b.
    ((forall a. InterceptRC e m a -> InterceptRC e m a)
     -> InterceptRC e m b)
    -> InterceptRC e m b)
-> (forall a b c.
    InterceptRC e m a
    -> (a -> ExitCase b -> InterceptRC e m c)
    -> (a -> InterceptRC e m b)
    -> InterceptRC e m (b, c))
-> MonadMask (InterceptRC e m)
InterceptRC e m a
-> (a -> ExitCase b -> InterceptRC e m c)
-> (a -> InterceptRC e m b)
-> InterceptRC e m (b, c)
((forall a. InterceptRC e m a -> InterceptRC e m a)
 -> InterceptRC e m b)
-> InterceptRC e m b
((forall a. InterceptRC e m a -> InterceptRC e m a)
 -> InterceptRC e m b)
-> InterceptRC e m b
forall b.
((forall a. InterceptRC e m a -> InterceptRC e m a)
 -> InterceptRC e m b)
-> InterceptRC e m b
forall a b c.
InterceptRC e m a
-> (a -> ExitCase b -> InterceptRC e m c)
-> (a -> InterceptRC e m b)
-> InterceptRC e m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (e :: Effect) (m :: * -> *).
MonadMask m =>
MonadCatch (InterceptRC e m)
forall (e :: Effect) (m :: * -> *) b.
MonadMask m =>
((forall a. InterceptRC e m a -> InterceptRC e m a)
 -> InterceptRC e m b)
-> InterceptRC e m b
forall (e :: Effect) (m :: * -> *) a b c.
MonadMask m =>
InterceptRC e m a
-> (a -> ExitCase b -> InterceptRC e m c)
-> (a -> InterceptRC e m b)
-> InterceptRC e m (b, c)
generalBracket :: InterceptRC e m a
-> (a -> ExitCase b -> InterceptRC e m c)
-> (a -> InterceptRC e m b)
-> InterceptRC e m (b, c)
$cgeneralBracket :: forall (e :: Effect) (m :: * -> *) a b c.
MonadMask m =>
InterceptRC e m a
-> (a -> ExitCase b -> InterceptRC e m c)
-> (a -> InterceptRC e m b)
-> InterceptRC e m (b, c)
uninterruptibleMask :: ((forall a. InterceptRC e m a -> InterceptRC e m a)
 -> InterceptRC e m b)
-> InterceptRC e m b
$cuninterruptibleMask :: forall (e :: Effect) (m :: * -> *) b.
MonadMask m =>
((forall a. InterceptRC e m a -> InterceptRC e m a)
 -> InterceptRC e m b)
-> InterceptRC e m b
mask :: ((forall a. InterceptRC e m a -> InterceptRC e m a)
 -> InterceptRC e m b)
-> InterceptRC e m b
$cmask :: forall (e :: Effect) (m :: * -> *) b.
MonadMask m =>
((forall a. InterceptRC e m a -> InterceptRC e m a)
 -> InterceptRC e m b)
-> InterceptRC e m b
$cp1MonadMask :: forall (e :: Effect) (m :: * -> *).
MonadMask m =>
MonadCatch (InterceptRC e m)
MonadMask
           , MonadBase b, MonadBaseControl b
           )

instance MonadTrans (InterceptRC e) where
  lift :: m a -> InterceptRC e m a
lift = ReaderT (ReifiedFOHandler e m) m a -> InterceptRC e m a
forall (e :: Effect) (m :: * -> *) a.
ReaderT (ReifiedFOHandler e m) m a -> InterceptRC e m a
InterceptRC (ReaderT (ReifiedFOHandler e m) m a -> InterceptRC e m a)
-> (m a -> ReaderT (ReifiedFOHandler e m) m a)
-> m a
-> InterceptRC e m a
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. m a -> ReaderT (ReifiedFOHandler e m) m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
  {-# INLINE lift #-}

instance ( FirstOrder e
         , Carrier m
         , Threads (ReaderT (ReifiedFOHandler e m)) (Prims m)
         )
      => Carrier (InterceptRC e m) where
  type Derivs (InterceptRC e m) = Intercept e ': e ': Derivs m
  type Prims  (InterceptRC e m) = Unlift (ReaderT (ReifiedFOHandler e m) m)
                                  ': Prims m

  algPrims :: Algebra' (Prims (InterceptRC e m)) (InterceptRC e m) a
algPrims =
    Algebra' (Prims m) (InterceptRC e m) a
-> (Unlift (ReaderT (ReifiedFOHandler e m) m) (InterceptRC e m) a
    -> InterceptRC e m a)
-> Algebra'
     (Unlift (ReaderT (ReifiedFOHandler e m) m) : Prims m)
     (InterceptRC e m)
     a
forall (e :: Effect) (r :: [Effect]) (m :: * -> *) a.
RepresentationalEff e =>
Algebra' r m a -> (e m a -> m a) -> Algebra' (e : r) m a
powerAlg (
      (Union (Prims m) (ReaderT (ReifiedFOHandler e m) m) a
 -> ReaderT (ReifiedFOHandler e m) m a)
-> Algebra' (Prims m) (InterceptRC e m) a
coerce (Algebra (Prims m) m
-> Algebra (Prims m) (ReaderT (ReifiedFOHandler e m) m)
forall (t :: Effect) (p :: [Effect]) (m :: * -> *).
(Threads t p, Monad m) =>
Algebra p m -> Algebra p (t m)
thread @(ReaderT (ReifiedFOHandler e m)) (Carrier m => Algebra (Prims m) m
forall (m :: * -> *) a. Carrier m => Algebra' (Prims m) m a
algPrims @m))
    ) ((Unlift (ReaderT (ReifiedFOHandler e m) m) (InterceptRC e m) a
  -> InterceptRC e m a)
 -> Algebra'
      (Unlift (ReaderT (ReifiedFOHandler e m) m) : Prims m)
      (InterceptRC e m)
      a)
-> (Unlift (ReaderT (ReifiedFOHandler e m) m) (InterceptRC e m) a
    -> InterceptRC e m a)
-> Algebra'
     (Unlift (ReaderT (ReifiedFOHandler e m) m) : Prims m)
     (InterceptRC e m)
     a
forall a b. (a -> b) -> a -> b
$ \case
      Unlift (forall x. InterceptRC e m x -> ReaderT (ReifiedFOHandler e m) m x)
-> ReaderT (ReifiedFOHandler e m) m a
main -> ReaderT (ReifiedFOHandler e m) m a -> InterceptRC e m a
forall (e :: Effect) (m :: * -> *) a.
ReaderT (ReifiedFOHandler e m) m a -> InterceptRC e m a
InterceptRC ((forall x. InterceptRC e m x -> ReaderT (ReifiedFOHandler e m) m x)
-> ReaderT (ReifiedFOHandler e m) m a
main forall x. InterceptRC e m x -> ReaderT (ReifiedFOHandler e m) m x
forall (e :: Effect) (m :: * -> *) a.
InterceptRC e m a -> ReaderT (ReifiedFOHandler e m) m a
unInterceptRC)
  {-# INLINEABLE algPrims #-}

  reformulate :: Reformulation'
  (Derivs (InterceptRC e m))
  (Prims (InterceptRC e m))
  (InterceptRC e m)
  z
  a
reformulate forall x. InterceptRC e m x -> z x
n Algebra (Prims (InterceptRC e m)) z
alg =
    Algebra' (e : Derivs m) z a
-> (Intercept e z a -> z a)
-> Algebra' (Intercept e : e : Derivs m) z a
forall (e :: Effect) (r :: [Effect]) (m :: * -> *) a.
RepresentationalEff e =>
Algebra' r m a -> (e m a -> m a) -> Algebra' (e : r) m a
powerAlg (
    Algebra' (Derivs m) z a
-> (forall (z :: * -> *). Coercible z z => e z a -> z a)
-> Algebra' (e : Derivs m) z a
forall (e :: Effect) (r :: [Effect]) (m :: * -> *) a.
Algebra' r m a
-> (forall (z :: * -> *). Coercible z m => e z a -> m a)
-> Algebra' (e : r) m a
powerAlg' (
      Reformulation' (Derivs m) (Prims m) m z a
forall (m :: * -> *) (z :: * -> *) a.
(Carrier m, Monad z) =>
Reformulation' (Derivs m) (Prims m) m z a
reformulate (InterceptRC e m x -> z x
forall x. InterceptRC e m x -> z x
n (InterceptRC e m x -> z x)
-> (m x -> InterceptRC e m x) -> m x -> z x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m x -> InterceptRC e m x
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) (Algebra' (Unlift (ReaderT (ReifiedFOHandler e m) m) : Prims m) z x
-> Union (Prims m) z x -> z x
forall (e :: Effect) (r :: [Effect]) (m :: * -> *) a.
Algebra' (e : r) m a -> Algebra' r m a
weakenAlg Algebra' (Unlift (ReaderT (ReifiedFOHandler e m) m) : Prims m) z x
Algebra (Prims (InterceptRC e m)) z
alg)
    ) ((forall (z :: * -> *). Coercible z z => e z a -> z a)
 -> Algebra' (e : Derivs m) z a)
-> (forall (z :: * -> *). Coercible z z => e z a -> z a)
-> Algebra' (e : Derivs m) z a
forall a b. (a -> b) -> a -> b
$ \e z a
e -> do
        ReifiedFOHandler forall (q :: * -> *) x. e q x -> m x
h <- InterceptRC e m (ReifiedFOHandler e m) -> z (ReifiedFOHandler e m)
forall x. InterceptRC e m x -> z x
n (InterceptRC e m (ReifiedFOHandler e m)
 -> z (ReifiedFOHandler e m))
-> InterceptRC e m (ReifiedFOHandler e m)
-> z (ReifiedFOHandler e m)
forall a b. (a -> b) -> a -> b
$ ReaderT (ReifiedFOHandler e m) m (ReifiedFOHandler e m)
-> InterceptRC e m (ReifiedFOHandler e m)
forall (e :: Effect) (m :: * -> *) a.
ReaderT (ReifiedFOHandler e m) m a -> InterceptRC e m a
InterceptRC ReaderT (ReifiedFOHandler e m) m (ReifiedFOHandler e m)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
        InterceptRC e m a -> z a
forall x. InterceptRC e m x -> z x
n (InterceptRC e m a -> z a) -> InterceptRC e m a -> z a
forall a b. (a -> b) -> a -> b
$ m a -> InterceptRC e m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> InterceptRC e m a) -> m a -> InterceptRC e m a
forall a b. (a -> b) -> a -> b
$ e z a -> m a
forall (q :: * -> *) x. e q x -> m x
h e z a
e
    ) ((Intercept e z a -> z a)
 -> Algebra' (Intercept e : e : Derivs m) z a)
-> (Intercept e z a -> z a)
-> Algebra' (Intercept e : e : Derivs m) z a
forall a b. (a -> b) -> a -> b
$ \case
      Intercept forall x. e z x -> z x
h z a
m ->
        (Union (Unlift (ReaderT (ReifiedFOHandler e m) m) : Prims m) z a
-> z a
Algebra (Prims (InterceptRC e m)) z
alg (Union (Unlift (ReaderT (ReifiedFOHandler e m) m) : Prims m) z a
 -> z a)
-> (Unlift (ReaderT (ReifiedFOHandler e m) m) z a
    -> Union (Unlift (ReaderT (ReifiedFOHandler e m) m) : Prims m) z a)
-> Unlift (ReaderT (ReifiedFOHandler e m) m) z a
-> z a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unlift (ReaderT (ReifiedFOHandler e m) m) z a
-> Union (Unlift (ReaderT (ReifiedFOHandler e m) m) : Prims m) z a
forall (e :: Effect) (r :: [Effect]) (m :: * -> *) a.
Member e r =>
e m a -> Union r m a
inj) (Unlift (ReaderT (ReifiedFOHandler e m) m) z a -> z a)
-> Unlift (ReaderT (ReifiedFOHandler e m) m) z a -> z a
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
((forall x. m x -> ReaderT (ReifiedFOHandler e m) m x)
 -> ReaderT (ReifiedFOHandler e m) m a)
-> Unlift (ReaderT (ReifiedFOHandler e m) m) m a
forall (b :: * -> *) (m :: * -> *) a.
((forall x. m x -> b x) -> b a) -> Unlift b m a
Unlift @(ReaderT (ReifiedFOHandler e m) m) (((forall x. z x -> ReaderT (ReifiedFOHandler e m) m x)
  -> ReaderT (ReifiedFOHandler e m) m a)
 -> Unlift (ReaderT (ReifiedFOHandler e m) m) z a)
-> ((forall x. z x -> ReaderT (ReifiedFOHandler e m) m x)
    -> ReaderT (ReifiedFOHandler e m) m a)
-> Unlift (ReaderT (ReifiedFOHandler e m) m) z a
forall a b. (a -> b) -> a -> b
$ \forall x. z x -> ReaderT (ReifiedFOHandler e m) m x
lower ->
          (ReifiedFOHandler e m -> ReifiedFOHandler e m)
-> ReaderT (ReifiedFOHandler e m) m a
-> ReaderT (ReifiedFOHandler e m) m a
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local
            (\ReifiedFOHandler e m
h' -> (forall (q :: * -> *) x. e q x -> m x) -> ReifiedFOHandler e m
forall k k (e :: k -> k -> *) (m :: k -> *).
(forall (q :: k) (x :: k). e q x -> m x) -> ReifiedFOHandler e m
ReifiedFOHandler ((forall (q :: * -> *) x. e q x -> m x) -> ReifiedFOHandler e m)
-> (forall (q :: * -> *) x. e q x -> m x) -> ReifiedFOHandler e m
forall a b. (a -> b) -> a -> b
$ \e q x
e ->
              ReaderT (ReifiedFOHandler e m) m x -> ReifiedFOHandler e m -> m x
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (z x -> ReaderT (ReifiedFOHandler e m) m x
forall x. z x -> ReaderT (ReifiedFOHandler e m) m x
lower (e z x -> z x
forall x. e z x -> z x
h (e q x -> e z x
coerce e q x
e))) ReifiedFOHandler e m
h'
            )
            (z a -> ReaderT (ReifiedFOHandler e m) m a
forall x. z x -> ReaderT (ReifiedFOHandler e m) m x
lower z a
m)
  {-# INLINEABLE reformulate #-}


-- | Run @'Intercept' e@ and @e@ effects, provided
-- @e@ is first-order and part of the effect stack.
--
-- 'runInterceptR' differs from 'runInterceptCont' in four different ways:
--
-- * It doesn't handle 'InterceptCont'.
-- * It has the significantly less restrictive threading constraint
-- 'ReaderThreads' instead of 'SteppedThreads'
-- * It imposes the significantly /more/ restrictive primitive effect 'Unlift'
-- instead of 'Unravel'.
-- * It is significantly faster.
--
-- There are some interpreters -- such as 'Control.Effect.Bracket.bracketToIO' and 'Control.Effect.Conc.concToIO' --
-- that 'runInterceptCont' can't be used together with in any capacity
-- due to its 'SteppedThreads' threading constraint. In
-- these cases, 'runInterceptR' can be used instead.
--
-- @'Derivs' ('InterceptRC' e m) = 'Intercept' e ': e ': 'Derivs m'@
--
-- @'Prims'  ('InterceptRC' e m) = 'Unlift' (ReaderT (ReifiedFOHandler e m)) ': 'Derivs m'@
runInterceptR :: forall e m a p
               . ( FirstOrder e
                 , Member e (Derivs m)
                 , Carrier m
                 , Threaders '[ReaderThreads] m p
                 )
              => InterceptRC e m a
              -> m a
runInterceptR :: InterceptRC e m a -> m a
runInterceptR InterceptRC e m a
m =
  ReaderT (ReifiedFOHandler e m) m a -> ReifiedFOHandler e m -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (InterceptRC e m a -> ReaderT (ReifiedFOHandler e m) m a
forall (e :: Effect) (m :: * -> *) a.
InterceptRC e m a -> ReaderT (ReifiedFOHandler e m) m a
unInterceptRC InterceptRC e m a
m)
             ((forall (q :: * -> *) x. e q x -> m x) -> ReifiedFOHandler e m
forall k k (e :: k -> k -> *) (m :: k -> *).
(forall (q :: k) (x :: k). e q x -> m x) -> ReifiedFOHandler e m
ReifiedFOHandler ((forall (q :: * -> *) x. e q x -> m x) -> ReifiedFOHandler e m)
-> (forall (q :: * -> *) x. e q x -> m x) -> ReifiedFOHandler e m
forall a b. (a -> b) -> a -> b
$ \e q x
e -> e m x -> m x
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send @e (e q x -> e m x
coerce e q x
e))
{-# INLINE runInterceptR #-}