@@ -21,12 +21,22 @@ A `MonadPQ` for pooled connections.
21 , UndecidableInstances
21 , UndecidableInstances
24−module Squeal.PostgreSQL.Pool where
24+module Squeal.PostgreSQL.Pool
27+ , createConnectionPool
29+ , destroyAllResources
26import Control.Monad.Base
34import Control.Monad.Base
27import Control.Monad.Trans
35import Control.Monad.Trans
28import Control.Monad.Trans.Control
36import Control.Monad.Trans.Control
37+import Data.ByteString
29import Data.Pool
38import Data.Pool
30import Generics.SOP (K(..))
40import Generics.SOP (K(..))
32import Squeal.PostgreSQL.PQ
42import Squeal.PostgreSQL.PQ
@@ -38,6 +48,23 @@ newtype PoolPQ (schema :: TablesType) m x =
38 PoolPQ { runPoolPQ :: Pool (K Connection schema) -> m x }
48 PoolPQ { runPoolPQ :: Pool (K Connection schema) -> m x }
39 deriving Functor
49 deriving Functor
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.
55+ => ByteString -- ^ conninfo
57+ -- ^ The number of stripes (distinct sub-pools) to maintain. The smallest acceptable value is 1.
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.
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
41-- | `Applicative` instance for `PoolPQ`.
68-- | `Applicative` instance for `PoolPQ`.
42instance Monad m => Applicative (PoolPQ schema m) where
69instance Monad m => Applicative (PoolPQ schema m) where
43 pure x = PoolPQ $ \ _ -> pure x
70 pure x = PoolPQ $ \ _ -> pure x
@@ -65,22 +92,22 @@ instance MonadBase b m => MonadBase b (PoolPQ schema m) where
65instance MonadBaseControl IO io => MonadPQ schema (PoolPQ schema io) where
92instance MonadBaseControl IO io => MonadPQ schema (PoolPQ schema io) where
66 manipulateParams manipulation params = PoolPQ $ \ pool -> do
93 manipulateParams manipulation params = PoolPQ $ \ pool -> do
67 withResource pool $ \ conn -> do
94 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 $
69 manipulateParams manipulation params
96 manipulateParams manipulation params
70 return result
97 return result
71 traversePrepared manipulation params = PoolPQ $ \ pool ->
98 traversePrepared manipulation params = PoolPQ $ \ pool ->
72 withResource pool $ \ conn -> do
99 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 $
74 traversePrepared manipulation params
101 traversePrepared manipulation params
75 return result
102 return result
76 traversePrepared_ manipulation params = PoolPQ $ \ pool -> do
103 traversePrepared_ manipulation params = PoolPQ $ \ pool -> do
77 withResource pool $ \ conn -> do
104 withResource pool $ \ conn -> do
78− (_ :: K () schema) <- flip runPQ conn $
105+ (_ :: K () schema) <- flip unPQ conn $
79 traversePrepared_ manipulation params
106 traversePrepared_ manipulation params
80 return ()
107 return ()
81 liftPQ m = PoolPQ $ \ pool ->
108 liftPQ m = PoolPQ $ \ pool ->
82 withResource pool $ \ conn -> do
109 withResource pool $ \ conn -> do
83− (K result :: K result schema) <- flip runPQ conn $
110+ (K result :: K result schema) <- flip unPQ conn $
85 return result
112 return result