{-# LANGUAGE TemplateHaskell #-}

-- | Description: The 'Resource' effect, providing bracketing functionality
module Polysemy.Resource
  ( -- * Effect
    Resource (..)

    -- * Actions
  , bracket
  , bracket_
  , bracketOnError
  , finally
  , onException

    -- * Interpretations
  , runResource
  , resourceToIOFinal
  ) where

import qualified Control.Exception as X
import           Polysemy
import           Polysemy.Final


------------------------------------------------------------------------------
-- | An effect capable of providing 'X.bracket' semantics. Interpreters for this
-- will successfully run the deallocation action even in the presence of other
-- short-circuiting effects.
data Resource m a where
  -- | Allocate a resource, use it, and clean it up afterwards.
  Bracket
    :: m a
       -- Action to allocate a resource.
    -> (a -> m c)
       -- Action to cleanup the resource. This is guaranteed to be
       -- called.
    -> (a -> m b)
       -- Action which uses the resource.
    -> Resource m b
  -- | Allocate a resource, use it, and clean it up afterwards if an error occurred.
  BracketOnError
    :: m a
       -- Action to allocate a resource.
    -> (a -> m c)
       -- Action to cleanup the resource. This will only be called if the
       -- "use" block fails.
    -> (a -> m b)
       -- Action which uses the resource.
    -> Resource m b

makeSem ''Resource

------------------------------------------------------------------------------
-- | A variant of 'bracket' where the return value from the first computation
-- is not required.
--
-- cf. 'Control.Exception.bracket' and 'Control.Exception.bracket_'
--
-- @since 1.5.0.0
bracket_
    :: Member Resource r
    => Sem r a -- ^ computation to run first
    -> Sem r b -- ^ computation to run last (even if an exception was raised)
    -> Sem r c -- ^ computation to run in-between
    -> Sem r c
bracket_ :: forall (r :: EffectRow) a b c.
Member Resource r =>
Sem r a -> Sem r b -> Sem r c -> Sem r c
bracket_ Sem r a
begin Sem r b
end Sem r c
act = forall (r :: EffectRow) a c b.
Member Resource r =>
Sem r a -> (a -> Sem r c) -> (a -> Sem r b) -> Sem r b
bracket Sem r a
begin (forall a b. a -> b -> a
const Sem r b
end) (forall a b. a -> b -> a
const Sem r c
act)

------------------------------------------------------------------------------
-- | Like 'bracket', but for the simple case of one computation to run
-- afterward.
--
-- @since 0.4.0.0
finally
    :: Member Resource r
    => Sem r a -- ^ computation to run first
    -> Sem r b -- ^ computation to run afterward (even if an exception was raised)
    -> Sem r a
finally :: forall (r :: EffectRow) a b.
Member Resource r =>
Sem r a -> Sem r b -> Sem r a
finally Sem r a
act Sem r b
end = forall (r :: EffectRow) a c b.
Member Resource r =>
Sem r a -> (a -> Sem r c) -> (a -> Sem r b) -> Sem r b
bracket (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (forall a b. a -> b -> a
const Sem r b
end) (forall a b. a -> b -> a
const Sem r a
act)


------------------------------------------------------------------------------
-- | Like 'bracketOnError', but for the simple case of one computation to run
-- afterward.
--
-- @since 0.4.0.0
onException
    :: Member Resource r
    => Sem r a -- ^ computation to run first
    -> Sem r b -- ^ computation to run afterward if an exception was raised
    -> Sem r a
onException :: forall (r :: EffectRow) a b.
Member Resource r =>
Sem r a -> Sem r b -> Sem r a
onException Sem r a
act Sem r b
end = forall (r :: EffectRow) a c b.
Member Resource r =>
Sem r a -> (a -> Sem r c) -> (a -> Sem r b) -> Sem r b
bracketOnError (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (forall a b. a -> b -> a
const Sem r b
end) (forall a b. a -> b -> a
const Sem r a
act)

------------------------------------------------------------------------------
-- | Run a 'Resource' effect in terms of 'X.bracket' through final 'IO'
--
-- /Beware/: Effects that aren't interpreted in terms of 'IO'
-- will have local state semantics in regards to 'Resource' effects
-- interpreted this way. See 'Final'.
--
-- @since 1.2.0.0
resourceToIOFinal :: Member (Final IO) r
                  => Sem (Resource ': r) a
                  -> Sem r a
resourceToIOFinal :: forall (r :: EffectRow) a.
Member (Final IO) r =>
Sem (Resource : r) a -> Sem r a
resourceToIOFinal = forall (m :: * -> *) (e :: Effect) (r :: EffectRow) a.
Member (Final m) r =>
(forall x (rInitial :: EffectRow).
 e (Sem rInitial) x -> Strategic m (Sem rInitial) x)
-> Sem (e : r) a -> Sem r a
interpretFinal forall a b. (a -> b) -> a -> b
$ \case
  Bracket Sem rInitial a
alloc a -> Sem rInitial c
dealloc a -> Sem rInitial x
use -> do
    IO (f a)
a <- forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS  Sem rInitial a
alloc
    f a -> IO (f c)
d <- forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS a -> Sem rInitial c
dealloc
    f a -> IO (f x)
u <- forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS a -> Sem rInitial x
use
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
X.bracket IO (f a)
a f a -> IO (f c)
d f a -> IO (f x)
u

  BracketOnError Sem rInitial a
alloc a -> Sem rInitial c
dealloc a -> Sem rInitial x
use -> do
    Inspector f
ins <- forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (Inspector f)
getInspectorS
    IO (f a)
a <- forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS  Sem rInitial a
alloc
    f a -> IO (f c)
d <- forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS a -> Sem rInitial c
dealloc
    f a -> IO (f x)
u <- forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS a -> Sem rInitial x
use
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
X.bracketOnError
        IO (f a)
a
        f a -> IO (f c)
d
        (\f a
x -> do
          f x
result <- f a -> IO (f x)
u f a
x
          case forall (f :: * -> *). Inspector f -> forall x. f x -> Maybe x
inspect Inspector f
ins f x
result of
            Just x
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure f x
result
            Maybe x
Nothing -> do
              f c
_ <- f a -> IO (f c)
d f a
x
              forall (f :: * -> *) a. Applicative f => a -> f a
pure f x
result
        )

{-# INLINE resourceToIOFinal #-}


------------------------------------------------------------------------------
-- | Run a 'Resource' effect purely.
--
-- @since 1.0.0.0
runResource
    :: ∀ r a
     . Sem (Resource ': r) a
    -> Sem r a
runResource :: forall (r :: EffectRow) a. Sem (Resource : r) a -> Sem r a
runResource = forall (e :: Effect) (r :: EffectRow) a.
(forall (rInitial :: EffectRow) x.
 e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem (e : r) a -> Sem r a
interpretH forall a b. (a -> b) -> a -> b
$ \case
  Bracket Sem rInitial a
alloc a -> Sem rInitial c
dealloc a -> Sem rInitial x
use -> do
    Sem (Resource : r) (f a)
a <- forall (m :: * -> *) a (e :: Effect) (f :: * -> *)
       (r :: EffectRow).
m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a))
runT  Sem rInitial a
alloc
    f a -> Sem (Resource : r) (f c)
d <- forall a (m :: * -> *) b (e :: Effect) (f :: * -> *)
       (r :: EffectRow).
(a -> m b) -> Sem (WithTactics e f m r) (f a -> Sem (e : r) (f b))
bindT a -> Sem rInitial c
dealloc
    f a -> Sem (Resource : r) (f x)
u <- forall a (m :: * -> *) b (e :: Effect) (f :: * -> *)
       (r :: EffectRow).
(a -> m b) -> Sem (WithTactics e f m r) (f a -> Sem (e : r) (f b))
bindT a -> Sem rInitial x
use

    let run_it :: Sem (Resource : r) a -> Sem (e : r) a
run_it = forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: EffectRow) a. Sem (Resource : r) a -> Sem r a
runResource
    f a
resource <- forall {r :: EffectRow} {a} {e :: Effect}.
Sem (Resource : r) a -> Sem (e : r) a
run_it Sem (Resource : r) (f a)
a
    f x
result <- forall {r :: EffectRow} {a} {e :: Effect}.
Sem (Resource : r) a -> Sem (e : r) a
run_it forall a b. (a -> b) -> a -> b
$ f a -> Sem (Resource : r) (f x)
u f a
resource
    f c
_ <- forall {r :: EffectRow} {a} {e :: Effect}.
Sem (Resource : r) a -> Sem (e : r) a
run_it forall a b. (a -> b) -> a -> b
$ f a -> Sem (Resource : r) (f c)
d f a
resource
    forall (f :: * -> *) a. Applicative f => a -> f a
pure f x
result

  BracketOnError Sem rInitial a
alloc a -> Sem rInitial c
dealloc a -> Sem rInitial x
use -> do
    Sem (Resource : r) (f a)
a <- forall (m :: * -> *) a (e :: Effect) (f :: * -> *)
       (r :: EffectRow).
m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a))
runT  Sem rInitial a
alloc
    f a -> Sem (Resource : r) (f c)
d <- forall a (m :: * -> *) b (e :: Effect) (f :: * -> *)
       (r :: EffectRow).
(a -> m b) -> Sem (WithTactics e f m r) (f a -> Sem (e : r) (f b))
bindT a -> Sem rInitial c
dealloc
    f a -> Sem (Resource : r) (f x)
u <- forall a (m :: * -> *) b (e :: Effect) (f :: * -> *)
       (r :: EffectRow).
(a -> m b) -> Sem (WithTactics e f m r) (f a -> Sem (e : r) (f b))
bindT a -> Sem rInitial x
use

    let run_it :: Sem (Resource : r) a -> Sem (e : r) a
run_it = forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: EffectRow) a. Sem (Resource : r) a -> Sem r a
runResource

    f a
resource <- forall {r :: EffectRow} {a} {e :: Effect}.
Sem (Resource : r) a -> Sem (e : r) a
run_it Sem (Resource : r) (f a)
a
    f x
result <- forall {r :: EffectRow} {a} {e :: Effect}.
Sem (Resource : r) a -> Sem (e : r) a
run_it forall a b. (a -> b) -> a -> b
$ f a -> Sem (Resource : r) (f x)
u f a
resource

    Inspector f
ins <- forall (e :: Effect) (f :: * -> *) (m :: * -> *) (r :: EffectRow).
Sem (WithTactics e f m r) (Inspector f)
getInspectorT
    case forall (f :: * -> *). Inspector f -> forall x. f x -> Maybe x
inspect Inspector f
ins f x
result of
      Just x
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure f x
result
      Maybe x
Nothing -> do
        f c
_ <- forall {r :: EffectRow} {a} {e :: Effect}.
Sem (Resource : r) a -> Sem (e : r) a
run_it forall a b. (a -> b) -> a -> b
$ f a -> Sem (Resource : r) (f c)
d f a
resource
        forall (f :: * -> *) a. Applicative f => a -> f a
pure f x
result
{-# INLINE runResource #-}