{-# LANGUAGE TemplateHaskell #-}
-----------------------------------------------------------------------------

-- |

-- Module      :  Control.Effect.Resource

-- Copyright   :  (c) Michael Szvetits, 2020

-- License     :  BSD3 (see the file LICENSE)

-- Maintainer  :  typedbyte@qualified.name

-- Stability   :  stable

-- Portability :  portable

--

-- The resource effect allows a computation to allocate resources which are

-- guaranteed to be released after their usage.

-----------------------------------------------------------------------------

module Control.Effect.Resource
  ( -- * Tagged Resource Effect

    Resource'(..)
    -- * Untagged Resource Effect

    -- | If you don't require disambiguation of multiple resource effects

    -- (i.e., you only have one resource effect in your monadic context),

    -- it is recommended to always use the untagged resource effect.

  , Resource
  , bracket
  , bracketOnError
    -- * Convenience Functions

    -- | If you don't require disambiguation of multiple resource effects

    -- (i.e., you only have one resource effect in your monadic context),

    -- it is recommended to always use the untagged functions.

  , finally'
  , finally
  , onException'
  , onException
    -- * Interpretations

  , LowerIO
  , runResourceIO'
  , runResourceIO
    -- * Tagging and Untagging

    -- | Conversion functions between the tagged and untagged resource effect,

    -- usually used in combination with type applications, like:

    --

    -- @

    --     'tagResource'' \@\"newTag\" program

    --     'retagResource'' \@\"oldTag\" \@\"newTag\" program

    --     'untagResource'' \@\"erasedTag\" program

    -- @

    -- 

  , tagResource'
  , retagResource'
  , untagResource'
  ) where

-- base

import qualified Control.Exception as IO
import Data.Coerce (coerce)

import Control.Effect.Machinery

-- | An effect that allows a computation to allocate resources which are

-- guaranteed to be released after their usage.

class Monad m => Resource' tag m where
  -- | Acquire a resource, use it, and then release the resource after usage.

  bracket' :: m a        -- ^ The computation which acquires the resource.

           -> (a -> m c) -- ^ The computation which releases the resource.

           -> (a -> m b) -- ^ The computation which uses the resource.

           -> m b        -- ^ The result of the computation which used the resource.


  -- | Like 'bracket'', but only performs the release computation if the usage

  -- computation throws an exception.

  bracketOnError' :: m a        -- ^ The computation which acquires the resource.

                  -> (a -> m c) -- ^ The computation which releases the resource.

                  -> (a -> m b) -- ^ The computation which uses the resource.

                  -> m b        -- ^ The result of the computation which used the resource.


makeTaggedEffect ''Resource'

-- | A simpler version of 'bracket'' where one computation is guaranteed to

-- run after another.

finally' :: forall tag m a b. Resource' tag m
         => m a -- ^ The computation to run.

         -> m b -- ^ The computation to run afterwards, even if the first

                --   computation throws an exception.

         -> m a -- ^ The result of the first computation.

finally' :: m a -> m b -> m a
finally' use :: m a
use free :: m b
free =
  m () -> (() -> m b) -> (() -> m a) -> m a
forall k (tag :: k) (m :: SomeMonad) a c b.
Resource' tag m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket' @tag (() -> m ()
forall (f :: SomeMonad) a. Applicative f => a -> f a
pure ()) (m b -> () -> m b
forall (f :: SomeMonad) a. Applicative f => a -> f a
pure m b
free) (m a -> () -> m a
forall a b. a -> b -> a
const m a
use)
{-# INLINE finally' #-}

-- | The untagged version of 'finally''.

finally :: Resource m => m a -> m b -> m a
finally :: m a -> m b -> m a
finally = forall k (tag :: k) (m :: SomeMonad) a b.
Resource' tag m =>
m a -> m b -> m a
forall (m :: SomeMonad) a b. Resource' G m => m a -> m b -> m a
finally' @G
{-# INLINE finally #-}

-- | A simpler version of 'bracketOnError'' where one computation is guaranteed

-- to run after another in case the first computation throws an exception.

onException' :: forall tag m a b. Resource' tag m
             => m a -- ^ The computation to run.

             -> m b -- ^ The computation to run afterwards, only if the first

                    --   computation throws an exception.

             -> m a -- ^ The result of the first computation.

onException' :: m a -> m b -> m a
onException' use :: m a
use free :: m b
free =
  m () -> (() -> m b) -> (() -> m a) -> m a
forall k (tag :: k) (m :: SomeMonad) a c b.
Resource' tag m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracketOnError' @tag (() -> m ()
forall (f :: SomeMonad) a. Applicative f => a -> f a
pure ()) (m b -> () -> m b
forall a b. a -> b -> a
const m b
free) (m a -> () -> m a
forall a b. a -> b -> a
const m a
use)
{-# INLINE onException' #-}

-- | The untagged version of 'onException''.

onException :: Resource m => m a -> m b -> m a
onException :: m a -> m b -> m a
onException = forall k (tag :: k) (m :: SomeMonad) a b.
Resource' tag m =>
m a -> m b -> m a
forall (m :: SomeMonad) a b. Resource' G m => m a -> m b -> m a
onException' @G
{-# INLINE onException #-}

-- | The IO-based interpreter of the resource effect. This type implements the

-- 'Resource'' type class by using 'IO.bracket', thus requiring 'IO' at the bottom

-- of the monad transformer stack.

--

-- When interpreting the effect, you usually don\'t interact with this type directly,

-- but instead use one of its corresponding interpretation functions.

newtype LowerIO m a =
  LowerIO { LowerIO m a -> m a
_runLowerIO :: m a }
    deriving (Functor (LowerIO m)
a -> LowerIO m a
Functor (LowerIO m) =>
(forall a. a -> LowerIO m a)
-> (forall a b. LowerIO m (a -> b) -> LowerIO m a -> LowerIO m b)
-> (forall a b c.
    (a -> b -> c) -> LowerIO m a -> LowerIO m b -> LowerIO m c)
-> (forall a b. LowerIO m a -> LowerIO m b -> LowerIO m b)
-> (forall a b. LowerIO m a -> LowerIO m b -> LowerIO m a)
-> Applicative (LowerIO m)
LowerIO m a -> LowerIO m b -> LowerIO m b
LowerIO m a -> LowerIO m b -> LowerIO m a
LowerIO m (a -> b) -> LowerIO m a -> LowerIO m b
(a -> b -> c) -> LowerIO m a -> LowerIO m b -> LowerIO m c
forall a. a -> LowerIO m a
forall a b. LowerIO m a -> LowerIO m b -> LowerIO m a
forall a b. LowerIO m a -> LowerIO m b -> LowerIO m b
forall a b. LowerIO m (a -> b) -> LowerIO m a -> LowerIO m b
forall a b c.
(a -> b -> c) -> LowerIO m a -> LowerIO m b -> LowerIO m c
forall (f :: SomeMonad).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: SomeMonad). Applicative m => Functor (LowerIO m)
forall (m :: SomeMonad) a. Applicative m => a -> LowerIO m a
forall (m :: SomeMonad) a b.
Applicative m =>
LowerIO m a -> LowerIO m b -> LowerIO m a
forall (m :: SomeMonad) a b.
Applicative m =>
LowerIO m a -> LowerIO m b -> LowerIO m b
forall (m :: SomeMonad) a b.
Applicative m =>
LowerIO m (a -> b) -> LowerIO m a -> LowerIO m b
forall (m :: SomeMonad) a b c.
Applicative m =>
(a -> b -> c) -> LowerIO m a -> LowerIO m b -> LowerIO m c
<* :: LowerIO m a -> LowerIO m b -> LowerIO m a
$c<* :: forall (m :: SomeMonad) a b.
Applicative m =>
LowerIO m a -> LowerIO m b -> LowerIO m a
*> :: LowerIO m a -> LowerIO m b -> LowerIO m b
$c*> :: forall (m :: SomeMonad) a b.
Applicative m =>
LowerIO m a -> LowerIO m b -> LowerIO m b
liftA2 :: (a -> b -> c) -> LowerIO m a -> LowerIO m b -> LowerIO m c
$cliftA2 :: forall (m :: SomeMonad) a b c.
Applicative m =>
(a -> b -> c) -> LowerIO m a -> LowerIO m b -> LowerIO m c
<*> :: LowerIO m (a -> b) -> LowerIO m a -> LowerIO m b
$c<*> :: forall (m :: SomeMonad) a b.
Applicative m =>
LowerIO m (a -> b) -> LowerIO m a -> LowerIO m b
pure :: a -> LowerIO m a
$cpure :: forall (m :: SomeMonad) a. Applicative m => a -> LowerIO m a
$cp1Applicative :: forall (m :: SomeMonad). Applicative m => Functor (LowerIO m)
Applicative, a -> LowerIO m b -> LowerIO m a
(a -> b) -> LowerIO m a -> LowerIO m b
(forall a b. (a -> b) -> LowerIO m a -> LowerIO m b)
-> (forall a b. a -> LowerIO m b -> LowerIO m a)
-> Functor (LowerIO m)
forall a b. a -> LowerIO m b -> LowerIO m a
forall a b. (a -> b) -> LowerIO m a -> LowerIO m b
forall (m :: SomeMonad) a b.
Functor m =>
a -> LowerIO m b -> LowerIO m a
forall (m :: SomeMonad) a b.
Functor m =>
(a -> b) -> LowerIO m a -> LowerIO m b
forall (f :: SomeMonad).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LowerIO m b -> LowerIO m a
$c<$ :: forall (m :: SomeMonad) a b.
Functor m =>
a -> LowerIO m b -> LowerIO m a
fmap :: (a -> b) -> LowerIO m a -> LowerIO m b
$cfmap :: forall (m :: SomeMonad) a b.
Functor m =>
(a -> b) -> LowerIO m a -> LowerIO m b
Functor, Applicative (LowerIO m)
a -> LowerIO m a
Applicative (LowerIO m) =>
(forall a b. LowerIO m a -> (a -> LowerIO m b) -> LowerIO m b)
-> (forall a b. LowerIO m a -> LowerIO m b -> LowerIO m b)
-> (forall a. a -> LowerIO m a)
-> Monad (LowerIO m)
LowerIO m a -> (a -> LowerIO m b) -> LowerIO m b
LowerIO m a -> LowerIO m b -> LowerIO m b
forall a. a -> LowerIO m a
forall a b. LowerIO m a -> LowerIO m b -> LowerIO m b
forall a b. LowerIO m a -> (a -> LowerIO m b) -> LowerIO m b
forall (m :: SomeMonad). Monad m => Applicative (LowerIO m)
forall (m :: SomeMonad) a. Monad m => a -> LowerIO m a
forall (m :: SomeMonad) a b.
Monad m =>
LowerIO m a -> LowerIO m b -> LowerIO m b
forall (m :: SomeMonad) a b.
Monad m =>
LowerIO m a -> (a -> LowerIO m b) -> LowerIO m b
forall (m :: SomeMonad).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> LowerIO m a
$creturn :: forall (m :: SomeMonad) a. Monad m => a -> LowerIO m a
>> :: LowerIO m a -> LowerIO m b -> LowerIO m b
$c>> :: forall (m :: SomeMonad) a b.
Monad m =>
LowerIO m a -> LowerIO m b -> LowerIO m b
>>= :: LowerIO m a -> (a -> LowerIO m b) -> LowerIO m b
$c>>= :: forall (m :: SomeMonad) a b.
Monad m =>
LowerIO m a -> (a -> LowerIO m b) -> LowerIO m b
$cp1Monad :: forall (m :: SomeMonad). Monad m => Applicative (LowerIO m)
Monad, Monad (LowerIO m)
Monad (LowerIO m) =>
(forall a. IO a -> LowerIO m a) -> MonadIO (LowerIO m)
IO a -> LowerIO m a
forall a. IO a -> LowerIO m a
forall (m :: SomeMonad).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: SomeMonad). MonadIO m => Monad (LowerIO m)
forall (m :: SomeMonad) a. MonadIO m => IO a -> LowerIO m a
liftIO :: IO a -> LowerIO m a
$cliftIO :: forall (m :: SomeMonad) a. MonadIO m => IO a -> LowerIO m a
$cp1MonadIO :: forall (m :: SomeMonad). MonadIO m => Monad (LowerIO m)
MonadIO)
    deriving (m a -> LowerIO m a
(forall (m :: SomeMonad) a. Monad m => m a -> LowerIO m a)
-> MonadTrans LowerIO
forall (m :: SomeMonad) a. Monad m => m a -> LowerIO m a
forall (t :: SomeMonad -> SomeMonad).
(forall (m :: SomeMonad) a. Monad m => m a -> t m a)
-> MonadTrans t
lift :: m a -> LowerIO m a
$clift :: forall (m :: SomeMonad) a. Monad m => m a -> LowerIO m a
MonadTrans, MonadTrans LowerIO
m (StT LowerIO a) -> LowerIO m a
MonadTrans LowerIO =>
(forall (m :: SomeMonad) a.
 Monad m =>
 (Run LowerIO -> m a) -> LowerIO m a)
-> (forall (m :: SomeMonad) a.
    Monad m =>
    m (StT LowerIO a) -> LowerIO m a)
-> MonadTransControl LowerIO
(Run LowerIO -> m a) -> LowerIO m a
forall (m :: SomeMonad) a.
Monad m =>
m (StT LowerIO a) -> LowerIO m a
forall (m :: SomeMonad) a.
Monad m =>
(Run LowerIO -> m a) -> LowerIO m a
forall (t :: SomeMonad -> SomeMonad).
MonadTrans t =>
(forall (m :: SomeMonad) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: SomeMonad) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
restoreT :: m (StT LowerIO a) -> LowerIO m a
$crestoreT :: forall (m :: SomeMonad) a.
Monad m =>
m (StT LowerIO a) -> LowerIO m a
liftWith :: (Run LowerIO -> m a) -> LowerIO m a
$cliftWith :: forall (m :: SomeMonad) a.
Monad m =>
(Run LowerIO -> m a) -> LowerIO m a
$cp1MonadTransControl :: MonadTrans LowerIO
MonadTransControl) via Default
    deriving (MonadBase b, MonadBaseControl b)

instance MonadBaseControl IO m => Resource' tag (LowerIO m) where
  bracket' :: LowerIO m a
-> (a -> LowerIO m c) -> (a -> LowerIO m b) -> LowerIO m b
bracket' alloc :: LowerIO m a
alloc free :: a -> LowerIO m c
free use :: a -> LowerIO m b
use =
    (RunInBase (LowerIO m) IO -> IO (StM (LowerIO m) b)) -> LowerIO m b
forall (b :: SomeMonad) (m :: SomeMonad) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control ((RunInBase (LowerIO m) IO -> IO (StM (LowerIO m) b))
 -> LowerIO m b)
-> (RunInBase (LowerIO m) IO -> IO (StM (LowerIO m) b))
-> LowerIO m b
forall a b. (a -> b) -> a -> b
$ \run :: RunInBase (LowerIO m) IO
run ->
      IO (StM m a)
-> (StM m a -> IO (StM m c))
-> (StM m a -> IO (StM m b))
-> IO (StM m b)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
IO.bracket
        ( LowerIO m a -> IO (StM (LowerIO m) a)
RunInBase (LowerIO m) IO
run LowerIO m a
alloc )
        ( \a :: StM m a
a -> LowerIO m c -> IO (StM (LowerIO m) c)
RunInBase (LowerIO m) IO
run (StM (LowerIO m) a -> LowerIO m a
forall (b :: SomeMonad) (m :: SomeMonad) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
StM (LowerIO m) a
a LowerIO m a -> (a -> LowerIO m c) -> LowerIO m c
forall (m :: SomeMonad) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> LowerIO m c
free) )
        ( \a :: StM m a
a -> LowerIO m b -> IO (StM (LowerIO m) b)
RunInBase (LowerIO m) IO
run (StM (LowerIO m) a -> LowerIO m a
forall (b :: SomeMonad) (m :: SomeMonad) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
StM (LowerIO m) a
a LowerIO m a -> (a -> LowerIO m b) -> LowerIO m b
forall (m :: SomeMonad) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> LowerIO m b
use) )
  {-# INLINABLE bracket' #-}
  bracketOnError' :: LowerIO m a
-> (a -> LowerIO m c) -> (a -> LowerIO m b) -> LowerIO m b
bracketOnError' alloc :: LowerIO m a
alloc free :: a -> LowerIO m c
free use :: a -> LowerIO m b
use =
    (RunInBase (LowerIO m) IO -> IO (StM (LowerIO m) b)) -> LowerIO m b
forall (b :: SomeMonad) (m :: SomeMonad) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control ((RunInBase (LowerIO m) IO -> IO (StM (LowerIO m) b))
 -> LowerIO m b)
-> (RunInBase (LowerIO m) IO -> IO (StM (LowerIO m) b))
-> LowerIO m b
forall a b. (a -> b) -> a -> b
$ \run :: RunInBase (LowerIO m) IO
run ->
      IO (StM m a)
-> (StM m a -> IO (StM m c))
-> (StM m a -> IO (StM m b))
-> IO (StM m b)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
IO.bracketOnError
        ( LowerIO m a -> IO (StM (LowerIO m) a)
RunInBase (LowerIO m) IO
run LowerIO m a
alloc )
        ( \a :: StM m a
a -> LowerIO m c -> IO (StM (LowerIO m) c)
RunInBase (LowerIO m) IO
run (StM (LowerIO m) a -> LowerIO m a
forall (b :: SomeMonad) (m :: SomeMonad) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
StM (LowerIO m) a
a LowerIO m a -> (a -> LowerIO m c) -> LowerIO m c
forall (m :: SomeMonad) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> LowerIO m c
free) )
        ( \a :: StM m a
a -> LowerIO m b -> IO (StM (LowerIO m) b)
RunInBase (LowerIO m) IO
run (StM (LowerIO m) a -> LowerIO m a
forall (b :: SomeMonad) (m :: SomeMonad) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
StM (LowerIO m) a
a LowerIO m a -> (a -> LowerIO m b) -> LowerIO m b
forall (m :: SomeMonad) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> LowerIO m b
use) )
  {-# INLINABLE bracketOnError' #-} 

-- | Runs the resource effect using 'IO.bracket'.

runResourceIO' :: (Resource' tag `Via` LowerIO) m a -> m a
runResourceIO' :: Via (Resource' tag) LowerIO m a -> m a
runResourceIO' = Via (Resource' tag) LowerIO m a -> m a
forall a b. Coercible a b => a -> b
coerce
{-# INLINE runResourceIO' #-}

-- | The untagged version of 'runResourceIO''.

runResourceIO :: (Resource `Via` LowerIO) m a -> m a
runResourceIO :: Via (Resource' G) LowerIO m a -> m a
runResourceIO = Via (Resource' G) LowerIO m a -> m a
forall a b. Coercible a b => a -> b
coerce
{-# INLINE runResourceIO #-}