| Safe Haskell | None | 
|---|---|
| Language | Haskell2010 | 
Database.Persist.Class.PersistEntity
Synopsis
- class (PersistField (Key record), ToJSON (Key record), FromJSON (Key record), Show (Key record), Read (Key record), Eq (Key record), Ord (Key record)) => PersistEntity record where- type PersistEntityBackend record
- data Key record
- data EntityField record :: Type -> Type
- data Unique record
- keyToValues :: Key record -> [PersistValue]
- keyFromValues :: [PersistValue] -> Either Text (Key record)
- persistIdField :: EntityField record (Key record)
- entityDef :: proxy record -> EntityDef
- persistFieldDef :: EntityField record typ -> FieldDef
- toPersistFields :: record -> [PersistValue]
- fromPersistValues :: [PersistValue] -> Either Text record
- tabulateEntityA :: Applicative f => (forall a. EntityField record a -> f a) -> f (Entity record)
- persistUniqueKeys :: record -> [Unique record]
- persistUniqueToFieldNames :: Unique record -> NonEmpty (FieldNameHS, FieldNameDB)
- persistUniqueToValues :: Unique record -> [PersistValue]
- fieldLens :: EntityField record field -> forall (f :: Type -> Type). Functor f => (field -> f field) -> Entity record -> f (Entity record)
- keyFromRecordM :: Maybe (record -> Key record)
 
