persistent-eventsource-0.2.0: Persistent based event sourcing.
Safe HaskellSafe-Inferred
LanguageHaskell2010

Database.Esqueleto.Monad.Legacy

Description

Classy shim around Database.Esqueleto.Legacy

In the style of Database.Persist.Monad, this exposes a "classy" (typeclass-using) API for Esqueleto functions, allowing them to be used with MonadSqlQuery constraints rather than a ReaderT SqlBackend concrete type.

The goal of this module is to be a drop-in replacement for Database.Esqueleto.Legacy.

Synopsis

Documentation

select :: (MonadSqlQuery m, SqlSelect a r) => SqlQuery a -> m [r] Source #

Classy version of select

selectOne :: (MonadSqlQuery m, SqlSelect a r) => SqlQuery a -> m (Maybe r) Source #

Classy version of selectOne

delete :: MonadSqlQuery m => SqlQuery () -> m () Source #

Classy version of delete

deleteWhere :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => [Filter record] -> m () #

The lifted version of deleteWhere

get :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => Key record -> m (Maybe record) #

The lifted version of get

getBy :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => Unique record -> m (Maybe (Entity record)) #

The lifted version of getBy

getEntity :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => Key record -> m (Maybe (Entity record)) #

The lifted version of getEntity

getMany :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => [Key record] -> m (Map (Key record) record) #

The lifted version of getMany

insert :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => record -> m (Key record) #

The lifted version of insert

insert_ :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => record -> m () #

The lifted version of insert_

insertKey :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => Key record -> record -> m () #

The lifted version of insertKey

insertMany_ :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => [record] -> m () #

The lifted version of insertMany_

insertEntityMany :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => [Entity record] -> m () #

The lifted version of insertEntityMany

selectFirst :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => [Filter record] -> [SelectOpt record] -> m (Maybe (Entity record)) #

The lifted version of selectFirst

updateWhere :: (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) => [Filter record] -> [Update record] -> m () #

The lifted version of updateWhere

associateJoin :: forall e1 e0. Ord (Key e0) => [(Entity e0, e1)] -> Map (Key e0) (e0, [e1]) #

Avoid N+1 queries and join entities into a map structure.

This function is useful to call on the result of a single JOIN. For example, suppose you have this query:

getFoosAndNestedBarsFromParent
    :: ParentId
    -> SqlPersistT IO [(Entity Foo, Maybe (Entity Bar))]
getFoosAndNestedBarsFromParent parentId =
    select $ do
        (foo :& bar) <- from $
            table Foo
            `LeftOuterJoin`
            table Bar
                `on` do
                    \(foo :& bar) ->
                        foo ^. FooId ==. bar ?. BarFooId
        where_ $
            foo ^. FooParentId ==. val parentId
        pure (foo, bar)

This is a natural result type for SQL - a list of tuples. However, it's not what we usually want in Haskell - each Foo in the list will be represented multiple times, once for each Bar.

We can write fmap associateJoin and it will translate it into a Map that is keyed on the Key of the left Entity, and the value is a tuple of the entity's value as well as the list of each coresponding entity.

getFoosAndNestedBarsFromParentHaskellese
    :: ParentId
    -> SqlPersistT (Map (Key Foo) (Foo, [Maybe (Entity Bar)]))
getFoosAndNestedBarsFromParentHaskellese parentId =
    fmap associateJoin $ getFoosdAndNestedBarsFromParent parentId

What if you have multiple joins?

Let's use associateJoin with a *two* join query.

userPostComments
    :: SqlQuery (SqlExpr (Entity User, Entity Post, Entity Comment))
userPostsComment = do
    (u :& p :& c) <- from $
        table User
        `InnerJoin`
        table Post
            on do
                \(u :& p) ->
                    u ^. UserId ==. p ^. PostUserId
        `InnerJoin`
        table @Comment
            `on` do
                \(_ :& p :& c) ->
                    p ^. PostId ==. c ^. CommentPostId
    pure (u, p, c)

This query returns a User, with all of the users Posts, and then all of the Comments on that post.

First, we *nest* the tuple.

nest :: (a, b, c) -> (a, (b, c))
nest (a, b, c) = (a, (b, c))

This makes the return of the query conform to the input expected from associateJoin.

nestedUserPostComments
    :: SqlPersistT IO [(Entity User, (Entity Post, Entity Comment))]
nestedUserPostComments =
    fmap nest $ select userPostsComments

Now, we can call associateJoin on it.

associateUsers
    :: [(Entity User, (Entity Post, Entity Comment))]
    -> Map UserId (User, [(Entity Post, Entity Comment)])
associateUsers =
    associateJoin

Next, we'll use the Functor instances for Map and tuple to call associateJoin on the [(Entity Post, Entity Comment)].

associatePostsAndComments
    :: Map UserId (User, [(Entity Post, Entity Comment)])
    -> Map UserId (User, Map PostId (Post, [Entity Comment]))
associatePostsAndComments =
    fmap (fmap associateJoin)

For more reading on this topic, see this Foxhound Systems blog post.

Since: esqueleto-3.1.2

deleteKey :: forall backend val (m :: Type -> Type). (PersistStore backend, BaseBackend backend ~ PersistEntityBackend val, MonadIO m, PersistEntity val) => Key val -> ReaderT backend m () #

Synonym for delete that does not clash with esqueleto's delete.

valJ :: PersistField (Key entity) => Value (Key entity) -> SqlExpr (Value (Key entity)) #

valJ is like val but for something that is already a Value. The use case it was written for was, given a Value lift the Key for that Value into the query expression in a type safe way. However, the implementation is more generic than that so we call it valJ.

