    {-# 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
    (Int -> ReleaseType -> ShowS)
    -> (ReleaseType -> String)
    -> ([ReleaseType] -> ShowS)
    -> Show ReleaseType
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ReleaseType -> ShowS
    showsPrec :: Int -> ReleaseType -> ShowS
    $cshow :: ReleaseType -> String
    show :: ReleaseType -> String
    $cshowList :: [ReleaseType] -> ShowS
    showList :: [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 = (a -> b) -> Acquire a -> Acquire b
    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 b. IO b -> IO b) -> IO (Allocated a)) -> Acquire a
    forall a.
    ((forall b. IO b -> IO b) -> IO (Allocated a)) -> Acquire a
    Acquire (\forall b. IO b -> IO b
    _ -> Allocated a -> IO (Allocated a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> (ReleaseType -> IO ()) -> Allocated a
    forall a. a -> (ReleaseType -> IO ()) -> Allocated a
    Allocated a
    a (IO () -> ReleaseType -> IO ()
    forall a b. a -> b -> a
    const (IO () -> ReleaseType -> IO ()) -> IO () -> ReleaseType -> IO ()
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())))
        <*> :: forall a b. Acquire (a -> b) -> Acquire a -> Acquire 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 = a -> Acquire a
    forall a. a -> Acquire a
    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 b. IO b -> IO b) -> IO (Allocated b)) -> Acquire b
    forall a.
    ((forall b. IO b -> IO b) -> IO (Allocated a)) -> Acquire a
    Acquire (((forall b. IO b -> IO b) -> IO (Allocated b)) -> Acquire b)
    -> ((forall b. IO b -> IO b) -> IO (Allocated b)) -> Acquire b
    forall a b. (a -> b) -> a -> b
    $ \forall b. IO b -> IO b
    restore -> do
            Allocated x free1 <- (forall b. IO b -> IO b) -> IO (Allocated a)
    f IO b -> IO b
    forall b. IO b -> IO b
    restore
            let Acquire g = g' x
            Allocated y free2 <- g restore `E.catch` (\SomeException
    e -> ReleaseType -> IO ()
    free1 (SomeException -> ReleaseType
    ReleaseExceptionWith SomeException
    e) IO () -> IO (Allocated b) -> IO (Allocated b)
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> SomeException -> IO (Allocated b)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO SomeException
    e)
            return $! Allocated y (\ReleaseType
    rt -> ReleaseType -> IO ()
    free2 ReleaseType
    rt IO () -> IO () -> IO ()
    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 b. IO b -> IO b) -> IO (Allocated a)) -> Acquire a
    forall a.
    ((forall b. IO b -> IO b) -> IO (Allocated a)) -> Acquire a
    Acquire (((forall b. IO b -> IO b) -> IO (Allocated a)) -> Acquire a)
    -> ((forall b. IO b -> IO b) -> IO (Allocated a)) -> Acquire a
    forall a b. (a -> b) -> a -> b
    $ \forall b. IO b -> IO b
    restore -> do
            x <- IO a -> IO a
    forall b. IO b -> IO b
    restore IO a
    f
            return $! Allocated x (const $ 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 = IO a -> (a -> ReleaseType -> IO ()) -> Acquire a
    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 b. IO b -> IO b) -> IO (Allocated a)) -> Acquire a
    forall a.
    ((forall b. IO b -> IO b) -> IO (Allocated a)) -> Acquire a
    Acquire (((forall b. IO b -> IO b) -> IO (Allocated a)) -> Acquire a)
    -> ((forall b. IO b -> IO b) -> IO (Allocated a)) -> Acquire a
    forall a b. (a -> b) -> a -> b
    $ \forall b. IO b -> IO b
    _ -> do
        x <- IO a
    create
        return $! Allocated x (free 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 a. m a -> IO a) -> IO b) -> m b
    forall b. ((forall a. m a -> IO a) -> IO b) -> m b
    forall (m :: * -> *) b.
    MonadUnliftIO m =>
    ((forall a. m a -> IO a) -> IO b) -> m b
    withRunInIO (((forall a. m a -> IO a) -> IO b) -> m b)
    -> ((forall a. m a -> IO a) -> IO b) -> m b
    forall a b. (a -> b) -> a -> b
    $ \forall a. m a -> IO a
    run -> ((forall b. IO b -> IO b) -> IO b) -> IO b
    forall b. ((forall b. IO b -> IO b) -> IO b) -> IO b
    E.mask (((forall b. IO b -> IO b) -> IO b) -> IO b)
    -> ((forall b. IO b -> IO b) -> IO b) -> IO b
    forall a b. (a -> b) -> a -> b
    $ \forall b. IO b -> IO b
    restore -> do
        Allocated x free <- (forall b. IO b -> IO b) -> IO (Allocated a)
    f IO b -> IO b
    forall b. IO b -> IO b
    restore
        res <- restore (run (g x)) `E.catch` (\SomeException
    e -> ReleaseType -> IO ()
    free (SomeException -> ReleaseType
    ReleaseExceptionWith SomeException
    e) IO () -> IO b -> IO b
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> SomeException -> IO b
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO SomeException
    e)
        free ReleaseNormal
        return res