{-# options_haddock prune #-}

-- |Description: Mask Interpreters, Internal
module Polysemy.Conc.Interpreter.Mask where

import qualified Control.Exception as Base
import Polysemy.Final (runS, withStrategicToFinal, withWeavingToFinal)

import Polysemy.Conc.Effect.Mask (
  Mask,
  Restoration (Restoration),
  RestoreMask (Restore),
  UninterruptibleMask,
  )
import Polysemy.Conc.Interpreter.Scoped (interpretScopedH, runScoped)

mask ::
  Member (Final IO) r =>
  (Restoration -> Sem r a) ->
  Sem r a
mask :: forall (r :: [(* -> *) -> * -> *]) a.
Member (Final IO) r =>
(Restoration -> Sem r a) -> Sem r a
mask Restoration -> Sem r a
f =
  forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Final m) r =>
ThroughWeavingToFinal m (Sem r) a -> Sem r a
withWeavingToFinal @IO \ f ()
s forall x. f (Sem r x) -> IO (f x)
lower forall x. f x -> Maybe x
_ ->
    ((forall a. IO a -> IO a) -> IO (f a)) -> IO (f a)
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
Base.mask \ forall a. IO a -> IO a
restore -> f (Sem r a) -> IO (f a)
forall x. f (Sem r x) -> IO (f x)
lower (Restoration -> Sem r a
f ((forall a. IO a -> IO a) -> Restoration
Restoration forall a. IO a -> IO a
restore) Sem r a -> f () -> f (Sem r a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s)

uninterruptibleMask ::
  Member (Final IO) r =>
  (Restoration -> Sem r a) ->
  Sem r a
uninterruptibleMask :: forall (r :: [(* -> *) -> * -> *]) a.
Member (Final IO) r =>
(Restoration -> Sem r a) -> Sem r a
uninterruptibleMask Restoration -> Sem r a
f =
  forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Final m) r =>
ThroughWeavingToFinal m (Sem r) a -> Sem r a
withWeavingToFinal @IO \ f ()
s forall x. f (Sem r x) -> IO (f x)
lower forall x. f x -> Maybe x
_ ->
    ((forall a. IO a -> IO a) -> IO (f a)) -> IO (f a)
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
Base.uninterruptibleMask \ forall a. IO a -> IO a
restore -> f (Sem r a) -> IO (f a)
forall x. f (Sem r x) -> IO (f x)
lower (Restoration -> Sem r a
f ((forall a. IO a -> IO a) -> Restoration
Restoration forall a. IO a -> IO a
restore) Sem r a -> f () -> f (Sem r a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s)

interpretRestoreMask ::
  ∀ r .
  Member (Final IO) r =>
  Restoration ->
  InterpreterFor RestoreMask r
interpretRestoreMask :: forall (r :: [(* -> *) -> * -> *]).
Member (Final IO) r =>
Restoration -> InterpreterFor RestoreMask r
interpretRestoreMask (Restoration forall a. IO a -> IO a
restore) =
  (forall (rInitial :: [(* -> *) -> * -> *]) x.
 RestoreMask (Sem rInitial) x
 -> Tactical RestoreMask (Sem rInitial) r x)
-> Sem (RestoreMask : r) a -> Sem r a
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 \case
    Restore Sem rInitial x
ma ->
      Strategic
  IO (Sem (WithTactics RestoreMask f (Sem rInitial) r)) (f x)
-> Sem (WithTactics RestoreMask f (Sem rInitial) r) (f x)
forall (m :: * -> *) (r :: [(* -> *) -> * -> *]) a.
Member (Final m) r =>
Strategic m (Sem r) a -> Sem r a
withStrategicToFinal (IO (f (f x)) -> IO (f (f x))
forall a. IO a -> IO a
restore (IO (f (f x)) -> IO (f (f x)))
-> Sem
     (WithStrategy
        IO f (Sem (WithTactics RestoreMask f (Sem rInitial) r)))
     (IO (f (f x)))
-> Sem
     (WithStrategy
        IO f (Sem (WithTactics RestoreMask f (Sem rInitial) r)))
     (IO (f (f x)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem (WithTactics RestoreMask f (Sem rInitial) r) (f x)
-> Sem
     (WithStrategy
        IO f (Sem (WithTactics RestoreMask f (Sem rInitial) r)))
     (IO (f (f x)))
forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS (Sem rInitial x -> Tactical RestoreMask (Sem rInitial) r x
forall (m :: * -> *) a (e :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]).
m a -> Tactical e m r a
runTSimple Sem rInitial x
ma))

-- |Interpret 'Mask' by sequencing the action without masking.
interpretMaskPure :: InterpreterFor Mask r
interpretMaskPure :: forall (r :: [(* -> *) -> * -> *]). InterpreterFor Mask r
interpretMaskPure =
  (forall x. () -> (() -> Sem r x) -> Sem r x)
-> (forall (r0 :: [(* -> *) -> * -> *]) x.
    () -> RestoreMask (Sem r0) x -> Tactical RestoreMask (Sem r0) r x)
-> InterpreterFor Mask r
forall resource param (effect :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]).
(forall x. param -> (resource -> Sem r x) -> Sem r x)
-> (forall (r0 :: [(* -> *) -> * -> *]) x.
    resource -> effect (Sem r0) x -> Tactical effect (Sem r0) r x)
-> InterpreterFor (Scoped param effect) r
interpretScopedH (((() -> Sem r x) -> Sem r x) -> () -> (() -> Sem r x) -> Sem r x
forall a b. a -> b -> a
const ((() -> Sem r x) -> () -> Sem r x
forall a b. (a -> b) -> a -> b
$ ())) \ () -> \case
    Restore Sem r0 x
ma -> Sem r0 x -> Tactical RestoreMask (Sem r0) r x
forall (m :: * -> *) a (e :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]).
m a -> Tactical e m r a
runTSimple Sem r0 x
ma