Its important to note that the input entity and the output entity are constrained to be the same by the type signature on the function (https://github.com/prowdsponsor/esqueleto/pull/69).

Since: esqueleto-1.4.2

insertSelectCount :: forall (m :: Type -> Type) a backend. (MonadIO m, PersistEntity a, SqlBackendCanWrite backend) => SqlQuery (SqlExpr (Insertion a)) -> ReaderT backend m Int64 #

Insert a PersistField for every selected value, return the count afterward

insertSelect :: forall (m :: Type -> Type) a backend. (MonadIO m, PersistEntity a, SqlBackendCanWrite backend) => SqlQuery (SqlExpr (Insertion a)) -> ReaderT backend m () #

Insert a PersistField for every selected value.

Since: esqueleto-2.4.2

renderQueryInsertInto #

Arguments

:: forall a r backend (m :: Type -> Type). (SqlSelect a r, BackendCompatible SqlBackend backend, Monad m) 
=> SqlQuery a

The SQL query you want to render.

-> ReaderT backend m (Text, [PersistValue]) 

Renders a SqlQuery into a Text value along with the list of PersistValues that would be supplied to the database for ? placeholders.

Since: esqueleto-3.1.1

renderQueryUpdate #

Arguments

:: forall a r backend (m :: Type -> Type). (SqlSelect a r, BackendCompatible SqlBackend backend, Monad m) 
=> SqlQuery a

The SQL query you want to render.

-> ReaderT backend m (Text, [PersistValue]) 

Renders a SqlQuery into a Text value along with the list of PersistValues that would be supplied to the database for ? placeholders.

Since: esqueleto-3.1.1

renderQueryDelete #

Arguments

:: forall a r backend (m :: Type -> Type). (SqlSelect a r, BackendCompatible SqlBackend backend, Monad m) 
=> SqlQuery a

The SQL query you want to render.

-> ReaderT backend m (Text, [PersistValue]) 

Renders a SqlQuery into a Text value along with the list of PersistValues that would be supplied to the database for ? placeholders.

Since: esqueleto-3.1.1

renderQueryToText #

Arguments

:: forall a r backend (m :: Type -> Type). (SqlSelect a r, BackendCompatible SqlBackend backend, Monad m) 
=> Mode

Whether to render as an SELECT, DELETE, etc.

-> SqlQuery a

The SQL query you want to render.

-> ReaderT backend m (Text, [PersistValue]) 

Renders a SqlQuery into a Text value along with the list of PersistValues that would be supplied to the database for ? placeholders.

You must ensure that the Mode you pass to this function corresponds with the actual SqlQuery. If you pass a query that uses incompatible features (like an INSERT statement with a SELECT mode) then you'll get a weird result.

Since: esqueleto-3.1.1

updateCount :: forall (m :: Type -> Type) val backend. (MonadIO m, PersistEntity val, BackendCompatible SqlBackend (PersistEntityBackend val), SqlBackendCanWrite backend) => (SqlExpr (Entity val) -> SqlQuery ()) -> ReaderT backend m Int64 #

Same as update, but returns the number of rows affected.

deleteCount :: forall (m :: Type -> Type) backend. (MonadIO m, SqlBackendCanWrite backend) => SqlQuery () -> ReaderT backend m Int64 #

Same as delete, but returns the number of rows affected.

selectSource :: forall a r backend (m :: Type -> Type). (SqlSelect a r, BackendCompatible SqlBackend backend, IsPersistBackend backend, PersistQueryRead backend, PersistStoreRead backend, PersistUniqueRead backend, MonadResource m) => SqlQuery a -> ConduitT () r (ReaderT backend m) () #

Execute an esqueleto SELECT query inside persistent's SqlPersistT monad and return a Source of rows.

from :: From a => (a -> SqlQuery b) -> SqlQuery b #

FROM clause: bring entities into scope.

Note that this function will be replaced by the one in Database.Esqueleto.Experimental in version 4.0.0.0 of the library. The Experimental module has a dramatically improved means for introducing tables and entities that provides more power and less potential for runtime errors.

This function internally uses two type classes in order to provide some flexibility of how you may call it. Internally we refer to these type classes as the two different magics.

The innermost magic allows you to use from with the following types:

  • expr (Entity val), which brings a single entity into scope.
  • expr (Maybe (Entity val)), which brings a single entity that may be NULL into scope. Used for OUTER JOINs.
  • A JOIN of any other two types allowed by the innermost magic, where a JOIN may be an InnerJoin, a CrossJoin, a LeftOuterJoin, a RightOuterJoin, or a FullOuterJoin. The JOINs have left fixity.

The outermost magic allows you to use from on any tuples of types supported by innermost magic (and also tuples of tuples, and so on), up to 8-tuples.

Note that using from for the same entity twice does work and corresponds to a self-join. You don't even need to use two different calls to from, you may use a JOIN or a tuple.

The following are valid examples of uses of from (the types of the arguments of the lambda are inside square brackets):

from $ \person -> ...
from $ \(person, blogPost) -> ...
from $ \(p `LeftOuterJoin` mb) -> ...
from $ \(p1 `InnerJoin` f `InnerJoin` p2) -> ...
from $ \((p1 `InnerJoin` f) `InnerJoin` p2) -> ...

The types of the arguments to the lambdas above are, respectively:

person
  :: ( Esqueleto query expr backend
     , PersistEntity Person
     , PersistEntityBackend Person ~ backend
     ) => expr (Entity Person)
(person, blogPost)
  :: (...) => (expr (Entity Person), expr (Entity BlogPost))
(p `LeftOuterJoin` mb)
  :: (...) => InnerJoin (expr (Entity Person)) (expr (Maybe (Entity BlogPost)))
(p1 `InnerJoin` f `InnerJoin` p2)
  :: (...) => InnerJoin
                (InnerJoin (expr (Entity Person))
                           (expr (Entity Follow)))
                (expr (Entity Person))
(p1 `InnerJoin` (f `InnerJoin` p2)) ::
  :: (...) => InnerJoin
                (expr (Entity Person))
                (InnerJoin (expr (Entity Follow))
                           (expr (Entity Person)))

Note that some backends may not support all kinds of JOINs.

else_ :: expr a -> expr a #

Syntax sugar for case_.

Since: esqueleto-2.1.2

then_ :: () #

Syntax sugar for case_.

Since: esqueleto-2.1.2

when_ :: expr (Value Bool) -> () -> expr a -> (expr (Value Bool), expr a) #

Syntax sugar for case_.

Since: esqueleto-2.1.2

toBaseId :: ToBaseId ent => SqlExpr (Value (Key ent)) -> SqlExpr (Value (Key (BaseEnt ent))) #

Convert an entity's key into another entity's.

This function is to be used when you change an entity's Id to be that of another entity. For example:

Bar
  barNum Int
Foo
  bar BarId
  fooNum Int
  Primary bar

In this example, Bar is said to be the BaseEnt(ity), and Foo the child. To model this in Esqueleto, declare:

instance ToBaseId Foo where
  type BaseEnt Foo = Bar
  toBaseIdWitness barId = FooKey barId

Now you're able to write queries such as:

select $
from $ (bar `InnerJoin` foo) -> do
on (toBaseId (foo ^. FooId) ==. bar ^. BarId)
return (bar, foo)

Note: this function may be unsafe to use in conditions not like the one of the example above.

Since: esqueleto-2.4.3

case_ :: PersistField a => [(SqlExpr (Value Bool), SqlExpr (Value a))] -> SqlExpr (Value a) -> SqlExpr (Value a) #

CASE statement. For example:

select $
return $
case_
   [ when_
       (exists $
       from $ \p -> do
       where_ (p ^. PersonName ==. val "Mike"))
     then_
       (sub_select $
       from $ \v -> do
       let sub =
               from $ \c -> do
               where_ (c ^. PersonName ==. val "Mike")
               return (c ^. PersonFavNum)
       where_ (v ^. PersonFavNum >. sub_select sub)
       return $ count (v ^. PersonName) +. val (1 :: Int)) ]
   (else_ $ val (-1))

This query is a bit complicated, but basically it checks if a person named "Mike" exists, and if that person does, run the subquery to find out how many people have a ranking (by Fav Num) higher than "Mike".

NOTE: There are a few things to be aware about this statement.

  • This only implements the full CASE statement, it does not implement the "simple" CASE statement.
  • At least one when_ and then_ is mandatory otherwise it will emit an error.
  • The else_ is also mandatory, unlike the SQL statement in which if the ELSE is omitted it will return a NULL. You can reproduce this via nothing.

Since: esqueleto-2.1.2

(<&>) :: SqlExpr (Insertion (a -> b)) -> SqlExpr (Value a) -> SqlExpr (Insertion b) #

Apply extra SqlExpr Value arguments to a PersistField constructor

(<#) :: (a -> b) -> SqlExpr (Value a) -> SqlExpr (Insertion b) #

Apply a PersistField constructor to SqlExpr Value arguments.

(/=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> SqlExpr (Entity val) -> SqlExpr Update infixr 3 #

(*=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> SqlExpr (Entity val) -> SqlExpr Update infixr 3 #

(-=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> SqlExpr (Entity val) -> SqlExpr Update infixr 3 #

(+=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> SqlExpr (Entity val) -> SqlExpr Update infixr 3 #

(=.) :: (PersistEntity val, PersistField typ) => EntityField val typ -> SqlExpr (Value typ) -> SqlExpr (Entity val) -> SqlExpr Update infixr 3 #

set :: PersistEntity val => SqlExpr (Entity val) -> [SqlExpr (Entity val) -> SqlExpr Update] -> SqlQuery () #

SET clause used on UPDATEs. Note that while it's not a type error to use this function on a SELECT, it will most certainly result in a runtime error.

notExists :: SqlQuery () -> SqlExpr (Value Bool) #

NOT EXISTS operator.

exists :: SqlQuery () -> SqlExpr (Value Bool) #

EXISTS operator. For example:

select $
from $ \person -> do
where_ $ exists $
         from $ \post -> do
         where_ (post ^. BlogPostAuthorId ==. person ^. PersonId)
return person

notIn :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> SqlExpr (Value Bool) #

NOT IN operator.

in_ :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> SqlExpr (Value Bool) #

IN operator. For example if you want to select all Persons by a list of IDs:

SELECT *
FROM Person
WHERE Person.id IN (?)

In esqueleto, we may write the same query above as:

select $
from $ \person -> do
where_ $ person ^. PersonId `in_` valList personIds
return person

Where personIds is of type [Key Person].

justList :: SqlExpr (ValueList typ) -> SqlExpr (ValueList (Maybe typ)) #

Same as just but for ValueList. Most of the time you won't need it, though, because you can use just from inside subList_select or Just from inside valList.

Since: esqueleto-2.2.12

valList :: PersistField typ => [typ] -> SqlExpr (ValueList typ) #

Lift a list of constant value from Haskell-land to the query.

subList_select :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (ValueList a) #

Execute a subquery SELECT in an SqlExpression. Returns a list of values.

castString :: (SqlString s, SqlString r) => SqlExpr (Value s) -> SqlExpr (Value r) #

Cast a string type into Text. This function is very useful if you want to use newtypes, or if you want to apply functions such as like to strings of different types.

Safety: This is a slightly unsafe function, especially if you have defined your own instances of SqlString. Also, since Maybe is an instance of SqlString, it's possible to turn a nullable value into a non-nullable one. Avoid using this function if possible.

(++.) :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value s) infixr 5 #

The || string concatenation operator (named after Haskell's ++ in order to avoid naming clash with ||.). Supported by SQLite and PostgreSQL.

concat_ :: SqlString s => [SqlExpr (Value s)] -> SqlExpr (Value s) #

The CONCAT function with a variable number of parameters. Supported by MySQL and PostgreSQL.

(%) :: SqlString s => SqlExpr (Value s) #

The string %. May be useful while using like and concatenation (concat_ or ++., depending on your database). Note that you always have to type the parenthesis, for example:

name `like` (%) ++. val "John" ++. (%)

ilike :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool) infixr 2 #

ILIKE operator (case-insensitive LIKE).

Supported by PostgreSQL only.

Since: esqueleto-2.2.3

like :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool) infixr 2 #

LIKE operator.

right_ :: (SqlString s, Num a) => (SqlExpr (Value s), SqlExpr (Value a)) -> SqlExpr (Value s) #

RIGHT function. @since 3.3.0

left_ :: (SqlString s, Num a) => (SqlExpr (Value s), SqlExpr (Value a)) -> SqlExpr (Value s) #

LEFT function. @since 3.3.0

length_ :: (SqlString s, Num a) => SqlExpr (Value s) -> SqlExpr (Value a) #

LENGTH function. @since 3.3.0

ltrim_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) #

LTRIM function. @since 3.3.0

rtrim_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) #

RTRIM function. @since 3.3.0

trim_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) #

TRIM function. @since 3.3.0

upper_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) #

UPPER function. @since 3.3.0

