persistent-sql-lifted-0.4.3.1: Monad classes for running queries with Persistent and Esqueleto
Safe HaskellSafe-Inferred
LanguageGHC2021

Database.Persist.Sql.Lifted

Description

Re-exports from:

There are a few name conflicts between Persistent and Esqueleto. Where conflicts occur, this module gives preference to Esqueleto. The following Persistent definitions are renamed:

Synopsis

Core concepts

class (MonadSqlBackend db, MonadUnliftIO m) => MonadSqlTx db m | m -> db where Source #

The constraint MonadSqlTx db m indicates that m is a monadic context that can run db actions, usually as a SQL transaction. Typically, this means that db needs a connection and m can provide one, e.g. from a connection pool.

Methods

runSqlTx :: forall a. HasCallStack => db a -> m a Source #

Runs the action in a SQL transaction

class HasSqlBackend a where Source #

Instances

Instances details
HasSqlBackend SqlBackend Source # 
Instance details

Defined in Database.Persist.Sql.Lifted.HasSqlBackend

data SqlBackend #

A SqlBackend represents a handle or connection to a database. It contains functions and values that allow databases to have more optimized implementations, as well as references that benefit performance and sharing.

Instead of using the SqlBackend constructor directly, use the mkSqlBackend function.

A SqlBackend is *not* thread-safe. You should not assume that a SqlBackend can be shared among threads and run concurrent queries. This *will* result in problems. Instead, you should create a Pool SqlBackend, known as a ConnectionPool, and pass that around in multi-threaded applications.

To run actions in the persistent library, you should use the runSqlConn function. If you're using a multithreaded application, use the runSqlPool function.

Instances

Instances details
HasPersistBackend SqlBackend 
Instance details

Defined in Database.Persist.SqlBackend.Internal

Associated Types

type BaseBackend SqlBackend #

IsPersistBackend SqlBackend 
Instance details

Defined in Database.Persist.SqlBackend.Internal

HasSqlBackend SqlBackend Source # 
Instance details

Defined in Database.Persist.Sql.Lifted.HasSqlBackend

newtype BackendKey SqlBackend 
Instance details

Defined in Database.Persist.Sql.Orphan.PersistStore

type BaseBackend SqlBackend 
Instance details

Defined in Database.Persist.SqlBackend.Internal

type Rep (BackendKey SqlBackend) 
Instance details

Defined in Database.Persist.Sql.Orphan.PersistStore

type Rep (BackendKey SqlBackend) = D1 ('MetaData "BackendKey" "Database.Persist.Sql.Orphan.PersistStore" "persistent-2.15.1.0-18EFgO0PgmjDdch24u6s9Z" 'True) (C1 ('MetaCons "SqlBackendKey" 'PrefixI 'True) (S1 ('MetaSel ('Just "unSqlBackendKey") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Int64)))

class MonadUnliftIO m => MonadSqlBackend m where Source #

A monadic context in which a SQL backend is available for running database queries

Instances

Instances details
(HasSqlBackend r, MonadUnliftIO m) => MonadSqlBackend (ReaderT r m) Source # 
Instance details

Defined in Database.Persist.Sql.Lifted.MonadSqlBackend

liftSql :: forall m a. (HasCallStack, MonadSqlBackend m) => ReaderT SqlBackend m a -> m a Source #

Generalize from SqlPersistT to MonadSqlBackend

Getting by key

get :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => Key a -> m (Maybe a) Source #

Get a record by identifier, if available

getBy :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => Unique a -> m (Maybe (Entity a)) Source #

Get a record by unique key, if available, returning both the identifier and the record

getByValue Source #

Arguments

:: forall a m. (AtLeastOneUniqueKey a, HasCallStack, MonadSqlBackend m, PersistEntityBackend a ~ SqlBackend) 
=> a 
-> m (Maybe (Entity a))

A record matching one of the unique keys.

getEntity :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => Key a -> m (Maybe (Entity a)) Source #

Get a record by identifier, if available

getJust :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => Key a -> m a Source #

Get a record by identifier, if available, for a non-null (not Maybe) foreign key

Unsafe unless your database is enforcing that the foreign key is valid.

getJustEntity :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => Key a -> m (Entity a) Source #

Get a record by identifier, if available, for a non-null (not Maybe) foreign key

Unsafe unless your database is enforcing that the foreign key is valid.

getMany :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => [Key a] -> m (Map (Key a) a) Source #

Get many records by their respective identifiers, if available

Selecting by filter

select Source #

Arguments

:: forall a r m. (HasCallStack, MonadSqlBackend m, SqlSelect a r) 
=> SqlQuery a 
-> m [r]

A list of rows

Execute an Esqueleto SELECT query

selectOne Source #

Arguments

:: forall a r m. (HasCallStack, MonadSqlBackend m, SqlSelect a r) 
=> SqlQuery a 
-> m (Maybe r)

The first row, or Nothing if no rows are selected

Execute an Esqueleto SELECT query, getting only the first row

selectFirst Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) 
=> [Filter a]

If you provide multiple values in the list, the conditions are ANDed together.

-> [SelectOpt a] 
-> m (Maybe (Entity a)) 

Get just the first record for the criteria

selectKeysList Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) 
=> [Filter a]

If you provide multiple values in the list, the conditions are ANDed together.

-> [SelectOpt a] 
-> m [Key a] 

Get the Keys of all records matching the given criteria

selectList Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) 
=> [Filter a]

