@@ -21,12 +21,22 @@ A `MonadPQ` for pooled connections.
2121 , UndecidableInstances
2222#-}
2323
24−module Squeal.PostgreSQL.Pool where
24+module Squeal.PostgreSQL.Pool
25+ ( -- * Pools
26+ PoolPQ (..)
27+ , createConnectionPool
28+ , Pool
29+ , destroyAllResources
30+ , PoolPQRun
31+ , poolpqliftWith
32+ ) where
2533
2634import Control.Monad.Base
2735import Control.Monad.Trans
2836import Control.Monad.Trans.Control
37+import Data.ByteString
2938import Data.Pool
39+import Data.Time
3040import Generics.SOP (K(..))
3141
3242import Squeal.PostgreSQL.PQ
@@ -38,6 +48,23 @@ newtype PoolPQ (schema :: TablesType) m x =
3848 PoolPQ { runPoolPQ :: Pool (K Connection schema) -> m x }
3949 deriving Functor
4050
51+createConnectionPool
52+ -- ^ Create a striped pool of connections.
53+ -- Although the garbage collector will destroy all idle connections when the pool is garbage collected it's recommended to manually destroyAllResources when you're done with the pool so that the connections are freed up as soon as possible.
54+ :: MonadBase IO io
55+ => ByteString -- ^ conninfo
56+ -> Int
57+ -- ^ The number of stripes (distinct sub-pools) to maintain. The smallest acceptable value is 1.
58+ -> NominalDiffTime
59+ -- ^ Amount of time for which an unused connection is kept open. The smallest acceptable value is 0.5 seconds.
60+ -- The elapsed time before destroying a connection may be a little longer than requested, as the reaper thread wakes at 1-second intervals.
61+ -> Int
62+ -- ^ Maximum number of connections to keep open per stripe. The smallest acceptable value is 1.
63+ -- Requests for connections will block if this limit is reached on a single stripe, even if other stripes have idle connections available.
64+ -> io (Pool (K Connection schema))
65+createConnectionPool conninfo stripes idle maxResrc = liftBase $
66+ createPool (connectdb conninfo) finish stripes idle maxResrc
67+
4168-- | `Applicative` instance for `PoolPQ`.
4269instance Monad m => Applicative (PoolPQ schema m) where
4370 pure x = PoolPQ $ \ _ -> pure x
@@ -65,22 +92,22 @@ instance MonadBase b m => MonadBase b (PoolPQ schema m) where
6592instance MonadBaseControl IO io => MonadPQ schema (PoolPQ schema io) where
6693 manipulateParams manipulation params = PoolPQ $ \ pool -> do
6794 withResource pool $ \ conn -> do
68− (K result :: K (K Result ys) schema) <- flip runPQ conn $
95+ (K result :: K (K Result ys) schema) <- flip unPQ conn $
6996 manipulateParams manipulation params
7097 return result
7198 traversePrepared manipulation params = PoolPQ $ \ pool ->
7299 withResource pool $ \ conn -> do
73− (K result :: K (list (K Result ys)) schema) <- flip runPQ conn $
100+ (K result :: K (list (K Result ys)) schema) <- flip unPQ conn $
74101 traversePrepared manipulation params
75102 return result
76103 traversePrepared_ manipulation params = PoolPQ $ \ pool -> do
77104 withResource pool $ \ conn -> do
78− (_ :: K () schema) <- flip runPQ conn $
105+ (_ :: K () schema) <- flip unPQ conn $
79106 traversePrepared_ manipulation params
80107 return ()
81108 liftPQ m = PoolPQ $ \ pool ->
82109 withResource pool $ \ conn -> do
83− (K result :: K result schema) <- flip runPQ conn $
110+ (K result :: K result schema) <- flip unPQ conn $
84111 liftPQ m
85112 return result
86113