module Control.Effect.Bracket
  ( -- * Effects
    Bracket(..)
  , ExitCase(..)

    -- * Actions
  , generalBracket
  , bracket
  , bracket_
  , bracketOnError
  , onError
  , finally

    -- * Interpretations
  , bracketToIO

  , runBracketLocally

  , ignoreBracket

    -- * Threading utilities
  , threadBracketViaClass

    -- * MonadMask
  , C.MonadMask

    -- * Carriers
  , BracketToIOC
  , BracketLocallyC
  , IgnoreBracketC
  ) where

import Control.Effect
import Control.Effect.Primitive
import Control.Effect.Type.Bracket

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

generalBracket :: Eff Bracket m
               => m a
               -> (a -> ExitCase b -> m c)
               -> (a -> m b)
               -> m (b, c)
generalBracket :: m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket m a
acquire a -> ExitCase b -> m c
release a -> m b
use = Bracket m (b, c) -> m (b, c)
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> Bracket m (b, c)
forall (m :: * -> *) a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> Bracket m (b, c)
GeneralBracket m a
acquire a -> ExitCase b -> m c
release a -> m b
use)
{-# INLINE generalBracket #-}

bracket :: Eff Bracket m
        => m a
        -> (a -> m c)
        -> (a -> m b)
        -> m b
bracket :: m a -> (a -> m c) -> (a -> m b) -> m b
bracket m a
acquire a -> m c
release a -> m b
use = do
  (b
b, c
_) <- m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
Eff Bracket m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket m a
acquire (\a
a ExitCase b
_ -> a -> m c
release a
a) a -> m b
use
  b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
{-# INLINE bracket #-}

bracket_ :: Eff Bracket m
         => m a
         -> m c
         -> m b
         -> m b
bracket_ :: m a -> m c -> m b -> m b
bracket_ m a
acquire m c
release m b
use = m a -> (a -> m c) -> (a -> m b) -> m b
forall (m :: * -> *) a c b.
Eff Bracket m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket m a
acquire (m c -> a -> m c
forall a b. a -> b -> a
const m c
release) (m b -> a -> m b
forall a b. a -> b -> a
const m b
use)
{-# INLINE bracket_ #-}

bracketOnError :: Eff Bracket m
               => m a
               -> (a -> m c)
               -> (a -> m b)
               -> m b
bracketOnError :: m a -> (a -> m c) -> (a -> m b) -> m b
bracketOnError m a
acquire a -> m c
release a -> m b
use = do
  (b
b, ()
_) <- m a -> (a -> ExitCase b -> m ()) -> (a -> m b) -> m (b, ())
forall (m :: * -> *) a b c.
Eff Bracket m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
              m a
acquire
              (\a
a -> \case
                ExitCaseSuccess b
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                ExitCase b
_ -> m c -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m c -> m ()) -> m c -> m ()
forall a b. (a -> b) -> a -> b
$ a -> m c
release a
a
              )
              a -> m b
use
  b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
{-# INLINE bracketOnError #-}

onError :: Eff Bracket m => m a -> m b -> m a
onError :: m a -> m b -> m a
onError m a
m m b
h = m () -> (() -> m b) -> (() -> m a) -> m a
forall (m :: * -> *) a c b.
Eff Bracket m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracketOnError (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (m b -> () -> m b
forall a b. a -> b -> a
const m b
h) (m a -> () -> m a
forall a b. a -> b -> a
const m a
m)
{-# INLINE onError #-}

finally :: Eff Bracket m => m a -> m b -> m a
finally :: m a -> m b -> m a
finally m a
m m b
h = m () -> (() -> m b) -> (() -> m a) -> m a
forall (m :: * -> *) a c b.
Eff Bracket m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (m b -> () -> m b
forall a b. a -> b -> a
const m b
h) (m a -> () -> m a
forall a b. a -> b -> a
const m a
m)
{-# INLINE finally #-}

data BracketToIOH

instance (Carrier m, MonadMask m)
      => PrimHandler BracketToIOH Bracket m where
  effPrimHandler :: Bracket m x -> m x
effPrimHandler (GeneralBracket m a
acquire a -> ExitCase b -> m c
release a -> m b
use) =
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
C.generalBracket m a
acquire a -> ExitCase b -> m c
release a -> m b
use
  {-# INLINEABLE effPrimHandler #-}

type BracketToIOC = InterpretPrimC BracketToIOH Bracket


-- | Run a 'Bracket' by effect that protects against
-- any abortive computation of any effect, as well
-- as any IO exceptions and asynchronous exceptions.
--
-- @'Derivs' ('BracketToIOC' m) = 'Bracket' ': 'Derivs' m@
--
-- @'Prims'  ('BracketToIOC' m) = 'Bracket' ': 'Prims' m@
bracketToIO :: (Carrier m, MonadMask m)
            => BracketToIOC m a
            -> m a
bracketToIO :: BracketToIOC m a -> m a
bracketToIO = BracketToIOC m a -> m a
forall h (e :: Effect) (m :: * -> *) a.
PrimHandler h e m =>
InterpretPrimC h e m a -> m a
interpretPrimViaHandler
{-# INLINE bracketToIO #-}

data BracketLocallyH

instance Carrier m => PrimHandler BracketLocallyH Bracket m where
  effPrimHandler :: Bracket m x -> m x
effPrimHandler (GeneralBracket m a
acquire a -> ExitCase b -> m c
release a -> m b
use) = do
    a
a <- m a
acquire
    b
b <- a -> m b
use a
a
    c
c <- a -> ExitCase b -> m c
release a
a (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
b)
    (b, c) -> m (b, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, c
c)
  {-# INLINEABLE effPrimHandler #-}

type BracketLocallyC = InterpretPrimC BracketLocallyH Bracket

-- | Run a 'Bracket' effect that protects against
-- any abortive computations of purely local effects
-- -- i.e. effects interpreted before 'runBracketLocally'
-- that are not interpreted in terms of the final monad
-- nor other effects interpreted after 'runBracketLocally'.
--
-- This does /not/ protect against IO exceptions of any kind,
-- including asynchronous exceptions.
--
-- This is more situational compared to 'bracketToIO',
-- but can be useful. For an example, see the [wiki](https://github.com/KingoftheHomeless/in-other-words/wiki/Advanced-topics#bracket).
--
-- @'Derivs' ('BracketLocallyC' m) = 'Bracket' ': 'Derivs' m@
--
-- @'Prims'  ('BracketLocallyC' m) = 'Bracket' ': 'Prims' m@
runBracketLocally :: Carrier m
                  => BracketLocallyC m a
                  -> m a
runBracketLocally :: BracketLocallyC m a -> m a
runBracketLocally = BracketLocallyC m a -> m a
forall h (e :: Effect) (m :: * -> *) a.
PrimHandler h e m =>
InterpretPrimC h e m a -> m a
interpretPrimViaHandler
{-# INLINE runBracketLocally #-}


type IgnoreBracketC = InterpretC IgnoreBracketH Bracket

data IgnoreBracketH

instance Carrier m => Handler IgnoreBracketH Bracket m where
  effHandler :: Bracket (Effly z) x -> Effly z x
effHandler (GeneralBracket Effly z a
acquire a -> ExitCase b -> Effly z c
release a -> Effly z b
use) = do
    a
a <- Effly z a
acquire
    b
b <- a -> Effly z b
use a
a
    c
c <- a -> ExitCase b -> Effly z c
release a
a (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
b)
    (b, c) -> Effly z (b, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, c
c)
  {-# INLINEABLE effHandler #-}

-- | Run a 'Bracket' effect by ignoring it, providing no protection at all.
--
-- @'Derivs' ('IgnoreBracketC' m) = 'Bracket' ': 'Derivs' m@
--
-- @'Prims'  ('IgnoreBracketC' m) = 'Prims' m@
ignoreBracket :: Carrier m
              => IgnoreBracketC m a
              -> m a
ignoreBracket :: IgnoreBracketC m a -> m a
ignoreBracket = IgnoreBracketC m a -> m a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
{-# INLINE ignoreBracket #-}