content: {-# LANGUAGE Trustworthy #-}
  -- |
  -- Copyright: (c) 2021 Xy Ren
  -- License: BSD3
  -- Maintainer: xy.r@outlook.com
  -- Stability: experimental
  -- Portability: non-portable (GHC only)
  module Cleff.Mask
    ( -- * Effect
      Mask (..)
      -- * High-level operations
    , bracket
    , bracketOnError
    , bracket_
    , bracketOnError_
    , onError
    , finally
      -- * Primitive operations
    , mask
    , uninterruptibleMask
    , onException
    , mask_
    , uninterruptibleMask_
      -- * Interpretations
    , runMask
    ) where
  
  import           Cleff
  import           Cleff.Internal.Base
  import qualified Control.Exception   as Exc
  
  -- * Effect
  
  -- | An effect capable of 'Exc.mask'ing and performing cleanup operations when an computation is interrupted. In
  -- particular, this effects allows the use of 'bracket'.
  --
  -- === Technical details
  --
  -- Regarding the nuances of 'bracket' semantics, this effect uses the semantics of "UnliftIO.Exception" rather than
  -- "Control.Exception". They are more sensible defaults and users can implement other semantics out of the primitive
  -- operations if they want to.
  data Mask :: Effect where
    Mask :: ((m ~> m) -> m a) -> Mask m a
    UninterruptibleMask :: ((m ~> m) -> m a) -> Mask m a
    OnException :: m a -> m b -> Mask m a
  
  -- * Operations
  
  makeEffect_ ''Mask
  
  -- | Prevents a computation from receiving asynchronous exceptions, /i.e./ being interrupted by another thread. Also
  -- provides a function to restore receiving async exceptions for a computation.
  --
  -- However, some potentially blocking actions like @takeMVar@ can still be interrupted, and for them also not to be
  -- interrupted in any case you'll need 'uninterruptibleMask'. See 'Control.Exception.mask' for details.
  mask :: Mask :> es => ((Eff es ~> Eff es) -> Eff es a) -> Eff es a
  
  -- | Prevents a computation from receiving asynchronous exceptions, even if there is an interruptible operation
  -- (operations that potentially deadlocks or otherwise blocks indefinitely). Therefore this function is potentially
  -- dangerous in the sense that it can make a thread both unresponsive and unkillable. See
  -- 'Control.Exception.uninterruptibleMask' for details.
  uninterruptibleMask :: Mask :> es => ((Eff es ~> Eff es) -> Eff es a) -> Eff es a
  
  -- | Like 'onError', but without 'uninterruptibleMask'ing the cleanup action, making it possible that a cleanup action
  -- is interrupted. Use 'onError' is usually the safer option.
  onException :: Mask :> es
    => Eff es a -- ^ The main computation that may throw an exception
    -> Eff es b -- ^ The computation that runs when an exception is thrown
    -> Eff es a
  
  -- | Run a computation that acquires a resource (@alloc@), then a main computation using that resource, then a cleanup
  -- computation (@dealloc@). 'bracket' guarantees that @alloc@ and @dealloc@ will always run, regardless of whether an
  -- exception is thrown in the main computation. Note that if an exception is thrown in the main computation, it will
  -- be rethrown after 'bracket' finishes.
  --
  -- === Technical details
  --
  -- Note that this function uses @unliftio@ semantics: resource acquiring action is interruptibly 'mask'ed while
  -- resource cleanup is 'uninterruptibleMask'ed. Most of the times, this will be what you want. Other functions in this
  -- module use @unliftio@ semantics too.
  bracket :: Mask :> es
    => Eff es a -- ^ The computation to run first, usually acquires a resource
    -> (a -> Eff es c) -- ^ The computation to run after the main computation, usually cleans up
    -> (a -> Eff es b) -- ^ The main computation that uses the resource
    -> Eff es b
  bracket alloc dealloc action = mask \restore -> do
    res <- alloc
    restore (action res) `finally` dealloc res
  
  -- | Like 'bracket', but only runs cleanup if an exception is thrown in the main computation.
  bracketOnError :: Mask :> es
    => Eff es a -- ^ The computation to run first, usually acquires a resource
    -> (a -> Eff es c) -- ^ The computation to run when the main computation throws an exception, usually cleans up
    -> (a -> Eff es b) -- ^ The main computation that uses the resource
    -> Eff es b
  bracketOnError alloc dealloc action = mask \restore -> do
    res <- alloc
    restore (action res) `onError` dealloc res
  
  -- | Variant of 'mask' that does not provide a restoring function.
  mask_ :: Mask :> es => Eff es a -> Eff es a
  mask_ m = mask \_ -> m
  
  -- | Variant of 'uninterruptibleMask' that does not provide a restoring function.
  uninterruptibleMask_ :: Mask :> es => Eff es a -> Eff es a
  uninterruptibleMask_ m = uninterruptibleMask \_ -> m
  
  -- | Variant of 'bracket' that does not pass the allocated resource to the cleanup action.
  bracket_ :: Mask :> es => Eff es a -> Eff es c -> (a -> Eff es b) -> Eff es b
  bracket_ ma = bracket ma . const
  
  -- | Variant of 'bracketOnError' that does not pass the allocated resource to the cleanup action.
  bracketOnError_ :: Mask :> es => Eff es a -> Eff es c -> (a -> Eff es b) -> Eff es b
  bracketOnError_ ma = bracketOnError ma . const
  
  -- | Attach an action that runs if the main computation throws an exception. Note that this will rethrow the exception
  -- instead of returning to normal control flow.
  --
  -- The cleanup action is guaranteed not to be interrupted halfways.
  onError :: Mask :> es
    => Eff es a -- ^ The main computation that may throw an exception
    -> Eff es b -- ^ The computation that runs when an exception is thrown
    -> Eff es a
  onError m n = m `onException` uninterruptibleMask_ n
  
  -- | Attach a cleanup action that will always run after a potentially throwing computation.
  finally :: Mask :> es
    => Eff es a -- ^ The main computation that may throw an exception
    -> Eff es b -- ^ The computation that runs after the main computation, regardless of whether an exception is thrown
    -> Eff es a
  finally m mz = (m `onError` mz) <* uninterruptibleMask_ mz
  
  -- * Interpretations
  
  -- | Interpret the 'Mask' effect in terms of primitive 'IO' actions.
  runMask :: Eff (Mask : es) ~> Eff es
  runMask = thisIsPureTrustMe . reinterpret \case
    Mask f -> withToIO \toIO -> Exc.mask \restore -> toIO $ f (fromIO . restore . toIO)
    UninterruptibleMask f -> withToIO \toIO -> Exc.uninterruptibleMask \restore -> toIO $ f (fromIO . restore . toIO)
    OnException m n -> withToIO \toIO -> toIO m `Exc.catch` \(e :: Exc.SomeException) ->
      Exc.try @Exc.SomeException (toIO n) *> Exc.throwIO e
  