Safe Haskell | None |
---|---|
Language | Haskell2010 |
A postgresql backend for persistent.
Synopsis
- withPostgresqlPool :: (MonadLoggerIO m, MonadUnliftIO m) => ConnectionString -> Int -> (Pool SqlBackend -> m a) -> m a
- withPostgresqlPoolWithVersion :: (MonadUnliftIO m, MonadLoggerIO m) => (Connection -> IO (Maybe Double)) -> ConnectionString -> Int -> (Pool SqlBackend -> m a) -> m a
- withPostgresqlPoolWithConf :: (MonadUnliftIO m, MonadLoggerIO m) => PostgresConf -> PostgresConfHooks -> (Pool SqlBackend -> m a) -> m a
- withPostgresqlPoolModified :: (MonadUnliftIO m, MonadLoggerIO m) => (Connection -> IO ()) -> ConnectionString -> Int -> (Pool SqlBackend -> m t) -> m t
- withPostgresqlPoolModifiedWithVersion :: (MonadUnliftIO m, MonadLoggerIO m) => (Connection -> IO (Maybe Double)) -> (Connection -> IO ()) -> ConnectionString -> Int -> (Pool SqlBackend -> m t) -> m t
- withPostgresqlConn :: (MonadUnliftIO m, MonadLoggerIO m) => ConnectionString -> (SqlBackend -> m a) -> m a
- withPostgresqlConnWithVersion :: (MonadUnliftIO m, MonadLoggerIO m) => (Connection -> IO (Maybe Double)) -> ConnectionString -> (SqlBackend -> m a) -> m a
- createPostgresqlPool :: (MonadUnliftIO m, MonadLoggerIO m) => ConnectionString -> Int -> m (Pool SqlBackend)
- createPostgresqlPoolModified :: (MonadUnliftIO m, MonadLoggerIO m) => (Connection -> IO ()) -> ConnectionString -> Int -> m (Pool SqlBackend)
- createPostgresqlPoolModifiedWithVersion :: (MonadUnliftIO m, MonadLoggerIO m) => (Connection -> IO (Maybe Double)) -> (Connection -> IO ()) -> ConnectionString -> Int -> m (Pool SqlBackend)
- createPostgresqlPoolWithConf :: (MonadUnliftIO m, MonadLoggerIO m) => PostgresConf -> PostgresConfHooks -> m (Pool SqlBackend)
- module Database.Persist.Sql
- type ConnectionString = ByteString
- data HandleUpdateCollision record
- copyField :: PersistField typ => EntityField record typ -> HandleUpdateCollision record
- copyUnlessNull :: PersistField typ => EntityField record (Maybe typ) -> HandleUpdateCollision record
- copyUnlessEmpty :: (Monoid typ, PersistField typ) => EntityField record typ -> HandleUpdateCollision record
- copyUnlessEq :: PersistField typ => EntityField record typ -> typ -> HandleUpdateCollision record
- excludeNotEqualToOriginal :: (PersistField typ, PersistEntity rec) => EntityField rec typ -> Filter rec
- data PostgresConf = PostgresConf {}
- newtype PgInterval = PgInterval {}
- upsertWhere :: (backend ~ PersistEntityBackend record, PersistEntity record, PersistEntityBackend record ~ SqlBackend, MonadIO m, PersistStore backend, BackendCompatible SqlBackend backend, OnlyOneUniqueKey record) => record -> [Update record] -> [Filter record] -> ReaderT backend m ()
- upsertManyWhere :: forall record backend m. (backend ~ PersistEntityBackend record, BackendCompatible SqlBackend backend, PersistEntityBackend record ~ SqlBackend, PersistEntity record, OnlyOneUniqueKey record, MonadIO m) => [record] -> [HandleUpdateCollision record] -> [Update record] -> [Filter record] -> ReaderT backend m ()
- openSimpleConn :: LogFunc -> Connection -> IO SqlBackend
- openSimpleConnWithVersion :: (Connection -> IO (Maybe Double)) -> LogFunc -> Connection -> IO SqlBackend
- getSimpleConn :: BackendCompatible SqlBackend backend => backend -> Maybe Connection
- tableName :: PersistEntity record => record -> Text
- fieldName :: PersistEntity record => EntityField record typ -> Text
- mockMigration :: Migration -> IO ()
- migrateEnableExtension :: Text -> Migration
- data PostgresConfHooks = PostgresConfHooks {
- pgConfHooksGetServerVersion :: Connection -> IO (NonEmpty Word)
- pgConfHooksAfterCreate :: Connection -> IO ()
- defaultPostgresConfHooks :: PostgresConfHooks
- data RawPostgresql backend = RawPostgresql {
- persistentBackend :: backend
- rawPostgresqlConnection :: Connection
- createRawPostgresqlPool :: (MonadUnliftIO m, MonadLoggerIO m) => ConnectionString -> Int -> m (Pool (RawPostgresql SqlBackend))
- createRawPostgresqlPoolModified :: (MonadUnliftIO m, MonadLoggerIO m) => (Connection -> IO ()) -> ConnectionString -> Int -> m (Pool (RawPostgresql SqlBackend))
- createRawPostgresqlPoolModifiedWithVersion :: (MonadUnliftIO m, MonadLoggerIO m) => (Connection -> IO (Maybe Double)) -> (Connection -> IO ()) -> ConnectionString -> Int -> m (Pool (RawPostgresql SqlBackend))
- createRawPostgresqlPoolWithConf :: (MonadUnliftIO m, MonadLoggerIO m) => PostgresConf -> PostgresConfHooks -> m (Pool (RawPostgresql SqlBackend))
Documentation
:: (MonadLoggerIO m, MonadUnliftIO m) | |
=> ConnectionString | Connection string to the database. |
-> Int | Number of connections to be kept open in the pool. |
-> (Pool SqlBackend -> m a) | Action to be executed that uses the connection pool. |
-> m a |
Create a PostgreSQL connection pool and run the given action. The pool is
properly released after the action finishes using it. Note that you should
not use the given ConnectionPool
outside the action since it may already
have been released.
The provided action should use runSqlConn
and *not* runReaderT
because
the former brackets the database action with transaction begin/commit.
withPostgresqlPoolWithVersion Source #
:: (MonadUnliftIO m, MonadLoggerIO m) | |
=> (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 SqlBackend -> m a) | Action to be executed that uses the connection pool. |
-> m a |
Same as withPostgresPool
, but takes a callback for obtaining
the server version (to work around an Amazon Redshift bug).
Since: 2.6.2
withPostgresqlPoolWithConf Source #
:: (MonadUnliftIO m, MonadLoggerIO m) | |
=> PostgresConf | Configuration for connecting to Postgres |
-> PostgresConfHooks | Record of callback functions |
-> (Pool SqlBackend -> m a) | Action to be executed that uses the connection pool. |
-> m a |
Same as withPostgresqlPool
, but can be configured with PostgresConf
and PostgresConfHooks
.
Since: 2.11.0.0
withPostgresqlPoolModified Source #
:: (MonadUnliftIO m, MonadLoggerIO m) | |
=> (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. |
-> (Pool SqlBackend -> m t) | |
-> m t |
Same as withPostgresqlPool
, but with the createPostgresqlPoolModified
feature.
Since: 2.13.5.0
withPostgresqlPoolModifiedWithVersion Source #
:: (MonadUnliftIO m, MonadLoggerIO m) | |
=> (Connection -> IO (Maybe Double)) | Action to perform to get the server version. |
-> (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. |
-> (Pool SqlBackend -> m t) | |
-> m t |
Same as withPostgresqlPool
, but with the
createPostgresqlPoolModifiedWithVersion
feature.
Since: 2.13.5.0
withPostgresqlConn :: (MonadUnliftIO m, MonadLoggerIO m) => ConnectionString -> (SqlBackend -> m a) -> m a Source #
Same as withPostgresqlPool
, but instead of opening a pool
of connections, only one connection is opened.
The provided action should use runSqlConn
and *not* runReaderT
because
the former brackets the database action with transaction begin/commit.
withPostgresqlConnWithVersion :: (MonadUnliftIO m, MonadLoggerIO m) => (Connection -> IO (Maybe Double)) -> ConnectionString -> (SqlBackend -> m a) -> m a Source #
Same as withPostgresqlConn
, but takes a callback for obtaining
the server version (to work around an Amazon Redshift bug).
Since: 2.6.2
:: (MonadUnliftIO m, MonadLoggerIO m) | |
=> ConnectionString | Connection string to the database. |
-> Int | Number of connections to be kept open in the pool. |
-> m (Pool SqlBackend) |
Create a PostgreSQL connection pool. Note that it's your
responsibility to properly close the connection pool when
unneeded. Use withPostgresqlPool
for an automatic resource
control.
createPostgresqlPoolModified Source #
:: (MonadUnliftIO m, MonadLoggerIO m) | |
=> (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 SqlBackend) |
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
createPostgresqlPoolModifiedWithVersion Source #
:: (MonadUnliftIO m, MonadLoggerIO m) | |
=> (Connection -> IO (Maybe Double)) | Action to perform to get the server version. |
-> (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 SqlBackend) |
Same as other similarly-named functions in this module, but takes callbacks for obtaining the server version (to work around an Amazon Redshift bug) and connection-specific tweaking (to change the schema).
Since: 2.6.2
createPostgresqlPoolWithConf Source #
:: (MonadUnliftIO m, MonadLoggerIO m) | |
=> PostgresConf | Configuration for connecting to Postgres |
-> PostgresConfHooks | Record of callback functions |
-> m (Pool SqlBackend) |
Same as createPostgresqlPool
, but can be configured with PostgresConf
and PostgresConfHooks
.
Since: 2.11.0.0
module Database.Persist.Sql
type ConnectionString = ByteString Source #
A libpq
connection string. A simple example of connection
string would be "host=localhost port=5432 user=test
dbname=test password=test"
. Please read libpq's
documentation at
https://www.postgresql.org/docs/current/static/libpq-connect.html
for more details on how to create such strings.
data HandleUpdateCollision record Source #
This type is used to determine how to update rows using Postgres'
INSERT ... ON CONFLICT KEY UPDATE
functionality, exposed via
upsertWhere
and upsertManyWhere
in this library.
Since: 2.12.1.0
copyField :: PersistField typ => EntityField record typ -> HandleUpdateCollision record Source #
Copy the field directly from the record.
Since: 2.12.1.0
copyUnlessNull :: PersistField typ => EntityField record (Maybe typ) -> HandleUpdateCollision record Source #
Copy the field into the database only if the value in the
corresponding record is non-NULL
.
@since 2.12.1.0
copyUnlessEmpty :: (Monoid typ, PersistField typ) => EntityField record typ -> HandleUpdateCollision record Source #
Copy the field into the database only if the value in the
corresponding record is non-empty, where "empty" means the Monoid
definition for mempty
. Useful for Text
, String
, ByteString
, etc.
The resulting HandleUpdateCollision
type is useful for the
upsertManyWhere
function.
@since 2.12.1.0
copyUnlessEq :: PersistField typ => EntityField record typ -> typ -> HandleUpdateCollision record Source #
Copy the field into the database only if the field is not equal to the provided value. This is useful to avoid copying weird nullary data into the database.
The resulting HandleUpdateCollision
type is useful for the
upsertMany
function.
@since 2.12.1.0
excludeNotEqualToOriginal :: (PersistField typ, PersistEntity rec) => EntityField rec typ -> Filter rec Source #
Exclude any record field if it doesn't match the filter record. Used only in upsertWhere
and
upsertManyWhere
TODO: we could probably make a sum type for the Filter
record that's passed into the upsertWhere
and
upsertManyWhere
methods that has similar behavior to the HandleCollisionUpdate type.
Since: 2.12.1.0
data PostgresConf Source #
Information required to connect to a PostgreSQL database
using persistent
's generic facilities. These values are the
same that are given to withPostgresqlPool
.
PostgresConf | |
|
Instances
newtype PgInterval Source #
Represent Postgres interval using NominalDiffTime
Since: 2.11.0.0
Instances
Eq PgInterval Source # | |
Defined in Database.Persist.Postgresql.Internal (==) :: PgInterval -> PgInterval -> Bool # (/=) :: PgInterval -> PgInterval -> Bool # | |
Show PgInterval Source # | |
Defined in Database.Persist.Postgresql.Internal showsPrec :: Int -> PgInterval -> ShowS # show :: PgInterval -> String # showList :: [PgInterval] -> ShowS # | |
PersistFieldSql PgInterval Source # | |
Defined in Database.Persist.Postgresql.Internal sqlType :: Proxy PgInterval -> SqlType # | |
PersistField PgInterval Source # | |
Defined in Database.Persist.Postgresql.Internal | |
FromField PgInterval Source # | |
Defined in Database.Persist.Postgresql.Internal | |
ToField PgInterval Source # | |
Defined in Database.Persist.Postgresql.Internal toField :: PgInterval -> Action # |
upsertWhere :: (backend ~ PersistEntityBackend record, PersistEntity record, PersistEntityBackend record ~ SqlBackend, MonadIO m, PersistStore backend, BackendCompatible SqlBackend backend, OnlyOneUniqueKey record) => record -> [Update record] -> [Filter record] -> ReaderT backend m () Source #
Postgres specific upsertWhere
. This method does the following:
It will insert a record if no matching unique key exists.
If a unique key exists, it will update the relevant field with a user-supplied value, however,
it will only do this update on a user-supplied condition.
For example, here's how this method could be called like such:
upsertWhere record [recordField =. newValue] [recordField /= newValue]
Called thusly, this method will insert a new record (if none exists) OR update a recordField with a new value assuming the condition in the last block is met.
Since: 2.12.1.0
:: forall record backend m. (backend ~ PersistEntityBackend record, BackendCompatible SqlBackend backend, PersistEntityBackend record ~ SqlBackend, PersistEntity record, OnlyOneUniqueKey record, MonadIO m) | |
=> [record] | A list of the records you want to insert, or update |
-> [HandleUpdateCollision record] | A list of the fields you want to copy over. |
-> [Update record] | A list of the updates to apply that aren't dependent on the record being inserted. |
-> [Filter record] | A filter condition that dictates the scope of the updates |
-> ReaderT backend m () |
Postgres specific upsertManyWhere
. This method does the following:
It will insert a record if no matching unique key exists.
If a unique key exists, it will update the relevant field with a user-supplied value, however,
it will only do this update on a user-supplied condition.
For example, here's how this method could be called like such:
upsertManyWhere [record] [recordField =. newValue] [recordField !=. newValue]
Called thusly, this method will insert a new record (if none exists) OR update a recordField with a new value assuming the condition in the last block is met.
Since: 2.12.1.0
openSimpleConn :: LogFunc -> Connection -> IO SqlBackend Source #
Generate a SqlBackend
from a Connection
.
openSimpleConnWithVersion :: (Connection -> IO (Maybe Double)) -> LogFunc -> Connection -> IO SqlBackend Source #
Generate a SqlBackend
from a Connection
, but takes a callback for
obtaining the server version.
Since: 2.9.1
getSimpleConn :: BackendCompatible SqlBackend backend => backend -> Maybe Connection Source #
Access underlying connection, returning Nothing
if the SqlBackend
provided isn't backed by postgresql-simple.
Since: 2.13.0
tableName :: PersistEntity record => record -> Text Source #
Get the SQL string for the table that a PeristEntity represents. Useful for raw SQL queries.
fieldName :: PersistEntity record => EntityField record typ -> Text Source #
Get the SQL string for the field that an EntityField represents. Useful for raw SQL queries.
mockMigration :: Migration -> IO () Source #
Mock a migration even when the database is not present.
This function performs the same functionality of printMigration
with the difference that an actual database is not needed.
migrateEnableExtension :: Text -> Migration Source #
Enable a Postgres extension. See https://www.postgresql.org/docs/current/static/contrib.html for a list.
data PostgresConfHooks Source #
Hooks for configuring the Persistent/its connection to Postgres
Since: 2.11.0
PostgresConfHooks | |
|
defaultPostgresConfHooks :: PostgresConfHooks Source #
Default settings for PostgresConfHooks
. See the individual fields of PostgresConfHooks
for the default values.
Since: 2.11.0
data RawPostgresql backend Source #
Wrapper for persistent SqlBackends that carry the corresponding
Connection
.
Since: 2.13.1.0
RawPostgresql | |
|
Instances
createRawPostgresqlPool Source #
:: (MonadUnliftIO m, MonadLoggerIO m) | |
=> ConnectionString | Connection string to the database. |
-> Int | Number of connections to be kept open in the pool. |
-> m (Pool (RawPostgresql SqlBackend)) |
Create a PostgreSQL connection pool which also exposes the
raw connection. The raw counterpart to createPostgresqlPool
.
Since: 2.13.1.0
createRawPostgresqlPoolModified Source #
:: (MonadUnliftIO m, MonadLoggerIO m) | |
=> (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 (RawPostgresql SqlBackend)) |
The raw counterpart to createPostgresqlPoolModified
.
Since: 2.13.1.0
createRawPostgresqlPoolModifiedWithVersion Source #
:: (MonadUnliftIO m, MonadLoggerIO m) | |
=> (Connection -> IO (Maybe Double)) | Action to perform to get the server version. |
-> (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 (RawPostgresql SqlBackend)) |
The raw counterpart to createPostgresqlPoolModifiedWithVersion
.
Since: 2.13.1.0
createRawPostgresqlPoolWithConf Source #
:: (MonadUnliftIO m, MonadLoggerIO m) | |
=> PostgresConf | Configuration for connecting to Postgres |
-> PostgresConfHooks | Record of callback functions |
-> m (Pool (RawPostgresql SqlBackend)) |
The raw counterpart to createPostgresqlPoolWithConf
.
Since: 2.13.1.0