Safe Haskell | None |
---|
- class PersistField a where
- toPersistValue :: a -> PersistValue
- fromPersistValue :: PersistValue -> Either Text a
- sqlType :: a -> SqlType
- isNullable :: a -> Bool
- class PersistEntity val where
- data EntityField val :: * -> *
- type PersistEntityBackend val :: (* -> *) -> * -> *
- data Unique val :: ((* -> *) -> * -> *) -> *
- persistFieldDef :: EntityField val typ -> FieldDef
- entityDef :: val -> EntityDef
- toPersistFields :: val -> [SomePersistField]
- fromPersistValues :: [PersistValue] -> Either Text val
- halfDefined :: val
- persistUniqueToFieldNames :: Unique val backend -> [(HaskellName, DBName)]
- persistUniqueToValues :: Unique val backend -> [PersistValue]
- persistUniqueKeys :: val -> [Unique val backend]
- persistIdField :: EntityField val (Key (PersistEntityBackend val) val)
- class (MonadBaseControl IO m, MonadBaseControl IO (backend m)) => PersistStore backend m where
- insert :: PersistEntity val => val -> backend m (Key backend val)
- insertKey :: PersistEntity val => Key backend val -> val -> backend m ()
- repsert :: PersistEntity val => Key backend val -> val -> backend m ()
- replace :: PersistEntity val => Key backend val -> val -> backend m ()
- delete :: PersistEntity val => Key backend val -> backend m ()
- get :: PersistEntity val => Key backend val -> backend m (Maybe val)
- class PersistStore backend m => PersistUnique backend m where
- getBy :: (PersistEntityBackend val ~ backend, PersistEntity val) => Unique val backend -> backend m (Maybe (Entity val))
- deleteBy :: PersistEntity val => Unique val backend -> backend m ()
- insertUnique :: (backend ~ PersistEntityBackend val, PersistEntity val) => val -> backend m (Maybe (Key backend val))
- class PersistStore backend m => PersistQuery backend m where
- update :: PersistEntity val => Key backend val -> [Update val] -> backend m ()
- updateGet :: PersistEntity val => Key backend val -> [Update val] -> backend m val
- updateWhere :: PersistEntity val => [Filter val] -> [Update val] -> backend m ()
- deleteWhere :: PersistEntity val => [Filter val] -> backend m ()
- selectSource :: (PersistEntity val, PersistEntityBackend val ~ backend) => [Filter val] -> [SelectOpt val] -> Source (ResourceT (backend m)) (Entity val)
- selectFirst :: (PersistEntity val, PersistEntityBackend val ~ backend) => [Filter val] -> [SelectOpt val] -> backend m (Maybe (Entity val))
- selectKeys :: PersistEntity val => [Filter val] -> [SelectOpt val] -> Source (ResourceT (backend m)) (Key backend val)
- count :: PersistEntity val => [Filter val] -> backend m Int
- newtype Key backend entity = Key {}
- data Entity entity = Entity {
- entityKey :: Key (PersistEntityBackend entity) entity
- entityVal :: entity
- insertBy :: (PersistEntity v, PersistStore backend m, PersistUnique backend m, backend ~ PersistEntityBackend v) => v -> backend m (Either (Entity v) (Key backend v))
- getJust :: (PersistStore backend m, PersistEntity val, Show (Key backend val)) => Key backend val -> backend m val
- belongsTo :: (PersistStore backend m, PersistEntity ent1, PersistEntity ent2) => (ent1 -> Maybe (Key backend ent2)) -> ent1 -> backend m (Maybe ent2)
- belongsToJust :: (PersistStore backend m, PersistEntity ent1, PersistEntity ent2) => (ent1 -> Key backend ent2) -> ent1 -> backend m ent2
- getByValue :: (PersistEntity v, PersistUnique backend m, PersistEntityBackend v ~ backend) => v -> backend m (Maybe (Entity v))
- checkUnique :: (PersistEntityBackend val ~ backend, PersistEntity val, PersistUnique backend m) => val -> backend m Bool
- selectList :: (PersistEntity val, PersistQuery backend m, PersistEntityBackend val ~ backend) => [Filter val] -> [SelectOpt val] -> backend m [Entity val]
- deleteCascadeWhere :: (DeleteCascade a backend m, PersistQuery backend m) => [Filter a] -> backend m ()
- data SelectOpt v
- = forall typ . Asc (EntityField v typ)
- | forall typ . Desc (EntityField v typ)
- | OffsetBy Int
- | LimitTo Int
- data Filter v
- = forall typ . PersistField typ => Filter {
- filterField :: EntityField v typ
- filterValue :: Either typ [typ]
- filterFilter :: PersistFilter
- | FilterAnd [Filter v]
- | FilterOr [Filter v]
- = forall typ . PersistField typ => Filter {
- (=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Update v
- (+=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Update v
- (-=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Update v
- (*=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Update v
- (/=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Update v
- (==.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Filter v
- (!=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Filter v
- (<.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Filter v
- (>.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Filter v
- (<=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Filter v
- (>=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Filter v
- (<-.) :: forall v typ. PersistField typ => EntityField v typ -> [typ] -> Filter v
- (/<-.) :: forall v typ. PersistField typ => EntityField v typ -> [typ] -> Filter v
- (||.) :: forall v. [Filter v] -> [Filter v] -> [Filter v]
Documentation
class PersistField a whereSource
A value which can be marshalled to and from a PersistValue
.
toPersistValue :: a -> PersistValueSource
fromPersistValue :: PersistValue -> Either Text aSource
isNullable :: a -> BoolSource
class PersistEntity val whereSource
A single database entity. For example, if writing a blog application, a blog entry would be an entry, containing fields such as title and content.
data EntityField val :: * -> *Source
Parameters: val and datatype of the field
type PersistEntityBackend val :: (* -> *) -> * -> *Source
data Unique val :: ((* -> *) -> * -> *) -> *Source
Unique keys in existence on this entity.
persistFieldDef :: EntityField val typ -> FieldDefSource
entityDef :: val -> EntityDefSource
toPersistFields :: val -> [SomePersistField]Source
fromPersistValues :: [PersistValue] -> Either Text valSource
halfDefined :: valSource
persistUniqueToFieldNames :: Unique val backend -> [(HaskellName, DBName)]Source
persistUniqueToValues :: Unique val backend -> [PersistValue]Source
persistUniqueKeys :: val -> [Unique val backend]Source
persistIdField :: EntityField val (Key (PersistEntityBackend val) val)Source
class (MonadBaseControl IO m, MonadBaseControl IO (backend m)) => PersistStore backend m whereSource
insert :: PersistEntity val => val -> backend m (Key backend val)Source
Create a new record in the database, returning an automatically created key (in SQL an auto-increment id).
insertKey :: PersistEntity val => Key backend val -> val -> backend m ()Source
Create a new record in the database using the given key.
repsert :: PersistEntity val => Key backend val -> val -> backend m ()Source
Put the record in the database with the given key.
Unlike replace
, if a record with the given key does not
exist then a new record will be inserted.
replace :: PersistEntity val => Key backend val -> val -> backend m ()Source
Replace the record in the database with the given
key. Note that the result is undefined if such record does
not exist, so you must use insertKey
or repsert
in
these cases.
delete :: PersistEntity val => Key backend val -> backend m ()Source
Delete a specific record by identifier. Does nothing if record does not exist.
get :: PersistEntity val => Key backend val -> backend m (Maybe val)Source
Get a record by identifier, if available.
(MonadBaseControl IO (SqlPersist m), MonadBaseControl IO m, MonadIO m, MonadThrow m, MonadUnsafeIO m, MonadLogger m) => PersistStore SqlPersist m |
class PersistStore backend m => PersistUnique backend m whereSource
getBy :: (PersistEntityBackend val ~ backend, PersistEntity val) => Unique val backend -> backend m (Maybe (Entity val))Source
Get a record by unique key, if available. Returns also the identifier.
deleteBy :: PersistEntity val => Unique val backend -> backend m ()Source
Delete a specific record by unique key. Does nothing if no record matches.
insertUnique :: (backend ~ PersistEntityBackend val, PersistEntity val) => val -> backend m (Maybe (Key backend val))Source
(PersistStore SqlPersist m, MonadBaseControl IO m, MonadUnsafeIO m, MonadIO m, MonadThrow m, MonadLogger m) => PersistUnique SqlPersist m |
class PersistStore backend m => PersistQuery backend m whereSource
update :: PersistEntity val => Key backend val -> [Update val] -> backend m ()Source
Update individual fields on a specific record.
updateGet :: PersistEntity val => Key backend val -> [Update val] -> backend m valSource
Update individual fields on a specific record, and retrieve the updated value from the database.
Note that this function will throw an exception if the given key is not found in the database.
updateWhere :: PersistEntity val => [Filter val] -> [Update val] -> backend m ()Source
Update individual fields on any record matching the given criterion.
deleteWhere :: PersistEntity val => [Filter val] -> backend m ()Source
Delete all records matching the given criterion.
selectSource :: (PersistEntity val, PersistEntityBackend val ~ backend) => [Filter val] -> [SelectOpt val] -> Source (ResourceT (backend m)) (Entity val)Source
Get all records matching the given criterion in the specified order. Returns also the identifiers.
selectFirst :: (PersistEntity val, PersistEntityBackend val ~ backend) => [Filter val] -> [SelectOpt val] -> backend m (Maybe (Entity val))Source
get just the first record for the criterion
selectKeys :: PersistEntity val => [Filter val] -> [SelectOpt val] -> Source (ResourceT (backend m)) (Key backend val)Source
Get the Key
s of all records matching the given criterion.
count :: PersistEntity val => [Filter val] -> backend m IntSource
The total number of records fulfilling the given criterion.
(PersistStore SqlPersist m, MonadThrow m, MonadIO m, MonadUnsafeIO m, MonadBaseControl IO m, MonadLogger m) => PersistQuery SqlPersist m |
Datatype that represents an entity, with both its key and its Haskell representation.
When using the an SQL-based backend (such as SQLite or
PostgreSQL), an Entity
may take any number of columns
depending on how many fields it has. In order to reconstruct
your entity on the Haskell side, persistent
needs all of
your entity columns and in the right order. Note that you
don't need to worry about this when using persistent
's API
since everything is handled correctly behind the scenes.
However, if you want to issue a raw SQL command that returns
an Entity
, then you have to be careful with the column
order. While you could use SELECT Entity.* WHERE ...
and
that would work most of the time, there are times when the
order of the columns on your database is different from the
order that persistent
expects (for example, if you add a new
field in the middle of you entity definition and then use the
migration code -- persistent
will expect the column to be in
the middle, but your DBMS will put it as the last column).
So, instead of using a query like the one above, you may use
rawSql
(from the
Database.Persist.GenericSql module) with its /entity
selection placeholder/ (a double question mark ??
). Using
rawSql
the query above must be written as SELECT ?? WHERE
..
. Then rawSql
will replace ??
with the list of all
columns that we need from your entity in the right order. If
your query returns two entities (i.e. (Entity backend a,
Entity backend b)
), then you must you use SELECT ??, ??
WHERE ...
, and so on.
Entity | |
|
insertBy :: (PersistEntity v, PersistStore backend m, PersistUnique backend m, backend ~ PersistEntityBackend v) => v -> backend m (Either (Entity v) (Key backend v))Source
getJust :: (PersistStore backend m, PersistEntity val, Show (Key backend val)) => Key backend val -> backend m valSource
Same as get, but for a non-null (not Maybe) foreign key Unsafe unless your database is enforcing that the foreign key is valid
belongsTo :: (PersistStore backend m, PersistEntity ent1, PersistEntity ent2) => (ent1 -> Maybe (Key backend ent2)) -> ent1 -> backend m (Maybe ent2)Source
belongsToJust :: (PersistStore backend m, PersistEntity ent1, PersistEntity ent2) => (ent1 -> Key backend ent2) -> ent1 -> backend m ent2Source
same as belongsTo, but uses getJust
and therefore is similarly unsafe
getByValue :: (PersistEntity v, PersistUnique backend m, PersistEntityBackend v ~ backend) => v -> backend m (Maybe (Entity v))Source
A modification of getBy
, which takes the PersistEntity
itself instead
of a Unique
value. Returns a value matching one of the unique keys. This
function makes the most sense on entities with a single Unique
constructor.
checkUnique :: (PersistEntityBackend val ~ backend, PersistEntity val, PersistUnique backend m) => val -> backend m BoolSource
selectList :: (PersistEntity val, PersistQuery backend m, PersistEntityBackend val ~ backend) => [Filter val] -> [SelectOpt val] -> backend m [Entity val]Source
Call selectSource
but return the result as a list.
deleteCascadeWhere :: (DeleteCascade a backend m, PersistQuery backend m) => [Filter a] -> backend m ()Source
forall typ . Asc (EntityField v typ) | |
forall typ . Desc (EntityField v typ) | |
OffsetBy Int | |
LimitTo Int |
Filters which are available for select
, updateWhere
and
deleteWhere
. Each filter constructor specifies the field being
filtered on, the type of comparison applied (equals, not equals, etc)
and the argument for the comparison.
forall typ . PersistField typ => Filter | |
| |
FilterAnd [Filter v] | convenient for internal use, not needed for the API |
FilterOr [Filter v] |
query combinators
(=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Update vSource
assign a field a value
(+=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Update vSource
assign a field by addition (+=)
(-=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Update vSource
assign a field by subtraction (-=)
(*=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Update vSource
assign a field by multiplication (*=)
(/=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Update vSource
assign a field by division (/=)
(==.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Filter vSource
(!=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Filter vSource
(<.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Filter vSource
(>.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Filter vSource
(<=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Filter vSource
(>=.) :: forall v typ. PersistField typ => EntityField v typ -> typ -> Filter vSource
(<-.) :: forall v typ. PersistField typ => EntityField v typ -> [typ] -> Filter vSource
In
(/<-.) :: forall v typ. PersistField typ => EntityField v typ -> [typ] -> Filter vSource
NotIn