If you provide multiple values in the list, the conditions are ANDed together.

-> [SelectOpt a] 
-> m [Entity a]

Entities corresponding to the filters and options provided

Selecting counts/existence

count Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) 
=> [Filter a]

If you provide multiple values in the list, the conditions are ANDed together.

-> m Int 

The total number of records fulfilling the given criteria

exists Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) 
=> [Filter a]

If you provide multiple values in the list, the conditions are ANDed together.

-> m Bool 

Check if there is at least one record fulfilling the given criteria

existsBy :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => Unique a -> m Bool Source #

Check if a record with this unique key exists

Inserting

insertSelect :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a) => SqlQuery (SqlExpr (Insertion a)) -> m () Source #

Insert a PersistField for every selected value

insertSelectCount Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a) 
=> SqlQuery (SqlExpr (Insertion a)) 
-> m Int64

The number of inserted rows

Insert a PersistField for every selected value, returning the count

insert Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend, SafeToInsert a) 
=> a 
-> m (Key a)

The auto-increment ID that was generated

Create a new record in the database

insert_ :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend, SafeToInsert a) => a -> m () Source #

Create a new record in the database

insertBy Source #

Arguments

:: forall a m. (AtLeastOneUniqueKey a, HasCallStack, MonadSqlBackend m, PersistEntityBackend a ~ SqlBackend, SafeToInsert a) 
=> a 
-> m (Either (Entity a) (Key a))

If a duplicate exists in the database, it is returned as Left. Otherwise, the new Key is returned as Right.

Insert a value, checking for conflicts with any unique constraints

insertEntity :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend, SafeToInsert a) => a -> m (Entity a) Source #

Create a new record in the database, returning an auto-increment ID and the inserted record

insertEntityMany :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => [Entity a] -> m () Source #

Create multiple records in the database, with specified keys

insertKey :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => Key a -> a -> m () Source #

Create a new record in the database using the given key

insertMany :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend, SafeToInsert a) => [a] -> m [Key a] Source #

Create multiple records in the database and return their Keys

insertMany_ :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend, SafeToInsert a) => [a] -> m () Source #

Create multiple records in the database

insertRecord Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend, SafeToInsert a) 
=> a 
-> m a

The record that was inserted

Create a new record in the database

insertUnique Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend, SafeToInsert a) 
=> a 
-> m (Maybe (Key a))

An auto-increment ID, or Nothing when the record couldn't be inserted because of a uniqueness constraint

Create a new record in the database

insertUnique_ Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend, SafeToInsert a) 
=> a 
-> m (Maybe ())

(), or Nothing when the record couldn't be inserted because of a uniqueness constraint

Create a new record in the database

insertUniqueEntity Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend, SafeToInsert a) 
=> a 
-> m (Maybe (Entity a))

An auto-increment ID and the inserted record, or Nothing when the record couldn't be inserted because of a uniqueness constraint.

Create a new record in the database

Updating

update :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => (SqlExpr (Entity a) -> SqlQuery ()) -> m () Source #

Execute an Esqueleto UPDATE query

