Safe Haskell | None |
---|
- data Checkmark
- data IsNullable
- data WhyNullable
- data EntityDef sqlType = EntityDef {
- entityHaskell :: !HaskellName
- entityDB :: !DBName
- entityID :: !DBName
- entityAttrs :: ![Attr]
- entityFields :: ![FieldDef sqlType]
- entityUniques :: ![UniqueDef]
- entityDerives :: ![Text]
- entityExtra :: !(Map Text [ExtraLine])
- entitySum :: !Bool
- type ExtraLine = [Text]
- newtype HaskellName = HaskellName {}
- newtype DBName = DBName {}
- type Attr = Text
- data FieldType
- data FieldDef sqlType = FieldDef {
- fieldHaskell :: !HaskellName
- fieldDB :: !DBName
- fieldType :: !FieldType
- fieldSqlType :: !sqlType
- fieldAttrs :: ![Attr]
- fieldStrict :: !Bool
- fieldEmbedded :: Maybe (EntityDef ())
- data UniqueDef = UniqueDef {
- uniqueHaskell :: !HaskellName
- uniqueDBName :: !DBName
- uniqueFields :: ![(HaskellName, DBName)]
- uniqueAttrs :: ![Attr]
- data PersistException
- newtype ZT = ZT ZonedTime
- data PersistValue
- = PersistText Text
- | PersistByteString ByteString
- | PersistInt64 Int64
- | PersistDouble Double
- | PersistRational Rational
- | PersistBool Bool
- | PersistDay Day
- | PersistTimeOfDay TimeOfDay
- | PersistUTCTime UTCTime
- | PersistZonedTime ZT
- | PersistNull
- | PersistList [PersistValue]
- | PersistMap [(Text, PersistValue)]
- | PersistObjectId ByteString
- fromPersistValueText :: PersistValue -> Either String Text
- data SqlType
- = SqlString
- | SqlInt32
- | SqlInt64
- | SqlReal
- | SqlNumeric Word32 Word32
- | SqlBool
- | SqlDay
- | SqlTime
- | SqlDayTime
- | SqlDayTimeZoned
- | SqlBlob
- | SqlOther Text
- newtype KeyBackend backend entity = Key {}
- type family KeyEntity key
- data PersistFilter
- data UpdateGetException = KeyNotFound String
- data PersistUpdate
- data SomePersistField = forall a . PersistField a => SomePersistField a
- data Update v = forall typ . PersistField typ => Update {
- updateField :: EntityField v typ
- updateValue :: typ
- updateUpdate :: PersistUpdate
- data SelectOpt v
- = forall typ . Asc (EntityField v typ)
- | forall typ . Desc (EntityField v typ)
- | OffsetBy Int
- | LimitTo Int
- type family BackendSpecificFilter b v
- data Filter v
- = forall typ . PersistField typ => Filter {
- filterField :: EntityField v typ
- filterValue :: Either typ [typ]
- filterFilter :: PersistFilter
- | FilterAnd [Filter v]
- | FilterOr [Filter v]
- | BackendFilter (BackendSpecificFilter (PersistEntityBackend v) v)
- = forall typ . PersistField typ => Filter {
- type Key val = KeyBackend (PersistEntityBackend val) val
- data Entity entity = Entity {}
Documentation
A Checkmark
should be used as a field type whenever a
uniqueness constraint should guarantee that a certain kind of
record may appear at most once, but other kinds of records may
appear any number of times.
NOTE: You need to mark any Checkmark
fields as nullable
(see the following example).
For example, suppose there's a Location
entity that
represents where a user has lived:
Location user UserId name Text current Checkmark nullable UniqueLocation user current
The UniqueLocation
constraint allows any number of
Inactive
Location
s to be current
. However, there may be
at most one current
Location
per user (i.e., either zero
or one per user).
This data type works because of the way that SQL treats
NULL
able fields within uniqueness constraints. The SQL
standard says that NULL
values should be considered
different, so we represent Inactive
as SQL NULL
, thus
allowing any number of Inactive
records. On the other hand,
we represent Active
as TRUE
, so the uniqueness constraint
will disallow more than one Active
record.
Note: There may be DBMSs that do not respect the SQL
standard's treatment of NULL
values on uniqueness
constraints, please check if this data type works before
relying on it.
The SQL BOOLEAN
type is used because it's the smallest data
type available. Note that we never use FALSE
, just TRUE
and NULL
. Provides the same behavior Maybe ()
would if
()
was a valid PersistField
.
data WhyNullable Source
The reason why a field is nullable
is very important. A
field that is nullable because of a Maybe
tag will have its
type changed from A
to Maybe A
. OTOH, a field that is
nullable because of a nullable
tag will remain with the same
type.
EntityDef | |
|
newtype HaskellName Source
FieldDef | |
|
UniqueDef | |
|
data PersistException Source
data PersistValue Source
A raw value which can be stored in any backend and can be marshalled to
and from a PersistField
.
PersistText Text | |
PersistByteString ByteString | |
PersistInt64 Int64 | |
PersistDouble Double | |
PersistRational Rational | |
PersistBool Bool | |
PersistDay Day | |
PersistTimeOfDay TimeOfDay | |
PersistUTCTime UTCTime | |
PersistZonedTime ZT | |
PersistNull | |
PersistList [PersistValue] | |
PersistMap [(Text, PersistValue)] | |
PersistObjectId ByteString | intended especially for MongoDB backend |
A SQL data type. Naming attempts to reflect the underlying Haskell datatypes, eg SqlString instead of SqlVarchar. Different SQL databases may have different translations for these types.
SqlString | |
SqlInt32 | |
SqlInt64 | |
SqlReal | |
SqlNumeric Word32 Word32 | |
SqlBool | |
SqlDay | |
SqlTime | |
SqlDayTime | |
SqlDayTimeZoned | |
SqlBlob | |
SqlOther Text | a backend-specific name |
newtype KeyBackend backend entity Source
Eq (KeyBackend backend entity) | |
Ord (KeyBackend backend entity) | |
Read (KeyBackend backend entity) | |
Show (KeyBackend backend entity) | |
ToJSON (KeyBackend backend entity) | |
FromJSON (KeyBackend backend entity) | |
PathPiece (KeyBackend SqlBackend entity) | |
PersistField (KeyBackend backend entity) |
data PersistFilter Source
data UpdateGetException Source
data PersistUpdate Source
data SomePersistField Source
forall a . PersistField a => SomePersistField a |
forall typ . PersistField typ => Update | |
|
forall typ . Asc (EntityField v typ) | |
forall typ . Desc (EntityField v typ) | |
OffsetBy Int | |
LimitTo Int |
type family BackendSpecificFilter b v Source
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] | |
BackendFilter (BackendSpecificFilter (PersistEntityBackend v) v) |
type Key val = KeyBackend (PersistEntityBackend val) valSource
Helper wrapper, equivalent to Key (PersistEntityBackend val) val
.
Since 1.1.0
Datatype that represents an entity, with both its Key
and
its Haskell 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.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.
Eq entity => Eq (Entity entity) | |
Ord entity => Ord (Entity entity) | |
Read entity => Read (Entity entity) | |
Show entity => Show (Entity entity) | |
ToJSON e => ToJSON (Entity e) | |
FromJSON e => FromJSON (Entity e) | |
PersistField entity => PersistField (Entity entity) | |
PersistField entity => PersistFieldSql (Entity entity) | |
PersistEntity a => RawSql (Entity a) |