persistent-template-2.8.0.1: Type-safe, non-relational, multi-backend persistence.

Safe HaskellNone
LanguageHaskell2010

Database.Persist.TH

Contents

Description

This module provides the tools for defining your database schema and using it to generate Haskell data types and migrations.

Synopsis

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).

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

Expand

Split your Persistent definitions into multiple files (models1, models2), then create a new module for each new file and run mkPersist there:

-- Model1.hs
share
    [mkPersist sqlSettings]
    $(persistFileWith lowerCaseSettings "models1")
-- Model2.hs
share
    [mkPersist sqlSettings]
    $(persistFileWith lowerCaseSettings "models2")

Use persistManyFileWith to create your migrations:

-- Migrate.hs
share
    [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 EntityDefs into types

mkPersist :: MkPersistSettings -> [EntityDef] -> Q [Dec] Source #

Create data types and appropriate PersistEntity instances for the given EntityDefs. 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

mkPersistSettings Source #

Arguments

:: Type

Value for mpsBackend

-> 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 EntityDefs passed in under the given name.

mkDeleteCascade :: MkPersistSettings -> [EntityDef] -> Q [Dec] Source #

Generate a DeleteCascade instance for the given EntityDefs.

mkEntityDefList Source #

Arguments

:: String

The name that will be given to the EntityDef list.

-> [EntityDef] 
-> Q [Dec] 

Creates a declaration for the [EntityDef] from the 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 EntityDefs.

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

lensPTH :: (s -> a) -> (s -> b -> t) -> Lens s t a b Source #

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

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 EntityDef Source # 
Instance details

Methods

lift :: EntityDef -> Q Exp #

Lift HaskellName Source # 
Instance details

Methods

lift :: HaskellName -> Q Exp #

Lift DBName Source # 
Instance details

Methods

lift :: DBName -> Q Exp #

Lift FieldType Source # 
Instance details

Methods

lift :: FieldType -> Q Exp #

Lift FieldDef Source # 
Instance details

Methods

lift :: FieldDef -> Q Exp #

Lift ReferenceDef Source # 
Instance details

Methods

lift :: ReferenceDef -> Q Exp #

Lift EmbedEntityDef Source # 
Instance details

Methods

lift :: EmbedEntityDef -> Q Exp #

Lift EmbedFieldDef Source # 
Instance details

Methods

lift :: EmbedFieldDef -> Q Exp #

Lift UniqueDef Source # 
Instance details

Methods

lift :: UniqueDef -> Q Exp #

Lift CompositeDef Source # 
Instance details

Methods

lift :: CompositeDef -> Q Exp #

Lift ForeignDef Source # 
Instance details

Methods

lift :: ForeignDef -> Q Exp #

Lift SqlType Source # 
Instance details

Methods

lift :: SqlType -> Q Exp #

Lift PersistFilter Source # 
Instance details

Methods

lift :: PersistFilter -> Q Exp #

Lift PersistUpdate Source # 
Instance details

Methods

lift :: PersistUpdate -> Q Exp #