module Control.Effect.Mask
  ( -- * Effects
    Mask(..)
  , MaskMode(..)

    -- * Actions
  , mask
  , mask_
  , uninterruptibleMask
  , uninterruptibleMask_

    -- * Interpretations
  , maskToIO

  , ignoreMask

    -- * Threading utilities
  , threadMaskViaClass

    -- * MonadMask
  , C.MonadMask

    -- * Carriers
  , MaskToIOC
  , IgnoreMaskC
  ) where

import Control.Effect
import Control.Effect.Primitive
import Control.Effect.Type.Mask

import Control.Monad.Catch (MonadMask)
import qualified Control.Monad.Catch as C

mask :: Eff Mask m => ((forall x. m x -> m x) -> m a) -> m a
mask :: ((forall x. m x -> m x) -> m a) -> m a
mask (forall x. m x -> m x) -> m a
main = Mask m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (MaskMode -> ((forall x. m x -> m x) -> m a) -> Mask m a
forall (m :: * -> *) a.
MaskMode -> ((forall x. m x -> m x) -> m a) -> Mask m a
Mask MaskMode
InterruptibleMask (forall x. m x -> m x) -> m a
main)
{-# INLINE mask #-}

mask_ :: Eff Mask m => m a -> m a
mask_ :: m a -> m a
mask_ m a
main = ((forall x. m x -> m x) -> m a) -> m a
forall (m :: * -> *) a.
Eff Mask m =>
((forall x. m x -> m x) -> m a) -> m a
mask (((forall x. m x -> m x) -> m a) -> m a)
-> ((forall x. m x -> m x) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> m x
_ -> m a
main
{-# INLINE mask_ #-}

uninterruptibleMask :: Eff Mask m => ((forall x. m x -> m x) -> m a) -> m a
uninterruptibleMask :: ((forall x. m x -> m x) -> m a) -> m a
uninterruptibleMask (forall x. m x -> m x) -> m a
main = Mask m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (MaskMode -> ((forall x. m x -> m x) -> m a) -> Mask m a
forall (m :: * -> *) a.
MaskMode -> ((forall x. m x -> m x) -> m a) -> Mask m a
Mask MaskMode
UninterruptibleMask (forall x. m x -> m x) -> m a
main)
{-# INLINE uninterruptibleMask #-}

uninterruptibleMask_ :: Eff Mask m => m a -> m a
uninterruptibleMask_ :: m a -> m a
uninterruptibleMask_ m a
main = ((forall x. m x -> m x) -> m a) -> m a
forall (m :: * -> *) a.
Eff Mask m =>
((forall x. m x -> m x) -> m a) -> m a
uninterruptibleMask (((forall x. m x -> m x) -> m a) -> m a)
-> ((forall x. m x -> m x) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> m x
_ -> m a
main
{-# INLINE uninterruptibleMask_ #-}

data MaskToIOH

instance ( Carrier m
         , MonadMask m
         )
      => PrimHandler MaskToIOH Mask m where
  effPrimHandler :: Mask m x -> m x
effPrimHandler (Mask MaskMode
InterruptibleMask (forall x. m x -> m x) -> m x
main)   = ((forall x. m x -> m x) -> m x) -> m x
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
C.mask (forall x. m x -> m x) -> m x
main
  effPrimHandler (Mask MaskMode
UninterruptibleMask (forall x. m x -> m x) -> m x
main) = ((forall x. m x -> m x) -> m x) -> m x
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
C.uninterruptibleMask (forall x. m x -> m x) -> m x
main
  {-# INLINEABLE effPrimHandler #-}

type MaskToIOC = InterpretPrimC MaskToIOH Mask

-- | Run a 'Mask' effect by making use of the 'IO'-based 'Control.Exception.mask' and
-- 'Control.Exception.uninterruptibleMask'.
--
-- @'Derivs' ('MaskToIOC' m) = 'Mask' ': 'Derivs' m@
--
-- @'Prims'  ('MaskToIOC' m) = 'Mask' ': 'Prims' m@
maskToIO :: ( Carrier m
            , MonadMask m
            )
         => MaskToIOC m a
         -> m a
maskToIO :: MaskToIOC m a -> m a
maskToIO = MaskToIOC m a -> m a
forall h (e :: Effect) (m :: * -> *) a.
PrimHandler h e m =>
InterpretPrimC h e m a -> m a
interpretPrimViaHandler
{-# INLINE maskToIO #-}

data IgnoreMaskH

instance Carrier m
      => Handler IgnoreMaskH Mask m where
  effHandler :: Mask (Effly z) x -> Effly z x
effHandler (Mask MaskMode
_ (forall x. Effly z x -> Effly z x) -> Effly z x
main) = (forall x. Effly z x -> Effly z x) -> Effly z x
main forall a. a -> a
forall x. Effly z x -> Effly z x
id
  {-# INLINEABLE effHandler #-}

type IgnoreMaskC = InterpretC IgnoreMaskH Mask

-- | Run a 'Mask' effect by ignoring it, providing no protection
-- against asynchronous exceptions.
--
-- @'Derivs' ('IgnoreMaskC' m) = 'Mask' ': 'Derivs' m@
--
-- @'Prims'  ('IgnoreMaskC' m) = 'Prims' m@
ignoreMask :: Carrier m
           => IgnoreMaskC m a
           -> m a
ignoreMask :: IgnoreMaskC m a -> m a
ignoreMask = IgnoreMaskC m a -> m a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
{-# INLINE ignoreMask #-}