Safe Haskell | None |
---|---|
Language | Haskell2010 |
This module provides the tools for defining your database schema and using it to generate Haskell data types and migrations.
Synopsis
- persistWith :: PersistSettings -> QuasiQuoter
- persistUpperCase :: QuasiQuoter
- persistLowerCase :: QuasiQuoter
- persistFileWith :: PersistSettings -> FilePath -> Q Exp
- persistManyFileWith :: PersistSettings -> [FilePath] -> Q Exp
- mkPersist :: MkPersistSettings -> [EntityDef] -> Q [Dec]
- data MkPersistSettings
- mpsBackend :: MkPersistSettings -> Type
- mpsGeneric :: MkPersistSettings -> Bool
- mpsPrefixFields :: MkPersistSettings -> Bool
- mpsEntityJSON :: MkPersistSettings -> Maybe EntityJSON
- mpsGenerateLenses :: MkPersistSettings -> Bool
- data EntityJSON = EntityJSON {}
- mkPersistSettings :: Type -> MkPersistSettings
- sqlSettings :: MkPersistSettings
- mkMigrate :: String -> [EntityDef] -> Q [Dec]
- mkSave :: String -> [EntityDef] -> Q [Dec]
- mkDeleteCascade :: MkPersistSettings -> [EntityDef] -> Q [Dec]
- mkEntityDefList :: String -> [EntityDef] -> Q [Dec]
- share :: [[EntityDef] -> Q [Dec]] -> [EntityDef] -> Q [Dec]
- derivePersistField :: String -> Q [Dec]
- derivePersistFieldJSON :: String -> Q [Dec]
- persistFieldFromEntity :: MkPersistSettings -> EntityDef -> Q [Dec]
- lensPTH :: (s -> a) -> (s -> b -> t) -> Lens s t a b
- parseReferences :: PersistSettings -> Text -> Q Exp
- embedEntityDefs :: [EntityDef] -> [EntityDef]
- class PersistEntity record => AtLeastOneUniqueKey record where
- requireUniquesP :: record -> NonEmpty (Unique record)
- class PersistEntity record => OnlyOneUniqueKey record where
- onlyUniqueP :: record -> Unique record
Parse entity defs
persistWith :: PersistSettings -> QuasiQuoter Source #
Converts a quasi-quoted syntax into a list of entity definitions, to be used as input to the template haskell generation code (mkPersist).
persistUpperCase :: QuasiQuoter Source #
Apply persistWith
to upperCaseSettings
.
persistLowerCase :: QuasiQuoter Source #
Apply persistWith
to lowerCaseSettings
.
persistFileWith :: PersistSettings -> FilePath -> Q Exp Source #
Same as persistWith
, but uses an external file instead of a
quasiquotation. The recommended file extension is .persistentmodels
.
persistManyFileWith :: PersistSettings -> [FilePath] -> Q Exp Source #
Same as persistFileWith
, but uses several external files instead of
one. Splitting your Persistent definitions into multiple modules can
potentially dramatically speed up compile times.
The recommended file extension is .persistentmodels
.
Examples
Split your Persistent definitions into multiple files (models1
, models2
),
then create a new module for each new file and run mkPersist
there:
-- Model1.hsshare
[mkPersist
sqlSettings
] $(persistFileWith
lowerCaseSettings
"models1")
-- Model2.hsshare
[mkPersist
sqlSettings
] $(persistFileWith
lowerCaseSettings
"models2")
Use persistManyFileWith
to create your migrations:
-- Migrate.hsshare
[mkMigrate
"migrateAll"] $(persistManyFileWith
lowerCaseSettings
["models1.persistentmodels","models2.persistentmodels"])
Tip: To get the same import behavior as if you were declaring all your models in
one file, import your new files as Name
into another file, then export module Name
.
This approach may be used in the future to reduce memory usage during compilation, but so far we've only seen mild reductions.
See persistent#778 and persistent#791 for more details.
Since: 2.5.4
Turn EntityDef
s into types
mkPersist :: MkPersistSettings -> [EntityDef] -> Q [Dec] Source #
Create data types and appropriate PersistEntity
instances for the given
EntityDef
s. Works well with the persist quasi-quoter.
data MkPersistSettings Source #
Settings to be passed to the mkPersist
function.
mpsBackend :: MkPersistSettings -> Type Source #
Which database backend we're using.
When generating data types, each type is given a generic version- which works with any backend- and a type synonym for the commonly used backend. This is where you specify that commonly used backend.
mpsGeneric :: MkPersistSettings -> Bool Source #
Create generic types that can be used with multiple backends. Good for reusable code, but makes error messages harder to understand. Default: False.
mpsPrefixFields :: MkPersistSettings -> Bool Source #
Prefix field names with the model name. Default: True.
mpsEntityJSON :: MkPersistSettings -> Maybe EntityJSON Source #
Generate ToJSON
/FromJSON
instances for each model types. If it's
Nothing
, no instances will be generated. Default:
Just EntityJSON { entityToJSON = 'keyValueEntityToJSON , entityFromJSON = 'keyValueEntityFromJSON }
mpsGenerateLenses :: MkPersistSettings -> Bool Source #
Instead of generating normal field accessors, generator lens-style accessors.
Default: False
Since: 1.3.1
data EntityJSON Source #
EntityJSON | |
|
:: Type | Value for |
-> MkPersistSettings |
Create an MkPersistSettings
with default values.
sqlSettings :: MkPersistSettings Source #
Use the SqlPersist
backend.
Various other TH functions
mkMigrate :: String -> [EntityDef] -> Q [Dec] Source #
Creates a single function to perform all migrations for the entities defined here. One thing to be aware of is dependencies: if you have entities with foreign references, make sure to place those definitions after the entities they reference.
mkSave :: String -> [EntityDef] -> Q [Dec] Source #
Save the EntityDef
s passed in under the given name.
mkDeleteCascade :: MkPersistSettings -> [EntityDef] -> Q [Dec] Source #
Generate a DeleteCascade
instance for the given EntityDef
s.
Creates a declaration for the [
from the EntityDef
]persistent
schema. This is necessary because the Persistent QuasiQuoter is unable
to know the correct type of ID fields, and assumes that they are all
Int64.
Provide this in the list you give to share
, much like
.mkMigrate
share
[mkMigrate
"migrateAll",mkEntityDefList
"entityDefs"] [...]
Since: 2.7.1
share :: [[EntityDef] -> Q [Dec]] -> [EntityDef] -> Q [Dec] Source #
Apply the given list of functions to the same EntityDef
s.
This function is useful for cases such as:
>>>
share [mkSave "myDefs", mkPersist sqlSettings] [persistLowerCase|...|]
derivePersistField :: String -> Q [Dec] Source #
Automatically creates a valid PersistField
instance for any datatype
that has valid Show
and Read
instances. Can be very convenient for
Enum
types.
derivePersistFieldJSON :: String -> Q [Dec] Source #
Automatically creates a valid PersistField
instance for any datatype
that has valid ToJSON
and FromJSON
instances. For a datatype T
it
generates instances similar to these:
instance PersistField T where toPersistValue = PersistByteString . L.toStrict . encode fromPersistValue = (left T.pack) . eitherDecodeStrict' <=< fromPersistValue instance PersistFieldSql T where sqlType _ = SqlString
persistFieldFromEntity :: MkPersistSettings -> EntityDef -> Q [Dec] Source #
Produce code similar to the following:
instance PersistEntity e => PersistField e where toPersistValue = entityToPersistValueHelper fromPersistValue = entityFromPersistValueHelper ["col1", "col2"] sqlType _ = SqlString
Internal
parseReferences :: PersistSettings -> Text -> Q Exp Source #
Since: 2.5.3
embedEntityDefs :: [EntityDef] -> [EntityDef] Source #
Takes a list of (potentially) independently defined entities and properly
links all foreign keys to reference the right EntityDef
, tying the knot
between entities.
Allows users to define entities indepedently or in separate modules and then
fix the cross-references between them at runtime to create a Migration
.
Since: 2.7.2
class PersistEntity record => AtLeastOneUniqueKey record where #
This class is used to ensure that functions requring at least one
unique key are not called with records that have 0 unique keys. The
quasiquoter automatically writes working instances for appropriate
entities, and generates TypeError
instances for records that have
0 unique keys.
Since: persistent-2.10.0
requireUniquesP :: record -> NonEmpty (Unique record) #
class PersistEntity record => OnlyOneUniqueKey record where #
This class is used to ensure that upsert
is only called on records
that have a single Unique
key. The quasiquoter automatically generates
working instances for appropriate records, and generates TypeError
instances for records that have 0 or multiple unique keys.
Since: persistent-2.10.0
onlyUniqueP :: record -> Unique record #
Orphan instances
Lift EntityDef Source # | |
Lift HaskellName Source # | |
lift :: HaskellName -> Q Exp # | |
Lift DBName Source # | |
Lift FieldType Source # | |
Lift FieldDef Source # | |
Lift ReferenceDef Source # | |
lift :: ReferenceDef -> Q Exp # | |
Lift EmbedEntityDef Source # | |
lift :: EmbedEntityDef -> Q Exp # | |
Lift EmbedFieldDef Source # | |
lift :: EmbedFieldDef -> Q Exp # | |
Lift UniqueDef Source # | |
Lift CompositeDef Source # | |
lift :: CompositeDef -> Q Exp # | |
Lift ForeignDef Source # | |
lift :: ForeignDef -> Q Exp # | |
Lift SqlType Source # | |
Lift PersistFilter Source # | |
lift :: PersistFilter -> Q Exp # | |
Lift PersistUpdate Source # | |
lift :: PersistUpdate -> Q Exp # |