Skip to content

Commit

Permalink
createPostgresqlPoolModified function added
Browse files Browse the repository at this point in the history
  • Loading branch information
snoyberg committed Mar 18, 2015
1 parent 542c64e commit bbb0ce0
Show file tree
Hide file tree
Showing 3 changed files with 31 additions and 9 deletions.
5 changes: 3 additions & 2 deletions persistent-postgresql/ChangeLog.md
@@ -1,6 +1,7 @@
## Master
## 2.1.3

Added a `Show` instance for `PostgresConf`.
* Added a `Show` instance for `PostgresConf`.
* `createPostgresqlPoolModified` added, see [relevant mailing list discussion](https://groups.google.com/d/msg/yesodweb/qUXrEN_swEo/O0pFwqwQIdcJ)

## 2.1.2.1

Expand Down
33 changes: 27 additions & 6 deletions persistent-postgresql/Database/Persist/Postgresql.hs
Expand Up @@ -12,6 +12,7 @@ module Database.Persist.Postgresql
( withPostgresqlPool
, withPostgresqlConn
, createPostgresqlPool
, createPostgresqlPoolModified
, module Database.Persist.Sql
, ConnectionString
, PostgresConf (..)
Expand Down Expand Up @@ -88,7 +89,7 @@ withPostgresqlPool :: (MonadBaseControl IO m, MonadLogger m, MonadIO m)
-- ^ Action to be executed that uses the
-- connection pool.
-> m a
withPostgresqlPool ci = withSqlPool $ open' ci
withPostgresqlPool ci = withSqlPool $ open' (const $ return ()) ci


-- | Create a PostgreSQL connection pool. Note that it's your
Expand All @@ -102,17 +103,37 @@ createPostgresqlPool :: (MonadIO m, MonadBaseControl IO m, MonadLogger m)
-- ^ Number of connections to be kept open
-- in the pool.
-> m ConnectionPool
createPostgresqlPool ci = createSqlPool $ open' ci

createPostgresqlPool = createPostgresqlPoolModified (const $ return ())

-- | Same as 'createPostgresqlPool', but additionally takes a callback function
-- for some connection-specific tweaking to be performed after connection
-- creation. This could be used, for example, to change the schema. For more
-- information, see:
--
-- <https://groups.google.com/d/msg/yesodweb/qUXrEN_swEo/O0pFwqwQIdcJ>
--
-- Since 2.1.3
createPostgresqlPoolModified
:: (MonadIO m, MonadBaseControl IO m, MonadLogger m)
=> (PG.Connection -> IO ()) -- ^ action to perform after connection is created
-> ConnectionString -- ^ Connection string to the database.
-> Int -- ^ Number of connections to be kept open in the pool.
-> m ConnectionPool
createPostgresqlPoolModified modConn ci = createSqlPool $ open' modConn ci

-- | Same as 'withPostgresqlPool', but instead of opening a pool
-- of connections, only one connection is opened.
withPostgresqlConn :: (MonadIO m, MonadBaseControl IO m, MonadLogger m)
=> ConnectionString -> (SqlBackend -> m a) -> m a
withPostgresqlConn = withSqlConn . open'
withPostgresqlConn = withSqlConn . open' (const $ return ())

open' :: (PG.Connection -> IO ())
-> ConnectionString -> LogFunc -> IO SqlBackend
open' modConn cstr logFunc = do
conn <- PG.connectPostgreSQL cstr
modConn conn
openSimpleConn logFunc conn

open' :: ConnectionString -> LogFunc -> IO SqlBackend
open' cstr logFunc = PG.connectPostgreSQL cstr >>= openSimpleConn logFunc

-- | Generate a 'Connection' from a 'PG.Connection'
openSimpleConn :: LogFunc -> PG.Connection -> IO SqlBackend
Expand Down
2 changes: 1 addition & 1 deletion persistent-postgresql/persistent-postgresql.cabal
@@ -1,5 +1,5 @@
name: persistent-postgresql
version: 2.1.2.2
version: 2.1.3
license: MIT
license-file: LICENSE
author: Felipe Lessa, Michael Snoyman <michael@snoyman.com>
Expand Down

0 comments on commit bbb0ce0

Please sign in to comment.