lower_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) #

LOWER function.

coalesceDefault :: PersistField a => [SqlExpr (Value (Maybe a))] -> SqlExpr (Value a) -> SqlExpr (Value a) #

Like coalesce, but takes a non-nullable SqlExpression placed at the end of the SqlExpression list, which guarantees a non-NULL result.

Since: esqueleto-1.4.3

coalesce :: PersistField a => [SqlExpr (Value (Maybe a))] -> SqlExpr (Value (Maybe a)) #

COALESCE function. Evaluates the arguments in order and returns the value of the first non-NULL SqlExpression, or NULL (Nothing) otherwise. Some RDBMSs (such as SQLite) require at least two arguments; please refer to the appropriate documentation.

Since: esqueleto-1.4.3

castNumM :: (Num a, Num b) => SqlExpr (Value (Maybe a)) -> SqlExpr (Value (Maybe b)) #

Same as castNum, but for nullable values.

Since: esqueleto-2.2.9

castNum :: (Num a, Num b) => SqlExpr (Value a) -> SqlExpr (Value b) #

Allow a number of one type to be used as one of another type via an implicit cast. An explicit cast is not made, this function changes only the types on the Haskell side.

Caveat: Trying to use castNum from Double to Int will not result in an integer, the original fractional number will still be used! Use round_, ceiling_ or floor_ instead.

Safety: This operation is mostly safe due to the Num constraint between the types and the fact that RDBMSs usually allow numbers of different types to be used interchangeably. However, there may still be issues with the query not being accepted by the RDBMS or persistent not being able to parse it.

Since: esqueleto-2.2.9

between :: PersistField a => SqlExpr (Value a) -> (SqlExpr (Value a), SqlExpr (Value a)) -> SqlExpr (Value Bool) #

BETWEEN.

@since: 3.1.0

(*.) :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a) infixl 7 #

(/.) :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a) infixl 7 #

(-.) :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a) infixl 6 #

(+.) :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a) infixl 6 #

(!=.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) infix 4 #

(<.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) infix 4 #

(<=.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) infix 4 #

(>.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) infix 4 #

(>=.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) infix 4 #

(==.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) infix 4 #

countDistinct :: Num a => SqlExpr (Value typ) -> SqlExpr (Value a) #

COUNT(DISTINCT x).

Since: esqueleto-2.4.1

count :: Num a => SqlExpr (Value typ) -> SqlExpr (Value a) #

COUNT.

countRows :: Num a => SqlExpr (Value a) #

COUNT(*) value.

joinV :: SqlExpr (Value (Maybe (Maybe typ))) -> SqlExpr (Value (Maybe typ)) #

Join nested Maybes in a Value into one. This is useful when calling aggregate functions on nullable fields.

nothing :: SqlExpr (Value (Maybe typ)) #

NULL value.

just :: SqlExpr (Value typ) -> SqlExpr (Value (Maybe typ)) #

Analogous to Just, promotes a value of type typ into one of type Maybe typ. It should hold that val . Just === just . val.

isNothing :: PersistField typ => SqlExpr (Value (Maybe typ)) -> SqlExpr (Value Bool) #

IS NULL comparison.

For IS NOT NULL, you can negate this with not_, as in not_ (isNothing (person ^. PersonAge))

Warning: Persistent and Esqueleto have different behavior for != Nothing:

HaskellSQL
Persistent!=. NothingIS NOT NULL
Esqueleto!=. Nothing!= NULL

In SQL, = NULL and != NULL return NULL instead of true or false. For this reason, you very likely do not want to use !=. Nothing in Esqueleto. You may find these hlint rules helpful to enforce this:

