{-# LANGUAGE LambdaCase #-}

module Data.Pool.Acquire (poolToAcquire) where

import Data.Pool (Pool, destroyResource, putResource, takeResource)
import Data.Acquire (Acquire, ReleaseType(..), mkAcquireType)

-- | Convert a 'Pool' into an 'Acquire'.
poolToAcquire :: Pool a -> Acquire a
poolToAcquire :: Pool a -> Acquire a
poolToAcquire Pool a
pool = (a, LocalPool a) -> a
forall a b. (a, b) -> a
fst ((a, LocalPool a) -> a) -> Acquire (a, LocalPool a) -> Acquire a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (a, LocalPool a)
-> ((a, LocalPool a) -> ReleaseType -> IO ())
-> Acquire (a, LocalPool a)
forall a. IO a -> (a -> ReleaseType -> IO ()) -> Acquire a
mkAcquireType IO (a, LocalPool a)
getResource (a, LocalPool a) -> ReleaseType -> IO ()
freeResource
  where
    getResource :: IO (a, LocalPool a)
getResource = Pool a -> IO (a, LocalPool a)
forall a. Pool a -> IO (a, LocalPool a)
takeResource Pool a
pool
    freeResource :: (a, LocalPool a) -> ReleaseType -> IO ()
freeResource (a
resource, LocalPool a
localPool) = \case
      ReleaseType
ReleaseException -> Pool a -> LocalPool a -> a -> IO ()
forall a. Pool a -> LocalPool a -> a -> IO ()
destroyResource Pool a
pool LocalPool a
localPool a
resource
      ReleaseType
_ -> LocalPool a -> a -> IO ()
forall a. LocalPool a -> a -> IO ()
putResource LocalPool a
localPool a
resource