@@ -1,11 +1,33 @@
11{-|
2−Module: Squeal.PostgreSQL.Definition
3−Description: Pooled connections
2+Module: Squeal.PostgreSQL.Pool
3+Description: Connection pools
44Copyright: (c) Eitan Chatav, 2017
55Maintainer: eitan@morphism.tech
66Stability: experimental
77
8−A `MonadPQ` for pooled connections.
8+Connection pools.
9+
10+Typical use case would be to create your pool using `createConnectionPool`
11+and run anything that requires the pool connection with `usingConnectionPool`.
12+
13+Here's a simplified example:
14+
15+>>> import Squeal.PostgreSQL
16+
17+>>> :{
18+do
19+ let
20+ query :: Query_ (Public '[]) () (Only Char)
21+ query = values_ (literal 'a' `as` #fromOnly)
22+ pool <- createConnectionPool "host=localhost port=5432 dbname=exampledb" 1 0.5 10
23+ chr <- usingConnectionPool pool $ do
24+ result <- runQuery query
25+ Just (Only a) <- firstRow result
26+ return a
27+ destroyConnectionPool pool
28+ putChar chr
29+:}
30+a
931-}
1032
1133{-# LANGUAGE
@@ -23,51 +45,19 @@ A `MonadPQ` for pooled connections.
2345
2446module Squeal.PostgreSQL.Pool
2547 ( -- * Pools
26− PoolPQ (..)
48+ Pool
2749 , createConnectionPool
28− , Pool
29− , destroyAllResources
50+ , usingConnectionPool
51+ , destroyConnectionPool
3052 ) where
3153
32−import Control.Monad.Trans
3354import Data.ByteString
3455import Data.Time
35−import Generics.SOP (K(..))
56+import Generics.SOP (K(..), unK)
3657import UnliftIO (MonadUnliftIO (..))
3758import UnliftIO.Pool (Pool, createPool, destroyAllResources, withResource)
3859
39−import qualified Control.Monad.Fail as Fail
40−
4160import Squeal.PostgreSQL.PQ
42−import Squeal.PostgreSQL.Schema
43−
44−{- | `PoolPQ` @schemas@ should be a drop-in replacement for `PQ` @schemas schemas@.
45−
46−Typical use case would be to create your pool using `createConnectionPool` and run anything that requires the pool connection with it.
47−
48−Here's a simplified example:
49−
50−>>> import Squeal.PostgreSQL
51−>>> :{
52−do
53− let
54− query :: Query_ (Public '[]) () (Only Char)
55− query = values_ $ literal 'a' `as` #fromOnly
56− session :: PoolPQ (Public '[]) IO Char
57− session = do
58− result <- runQuery query
59− Just (Only chr) <- firstRow result
60− return chr
61− pool <- createConnectionPool "host=localhost port=5432 dbname=exampledb" 1 0.5 10
62− chr <- runPoolPQ session pool
63− destroyAllResources pool
64− putChar chr
65−:}
66−a
67−-}
68−newtype PoolPQ (schemas :: SchemasType) m x =
69− PoolPQ { runPoolPQ :: Pool (K Connection schemas) -> m x }
70− deriving Functor
7161
7262-- | Create a striped pool of connections.
7363-- 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.
@@ -92,63 +82,41 @@ createConnectionPool
9282createConnectionPool conninfo stripes idle maxResrc =
9383 createPool (connectdb conninfo) finish stripes idle maxResrc
9484
95−-- | `Applicative` instance for `PoolPQ`.
96−instance Monad m => Applicative (PoolPQ schemas m) where
97− pure x = PoolPQ $ \ _ -> pure x
98− PoolPQ f <*> PoolPQ x = PoolPQ $ \ pool -> do
99− f' <- f pool
100− x' <- x pool
101− return $ f' x'
102−
103−-- | `Monad` instance for `PoolPQ`.
104−instance Monad m => Monad (PoolPQ schemas m) where
105− return = pure
106− PoolPQ x >>= f = PoolPQ $ \ pool -> do
107− x' <- x pool
108− runPoolPQ (f x') pool
109−
110−-- | `Fail.MonadFail` instance for `PoolPQ`.
111−instance Monad m => Fail.MonadFail (PoolPQ schemas m) where
112− fail = Fail.fail
113−
114−-- | `MonadTrans` instance for `PoolPQ`.
115−instance MonadTrans (PoolPQ schemas) where
116− lift m = PoolPQ $ \ _pool -> m
117−
118−-- | `MonadPQ` instance for `PoolPQ`.
119−instance MonadUnliftIO io => MonadPQ schemas (PoolPQ schemas io) where
120− manipulateParams manipulation params = PoolPQ $ \ pool -> do
121− withResource pool $ \ conn -> do
122− (K result :: K (K Result ys) schemas) <- flip unPQ conn $
123− manipulateParams manipulation params
124− return result
125− traversePrepared manipulation params = PoolPQ $ \ pool ->
126− withResource pool $ \ conn -> do
127− (K result :: K (list (K Result ys)) schemas) <- flip unPQ conn $
128− traversePrepared manipulation params
129− return result
130− traversePrepared_ manipulation params = PoolPQ $ \ pool -> do
131− withResource pool $ \ conn -> do
132− (_ :: K () schemas) <- flip unPQ conn $
133− traversePrepared_ manipulation params
134− return ()
135− liftPQ m = PoolPQ $ \ pool ->
136− withResource pool $ \ conn -> do
137− (K result :: K result schemas) <- flip unPQ conn $
138− liftPQ m
139− return result
140−
141−-- | 'MonadIO' instance for 'PoolPQ'.
142−instance (MonadIO m)
143− => MonadIO (PoolPQ schemas m) where
144− liftIO = lift . liftIO
145−
146−-- | 'MonadUnliftIO' instance for 'PoolPQ'.
147−instance (MonadUnliftIO m)
148− => MonadUnliftIO (PoolPQ schemas m) where
149− withRunInIO
150− :: ((forall a . PoolPQ schemas m a -> IO a) -> IO b)
151− -> PoolPQ schemas m b
152− withRunInIO inner = PoolPQ $ \pool ->
153− withRunInIO $ \(run :: (forall x . m x -> IO x)) ->
154− inner (\poolpq -> run $ runPoolPQ poolpq pool)
85+{-|
86+Temporarily take a connection from a `Pool`, perform an action with it,
87+and return it to the pool afterwards.
88+
89+If the pool has an idle connection available, it is used immediately.
90+Otherwise, if the maximum number of connections has not yet been reached,
91+a new connection is created and used.
92+If the maximum number of connections has been reached, this function blocks
93+until a connection becomes available.
94+-}
95+usingConnectionPool
96+ :: MonadUnliftIO io
97+ => Pool (K Connection schemas) -- ^ pool
98+ -> PQ schemas schemas io x -- ^ session
99+ -> io x
100+usingConnectionPool pool (PQ session) = unK <$> withResource pool session
101+
102+{- |
103+Destroy all connections in all stripes in the pool.
104+Note that this will ignore any exceptions in the destroy function.
105+
106+This function is useful when you detect that all connections
107+in the pool are broken. For example after a database has been
108+restarted all connections opened before the restart will be broken.
109+In that case it's better to close those connections so that
110+`usingConnectionPool` won't take a broken connection from the pool
111+but will open a new connection instead.
112+
113+Another use-case for this function is that when you know you are done
114+with the pool you can destroy all idle connections immediately
115+instead of waiting on the garbage collector to destroy them,
116+thus freeing up those connections sooner.
117+-}
118+destroyConnectionPool
119+ :: MonadUnliftIO io
120+ => Pool (K Connection schemas) -- ^ pool
121+ -> io ()
122+destroyConnectionPool = destroyAllResources