- tabulateEntity :: PersistEntity record => (forall a. EntityField record a -> a) -> Entity record
- data Update record- = PersistField typ => Update { - updateField :: EntityField record typ
- updateValue :: typ
- updateUpdate :: PersistUpdate
 
- | BackendUpdate (BackendSpecificUpdate (PersistEntityBackend record) record)
 
- = PersistField typ => Update { 
- type family BackendSpecificUpdate backend record
- data SelectOpt record- = Asc (EntityField record typ)
- | Desc (EntityField record typ)
- | OffsetBy Int
- | LimitTo Int
 
- data Filter record- = PersistField typ => Filter { - filterField :: EntityField record typ
- filterValue :: FilterValue typ
- filterFilter :: PersistFilter
 
- | FilterAnd [Filter record]
- | FilterOr [Filter record]
- | BackendFilter (BackendSpecificFilter (PersistEntityBackend record) record)
 
- = PersistField typ => Filter { 
- data FilterValue typ where- FilterValue :: forall typ. typ -> FilterValue typ
- FilterValues :: forall typ. [typ] -> FilterValue typ
- UnsafeValue :: forall a typ. PersistField a => a -> FilterValue typ
 
- type family BackendSpecificFilter backend record
- data Entity record = Entity {}
- newtype ViaPersistEntity record = ViaPersistEntity (Key record)
- recordName :: PersistEntity record => record -> Text
- entityValues :: PersistEntity record => Entity record -> [PersistValue]
- keyValueEntityToJSON :: (PersistEntity record, ToJSON record) => Entity record -> Value
- keyValueEntityFromJSON :: (PersistEntity record, FromJSON record) => Value -> Parser (Entity record)
- entityIdToJSON :: (PersistEntity record, ToJSON record) => Entity record -> Value
- entityIdFromJSON :: (PersistEntity record, FromJSON record) => Value -> Parser (Entity record)
- toPersistValueJSON :: ToJSON a => a -> PersistValue
- fromPersistValueJSON :: FromJSON a => PersistValue -> Either Text a
- toPersistValueEnum :: Enum a => a -> PersistValue
- fromPersistValueEnum :: (Enum a, Bounded a) => PersistValue -> Either Text a
- class SymbolToField (sym :: Symbol) rec typ | sym rec -> typ where- symbolToField :: EntityField rec typ
 
- class SafeToInsert a
- type SafeToInsertErrorMessage a = (((('Text "The PersistEntity " ':<>: 'ShowType a) ':<>: 'Text " does not have a default primary key.") ':$$: 'Text "This means that 'insert' will fail with a database error.") ':$$: 'Text "Please provide a default= clause inthe entity definition,") ':$$: 'Text "or use 'insertKey' instead to provide one."
Documentation
class (PersistField (Key record), ToJSON (Key record), FromJSON (Key record), Show (Key record), Read (Key record), Eq (Key record), Ord (Key record)) => PersistEntity record where #
Persistent serialized Haskell records to the database.
 A Database Entity (A row in SQL, a document in MongoDB, etc)
 corresponds to a Key plus a Haskell record.
For every Haskell record type stored in the database there is a
 corresponding PersistEntity instance. An instance of PersistEntity
 contains meta-data for the record.  PersistEntity also helps abstract
 over different record types. That way the same query interface can return
 a PersistEntity, with each query returning different types of Haskell
 records.
Some advanced type system capabilities are used to make this process type-safe. Persistent users usually don't need to understand the class associated data and functions.
Minimal complete definition
keyToValues, keyFromValues, persistIdField, entityDef, persistFieldDef, toPersistFields, fromPersistValues, tabulateEntityA, persistUniqueKeys, persistUniqueToFieldNames, persistUniqueToValues, fieldLens
Associated Types
type PersistEntityBackend record #
Persistent allows multiple different backends (databases).
By default, a backend will automatically generate the key Instead you can specify a Primary key made up of unique values.
data EntityField record :: Type -> Type #
An EntityField is parameterised by the Haskell record it belongs to
 and the additional type of that field.
As of persistent-2.11.0.0, it's possible to use the OverloadedLabels
 language extension to refer to EntityField values polymorphically. See
 the documentation on SymbolToField for more information.
Unique keys besides the Key.
Methods
keyToValues :: Key record -> [PersistValue] #
A lower-level key operation.
keyFromValues :: [PersistValue] -> Either Text (Key record) #
A lower-level key operation.
persistIdField :: EntityField record (Key record) #
A meta-operation to retrieve the Key EntityField.
entityDef :: proxy record -> EntityDef #
Retrieve the EntityDef meta-data for the record.
persistFieldDef :: EntityField record typ -> FieldDef #
Return meta-data for a given EntityField.
toPersistFields :: record -> [PersistValue] #
A meta-operation to get the database fields of a record.
fromPersistValues :: [PersistValue] -> Either Text record #
A lower-level operation to convert from database values to a Haskell record.
Arguments
| :: Applicative f | |
| => (forall a. EntityField record a -> f a) | A function that builds a fragment of a record in an
  | 
| -> f (Entity record) | 
This function allows you to build an Entity a
parseFromEnvironmentVariables :: IO (Entity User)
parseFromEnvironmentVariables =
    tabulateEntityA $ \userField ->
        case userField of
            UserName ->
                getEnv USER_NAME
            UserAge -> do
                ageVar <- getEnv USER_AGE
                case readMaybe ageVar of
                    Just age ->
                        pure age
                    Nothing ->
                        error $ "Failed to parse Age from: " <> ageVar
            UserAddressId -> do
                addressVar <- getEnv USER_ADDRESS_ID
                pure $ AddressKey addressVar
Since: 2.14.0.0
persistUniqueKeys :: record -> [Unique record] #
A meta operation to retrieve all the Unique keys.
persistUniqueToFieldNames :: Unique record -> NonEmpty (FieldNameHS, FieldNameDB) #
A lower level operation.
persistUniqueToValues :: Unique record -> [PersistValue] #
A lower level operation.
fieldLens :: EntityField record field -> forall (f :: Type -> Type). Functor f => (field -> f field) -> Entity record -> f (Entity record) #
Use a PersistField as a lens.
keyFromRecordM :: Maybe (record -> Key record) #
Extract a Key recordrecord value. Currently, this is
 only defined for entities using the Primary syntax for
 natural/composite keys. In a future version of persistent which
 incorporates the ID directly into the entity, this will always be Just.
Since: 2.11.0.0
tabulateEntity :: PersistEntity record => (forall a. EntityField record a -> a) -> Entity record #
Construct an Entity record
These constructions are equivalent:
entityMattConstructor, entityMattTabulate :: Entity User
entityMattConstructor =
    Entity
        { entityKey = toSqlKey 123
        , entityVal =
            User
                { userName = Matt
                , userAge = 33
                }
        }
entityMattTabulate =
    tabulateEntity $ \case
        UserId ->
            toSqlKey 123
        UserName ->
            Matt
        UserAge ->
            33
This is a specialization of tabulateEntityA, which allows you to
 construct an Entity by providing an Applicative action for each
 field instead of a regular function.
Since: 2.14.0.0
Updating a database entity.
Persistent users use combinators to create these.
Constructors
| PersistField typ => Update | |
| Fields 
 | |
| BackendUpdate (BackendSpecificUpdate (PersistEntityBackend record) record) | |
type family BackendSpecificUpdate backend record #
Query options.
Persistent users use these directly.
Constructors
| Asc (EntityField record typ) | |
| Desc (EntityField record 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.
Persistent users use combinators to create these.
Note that it's important to be careful about the PersistFilter that
 you are using, if you use this directly. For example, using the In
 PersistFilter requires that you have an array- or list-shaped
 EntityField. It is possible to construct values using this that will
 create malformed runtime values.
Constructors
| PersistField typ => Filter | |
| Fields 
 | |
| FilterAnd [Filter record] | convenient for internal use, not needed for the API | 
| FilterOr [Filter record] | |
| BackendFilter (BackendSpecificFilter (PersistEntityBackend record) record) | |
data FilterValue typ where #
Value to filter with. Highly dependant on the type of filter used.
Since: 2.10.0
Constructors
| FilterValue :: forall typ. typ -> FilterValue typ | |
| FilterValues :: forall typ. [typ] -> FilterValue typ | |
| UnsafeValue :: forall a typ. PersistField a => a -> FilterValue typ | 
type family BackendSpecificFilter backend record #
Datatype that represents an entity, with both its Key and
 its Haskell record representation.
When using a 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.Sql 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.
Instances
newtype ViaPersistEntity record #
Newtype wrapper for optionally deriving typeclass instances on
 PersistEntity keys.
Since: 2.14.6.0
Constructors
| ViaPersistEntity (Key record) | 
Instances
| PersistEntity record => PathMultiPiece (ViaPersistEntity record) # | |
| Defined in Database.Persist.Class.PersistEntity Methods fromPathMultiPiece :: [Text] -> Maybe (ViaPersistEntity record) # toPathMultiPiece :: ViaPersistEntity record -> [Text] # | |
recordName :: PersistEntity record => record -> Text #
Textual representation of the record
entityValues :: PersistEntity record => Entity record -> [PersistValue] #
Get list of values corresponding to given entity.
keyValueEntityToJSON :: (PersistEntity record, ToJSON record) => Entity record -> Value #
Predefined toJSON. The resulting JSON looks like
 {"key": 1, "value": {"name": ...}}.
The typical usage is:
instance ToJSON (Entity User) where
    toJSON = keyValueEntityToJSON
keyValueEntityFromJSON :: (PersistEntity record, FromJSON record) => Value -> Parser (Entity record) #
Predefined parseJSON. The input JSON looks like
 {"key": 1, "value": {"name": ...}}.
The typical usage is:
instance FromJSON (Entity User) where
    parseJSON = keyValueEntityFromJSON
entityIdToJSON :: (PersistEntity record, ToJSON record) => Entity record -> Value #
Predefined toJSON. The resulting JSON looks like
 {"id": 1, "name": ...}.
The typical usage is:
instance ToJSON (Entity User) where
    toJSON = entityIdToJSON
entityIdFromJSON :: (PersistEntity record, FromJSON record) => Value -> Parser (Entity record) #
Predefined parseJSON. The input JSON looks like
 {"id": 1, "name": ...}.
The typical usage is:
instance FromJSON (Entity User) where
    parseJSON = entityIdFromJSON
PersistField based on other typeclasses
toPersistValueJSON :: ToJSON a => a -> PersistValue #
Convenience function for getting a free PersistField instance
 from a type with JSON instances.
Example usage in combination with fromPersistValueJSON:
instance PersistField MyData where fromPersistValue = fromPersistValueJSON toPersistValue = toPersistValueJSON
fromPersistValueJSON :: FromJSON a => PersistValue -> Either Text a #
Convenience function for getting a free PersistField instance
 from a type with JSON instances. The JSON parser used will accept JSON
 values other that object and arrays. So, if your instance serializes the
 data to a JSON string, this will still work.
Example usage in combination with toPersistValueJSON:
instance PersistField MyData where fromPersistValue = fromPersistValueJSON toPersistValue = toPersistValueJSON
toPersistValueEnum :: Enum a => a -> PersistValue #
Convenience function for getting a free PersistField instance
 from a type with an Enum instance. The function derivePersistField
 from the persistent-template package should generally be preferred.
 However, if you want to ensure that an ORDER BY clause that uses
 your field will order rows by the data constructor order, this is
 a better choice.
Example usage in combination with fromPersistValueEnum:
data SeverityLevel = Low | Medium | Critical | High deriving (Enum, Bounded) instance PersistField SeverityLevel where fromPersistValue = fromPersistValueEnum toPersistValue = toPersistValueEnum
fromPersistValueEnum :: (Enum a, Bounded a) => PersistValue -> Either Text a #
Convenience function for getting a free PersistField instance
 from a type with an Enum instance. This function also requires
 a Bounded instance to improve the reporting of errors.
Example usage in combination with toPersistValueEnum:
data SeverityLevel = Low | Medium | Critical | High deriving (Enum, Bounded) instance PersistField SeverityLevel where fromPersistValue = fromPersistValueEnum toPersistValue = toPersistValueEnum
Support for OverloadedLabels with EntityField
class SymbolToField (sym :: Symbol) rec typ | sym rec -> typ where #
This type class is used with the OverloadedLabels extension to
 provide a more convenient means of using the EntityField type.
 EntityField definitions are prefixed with the type name to avoid
 ambiguity, but this ambiguity can result in verbose code.
If you have a table User with a name Text field, then the
 corresponding EntityField is UserName. With this, we can write
 #name :: .EntityField User Text
What's more fun is that the type is more general: it's actually
 
 #name
     :: (SymbolToField "name" rec typ)
     => EntityField rec typ
 
Which means it is *polymorphic* over the actual record. This allows you to write code that can be generic over the tables, provided they have the right fields.
Since: 2.11.0.0
Methods
symbolToField :: EntityField rec typ #
Safety check for inserts
class SafeToInsert a #
A type class which is used to witness that a type is safe to insert into the database without providing a primary key.
The TemplateHaskell function mkPersist will generate instances of this
 class for any entity that it works on. If the entity has a default primary
 key, then it provides a regular instance. If the entity has a Primary
 natural key, then this works fine. But if the entity has an Id column with
 no default=, then this does a TypeError and forces the user to use
 insertKey.
Since: 2.14.0.0
Instances
| (TypeError (EntityErrorMessage a) :: Constraint) => SafeToInsert (Entity a) # | |
| Defined in Database.Persist.Class.PersistEntity | |
| (TypeError (FunctionErrorMessage a b) :: Constraint) => SafeToInsert (a -> b) # | |
| Defined in Database.Persist.Class.PersistEntity | |
type SafeToInsertErrorMessage a = (((('Text "The PersistEntity " ':<>: 'ShowType a) ':<>: 'Text " does not have a default primary key.") ':$$: 'Text "This means that 'insert' will fail with a database error.") ':$$: 'Text "Please provide a default= clause inthe entity definition,") ':$$: 'Text "or use 'insertKey' instead to provide one." #