{-# LANGUAGE
CPP
, DeriveFunctor
, FlexibleContexts
, FlexibleInstances
, InstanceSigs
, MultiParamTypeClasses
, PolyKinds
, RankNTypes
, ScopedTypeVariables
, TypeFamilies
, DataKinds
, PolyKinds
, UndecidableInstances
#-}
module Squeal.PostgreSQL.Session.Pool
(
Pool
, createConnectionPool
, usingConnectionPool
, destroyConnectionPool
) where
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.ByteString
import Data.Time
import Data.Pool
import Squeal.PostgreSQL.Type.Schema
import Squeal.PostgreSQL.Session (PQ (..))
import Squeal.PostgreSQL.Session.Connection
createConnectionPool
:: forall (db :: SchemasType) io. MonadIO io
=> ByteString
-> Int
-> NominalDiffTime
-> Int
-> io (Pool (K Connection db))
createConnectionPool :: forall (db :: SchemasType) (io :: * -> *).
MonadIO io =>
ByteString
-> Int -> NominalDiffTime -> Int -> io (Pool (K Connection db))
createConnectionPool ByteString
conninfo Int
stripes NominalDiffTime
idle Int
maxResrc =
#if MIN_VERSION_resource_pool(0,4,0)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PoolConfig a -> IO (Pool a)
newPool forall a b. (a -> b) -> a -> b
$ forall a. Maybe Int -> PoolConfig a -> PoolConfig a
setNumStripes
(forall a. a -> Maybe a
Just Int
stripes)
(forall a. IO a -> (a -> IO ()) -> Double -> Int -> PoolConfig a
defaultPoolConfig (forall (db :: SchemasType) (io :: * -> *).
MonadIO io =>
ByteString -> io (K Connection db)
connectdb ByteString
conninfo) forall {k} (io :: * -> *) (db :: k).
MonadIO io =>
K Connection db -> io ()
finish (forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
idle) Int
maxResrc)
#else
liftIO $ createPool (connectdb conninfo) finish stripes idle maxResrc
#endif
usingConnectionPool
:: (MonadIO io, MonadMask io)
=> Pool (K Connection db)
-> PQ db db io x
-> io x
usingConnectionPool :: forall (io :: * -> *) (db :: SchemasType) x.
(MonadIO io, MonadMask io) =>
Pool (K Connection db) -> PQ db db io x -> io x
usingConnectionPool Pool (K Connection db)
pool (PQ K Connection db -> io (K x db)
session) = forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. io a -> io a
restore -> do
(K Connection db
conn, LocalPool (K Connection db)
local) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Pool a -> IO (a, LocalPool a)
takeResource Pool (K Connection db)
pool
K x db
ret <- forall a. io a -> io a
restore (K Connection db -> io (K x db)
session K Connection db
conn) forall (m :: * -> *) a b. MonadCatch m => m a -> m b -> m a
`onException`
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. Pool a -> LocalPool a -> a -> IO ()
destroyResource Pool (K Connection db)
pool LocalPool (K Connection db)
local K Connection db
conn)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. LocalPool a -> a -> IO ()
putResource LocalPool (K Connection db)
local K Connection db
conn
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {k} a (b :: k). K a b -> a
unK K x db
ret
destroyConnectionPool
:: MonadIO io
=> Pool (K Connection db)
-> io ()
destroyConnectionPool :: forall {k} (io :: * -> *) (db :: k).
MonadIO io =>
Pool (K Connection db) -> io ()
destroyConnectionPool = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pool a -> IO ()
destroyAllResources