Safe Haskell | None |
---|---|
Language | Haskell2010 |
Database.Persist.TH
Contents
Description
This module provides utilities for creating backends. Regular users do not need to use this module.
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]
- 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
- 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 #
Constructors
EntityJSON | |
Fields
|
Arguments
:: 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.
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 = PersistMap $ zip columNames (map toPersistValue . toPersistFields) fromPersistValue (PersistMap o) = let columns = HM.fromList o in fromPersistValues $ map (name -> case HM.lookup name columns of Just v -> v Nothing -> PersistNull fromPersistValue x = Left $ "Expected PersistMap, received: " ++ show x sqlType _ = SqlString
Internal
parseReferences :: PersistSettings -> Text -> Q Exp Source #
Since: 2.5.3
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
Methods
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
Methods
onlyUniqueP :: record -> Unique record #
Orphan instances
Lift' a => Lift a Source # | |
Lift EntityDef Source # | |
Lift HaskellName Source # | |
Methods lift :: HaskellName -> Q Exp # | |
Lift DBName Source # | |
Lift FieldType Source # | |
Lift FieldDef Source # | |
Lift ReferenceDef Source # | |
Methods lift :: ReferenceDef -> Q Exp # | |
Lift EmbedEntityDef Source # | |
Methods lift :: EmbedEntityDef -> Q Exp # | |
Lift EmbedFieldDef Source # | |
Methods lift :: EmbedFieldDef -> Q Exp # | |
Lift UniqueDef Source # | |
Lift CompositeDef Source # | |
Methods lift :: CompositeDef -> Q Exp # | |
Lift ForeignDef Source # | |
Methods lift :: ForeignDef -> Q Exp # | |
Lift SqlType Source # | |
Lift PersistFilter Source # | |
Methods lift :: PersistFilter -> Q Exp # | |
Lift PersistUpdate Source # | |
Methods lift :: PersistUpdate -> Q Exp # |