updateCount Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) 
=> (SqlExpr (Entity a) -> SqlQuery ()) 
-> m Int64

The number of inserted rows

Execute an Esqueleto UPDATE query, returning the count

update' :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => Key a -> [Update a] -> m () Source #

Update individual fields on a specific record

updateGet :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => Key a -> [Update a] -> m a Source #

Update individual fields on a specific record, and retrieve the updated value from the database

This function will throw an exception if the given key is not found in the database.

updateGetEntity :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => Key a -> [Update a] -> m (Entity a) Source #

Update individual fields on a specific record, and retrieve the updated Entity from the database

This function will throw an exception if the given key is not found in the database.

updateWhere Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) 
=> [Filter a]

If you provide multiple values in the list, the conditions are ANDed together.

-> [Update a] 
-> m () 

Update individual fields on any record matching the given criteria

updateWhereCount Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) 
=> [Filter a]

If you provide multiple values in the list, the conditions are ANDed together.

-> [Update a] 
-> m Int64

The number of rows affected

Update individual fields on any record matching the given criteria

Insert/update combinations

replace :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => Key a -> a -> m () Source #

Replace the record in the database with the given key

The result is undefined if such record does not exist.

replaceUnique Source #

Arguments

:: forall a m. (Eq (Unique a), HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) 
=> Key a 
-> a 
-> m (Maybe (Unique a))

Nothing if the replacement was made. If uniqueness is violated, Just the Unique violation.

Attempt to replace the record of the given key with the given new record

First query the unique fields to make sure the replacement maintains uniqueness constraints.

repsert :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => Key a -> a -> m () Source #

Put the record in the database with the given key

If a record with the given key does not exist then a new record will be inserted.

repsertMany :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => [(Key a, a)] -> m () Source #

Put many entities into the database

For each item, if a record with the given key does not exist then a new record will be inserted.

upsert Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, OnlyOneUniqueKey a, PersistEntityBackend a ~ SqlBackend, SafeToInsert a) 
=> a

New record to insert

-> [Update a]

Updates to perform if the record already exists

-> m (Entity a)

The record in the database after the operation

Update based on a uniqueness constraint or insert:

  • Unsert the new record if it does not exist;
  • If the record exists (matched via it's uniqueness constraint), then update the existing record with the parameters which is passed on as list to the function.

upsertBy Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend, SafeToInsert a) 
=> Unique a

Uniqueness constraint to find by

-> a

New record to insert

-> [Update a]

Updates to perform if the record already exists

-> m (Entity a)

The record in the database after the operation

Update based on a given uniqueness constraint or insert:

  • Insert the new record if it does not exist;
  • Update the existing record that matches the given uniqueness constraint.

putMany Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend, SafeToInsert a) 
=> [a]

A list of the records you want to insert or replace.

-> m () 

Put many records into the database

  • Insert new records that do not exist (or violate any unique constraints);
  • Replace existing records (matching any unique constraint).

Working with unique constraints

checkUnique Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) 
=> a 
-> m (Maybe (Unique a))

Nothing if the entity would be unique, and could thus safely be inserted. On a conflict, Just the conflicting key.

Check whether there are any conflicts for unique keys with this entity and existing entities in the database

checkUniqueUpdateable Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) 
=> Entity a 
-> m (Maybe (Unique a))

Nothing if the entity would stay unique, and could thus safely be updated. On a conflict, Just the conflicting key.

Check whether there are any conflicts for unique keys with this entity and existing entities in the database

This is useful for updating because it ignores conflicts when the particular entity already exists.

onlyUnique :: forall a m. (HasCallStack, MonadSqlBackend m, OnlyOneUniqueKey a, PersistEntityBackend a ~ SqlBackend) => a -> m (Unique a) Source #

Return the single unique key for a record

Deleting

delete :: forall m. (HasCallStack, MonadSqlBackend m) => SqlQuery () -> m () Source #

Execute an Esqueleto DELETE query

deleteKey :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => Key a -> m () Source #

Delete a specific record by identifier

Does nothing if record does not exist.

deleteBy :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => Unique a -> m () Source #

Delete a specific record by unique key

Does nothing if no record matches.

deleteWhere Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) 
=> [Filter a]

If you provide multiple values in the list, the conditions are ANDed together.

-> m () 