- error: {lhs: v Database.Esqueleto.==. Database.Esqueleto.nothing, rhs: Database.Esqueleto.isNothing v, name: Use Esqueleto's isNothing}
- error: {lhs: v Database.Esqueleto.==. Database.Esqueleto.val Nothing, rhs: Database.Esqueleto.isNothing v, name: Use Esqueleto's isNothing}
- error: {lhs: v Database.Esqueleto.!=. Database.Esqueleto.nothing, rhs: not_ (Database.Esqueleto.isNothing v), name: Use Esqueleto's not isNothing}
- error: {lhs: v Database.Esqueleto.!=. Database.Esqueleto.val Nothing, rhs: not_ (Database.Esqueleto.isNothing v), name: Use Esqueleto's not isNothing}

val :: PersistField typ => typ -> SqlExpr (Value typ) #

Lift a constant value from Haskell-land to the query.

(?.) :: (PersistEntity val, PersistField typ) => SqlExpr (Maybe (Entity val)) -> EntityField val typ -> SqlExpr (Value (Maybe typ)) #

Project a field of an entity that may be null.

withNonNull :: PersistField typ => SqlExpr (Value (Maybe typ)) -> (SqlExpr (Value typ) -> SqlQuery a) -> SqlQuery a #

Project an SqlExpression that may be null, guarding against null cases.

(^.) :: forall typ val. (PersistEntity val, PersistField typ) => SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ) infixl 9 #

Project a field of an entity.

subSelectUnsafe :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a) #

Execute a subquery SELECT in a SqlExpr. This function is unsafe, because it can throw runtime exceptions in two cases:

  1. If the query passed has 0 result rows, then it will return a NULL value. The persistent parsing operations will fail on an unexpected NULL.
  2. If the query passed returns more than one row, then the SQL engine will fail with an error like "More than one row returned by a subquery used as an expression".

This function is safe if you guarantee that exactly one row will be returned, or if the result already has a Maybe type for some reason.

For variants with the safety encoded already, see subSelect and subSelectMaybe. For the most common safe use of this, see subSelectCount.

Since: esqueleto-3.2.0

subSelectForeign #

Arguments

:: (BackendCompatible SqlBackend (PersistEntityBackend val1), PersistEntity val1, PersistEntity val2, PersistField a) 
=> SqlExpr (Entity val2)

An expression representing the table you have access to now.

-> EntityField val2 (Key val1)

The foreign key field on the table.

-> (SqlExpr (Entity val1) -> SqlExpr (Value a))

A function to extract a value from the foreign reference table.

-> SqlExpr (Value a) 

Performs a sub-select using the given foreign key on the entity. This is useful to extract values that are known to be present by the database schema.

As an example, consider the following persistent definition:

User
  profile ProfileId

Profile
  name    Text

The following query will return the name of the user.

getUserWithName =
    select $
    from $ user ->
    pure (user, subSelectForeign user UserProfile (^. ProfileName)

Since: esqueleto-3.2.0

subSelectList :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (ValueList a) #

Execute a subquery SELECT in a SqlExpr that returns a list. This is an alias for subList_select and is provided for symmetry with the other safe subselect functions.

Since: esqueleto-3.2.0

subSelectCount :: (Num a, PersistField a) => SqlQuery ignored -> SqlExpr (Value a) #

Performs a COUNT of the given query in a subSelect manner. This is always guaranteed to return a result value, and is completely safe.

Since: esqueleto-3.2.0

subSelectMaybe :: PersistField a => SqlQuery (SqlExpr (Value (Maybe a))) -> SqlExpr (Value (Maybe a)) #

Execute a subquery SELECT in a SqlExpr. This function is a shorthand for the common joinV . subSelect idiom, where you are calling subSelect on an expression that would be Maybe already.

As an example, you would use this function when calling sum_ or max_, which have Maybe in the result type (for a 0 row query).

Since: esqueleto-3.2.0

subSelect :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value (Maybe a)) #

Execute a subquery SELECT in a SqlExpr. The query passed to this function will only return a single result - it has a LIMIT 1 passed in to the query to make it safe, and the return type is Maybe to indicate that the subquery might result in 0 rows.

If you find yourself writing joinV . subSelect, then consider using subSelectMaybe.

If you're performing a countRows, then you can use subSelectCount which is safe.

If you know that the subquery will always return exactly one row (eg a foreign key constraint guarantees that you'll get exactly one row), then consider subSelectUnsafe, along with a comment explaining why it is safe.

Since: esqueleto-3.2.0

sub_select :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a) #

Execute a subquery SELECT in an SqlExpression. Returns a simple value so should be used only when the SELECT query is guaranteed to return just one row.

Deprecated in 3.2.0.

locking :: LockingKind -> SqlQuery () #

Add a locking clause to the query. Please read LockingKind documentation and your RDBMS manual.

If multiple calls to locking are made on the same query, the last one is used.

Since: esqueleto-2.2.7

having :: SqlExpr (Value Bool) -> SqlQuery () #

HAVING.

Since: esqueleto-1.2.2

rand :: SqlExpr OrderBy #

ORDER BY random() clause.

Since: esqueleto-1.3.10

distinctOnOrderBy :: [SqlExpr OrderBy] -> SqlQuery a -> SqlQuery a #

A convenience function that calls both distinctOn and orderBy. In other words,

distinctOnOrderBy [asc foo, desc bar, desc quux] $ do
  ...

is the same as:

distinctOn [don foo, don  bar, don  quux] $ do
  orderBy  [asc foo, desc bar, desc quux]
  ...

Since: esqueleto-2.2.4

don :: SqlExpr (Value a) -> SqlExpr DistinctOn #

Erase an SqlExpression's type so that it's suitable to be used by distinctOn.

Since: esqueleto-2.2.4

distinctOn :: [SqlExpr DistinctOn] -> SqlQuery a -> SqlQuery a #

DISTINCT ON. Change the current SELECT into SELECT DISTINCT ON (SqlExpressions). For example:

select $
  from \foo ->
  distinctOn [don (foo ^. FooName), don (foo ^. FooState)] $ do
  ...

You can also chain different calls to distinctOn. The above is equivalent to:

select $
  from \foo ->
  distinctOn [don (foo ^. FooName)] $
  distinctOn [don (foo ^. FooState)] $ do
  ...

Each call to distinctOn adds more SqlExpressions. Calls to distinctOn override any calls to distinct.

Note that PostgreSQL requires the SqlExpressions on DISTINCT ON to be the first ones to appear on a ORDER BY. This is not managed automatically by esqueleto, keeping its spirit of trying to be close to raw SQL.

Supported by PostgreSQL only.

Since: esqueleto-2.2.4

distinct :: SqlQuery a -> SqlQuery a #

DISTINCT. Change the current SELECT into SELECT DISTINCT. For example:

select $ distinct $
  from \foo -> do
  ...

Note that this also has the same effect:

select $
  from \foo -> do
  distinct (return ())
  ...

Since: esqueleto-2.2.4

offset :: Int64 -> SqlQuery () #

OFFSET. Usually used with limit.

limit :: Int64 -> SqlQuery () #

LIMIT. Limit the number of returned rows.

desc :: PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy #

Descending order of this field or SqlExpression.

asc :: PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy #

Ascending order of this field or SqlExpression.

orderBy :: [SqlExpr OrderBy] -> SqlQuery () #

ORDER BY clause. See also asc and desc.

Multiple calls to orderBy get concatenated on the final query, including distinctOnOrderBy.

groupBy :: ToSomeValues a => a -> SqlQuery () #

GROUP BY clause. You can enclose multiple columns in a tuple.

select $ from \(foo `InnerJoin` bar) -> do
  on (foo ^. FooBarId ==. bar ^. BarId)
  groupBy (bar ^. BarId, bar ^. BarName)
  return (bar ^. BarId, bar ^. BarName, countRows)

With groupBy you can sort by aggregate functions, like so (we used let to restrict the more general countRows to SqlSqlExpr (Value Int) to avoid ambiguity---the second use of countRows has its type restricted by the :: Int below):

r <- select $ from \(foo `InnerJoin` bar) -> do
  on (foo ^. FooBarId ==. bar ^. BarId)
  groupBy $ bar ^. BarName
  let countRows' = countRows
  orderBy [asc countRows']
  return (bar ^. BarName, countRows')
forM_ r $ \(Value name, Value count) -> do
  print name
  print (count :: Int)

Need more columns?

The ToSomeValues class is defined for SqlExpr and tuples of SqlExprs. We only have definitions for up to 8 elements in a tuple right now, so it's possible that you may need to have more than 8 elements.

For example, consider a query with a groupBy call like this:

groupBy (e0, e1, e2, e3, e4, e5, e6, e7)

This is the biggest you can get with a single tuple. However, you can easily nest the tuples to add more:

groupBy ((e0, e1, e2, e3, e4, e5, e6, e7), e8, e9)

on :: SqlExpr (Value Bool) -> SqlQuery () #

An ON clause, useful to describe how two tables are related. Cross joins and tuple-joins do not need an on clause, but InnerJoin and the various outer joins do.

Database.Esqueleto.Experimental in version 4.0.0.0 of the library. The Experimental module has a dramatically improved means for introducing tables and entities that provides more power and less potential for runtime errors.

If you don't include an on clause (or include too many!) then a runtime exception will be thrown.

As an example, consider this simple join:

select $
from $ \(foo `InnerJoin` bar) -> do
  on (foo ^. FooId ==. bar ^. BarFooId)
  ...

We need to specify the clause for joining the two columns together. If we had this:

select $
from $ \(foo `CrossJoin` bar) -> do
  ...

Then we can safely omit the on clause, because the cross join will make pairs of all records possible.

You can do multiple on clauses in a query. This query joins three tables, and has two on clauses:

select $
from $ \(foo `InnerJoin` bar `InnerJoin` baz) -> do
  on (baz ^. BazId ==. bar ^. BarBazId)
  on (foo ^. FooId ==. bar ^. BarFooId)
  ...

Old versions of esqueleto required that you provide the on clauses in reverse order. This restriction has been lifted - you can now provide on clauses in any order, and the SQL should work itself out. The above query is now totally equivalent to this:

select $
from $ \(foo `InnerJoin` bar `InnerJoin` baz) -> do
  on (foo ^. FooId ==. bar ^. BarFooId)
  on (baz ^. BazId ==. bar ^. BarBazId)
  ...

where_ :: SqlExpr (Value Bool) -> SqlQuery () #

WHERE clause: restrict the query's result.

newtype Value a #

A single value (as opposed to a whole entity). You may use (^.) or (?.) to get a Value from an Entity.

Constructors

Value 

Fields

Instances

Instances details
Applicative Value 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

pure :: a -> Value a #

(<*>) :: Value (a -> b) -> Value a -> Value b #

liftA2 :: (a -> b -> c) -> Value a -> Value b -> Value c #

(*>) :: Value a -> Value b -> Value b #

(<*) :: Value a -> Value b -> Value a #

Functor Value

Since: esqueleto-1.4.4

Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

fmap :: (a -> b) -> Value a -> Value b #

(<$) :: a -> Value b -> Value a #

Monad Value 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

(>>=) :: Value a -> (a -> Value b) -> Value b #

(>>) :: Value a -> Value b -> Value b #

return :: a -> Value a #

(PersistEntity rec, PersistField typ, SymbolToField sym rec typ) => HasField (sym :: Symbol) (SqlExpr (Entity rec)) (SqlExpr (Value typ))

This instance allows you to use record.field notation with GHC 9.2's OverloadedRecordDot extension.

Example:

-- persistent model:
BlogPost
    authorId     PersonId
    title        Text

-- query:
select $ do
    bp <- from $ table @BlogPost
    pure $ bp.title

This is exactly equivalent to the following:

blogPost :: SqlExpr (Entity BlogPost)

blogPost ^. BlogPostTitle
blogPost ^. #title
blogPost.title

There's another instance defined on SqlExpr (Entity (Maybe rec)), which allows you to project from a LEFT JOINed entity.

Since: esqueleto-3.5.4.0

Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

getField :: SqlExpr (Entity rec) -> SqlExpr (Value typ) #

(PersistEntity rec, PersistField typ, SymbolToField sym rec typ) => HasField (sym :: Symbol) (SqlExpr (Maybe (Entity rec))) (SqlExpr (Value (Maybe typ)))

This instance allows you to use record.field notation with GC 9.2's OverloadedRecordDot extension.

Example:

-- persistent model:
Person
    name         Text

BlogPost
    title        Text
    authorId     PersonId

-- query:

select $ do
    (p :& bp) <- from $
        table Person
        leftJoin table BlogPost
        on do
            \(p :& bp) ->
                just p.id ==. bp.authorId
    pure (p.name, bp.title)

The following forms are all equivalent:

blogPost :: SqlExpr (Maybe (Entity BlogPost))

blogPost ?. BlogPostTitle
blogPost ?. #title
blogPost.title

Since: esqueleto-3.5.4.0

Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

getField :: SqlExpr (Maybe (Entity rec)) -> SqlExpr (Value (Maybe typ)) #

(ToFrom a a', SqlSelect b r, ToAlias b, ToAliasReference b, d ~ (a' :& b)) => DoInnerJoin Lateral a (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) d 
Instance details

Defined in Database.Esqueleto.Experimental.From.Join

Methods

doInnerJoin :: Proxy Lateral -> a -> (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) -> From d #

(ToFrom a a', ToMaybe b, d ~ (a' :& ToMaybeT b), SqlSelect b r, ToAlias b, ToAliasReference b) => DoLeftJoin Lateral a (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) d 
Instance details

Defined in Database.Esqueleto.Experimental.From.Join

Methods

doLeftJoin :: Proxy Lateral -> a -> (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) -> From d #

Show a => Show (Value a) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

showsPrec :: Int -> Value a -> ShowS #

show :: Value a -> String #

showList :: [Value a] -> ShowS #

ToAlias (SqlExpr (Value a)) 
Instance details

Defined in Database.Esqueleto.Experimental.ToAlias

Methods

toAlias :: SqlExpr (Value a) -> SqlQuery (SqlExpr (Value a)) #

ToAliasReference (SqlExpr (Value a)) 
Instance details

Defined in Database.Esqueleto.Experimental.ToAliasReference

ToMaybe (SqlExpr (Value a)) 
Instance details

Defined in Database.Esqueleto.Experimental.ToMaybe

Associated Types

type ToMaybeT (SqlExpr (Value a)) #

Methods

toMaybe :: SqlExpr (Value a) -> ToMaybeT (SqlExpr (Value a)) #

ToSomeValues (SqlExpr (Value a)) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

toSomeValues :: SqlExpr (Value a) -> [SomeValue] #

Eq a => Eq (Value a) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

(==) :: Value a -> Value a -> Bool #

(/=) :: Value a -> Value a -> Bool #

Ord a => Ord (Value a) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

compare :: Value a -> Value a -> Ordering #

(<) :: Value a -> Value a -> Bool #

(<=) :: Value a -> Value a -> Bool #

(>) :: Value a -> Value a -> Bool #

(>=) :: Value a -> Value a -> Bool #

max :: Value a -> Value a -> Value a #

min :: Value a -> Value a -> Value a #

PersistField a => SqlSelect (SqlExpr (Value a)) (Value a)

You may return any single value (i.e. a single column) from a select query.

Instance details

Defined in Database.Esqueleto.Internal.Internal

type ToMaybeT (SqlExpr (Value a)) 
Instance details

Defined in Database.Esqueleto.Experimental.ToMaybe

newtype ValueList a #

A list of single values. There's a limited set of functions able to work with this data type (such as subList_select, valList, in_ and exists).

Constructors

ValueList a 

Instances

Instances details
Show a => Show (ValueList a) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Eq a => Eq (ValueList a) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

(==) :: ValueList a -> ValueList a -> Bool #

(/=) :: ValueList a -> ValueList a -> Bool #

Ord a => Ord (ValueList a) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

data InnerJoin a b infixl 2 #

Data type that represents an INNER JOIN (see LeftOuterJoin for an example).

Constructors

a `InnerJoin` b infixl 2 

Instances

Instances details
IsJoinKind InnerJoin 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

smartJoin :: a -> b -> InnerJoin a b #

reifyJoinKind :: InnerJoin a b -> JoinKind #

FromPreprocess (InnerJoin a b) => From (InnerJoin a b) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (InnerJoin a b) #

data CrossJoin a b infixl 2 #

Data type that represents a CROSS JOIN (see LeftOuterJoin for an example).

Constructors

a `CrossJoin` b infixl 2 

Instances

Instances details
IsJoinKind CrossJoin 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

smartJoin :: a -> b -> CrossJoin a b #

reifyJoinKind :: CrossJoin a b -> JoinKind #

FromPreprocess (CrossJoin a b) => From (CrossJoin a b) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (CrossJoin a b) #

data LeftOuterJoin a b infixl 2 #

Data type that represents a LEFT OUTER JOIN. For example,

select $
from $ \(person `LeftOuterJoin` pet) ->
  ...

is translated into

SELECT ...
FROM Person LEFT OUTER JOIN Pet
...

See also: from.

Constructors

a `LeftOuterJoin` b infixl 2 

Instances

Instances details
IsJoinKind LeftOuterJoin 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

smartJoin :: a -> b -> LeftOuterJoin a b #

reifyJoinKind :: LeftOuterJoin a b -> JoinKind #

FromPreprocess (LeftOuterJoin a b) => From (LeftOuterJoin a b) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (LeftOuterJoin a b) #

data RightOuterJoin a b infixl 2 #

Data type that represents a RIGHT OUTER JOIN (see LeftOuterJoin for an example).

Constructors

a `RightOuterJoin` b infixl 2 

Instances

Instances details
IsJoinKind RightOuterJoin 
Instance details

Defined in Database.Esqueleto.Internal.Internal

FromPreprocess (RightOuterJoin a b) => From (RightOuterJoin a b) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (RightOuterJoin a b) #

data FullOuterJoin a b infixl 2 #

Data type that represents a FULL OUTER JOIN (see LeftOuterJoin for an example).

Constructors

a `FullOuterJoin` b infixl 2 

Instances

Instances details
IsJoinKind FullOuterJoin 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

smartJoin :: a -> b -> FullOuterJoin a b #

reifyJoinKind :: FullOuterJoin a b -> JoinKind #

FromPreprocess (FullOuterJoin a b) => From (FullOuterJoin a b) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (FullOuterJoin a b) #

data JoinKind #

(Internal) A kind of JOIN.

Constructors

InnerJoinKind
INNER JOIN
CrossJoinKind
CROSS JOIN
LeftOuterJoinKind
LEFT OUTER JOIN
RightOuterJoinKind
RIGHT OUTER JOIN
FullOuterJoinKind
FULL OUTER JOIN

Instances

Instances details
Show JoinKind 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Eq JoinKind 
Instance details

Defined in Database.Esqueleto.Internal.Internal

data OnClauseWithoutMatchingJoinException #

Exception thrown whenever on is used to create an ON clause but no matching JOIN is found.

Instances

Instances details
Exception OnClauseWithoutMatchingJoinException 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Show OnClauseWithoutMatchingJoinException 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Eq OnClauseWithoutMatchingJoinException 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Ord OnClauseWithoutMatchingJoinException 
Instance details

Defined in Database.Esqueleto.Internal.Internal

data OrderBy #

Phantom type used by orderBy, asc and desc.

data DistinctOn #

Phantom type used by distinctOn and don.

data LockingKind #

Different kinds of locking clauses supported by locking.

Note that each RDBMS has different locking support. The constructors of this datatype specify only the syntax of the locking mechanism, not its semantics. For example, even though both MySQL and PostgreSQL support ForUpdate, there are no guarantees that they will behave the same.

Since: esqueleto-2.2.7

Constructors

ForUpdate

FOR UPDATE syntax. Supported by MySQL, Oracle and PostgreSQL.

Since: esqueleto-2.2.7

ForUpdateSkipLocked

FOR UPDATE SKIP LOCKED syntax. Supported by MySQL, Oracle and PostgreSQL.

Since: esqueleto-2.2.7

ForShare

FOR SHARE syntax. Supported by PostgreSQL.

Since: esqueleto-2.2.7

LockInShareMode

LOCK IN SHARE MODE syntax. Supported by MySQL.

Since: esqueleto-2.2.7

class PersistField a => SqlString a #

Phantom class of data types that are treated as strings by the RDBMS. It has no methods because it's only used to avoid type errors such as trying to concatenate integers.

If you have a custom data type or newtype, feel free to make it an instance of this class.

Since: esqueleto-2.4.0

Instances

Instances details
SqlString Html

Since: esqueleto-2.3.0

Instance details

Defined in Database.Esqueleto.Internal.Internal

SqlString ByteString

Since: esqueleto-2.3.0

Instance details

Defined in Database.Esqueleto.Internal.Internal

SqlString Text

Since: esqueleto-2.3.0

Instance details

Defined in Database.Esqueleto.Internal.Internal

SqlString Text

Since: esqueleto-2.3.0

Instance details

Defined in Database.Esqueleto.Internal.Internal

SqlString a => SqlString (Maybe a)

Since: esqueleto-2.4.0

Instance details

Defined in Database.Esqueleto.Internal.Internal

a ~ Char => SqlString [a]

Since: esqueleto-2.3.0

Instance details

Defined in Database.Esqueleto.Internal.Internal

type family BaseEnt ent #

e.g. type BaseEnt MyBase = MyChild

class ToBaseId ent where #

Class that enables one to use toBaseId to convert an entity's key on a query into another (cf. toBaseId).

Associated Types

type BaseEnt ent #

e.g. type BaseEnt MyBase = MyChild

Methods

toBaseIdWitness :: Key (BaseEnt ent) -> Key ent #

Convert from the key of the BaseEnt(ity) to the key of the child entity. This function is not actually called, but that it typechecks proves this operation is safe.

class From a #

(Internal) Class that implements the tuple from magic (see fromStart).

Minimal complete definition

from_

Instances

Instances details
FromPreprocess (SqlExpr (Entity val)) => From (SqlExpr (Entity val)) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (SqlExpr (Entity val)) #

FromPreprocess (SqlExpr (Maybe (Entity val))) => From (SqlExpr (Maybe (Entity val))) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (SqlExpr (Maybe (Entity val))) #

FromPreprocess (CrossJoin a b) => From (CrossJoin a b) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (CrossJoin a b) #

FromPreprocess (FullOuterJoin a b) => From (FullOuterJoin a b) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (FullOuterJoin a b) #

FromPreprocess (InnerJoin a b) => From (InnerJoin a b) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (InnerJoin a b) #

FromPreprocess (LeftOuterJoin a b) => From (LeftOuterJoin a b) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (LeftOuterJoin a b) #

FromPreprocess (RightOuterJoin a b) => From (RightOuterJoin a b) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (RightOuterJoin a b) #

(From a, From b) => From (a, b) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (a, b) #

(From a, From b, From c) => From (a, b, c) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (a, b, c) #

(From a, From b, From c, From d) => From (a, b, c, d) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (a, b, c, d) #

(From a, From b, From c, From d, From e) => From (a, b, c, d, e) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (a, b, c, d, e) #

(From a, From b, From c, From d, From e, From f) => From (a, b, c, d, e, f) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (a, b, c, d, e, f) #

(From a, From b, From c, From d, From e, From f, From g) => From (a, b, c, d, e, f, g) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (a, b, c, d, e, f, g) #

(From a, From b, From c, From d, From e, From f, From g, From h) => From (a, b, c, d, e, f, g, h) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (a, b, c, d, e, f, g, h) #

data SqlQuery a #

SQL backend for esqueleto using SqlPersistT.

Instances

Instances details
Applicative SqlQuery 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

pure :: a -> SqlQuery a #

(<*>) :: SqlQuery (a -> b) -> SqlQuery a -> SqlQuery b #

liftA2 :: (a -> b -> c) -> SqlQuery a -> SqlQuery b -> SqlQuery c #

(*>) :: SqlQuery a -> SqlQuery b -> SqlQuery b #

(<*) :: SqlQuery a -> SqlQuery b -> SqlQuery a #

Functor SqlQuery 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

fmap :: (a -> b) -> SqlQuery a -> SqlQuery b #

(<$) :: a -> SqlQuery b -> SqlQuery a #

Monad SqlQuery 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

(>>=) :: SqlQuery a -> (a -> SqlQuery b) -> SqlQuery b #

(>>) :: SqlQuery a -> SqlQuery b -> SqlQuery b #

return :: a -> SqlQuery a #

(ToFrom a a', SqlSelect b r, ToAlias b, ToAliasReference b, d ~ (a' :& b)) => DoInnerJoin Lateral a (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) d 
Instance details

Defined in Database.Esqueleto.Experimental.From.Join

Methods

doInnerJoin :: Proxy Lateral -> a -> (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) -> From d #

(ToFrom a a', ToMaybe b, d ~ (a' :& ToMaybeT b), SqlSelect b r, ToAlias b, ToAliasReference b) => DoLeftJoin Lateral a (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) d 
Instance details