-- |Interpret 'Mask' in 'IO'.
interpretMaskFinal ::
  Member (Final IO) r =>
  InterpreterFor Mask r
interpretMaskFinal :: forall (r :: [(* -> *) -> * -> *]).
Member (Final IO) r =>
InterpreterFor Mask r
interpretMaskFinal =
  (forall x. () -> (Restoration -> Sem r x) -> Sem r x)
-> (Restoration -> InterpreterFor RestoreMask r)
-> InterpreterFor Mask r
forall resource param (effect :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]).
(forall x. param -> (resource -> Sem r x) -> Sem r x)
-> (resource -> InterpreterFor effect r)
-> InterpreterFor (Scoped param effect) r
runScoped (((Restoration -> Sem r x) -> Sem r x)
-> () -> (Restoration -> Sem r x) -> Sem r x
forall a b. a -> b -> a
const (Restoration -> Sem r x) -> Sem r x
forall (r :: [(* -> *) -> * -> *]) a.
Member (Final IO) r =>
(Restoration -> Sem r a) -> Sem r a
mask) \ Restoration
r -> Restoration -> InterpreterFor RestoreMask r
forall (r :: [(* -> *) -> * -> *]).
Member (Final IO) r =>
Restoration -> InterpreterFor RestoreMask r
interpretRestoreMask Restoration
r

-- |Interpret 'UninterruptibleMask' by sequencing the action without masking.
interpretUninterruptibleMaskPure :: InterpreterFor UninterruptibleMask r
interpretUninterruptibleMaskPure :: forall (r :: [(* -> *) -> * -> *]). InterpreterFor Mask r
interpretUninterruptibleMaskPure =
  (forall x. () -> (() -> Sem r x) -> Sem r x)
-> (forall (r0 :: [(* -> *) -> * -> *]) x.
    () -> RestoreMask (Sem r0) x -> Tactical RestoreMask (Sem r0) r x)
-> InterpreterFor Mask r
forall resource param (effect :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]).
(forall x. param -> (resource -> Sem r x) -> Sem r x)
-> (forall (r0 :: [(* -> *) -> * -> *]) x.
    resource -> effect (Sem r0) x -> Tactical effect (Sem r0) r x)
-> InterpreterFor (Scoped param effect) r
interpretScopedH (((() -> Sem r x) -> Sem r x) -> () -> (() -> Sem r x) -> Sem r x
forall a b. a -> b -> a
const ((() -> Sem r x) -> () -> Sem r x
forall a b. (a -> b) -> a -> b
$ ())) \ () -> \case
    Restore Sem r0 x
ma -> Sem r0 x -> Tactical RestoreMask (Sem r0) r x
forall (m :: * -> *) a (e :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]).
m a -> Tactical e m r a
runTSimple Sem r0 x
ma

-- |Interpret 'UninterruptibleMask' in 'IO'.
interpretUninterruptibleMaskFinal ::
  Member (Final IO) r =>
  InterpreterFor UninterruptibleMask r
interpretUninterruptibleMaskFinal :: forall (r :: [(* -> *) -> * -> *]).
Member (Final IO) r =>
InterpreterFor Mask r
interpretUninterruptibleMaskFinal =
  (forall x. () -> (Restoration -> Sem r x) -> Sem r x)
-> (Restoration -> InterpreterFor RestoreMask r)
-> InterpreterFor Mask r
forall resource param (effect :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]).
(forall x. param -> (resource -> Sem r x) -> Sem r x)
-> (resource -> InterpreterFor effect r)
-> InterpreterFor (Scoped param effect) r
runScoped (((Restoration -> Sem r x) -> Sem r x)
-> () -> (Restoration -> Sem r x) -> Sem r x
forall a b. a -> b -> a
const (Restoration -> Sem r x) -> Sem r x
forall (r :: [(* -> *) -> * -> *]) a.
Member (Final IO) r =>
(Restoration -> Sem r a) -> Sem r a
uninterruptibleMask) \ Restoration
r -> Restoration -> InterpreterFor RestoreMask r
forall (r :: [(* -> *) -> * -> *]).
Member (Final IO) r =>
Restoration -> InterpreterFor RestoreMask r
interpretRestoreMask Restoration
r