Delete all records matching the given criteria

deleteCount Source #

Arguments

:: forall m. (HasCallStack, MonadSqlBackend m) 
=> SqlQuery () 
-> m Int64

The number of rows affected

Execute an Esqueleto DELETE query

deleteWhereCount Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) 
=> [Filter a]

If you provide multiple values in the list, the conditions are ANDed together.

-> m Int64

The number of rows affected

Delete all records matching the given criteria

Transactions

transactionSave :: forall m. (HasCallStack, MonadSqlBackend m) => m () Source #

Commit the current transaction and begin a new one

transactionSaveWithIsolation Source #

Arguments

:: forall m. (HasCallStack, MonadSqlBackend m) 
=> IsolationLevel

Isolation level

-> m () 

Commit the current transaction and begin a new one

transactionUndo :: forall m. (HasCallStack, MonadSqlBackend m) => m () Source #

Roll back the current transaction and begin a new one

transactionUndoWithIsolation Source #

Arguments

:: forall m. (HasCallStack, MonadSqlBackend m) 
=> IsolationLevel

Isolation level

-> m () 

Roll back the current transaction and begin a new one

Raw SQL

rawSql Source #

Arguments

:: forall a m. (HasCallStack, MonadSqlBackend m, RawSql a) 
=> Text

SQL statement, possibly with placeholders

-> [PersistValue]

Values to fill the placeholders

-> m [a] 

rawExecute Source #

Arguments

:: forall m. (HasCallStack, MonadSqlBackend m) 
=> Text

SQL statement, possibly with placeholders

-> [PersistValue]

Values to fill the placeholders

-> m () 

Execute a raw SQL statement

rawExecuteCount Source #

Arguments

:: forall m. (HasCallStack, MonadSqlBackend m) 
=> Text

SQL statement, possibly with placeholders

-> [PersistValue]

Values to fill the placeholders

-> m Int64

The number of rows modified

Execute a raw SQL statement

Getting names

getFieldName :: forall a t m. (HasCallStack, MonadSqlBackend m, PersistEntity a, PersistEntityBackend a ~ SqlBackend) => EntityField a t -> m Text Source #

Get the SQL string for the field that an EntityField represents

getTableName :: forall a m. (HasCallStack, MonadSqlBackend m, PersistEntity a) => a -> m Text Source #

Get the SQL string for the table that a PersistEntity represents

Rendering queries to text

renderQueryDelete Source #

Arguments

:: forall a r m. (HasCallStack, MonadSqlBackend m, SqlSelect a r) 
=> SqlQuery a

SQL query to render

-> m (Text, [PersistValue]) 

Renders a SqlQuery to Text along with the list of PersistValues that would be supplied to the database for ? placeholders

renderQueryInsertInto Source #

Arguments

:: forall a r m. (HasCallStack, MonadSqlBackend m, SqlSelect a r) 
=> SqlQuery a

SQL query to render

-> m (Text, [PersistValue]) 

Renders a SqlQuery to Text along with the list of PersistValues that would be supplied to the database for ? placeholders

renderQuerySelect Source #

Arguments

:: forall a r m. (HasCallStack, MonadSqlBackend m, SqlSelect a r) 
=> SqlQuery a

SQL query to render

-> m (Text, [PersistValue]) 

Renders a SqlQuery to Text along with the list of PersistValues that would be supplied to the database for ? placeholders

renderQueryToText Source #

Arguments

:: forall a r m. (HasCallStack, MonadSqlBackend m, SqlSelect a r) 
=> Mode

Whether to render as an SELECT, DELETE, etc. You must ensure that the Mode you pass to this function corresponds with the actual SqlQuery. If you pass a query that uses incompatible features (like an INSERT statement with a SELECT mode) then you'll get a weird result.

-> SqlQuery a

SQL query to render

-> m (Text, [PersistValue]) 

Renders a SqlQuery to Text along with the list of PersistValues that would be supplied to the database for ? placeholders

renderQueryUpdate Source #

Arguments

:: forall a r m. (HasCallStack, MonadSqlBackend m, SqlSelect a r) 
=> SqlQuery a

SQL query to render

-> m (Text, [PersistValue]) 

Renders a SqlQuery to Text along with the list of PersistValues that would be supplied to the database for ? placeholders