Defined in Database.Esqueleto.Experimental.From.Join

Methods

doLeftJoin :: Proxy Lateral -> a -> (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) -> From d #

(ToFrom a a', SqlSelect b r, ToAlias b, ToAliasReference b) => DoCrossJoin Lateral a (a' -> SqlQuery b) (a' :& b) 
Instance details

Defined in Database.Esqueleto.Experimental.From.Join

Methods

doCrossJoin :: Proxy Lateral -> a -> (a' -> SqlQuery b) -> From (a' :& b) #

(SqlSelect a r, ToAlias a, ToAliasReference a) => ToFrom (SubQuery (SqlQuery a)) a 
Instance details

Defined in Database.Esqueleto.Experimental.From

Methods

toFrom :: SubQuery (SqlQuery a) -> From a #

(SqlSelect a r, ToAlias a, ToAliasReference a) => ToFrom (SqlQuery a) a 
Instance details

Defined in Database.Esqueleto.Experimental.From

Methods

toFrom :: SqlQuery a -> From a #

(SqlSelect a r, ToAlias a, ToAliasReference a) => ToSqlSetOperation (SqlQuery a) a 
Instance details

Defined in Database.Esqueleto.Experimental.From.SqlSetOperation

ValidOnClause (a -> SqlQuery b) 
Instance details

Defined in Database.Esqueleto.Experimental.From.Join

type SqlEntity ent = (PersistEntity ent, PersistEntityBackend ent ~ SqlBackend) #

Constraint synonym for persistent entities whose backend is SqlBackend.

data SqlExpr a #

An expression on the SQL backend.

Raw expression: Contains a SqlExprMeta and a function for building the expr. It recieves a parameter telling it whether it is in a parenthesized context, and takes information about the SQL connection (mainly for escaping names) and returns both an string (Builder) and a list of values to be interpolated by the SQL backend.

Instances

Instances details
(PersistEntity rec, PersistField typ, SymbolToField sym rec typ) => HasField (sym :: Symbol) (SqlExpr (Entity rec)) (SqlExpr (Value typ))

This instance allows you to use record.field notation with GHC 9.2's OverloadedRecordDot extension.

Example:

-- persistent model:
BlogPost
    authorId     PersonId
    title        Text

-- query:
select $ do
    bp <- from $ table @BlogPost
    pure $ bp.title

This is exactly equivalent to the following:

blogPost :: SqlExpr (Entity BlogPost)

blogPost ^. BlogPostTitle
blogPost ^. #title
blogPost.title

There's another instance defined on SqlExpr (Entity (Maybe rec)), which allows you to project from a LEFT JOINed entity.

Since: esqueleto-3.5.4.0

Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

getField :: SqlExpr (Entity rec) -> SqlExpr (Value typ) #

(PersistEntity rec, PersistField typ, SymbolToField sym rec typ) => HasField (sym :: Symbol) (SqlExpr (Maybe (Entity rec))) (SqlExpr (Value (Maybe typ)))

This instance allows you to use record.field notation with GC 9.2's OverloadedRecordDot extension.

Example:

-- persistent model:
Person
    name         Text

BlogPost
    title        Text
    authorId     PersonId

-- query:

select $ do
    (p :& bp) <- from $
        table Person
        leftJoin table BlogPost
        on do
            \(p :& bp) ->
                just p.id ==. bp.authorId
    pure (p.name, bp.title)

The following forms are all equivalent:

blogPost :: SqlExpr (Maybe (Entity BlogPost))

blogPost ?. BlogPostTitle
blogPost ?. #title
blogPost.title

Since: esqueleto-3.5.4.0

Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

getField :: SqlExpr (Maybe (Entity rec)) -> SqlExpr (Value (Maybe typ)) #

(ToFrom a a', SqlSelect b r, ToAlias b, ToAliasReference b, d ~ (a' :& b)) => DoInnerJoin Lateral a (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) d 
Instance details

