{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
module Data.Acquire.Internal
    ( Acquire (..)
    , Allocated (..)
    , with
    , mkAcquire
    , ReleaseType (.., ReleaseException)
    , mkAcquireType
    ) where

import Control.Applicative (Applicative (..))
import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO, withRunInIO)
import qualified Control.Exception as E
import Data.Typeable (Typeable)
import Control.Monad (liftM, ap)
import qualified Control.Monad.Catch as C ()

-- | The way in which a release is called.
--
-- @since 1.1.2
data ReleaseType = ReleaseEarly
                 | ReleaseNormal
                 | ReleaseExceptionWith E.SomeException
    deriving (Int -> ReleaseType -> ShowS
[ReleaseType] -> ShowS
ReleaseType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReleaseType] -> ShowS
$cshowList :: [ReleaseType] -> ShowS
show :: ReleaseType -> String
$cshow :: ReleaseType -> String
showsPrec :: Int -> ReleaseType -> ShowS
$cshowsPrec :: Int -> ReleaseType -> ShowS
Show, Typeable)

{-# COMPLETE ReleaseEarly, ReleaseNormal, ReleaseException #-}
{-# DEPRECATED ReleaseException "Use `ReleaseExceptionWith`, which has the exception in the constructor. This pattern synonym hides the exception and can obscure problems." #-}
pattern ReleaseException :: ReleaseType
pattern $mReleaseException :: forall {r}. ReleaseType -> ((# #) -> r) -> ((# #) -> r) -> r
ReleaseException <- ReleaseExceptionWith _

data Allocated a = Allocated !a !(ReleaseType -> IO ())

-- | A method for acquiring a scarce resource, providing the means of freeing
-- it when no longer needed. This data type provides
-- @Functor@\/@Applicative@\/@Monad@ instances for composing different resources
-- together. You can allocate these resources using either the @bracket@
-- pattern (via @with@) or using @ResourceT@ (via @allocateAcquire@).
--
-- This concept was originally introduced by Gabriel Gonzalez and described at:
-- <http://www.haskellforall.com/2013/06/the-resource-applicative.html>. The
-- implementation in this package is slightly different, due to taking a
-- different approach to async exception safety.
--
-- @since 1.1.0
newtype Acquire a = Acquire ((forall b. IO b -> IO b) -> IO (Allocated a))
    deriving Typeable

instance Functor Acquire where
    fmap :: forall a b. (a -> b) -> Acquire a -> Acquire b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative Acquire where
    pure :: forall a. a -> Acquire a
pure a
a = forall a.
((forall b. IO b -> IO b) -> IO (Allocated a)) -> Acquire a
Acquire (\forall b. IO b -> IO b
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> (ReleaseType -> IO ()) -> Allocated a
Allocated a
a (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ())))
    <*> :: forall a b. Acquire (a -> b) -> Acquire a -> Acquire b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad Acquire where
    return :: forall a. a -> Acquire a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Acquire (forall b. IO b -> IO b) -> IO (Allocated a)
f >>= :: forall a b. Acquire a -> (a -> Acquire b) -> Acquire b
>>= a -> Acquire b
g' = forall a.
((forall b. IO b -> IO b) -> IO (Allocated a)) -> Acquire a
Acquire forall a b. (a -> b) -> a -> b
$ \forall b. IO b -> IO b
restore -> do
        Allocated a
x ReleaseType -> IO ()
free1 <- (forall b. IO b -> IO b) -> IO (Allocated a)
f forall b. IO b -> IO b
restore
        let Acquire (forall b. IO b -> IO b) -> IO (Allocated b)
g = a -> Acquire b
g' a
x
        Allocated b
y ReleaseType -> IO ()
free2 <- (forall b. IO b -> IO b) -> IO (Allocated b)
g forall b. IO b -> IO b
restore forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\SomeException
e -> ReleaseType -> IO ()
free1 (SomeException -> ReleaseType
ReleaseExceptionWith SomeException
e) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e a. Exception e => e -> IO a
E.throwIO SomeException
e)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> (ReleaseType -> IO ()) -> Allocated a
Allocated b
y (\ReleaseType
rt -> ReleaseType -> IO ()
free2 ReleaseType
rt forall a b. IO a -> IO b -> IO a
`E.finally` ReleaseType -> IO ()
free1 ReleaseType
rt)

instance MonadIO Acquire where
    liftIO :: forall a. IO a -> Acquire a
liftIO IO a
f = forall a.
((forall b. IO b -> IO b) -> IO (Allocated a)) -> Acquire a
Acquire forall a b. (a -> b) -> a -> b
$ \forall b. IO b -> IO b
restore -> do
        a
x <- forall b. IO b -> IO b
restore IO a
f
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> (ReleaseType -> IO ()) -> Allocated a
Allocated a
x (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Create an @Acquire@ value using the given allocate and free functions.
--
-- To acquire and free the resource in an arbitrary monad with `MonadUnliftIO`,
-- do the following:
--
-- > acquire <- withRunInIO $ \runInIO ->
-- >   return $ mkAcquire (runInIO create) (runInIO . free)
--
-- Note that this is only safe if the Acquire is run and freed within the same
-- monadic scope it was created in.
--
-- @since 1.1.0
mkAcquire :: IO a -- ^ acquire the resource
          -> (a -> IO ()) -- ^ free the resource
          -> Acquire a
mkAcquire :: forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire IO a
create a -> IO ()
free = forall a. IO a -> (a -> ReleaseType -> IO ()) -> Acquire a
mkAcquireType IO a
create (\a
a ReleaseType
_ -> a -> IO ()
free a
a)

-- | Same as 'mkAcquire', but the cleanup function will be informed of /how/
-- cleanup was initiated. This allows you to distinguish, for example, between
-- normal and exceptional exits.
--
-- To acquire and free the resource in an arbitrary monad with `MonadUnliftIO`,
-- do the following:
--
-- > acquire <- withRunInIO $ \runInIO ->
-- >   return $ mkAcquireType (runInIO create) (\a -> runInIO . free a)
--
-- Note that this is only safe if the Acquire is run and freed within the same
-- monadic scope it was created in.
--
-- @since 1.1.2
mkAcquireType
    :: IO a -- ^ acquire the resource
    -> (a -> ReleaseType -> IO ()) -- ^ free the resource
    -> Acquire a
mkAcquireType :: forall a. IO a -> (a -> ReleaseType -> IO ()) -> Acquire a
mkAcquireType IO a
create a -> ReleaseType -> IO ()
free = forall a.
((forall b. IO b -> IO b) -> IO (Allocated a)) -> Acquire a
Acquire forall a b. (a -> b) -> a -> b
$ \forall b. IO b -> IO b
_ -> do
    a
x <- IO a
create
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> (ReleaseType -> IO ()) -> Allocated a
Allocated a
x (a -> ReleaseType -> IO ()
free a
x)

-- | Allocate the given resource and provide it to the provided function. The
-- resource will be freed as soon as the inner block is exited, whether
-- normally or via an exception. This function is similar in function to
-- @bracket@.
--
-- @since 1.1.0
with :: MonadUnliftIO m
     => Acquire a
     -> (a -> m b)
     -> m b
with :: forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
with (Acquire (forall b. IO b -> IO b) -> IO (Allocated a)
f) a -> m b
g = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall b. ((forall b. IO b -> IO b) -> IO b) -> IO b
E.mask forall a b. (a -> b) -> a -> b
$ \forall b. IO b -> IO b
restore -> do
    Allocated a
x ReleaseType -> IO ()
free <- (forall b. IO b -> IO b) -> IO (Allocated a)
f forall b. IO b -> IO b
restore
    b
res <- forall b. IO b -> IO b
restore (forall a. m a -> IO a
run (a -> m b
g a
x)) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\SomeException
e -> ReleaseType -> IO ()
free (SomeException -> ReleaseType
ReleaseExceptionWith SomeException
e) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e a. Exception e => e -> IO a
E.throwIO SomeException
e)
    ReleaseType -> IO ()
free ReleaseType
ReleaseNormal
    forall (m :: * -> *) a. Monad m => a -> m a
return b
res