diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,7 @@ +## 2.6.2 + +* Expose new functions: `withPostgresqlPoolWithVersion`, `withPostgresqlConnWithVersion` and `createPostgresqlPoolModifiedWithVersion`. + ## 2.6.1 * Match changes in persistent diff --git a/Database/Persist/Postgresql.hs b/Database/Persist/Postgresql.hs --- a/Database/Persist/Postgresql.hs +++ b/Database/Persist/Postgresql.hs @@ -13,9 +13,12 @@ -- | A postgresql backend for persistent. module Database.Persist.Postgresql ( withPostgresqlPool + , withPostgresqlPoolWithVersion , withPostgresqlConn + , withPostgresqlConnWithVersion , createPostgresqlPool , createPostgresqlPoolModified + , createPostgresqlPoolModifiedWithVersion , module Database.Persist.Sql , ConnectionString , PostgresConf (..) @@ -112,8 +115,25 @@ -- ^ Action to be executed that uses the -- connection pool. -> m a -withPostgresqlPool ci = withSqlPool $ open' (const $ return ()) ci +withPostgresqlPool ci = withPostgresqlPoolWithVersion getServerVersion ci +-- | Same as 'withPostgresPool', but takes a callback for obtaining +-- the server version (to workaround an Amazon Redshift bug). +-- +-- @since 2.6.2 +withPostgresqlPoolWithVersion :: (MonadBaseControl IO m, MonadLogger m, MonadIO m, IsSqlBackend backend) + => (PG.Connection -> IO (Maybe Double)) + -- ^ action to perform to get the server version + -> ConnectionString + -- ^ Connection string to the database. + -> Int + -- ^ Number of connections to be kept open in + -- the pool. + -> (Pool backend -> m a) + -- ^ Action to be executed that uses the + -- connection pool. + -> m a +withPostgresqlPoolWithVersion getVer ci = withSqlPool $ open' (const $ return ()) getVer ci -- | Create a PostgreSQL connection pool. Note that it's your -- responsibility to properly close the connection pool when @@ -135,28 +155,58 @@ -- -- -- --- Since 2.1.3 +-- @since 2.1.3 createPostgresqlPoolModified :: (MonadIO m, MonadBaseControl IO m, MonadLogger m, IsSqlBackend backend) => (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 (Pool backend) -createPostgresqlPoolModified modConn ci = createSqlPool $ open' modConn ci +createPostgresqlPoolModified = createPostgresqlPoolModifiedWithVersion getServerVersion +-- | Same as other similarly-named functions in this module, but takes callbacks for obtaining +-- the server version (to workaround an Amazon Redshift bug) and connection-specific tweaking +-- (to change the schema). +-- +-- @since 2.6.2 +createPostgresqlPoolModifiedWithVersion + :: (MonadIO m, MonadBaseControl IO m, MonadLogger m, IsSqlBackend backend) + => (PG.Connection -> IO (Maybe Double)) -- ^ action to perform to get the server version + -> (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 (Pool backend) +createPostgresqlPoolModifiedWithVersion getVer modConn ci = + createSqlPool $ open' modConn getVer 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, IsSqlBackend backend) => ConnectionString -> (backend -> m a) -> m a -withPostgresqlConn = withSqlConn . open' (const $ return ()) +withPostgresqlConn = withPostgresqlConnWithVersion getServerVersion +-- | Same as 'withPostgresqlConn', but takes a callback for obtaining +-- the server version (to workaround an Amazon Redshift bug). +-- +-- @since 2.6.2 +withPostgresqlConnWithVersion :: (MonadIO m, MonadBaseControl IO m, MonadLogger m, IsSqlBackend backend) + => (PG.Connection -> IO (Maybe Double)) + -> ConnectionString + -> (backend -> m a) + -> m a +withPostgresqlConnWithVersion getVer = withSqlConn . open' (const $ return ()) getVer + open' :: (IsSqlBackend backend) - => (PG.Connection -> IO ()) -> ConnectionString -> LogFunc -> IO backend -open' modConn cstr logFunc = do + => (PG.Connection -> IO ()) + -> (PG.Connection -> IO (Maybe Double)) + -> ConnectionString -> LogFunc -> IO backend +open' modConn getVer cstr logFunc = do conn <- PG.connectPostgreSQL cstr modConn conn - openSimpleConn logFunc conn + ver <- getVer conn + smap <- newIORef $ Map.empty + return $ createBackend logFunc ver smap conn -- | Gets the PostgreSQL server version getServerVersion :: PG.Connection -> IO (Maybe Double) @@ -179,17 +229,25 @@ then Just upsertSql' else Nothing + -- | Generate a 'Connection' from a 'PG.Connection' openSimpleConn :: (IsSqlBackend backend) => LogFunc -> PG.Connection -> IO backend openSimpleConn logFunc conn = do smap <- newIORef $ Map.empty serverVersion <- getServerVersion conn - return . mkPersistBackend $ SqlBackend + return $ createBackend logFunc serverVersion smap conn + +-- | Create the backend given a logging function, server version, mutable statement cell, +-- and connection +createBackend :: IsSqlBackend backend => LogFunc -> Maybe Double + -> IORef (Map.Map Text Statement) -> PG.Connection -> backend +createBackend logFunc serverVersion smap conn = do + mkPersistBackend $ SqlBackend { connPrepare = prepare' conn , connStmtMap = smap , connInsertSql = insertSql' , connInsertManySql = Just insertManySql' - , connUpsertSql = maybe Nothing upsertFunction serverVersion + , connUpsertSql = maybe Nothing upsertFunction serverVersion , connClose = PG.close conn , connMigrateSql = migrate' , connBegin = const $ PG.begin conn diff --git a/persistent-postgresql.cabal b/persistent-postgresql.cabal --- a/persistent-postgresql.cabal +++ b/persistent-postgresql.cabal @@ -1,5 +1,5 @@ name: persistent-postgresql -version: 2.6.1 +version: 2.6.2 license: MIT license-file: LICENSE author: Felipe Lessa, Michael Snoyman