Defined in Database.Esqueleto.Experimental.From.Join

Methods

doInnerJoin :: Proxy Lateral -> a -> (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) -> From d #

(ToFrom a a', ToMaybe b, d ~ (a' :& ToMaybeT b), SqlSelect b r, ToAlias b, ToAliasReference b) => DoLeftJoin Lateral a (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) d 
Instance details

Defined in Database.Esqueleto.Experimental.From.Join

Methods

doLeftJoin :: Proxy Lateral -> a -> (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) -> From d #

ToAlias (SqlExpr (Value a)) 
Instance details

Defined in Database.Esqueleto.Experimental.ToAlias

Methods

toAlias :: SqlExpr (Value a) -> SqlQuery (SqlExpr (Value a)) #

ToAlias (SqlExpr (Entity a)) 
Instance details

Defined in Database.Esqueleto.Experimental.ToAlias

Methods

toAlias :: SqlExpr (Entity a) -> SqlQuery (SqlExpr (Entity a)) #

ToAlias (SqlExpr (Maybe (Entity a))) 
Instance details

Defined in Database.Esqueleto.Experimental.ToAlias

Methods

toAlias :: SqlExpr (Maybe (Entity a)) -> SqlQuery (SqlExpr (Maybe (Entity a))) #

ToAliasReference (SqlExpr (Value a)) 
Instance details

Defined in Database.Esqueleto.Experimental.ToAliasReference

ToAliasReference (SqlExpr (Entity a)) 
Instance details

Defined in Database.Esqueleto.Experimental.ToAliasReference

ToAliasReference (SqlExpr (Maybe (Entity a))) 
Instance details

Defined in Database.Esqueleto.Experimental.ToAliasReference

ToMaybe (SqlExpr (Value a)) 
Instance details

Defined in Database.Esqueleto.Experimental.ToMaybe

Associated Types

type ToMaybeT (SqlExpr (Value a)) #

Methods

toMaybe :: SqlExpr (Value a) -> ToMaybeT (SqlExpr (Value a)) #

ToMaybe (SqlExpr (Entity a)) 
Instance details

Defined in Database.Esqueleto.Experimental.ToMaybe

Associated Types

type ToMaybeT (SqlExpr (Entity a)) #

Methods

toMaybe :: SqlExpr (Entity a) -> ToMaybeT (SqlExpr (Entity a)) #

ToMaybe (SqlExpr (Maybe a)) 
Instance details

Defined in Database.Esqueleto.Experimental.ToMaybe

Associated Types

type ToMaybeT (SqlExpr (Maybe a)) #

Methods

toMaybe :: SqlExpr (Maybe a) -> ToMaybeT (SqlExpr (Maybe a)) #

FromPreprocess (SqlExpr (Entity val)) => From (SqlExpr (Entity val)) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (SqlExpr (Entity val)) #

FromPreprocess (SqlExpr (Maybe (Entity val))) => From (SqlExpr (Maybe (Entity val))) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

from_ :: SqlQuery (SqlExpr (Maybe (Entity val))) #

(PersistEntity val, BackendCompatible SqlBackend (PersistEntityBackend val)) => FromPreprocess (SqlExpr (Entity val)) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

(PersistEntity val, BackendCompatible SqlBackend (PersistEntityBackend val)) => FromPreprocess (SqlExpr (Maybe (Entity val))) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

ToSomeValues (SqlExpr (Value a)) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

toSomeValues :: SqlExpr (Value a) -> [SomeValue] #

a ~ Value b => UnsafeSqlFunctionArgument (SqlExpr a) 
Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

toArgList :: SqlExpr a -> [SqlExpr (Value ())] #

PersistEntity ent => ToFrom (Table ent) (SqlExpr (Entity ent)) 
Instance details

Defined in Database.Esqueleto.Experimental.From

Methods

toFrom :: Table ent -> From (SqlExpr (Entity ent)) #

PersistEntity e => SqlSelect (SqlExpr (Insertion e)) (Insertion e)

INSERT INTO hack.

Instance details

Defined in Database.Esqueleto.Internal.Internal

PersistField a => SqlSelect (SqlExpr (Value a)) (Value a)

You may return any single value (i.e. a single column) from a select query.

Instance details

Defined in Database.Esqueleto.Internal.Internal

PersistEntity a => SqlSelect (SqlExpr (Entity a)) (Entity a)

You may return an Entity from a select query.

Instance details

Defined in Database.Esqueleto.Internal.Internal

PersistEntity a => SqlSelect (SqlExpr (Maybe (Entity a))) (Maybe (Entity a))

