{-# 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,
  MaskResource (MaskResource),
  RestoreMask (Restore),
  UninterruptibleMask,
  UninterruptibleMaskResource (UninterruptibleMaskResource),
  )
import Polysemy.Conc.Interpreter.Scoped (runScoped)

-- |Resource type for the scoped 'Mask' effect, wrapping the @restore@ callback passed in by 'Base.mask'.
newtype Restoration =
  Restoration { Restoration -> forall a. IO a -> IO a
unRestoration :: ∀ a . IO a -> IO a }

mask ::
  Member (Final IO) r =>
  (MaskResource Restoration -> Sem r a) ->
  Sem r a
mask :: forall (r :: [(* -> *) -> * -> *]) a.
Member (Final IO) r =>
(MaskResource Restoration -> Sem r a) -> Sem r a
mask MaskResource 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 (MaskResource Restoration -> Sem r a
f (Restoration -> MaskResource Restoration
forall resource. resource -> MaskResource resource
MaskResource ((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 =>
  (UninterruptibleMaskResource Restoration -> Sem r a) ->
  Sem r a
uninterruptibleMask :: forall (r :: [(* -> *) -> * -> *]) a.
Member (Final IO) r =>
(UninterruptibleMaskResource Restoration -> Sem r a) -> Sem r a
uninterruptibleMask UninterruptibleMaskResource 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 (UninterruptibleMaskResource Restoration -> Sem r a
f (Restoration -> UninterruptibleMaskResource Restoration
forall resource. resource -> UninterruptibleMaskResource resource
UninterruptibleMaskResource ((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 -> do
      let
        restoreSem :: Sem (WithTactics RestoreMask f (Sem rInitial) r) (f x)
-> Sem (WithTactics RestoreMask f (Sem rInitial) r) (f x)
restoreSem Sem (WithTactics RestoreMask f (Sem rInitial) r) (f x)
m =
          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 (WithTactics RestoreMask f (Sem rInitial) r) (f x)
m)
      Sem (WithTactics RestoreMask f (Sem rInitial) r) (f x)
-> Sem (WithTactics RestoreMask f (Sem rInitial) r) (f x)
restoreSem (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' in 'IO'.
interpretMaskFinal ::
  Member (Final IO) r =>
  InterpreterFor (Mask Restoration) r
interpretMaskFinal :: forall (r :: [(* -> *) -> * -> *]).
Member (Final IO) r =>
InterpreterFor (Mask Restoration) r
interpretMaskFinal =
  (forall x. (MaskResource Restoration -> Sem r x) -> Sem r x)
-> (MaskResource Restoration -> InterpreterFor RestoreMask r)
-> InterpreterFor (Mask Restoration) r
forall resource (effect :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]).
(forall x. (resource -> Sem r x) -> Sem r x)
-> (resource -> InterpreterFor effect r)
-> InterpreterFor (Scoped resource effect) r
runScoped forall (r :: [(* -> *) -> * -> *]) a.
Member (Final IO) r =>
(MaskResource Restoration -> Sem r a) -> Sem r a
forall x. (MaskResource Restoration -> Sem r x) -> Sem r x
mask \ (MaskResource Restoration
r) -> Restoration -> InterpreterFor RestoreMask r
forall (r :: [(* -> *) -> * -> *]).
Member (Final IO) r =>
Restoration -> InterpreterFor RestoreMask r
interpretRestoreMask Restoration
r

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