git.iko.soy/squeal
on dev help sign in
Pool rewrite
5afb291Eitan Chatav
squeal-postgresql/src/Squeal/PostgreSQL/Pool.hs+57−99
compare with dev
unifiedsplit
@@ -1,11 +1,33 @@
1{-|
1{-|
2−Module: Squeal.PostgreSQL.Definition
2+Module: Squeal.PostgreSQL.Pool
3−Description: Pooled connections
3+Description: Connection pools
4Copyright: (c) Eitan Chatav, 2017
4Copyright: (c) Eitan Chatav, 2017
5Maintainer: eitan@morphism.tech
5Maintainer: eitan@morphism.tech
6Stability: experimental
6Stability: experimental
7
7
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 `useConnectionPool`.
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 <- useConnectionPool pool $ do
24+ result <- runQuery query
25+ Just (Only a) <- firstRow result
26+ return a
27+ destroyConnectionPool pool
28+ putChar chr
29+:}
30+a
9-}
31-}
10
32
11{-# LANGUAGE
33{-# LANGUAGE
@@ -23,51 +45,19 @@ A `MonadPQ` for pooled connections.
23
45
24module Squeal.PostgreSQL.Pool
46module Squeal.PostgreSQL.Pool
25 ( -- * Pools
47 ( -- * Pools
26− PoolPQ (..)
48+ Pool
27 , createConnectionPool
49 , createConnectionPool
28− , Pool
50+ , useConnectionPool
29− , destroyAllResources
51+ , destroyConnectionPool
30 ) where
52 ) where
31
53
32−import Control.Monad.Trans
33import Data.ByteString
54import Data.ByteString
34import Data.Time
55import Data.Time
35−import Generics.SOP (K(..))
56+import Generics.SOP (K(..), unK)
36import UnliftIO (MonadUnliftIO (..))
57import UnliftIO (MonadUnliftIO (..))
37import UnliftIO.Pool (Pool, createPool, destroyAllResources, withResource)
58import UnliftIO.Pool (Pool, createPool, destroyAllResources, withResource)
38
59
39−import qualified Control.Monad.Fail as Fail
40−
41import Squeal.PostgreSQL.PQ
60import 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
71
61
72-- | Create a striped pool of connections.
62-- | Create a striped pool of connections.
73-- 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.
63-- 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,31 @@ createConnectionPool
92createConnectionPool conninfo stripes idle maxResrc =
82createConnectionPool conninfo stripes idle maxResrc =
93 createPool (connectdb conninfo) finish stripes idle maxResrc
83 createPool (connectdb conninfo) finish stripes idle maxResrc
94
84
95−-- | `Applicative` instance for `PoolPQ`.
85+useConnectionPool
96−instance Monad m => Applicative (PoolPQ schemas m) where
86+ :: MonadUnliftIO io
97− pure x = PoolPQ $ \ _ -> pure x
87+ => Pool (K Connection schemas) -- ^ pool
98− PoolPQ f <*> PoolPQ x = PoolPQ $ \ pool -> do
88+ -> PQ schemas schemas io x -- ^ session
99− f' <- f pool
89+ -> io x
100− x' <- x pool
90+useConnectionPool pool (PQ session) = unK <$> withResource pool session
101− return $ f' x'
91+
102−
92+{- |
103−-- | `Monad` instance for `PoolPQ`.
93+Destroy all connections in all stripes in the pool.
104−instance Monad m => Monad (PoolPQ schemas m) where
94+Note that this will ignore any exceptions in the destroy function.
105− return = pure
95+
106− PoolPQ x >>= f = PoolPQ $ \ pool -> do
96+This function is useful when you detect that all connections
107− x' <- x pool
97+in the pool are broken. For example after a database has been
108− runPoolPQ (f x') pool
98+restarted all connections opened before the restart will be broken.
109−
99+In that case it's better to close those connections so that
110−-- | `Fail.MonadFail` instance for `PoolPQ`.
100+`useConnectionPool` won't take a broken connection from the pool
111−instance Monad m => Fail.MonadFail (PoolPQ schemas m) where
101+but will open a new connection instead.
112− fail = Fail.fail
102+
113−
103+Another use-case for this function is that when you know you are done
114−-- | `MonadTrans` instance for `PoolPQ`.
104+with the pool you can destroy all idle connections immediately
115−instance MonadTrans (PoolPQ schemas) where
105+instead of waiting on the garbage collector to destroy them,
116− lift m = PoolPQ $ \ _pool -> m
106+thus freeing up those connections sooner.
117−
107+-}
118−-- | `MonadPQ` instance for `PoolPQ`.
108+destroyConnectionPool
119−instance MonadUnliftIO io => MonadPQ schemas (PoolPQ schemas io) where
109+ :: MonadUnliftIO io
120− manipulateParams manipulation params = PoolPQ $ \ pool -> do
110+ => Pool (K Connection schemas) -- ^ pool
121− withResource pool $ \ conn -> do
111+ -> io ()
122− (K result :: K (K Result ys) schemas) <- flip unPQ conn $
112+destroyConnectionPool = destroyAllResources
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)