You may return a possibly-NULL Entity from a select query.

Instance details

Defined in Database.Esqueleto.Internal.Internal

type ToMaybeT (SqlExpr (Value a)) 
Instance details

Defined in Database.Esqueleto.Experimental.ToMaybe

type ToMaybeT (SqlExpr (Entity a)) 
Instance details

Defined in Database.Esqueleto.Experimental.ToMaybe

type ToMaybeT (SqlExpr (Maybe a)) 
Instance details

Defined in Database.Esqueleto.Experimental.ToMaybe

class PersistConfig c where #

Represents a value containing all the configuration options for a specific backend. This abstraction makes it easier to write code that can easily swap backends.

Minimal complete definition

loadConfig, createPoolConfig, runPool

Associated Types

type PersistConfigBackend c :: (Type -> Type) -> Type -> Type #

type PersistConfigPool c #

Methods

loadConfig :: Value -> Parser c #

Load the config settings from a Value, most likely taken from a YAML config file.

applyEnv :: c -> IO c #

Modify the config settings based on environment variables.

createPoolConfig :: c -> IO (PersistConfigPool c) #

Create a new connection pool based on the given config settings.

runPool :: MonadUnliftIO m => c -> PersistConfigBackend c m a -> PersistConfigPool c -> m a #

Run a database action by taking a connection from the pool.

Instances

Instances details
(PersistConfig c1, PersistConfig c2, PersistConfigPool c1 ~ PersistConfigPool c2, PersistConfigBackend c1 ~ PersistConfigBackend c2) => PersistConfig (Either c1 c2) 
Instance details

Defined in Database.Persist.Class.PersistConfig

Associated Types

type PersistConfigBackend (Either c1 c2) :: (Type -> Type) -> Type -> Type #

type PersistConfigPool (Either c1 c2) #

Methods

loadConfig :: Value -> Parser (Either c1 c2) #

applyEnv :: Either c1 c2 -> IO (Either c1 c2) #

createPoolConfig :: Either c1 c2 -> IO (PersistConfigPool (Either c1 c2)) #

runPool :: MonadUnliftIO m => Either c1 c2 -> PersistConfigBackend (Either c1 c2) m a -> PersistConfigPool (Either c1 c2) -> m a #

type family PersistConfigBackend c :: (Type -> Type) -> Type -> Type #

Instances

Instances details
type PersistConfigBackend (Either c1 c2) 
Instance details

Defined in Database.Persist.Class.PersistConfig

type family PersistConfigPool c #

Instances

Instances details
type PersistConfigPool (Either c1 c2) 
Instance details

Defined in Database.Persist.Class.PersistConfig

newtype ConstraintNameHS #

An ConstraintNameHS represents the Haskell-side name that persistent will use for a constraint.

Since: persistent-2.12.0.0

Constructors

ConstraintNameHS 

newtype ConstraintNameDB #

A ConstraintNameDB represents the datastore-side name that persistent will use for a constraint.

Since: persistent-2.12.0.0

Constructors

ConstraintNameDB 

Instances

Instances details
Read ConstraintNameDB 
Instance details

Defined in Database.Persist.Names

Show ConstraintNameDB 
Instance details

Defined in Database.Persist.Names

Eq ConstraintNameDB 
Instance details

Defined in Database.Persist.Names

Ord ConstraintNameDB 
Instance details

Defined in Database.Persist.Names

DatabaseName ConstraintNameDB

Since: persistent-2.12.0.0

Instance details

Defined in Database.Persist.Names

Methods

escapeWith :: (Text -> str) -> ConstraintNameDB -> str #

Lift ConstraintNameDB 
Instance details

Defined in Database.Persist.Names

Methods

lift :: Quote m => ConstraintNameDB -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => ConstraintNameDB -> Code m ConstraintNameDB #

newtype EntityNameDB #

An EntityNameDB represents the datastore-side name that persistent will use for an entity.

Since: persistent-2.12.0.0

Constructors

EntityNameDB 

Fields

newtype EntityNameHS #

An EntityNameHS represents the Haskell-side name that persistent will use for an entity.

Since: persistent-2.12.0.0

Constructors

EntityNameHS 

Fields

newtype FieldNameHS #

A FieldNameHS represents the Haskell-side name that persistent will use for a field.

Since: persistent-2.12.0.0

Constructors

FieldNameHS 

Fields

newtype FieldNameDB #

An EntityNameDB represents the datastore-side name that persistent will use for an entity.

Since: persistent-2.12.0.0

Constructors

FieldNameDB 

Fields

Instances

Instances details
Read FieldNameDB 
Instance details

Defined in Database.Persist.Names

Show FieldNameDB 
Instance details

Defined in Database.Persist.Names

Eq FieldNameDB 
Instance details

Defined in Database.Persist.Names

Ord FieldNameDB 
Instance details

Defined in Database.Persist.Names

DatabaseName FieldNameDB

Since: persistent-2.12.0.0

Instance details

Defined in Database.Persist.Names

Methods

escapeWith :: (Text -> str) -> FieldNameDB -> str #

Lift FieldNameDB 
Instance details

Defined in Database.Persist.Names

Methods

lift :: Quote m => FieldNameDB -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => FieldNameDB -> Code m FieldNameDB #

class DatabaseName a where #

Convenience operations for working with '-NameDB' types.

Since: persistent-2.12.0.0

Methods

escapeWith :: (Text -> str) -> a -> str #

Instances

Instances details
DatabaseName ConstraintNameDB

Since: persistent-2.12.0.0

Instance details

Defined in Database.Persist.Names

Methods

escapeWith :: (Text -> str) -> ConstraintNameDB -> str #

DatabaseName EntityNameDB 
Instance details

Defined in Database.Persist.Names

Methods

escapeWith :: (Text -> str) -> EntityNameDB -> str #

DatabaseName FieldNameDB

Since: persistent-2.12.0.0

Instance details

Defined in Database.Persist.Names

Methods

escapeWith :: (Text -> str) -> FieldNameDB -> str #

data LiteralType #

A type that determines how a backend should handle the literal.

Since: persistent-2.12.0.0

Constructors

Escaped

The accompanying value will be escaped before inserting into the database. This is the correct default choice to use.

Since: persistent-2.12.0.0

Unescaped

The accompanying value will not be escaped when inserting into the database. This is potentially dangerous - use this with care.

Since: persistent-2.12.0.0

DbSpecific

The DbSpecific constructor corresponds to the legacy PersistDbSpecific constructor. We need to keep this around because old databases may have serialized JSON representations that reference this. We don't want to break the ability of a database to load rows.

Since: persistent-2.12.0.0

data PersistValue #

A raw value which can be stored in any backend and can be marshalled to and from a PersistField.

Constructors

PersistText Text 
PersistByteString ByteString 
PersistInt64 Int64 
PersistDouble Double 
PersistRational Rational 
PersistBool Bool 
PersistDay Day 
PersistTimeOfDay TimeOfDay 
PersistUTCTime UTCTime 
PersistNull 
PersistList [PersistValue] 
PersistMap [(Text, PersistValue)] 
PersistObjectId ByteString

Intended especially for MongoDB backend

PersistArray [PersistValue]

Intended especially for PostgreSQL backend for text arrays

PersistLiteral_ LiteralType ByteString

This constructor is used to specify some raw literal value for the backend. The LiteralType value specifies how the value should be escaped. This can be used to make special, custom types avaialable in the back end.

Since: persistent-2.12.0.0

Bundled Patterns

pattern PersistLiteral :: ByteString -> PersistValue

This pattern synonym used to be a data constructor on PersistValue, but was changed into a catch-all pattern synonym to allow backwards compatiblity with database types. See the documentation on PersistDbSpecific for more details.

Since: persistent-2.12.0.0

pattern PersistDbSpecific :: ByteString -> PersistValue

This pattern synonym used to be a data constructor for the PersistValue type. It was changed to be a pattern so that JSON-encoded database values could be parsed into their corresponding values. You should not use this, and instead prefer to pattern match on PersistLiteral_ directly.

If you use this, it will overlap a patern match on the 'PersistLiteral_, PersistLiteral, and PersistLiteralEscaped patterns. If you need to disambiguate between these constructors, pattern match on PersistLiteral_ directly.

Since: persistent-2.12.0.0

pattern PersistLiteralEscaped :: ByteString -> PersistValue

This pattern synonym used to be a data constructor on PersistValue, but was changed into a catch-all pattern synonym to allow backwards compatiblity with database types. See the documentation on PersistDbSpecific for more details.

Since: persistent-2.12.0.0

Instances

Instances details
FromJSON PersistValue 
Instance details

Defined in Database.Persist.PersistValue

ToJSON PersistValue 
Instance details

Defined in Database.Persist.PersistValue

Read PersistValue 
Instance details

Defined in Database.Persist.PersistValue

Show PersistValue 
Instance details

Defined in Database.Persist.PersistValue

Eq PersistValue 
Instance details

Defined in Database.Persist.PersistValue

Ord PersistValue 
Instance details

Defined in Database.Persist.PersistValue

FromHttpApiData PersistValue 
Instance details

Defined in Database.Persist.PersistValue

ToHttpApiData PersistValue 
Instance details

Defined in Database.Persist.PersistValue

PathPiece PersistValue 
Instance details

Defined in Database.Persist.PersistValue

PersistField PersistValue 
Instance details

Defined in Database.Persist.Class.PersistField

PersistFieldSql PersistValue 
Instance details

Defined in Database.Persist.Sql.Class

data IsolationLevel #

Please refer to the documentation for the database in question for a full overview of the semantics of the varying isloation levels

Instances

Instances details
Bounded IsolationLevel 
Instance details

Defined in Database.Persist.SqlBackend.Internal.IsolationLevel

Enum IsolationLevel 
Instance details

Defined in Database.Persist.SqlBackend.Internal.IsolationLevel

Show IsolationLevel 
Instance details

Defined in Database.Persist.SqlBackend.Internal.IsolationLevel

Eq IsolationLevel 
Instance details

Defined in Database.Persist.SqlBackend.Internal.IsolationLevel

Ord IsolationLevel 
Instance details

Defined in Database.Persist.SqlBackend.Internal.IsolationLevel

data FieldDef #

A FieldDef represents the inormation that persistent knows about a field of a datatype. This includes information used to parse the field out of the database and what the field corresponds to.

Constructors

FieldDef 

Fields

Instances

Instances details
Read FieldDef 
Instance details

Defined in Database.Persist.Types.Base

Show FieldDef 
Instance details

Defined in Database.Persist.Types.Base

Eq FieldDef 
Instance details

Defined in Database.Persist.Types.Base

Ord FieldDef 
Instance details

Defined in Database.Persist.Types.Base

Lift FieldDef 
Instance details

Defined in Database.Persist.Types.Base

Methods

lift :: Quote m => FieldDef -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => FieldDef -> Code m FieldDef #

data SqlType #

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.

Constructors

SqlString 
SqlInt32 
SqlInt64 
SqlReal 
SqlNumeric Word32 Word32 
SqlBool 
SqlDay 
SqlTime 
SqlDayTime

Always uses UTC timezone

SqlBlob 
SqlOther Text

a backend-specific name

Instances

Instances details
Read SqlType 
Instance details

Defined in Database.Persist.Types.Base

Show SqlType 
Instance details

Defined in Database.Persist.Types.Base

Eq SqlType 
Instance details

Defined in Database.Persist.Types.Base

Methods

(==) :: SqlType -> SqlType -> Bool #

(/=) :: SqlType -> SqlType -> Bool #

Ord SqlType 
Instance details

Defined in Database.Persist.Types.Base

Lift SqlType 
Instance details

Defined in Database.Persist.Types.Base

Methods

lift :: Quote m => SqlType -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => SqlType -> Code m SqlType #

data FieldCascade #

This datatype describes how a foreign reference field cascades deletes or updates.

This type is used in both parsing the model definitions and performing migrations. A Nothing in either of the field values means that the user has not specified a CascadeAction. An unspecified CascadeAction is defaulted to Restrict when doing migrations.

Since: persistent-2.11.0

data ForeignDef #

Constructors

ForeignDef 

Fields

type ForeignFieldDef = (FieldNameHS, FieldNameDB) #

Used instead of FieldDef to generate a smaller amount of code

data UniqueDef #

Type for storing the Uniqueness constraint in the Schema. Assume you have the following schema with a uniqueness constraint:

Person
  name String
  age Int
  UniqueAge age

This will be represented as:

UniqueDef
    { uniqueHaskell = ConstraintNameHS (packPTH UniqueAge)
    , uniqueDBName = ConstraintNameDB (packPTH "unique_age")
    , uniqueFields = [(FieldNameHS (packPTH "age"), FieldNameDB (packPTH "age"))]
    , uniqueAttrs = []
    }

data EmbedFieldDef #

An EmbedFieldDef is the same as a FieldDef But it is only used for embeddedFields so it only has data needed for embedding

Constructors

EmbedFieldDef 

data EmbedEntityDef #

An EmbedEntityDef is the same as an EntityDef But it is only used for fieldReference so it only has data needed for embedding

data ReferenceDef #

There are 3 kinds of references 1) composite (to fields that exist in the record) 2) single field 3) embedded

Constructors

NoReference 
ForeignRef !EntityNameHS

A ForeignRef has a late binding to the EntityDef it references via name and has the Haskell type of the foreign key in the form of FieldType

EmbedRef EntityNameHS 
CompositeRef CompositeDef 
SelfReference

A SelfReference stops an immediate cycle which causes non-termination at compile-time (issue #311).

data FieldType #

A FieldType describes a field parsed from the QuasiQuoter and is used to determine the Haskell type in the generated code.

name Text parses into FTTypeCon Nothing Text

name T.Text parses into FTTypeCon (Just T Text)

name (Jsonb User) parses into:

FTApp (FTTypeCon Nothing Jsonb) (FTTypeCon Nothing User)

Constructors

FTTypeCon (Maybe Text) Text

Optional module and name.

FTTypePromoted Text 
FTApp FieldType FieldType 
FTList FieldType 

data FieldAttr #

Attributes that may be attached to fields that can affect migrations and serialization in backend-specific ways.

While we endeavor to, we can't forsee all use cases for all backends, and so FieldAttr is extensible through its constructor FieldAttrOther.

Since: persistent-2.11.0.0

Constructors

FieldAttrMaybe

The Maybe keyword goes after the type. This indicates that the column is nullable, and the generated Haskell code will have a Maybe type for it.

Example:

User
    name Text Maybe
FieldAttrNullable

This indicates that the column is nullable, but should not have a Maybe type. For this to work out, you need to ensure that the PersistField instance for the type in question can support a PersistNull value.

data What = NoWhat | Hello Text

instance PersistField What where
    fromPersistValue PersistNull =
        pure NoWhat
    fromPersistValue pv =
        Hello $ fromPersistValue pv

instance PersistFieldSql What where
    sqlType _ = SqlString

User
    what What nullable
FieldAttrMigrationOnly

This tag means that the column will not be present on the Haskell code, but will not be removed from the database. Useful to deprecate fields in phases.

You should set the column to be nullable in the database. Otherwise, inserts won't have values.

User
    oldName Text MigrationOnly
    newName Text
FieldAttrSafeToRemove

A SafeToRemove attribute is not present on the Haskell datatype, and the backend migrations should attempt to drop the column without triggering any unsafe migration warnings.

Useful after you've used MigrationOnly to remove a column from the database in phases.

User
    oldName Text SafeToRemove
    newName Text
FieldAttrNoreference

This attribute indicates that we should create a foreign key reference from a column. By default, persistent will try and create a foreign key reference for a column if it can determine that the type of the column is a Key entity or an EntityId and the Entity's name was present in mkPersist.

This is useful if you want to use the explicit foreign key syntax.

Post
    title    Text

Comment
    postId   PostId      noreference
    Foreign Post fk_comment_post postId
FieldAttrReference Text

This is set to specify precisely the database table the column refers to.

Post
    title    Text

Comment
    postId   PostId references="post"

You should not need this - persistent should be capable of correctly determining the target table's name. If you do need this, please file an issue describing why.

FieldAttrConstraint Text

Specify a name for the constraint on the foreign key reference for this table.

Post
    title    Text

Comment
    postId   PostId constraint="my_cool_constraint_name"
FieldAttrDefault Text

Specify the default value for a column.

User
    createdAt    UTCTime     default="NOW()"

Note that a default= attribute does not mean you can omit the value while inserting.

FieldAttrSqltype Text

Specify a custom SQL type for the column. Generally, you should define a custom datatype with a custom PersistFieldSql instance instead of using this.

User
    uuid     Text    sqltype=UUID
FieldAttrMaxlen Integer

Set a maximum length for a column. Useful for VARCHAR and indexes.

User
    name     Text    maxlen=200

    UniqueName name
FieldAttrSql Text

Specify the database name of the column.

User
    blarghle     Int     sql="b_l_a_r_g_h_l_e"

Useful for performing phased migrations, where one column is renamed to another column over time.

FieldAttrOther Text

A grab bag of random attributes that were unrecognized by the parser.

type Attr = Text #

type ExtraLine = [Text] #

data EntityIdDef #

The definition for the entity's primary key ID.

Since: persistent-2.13.0.0

Constructors

EntityIdField !FieldDef

The entity has a single key column, and it is a surrogate key - that is, you can't go from rec -> Key rec.

Since: persistent-2.13.0.0

EntityIdNaturalKey !CompositeDef

The entity has a natural key. This means you can write rec -> Key rec because all the key fields are present on the datatype.

A natural key can have one or more columns.

Since: persistent-2.13.0.0

data EntityDef #

An EntityDef represents the information that persistent knows about an Entity. It uses this information to generate the Haskell datatype, the SQL migrations, and other relevant conversions.

data WhyNullable #

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.

Instances

Instances details
Show WhyNullable 
Instance details

Defined in Database.Persist.Types.Base

Eq WhyNullable 
Instance details

Defined in Database.Persist.Types.Base

data IsNullable #

Instances

Instances details
Show IsNullable 
Instance details

Defined in Database.Persist.Types.Base

Eq IsNullable 
Instance details

Defined in Database.Persist.Types.Base

data Checkmark #

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 Locations 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 NULLable 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.

Constructors

Active

When used on a uniqueness constraint, there may be at most one Active record.

Inactive

When used on a uniqueness constraint, there may be any number of Inactive records.