persistent-sql-lifted-0.4.3.1: Monad classes for running queries with Persistent and Esqueleto
Safe HaskellSafe-Inferred
LanguageGHC2021

Database.Persist.Sql.Lifted.Expression

Synopsis

Type

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
(TypeError SqlExprFunctorMessage :: Constraint) => Functor SqlExpr

Folks often want the ability to promote a Haskell function into the SqlExpr expression language - and naturally reach for fmap. Unfortunately, this is impossible. We cannot send *functions* to the database, which is what we would need to do in order for this to make sense. Let's consider the type of fmap for SqlExpr:

fmap :: (a -> b) -> SqlExpr a -> SqlExpr b

This type signature is making a pretty strong claim: "Give me a Haskell function from a -> b. I will then transform a SQL expression representing a Haskell value of type a and turn it into a SQL expression representing a Haskell value of type b."

Let's suppose we *could* do this - fmap (+1) would have to somehow inspect the function expression means "add one", and then translate that to the appropriate SQL.

This is why esqueleto defines a bunch of operators: x +. (val 1) can be used instead of fmap (+1) x.

If you do have a SQL function, then you can provide a safe type and introduce it with unsafeSqlFunction or unsafeSqlBinOp.

Since: esqueleto-3.5.8.2

Instance details

Defined in Database.Esqueleto.Internal.Internal

Methods

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

(<$) :: a -> SqlExpr b -> SqlExpr 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, PersistField typ', SymbolToField sym rec typ, NullableFieldProjection typ typ', HasField sym (SqlExpr (Maybe (Entity rec))) (SqlExpr (Value (Maybe 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

PersistEntity val => LockableEntity (SqlExpr (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

Constant

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

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

Bool

(&&.) :: SqlExpr (Value Bool) -> SqlExpr (Value Bool) -> SqlExpr (Value Bool) infixr 3 #

This operator translates to the SQL operator AND.

Example:

 where_ $
         user ^. UserName ==. val Matt
     &&. user ^. UserAge >=. val 21

(||.) :: SqlExpr (Value Bool) -> SqlExpr (Value Bool) -> SqlExpr (Value Bool) infixr 2 #

This operator translates to the SQL operator AND.

Example:

 where_ $
         user ^. UserName ==. val Matt
     ||. user ^. UserName ==. val John

Case

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_
       (subSelect $
       from $ \v -> do
       let sub =
               from $ \c -> do
               where_ (c ^. PersonName ==. val "Mike")
               return (c ^. PersonFavNum)
       where_ (just (v ^. PersonFavNum) >. subSelect 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

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

Syntax sugar for case_.

Since: esqueleto-2.1.2

then_ :: () #

Syntax sugar for case_.

Since: esqueleto-2.1.2

else_ :: expr a -> expr a #

Syntax sugar for case_.

Since: esqueleto-2.1.2

Comparison

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

This operator produces the SQL operator =, which is used to compare values for equality.

Example:

 query :: UserId -> SqlPersistT IO [Entity User]
 query userId = select $ do
     user <- from $ table @User
     where_ (user ^. UserId ==. val userId)
     pure user

This would generate the following SQL:

 SELECT user.*
 FROM user
 WHERE user.id = ?

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

This operator translates to the SQL operator !=.

Example:

 where_ $ user ^. UserName !=. val Bob

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

This operator translates to the SQL operator >=.

Example:

 where_ $ user ^. UserAge >=. val 21

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

This operator translates to the SQL operator >.

Example:

 where_ $ user ^. UserAge >. val 20

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

This operator translates to the SQL operator <=.

Example:

 where_ $ val 21 <=. user ^. UserAge

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

This operator translates to the SQL operator <.

Example:

 where_ $ val 20 <. user ^. UserAge

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

a between (b, c) translates to the SQL expression a >= b AND a <= c. It does not use a SQL BETWEEN operator.

@since: 3.1.0

Count

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

COUNT.

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

COUNT(*) value.

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

COUNT(DISTINCT x).

Since: esqueleto-2.4.1

Exists

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

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

NOT EXISTS operator.

Insert

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

Apply a PersistField constructor to SqlExpr Value arguments.

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

Apply extra SqlExpr Value arguments to a PersistField constructor

Key

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

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.

List

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

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

NOT IN operator.

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

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

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

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

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

Maybe

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}

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

An alias for isNothing that avoids clashing with the function from Data.Maybe isNothing.

Since: esqueleto-3.5.10.0

just :: NullableFieldProjection typ typ' => 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.

This function will try not to produce a nested Maybe. This is in accord with how SQL represents NULL. That means that just . just = just. This behavior was changed in v3.6.0.0. If you want to produce nested Maybe, see just'.

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

NULL value.

joinV :: NullableFieldProjection typ typ' => SqlExpr (Value (Maybe typ)) -> SqlExpr (Value (Maybe typ')) #

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

As of v3.6.0.0, this function will attempt to work on both SqlExpr (Value (Maybe a)) as well as SqlExpr (Value (Maybe (Maybe a))) inputs to make transitioning to NullableFieldProjection easier. This may make type inference worse in some cases. If you want the monomorphic variant, see joinV'

coalesce :: (PersistField a, NullableFieldProjection a 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

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

Number

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

This operator translates to the SQL operator +.

This does not require or assume anything about the SQL values. Interpreting what +. means for a given type is left to the database engine.

Example:

 user ^. UserAge +. val 10

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

This operator translates to the SQL operator -.

This does not require or assume anything about the SQL values. Interpreting what -. means for a given type is left to the database engine.

Example:

 user ^. UserAge -. val 10

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

This operator translates to the SQL operator /.

This does not require or assume anything about the SQL values. Interpreting what /. means for a given type is left to the database engine.

Example:

 user ^. UserAge /. val 10

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

This operator translates to the SQL operator *.

This does not require or assume anything about the SQL values. Interpreting what *. means for a given type is left to the database engine.

Example:

 user ^. UserAge *. val 10

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

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

OrderBy

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

Ascending order of this field or SqlExpression.

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

Descending order of this field or SqlExpression.

Projection

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

Project a field of an entity.

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

Project an EntityField of a nullable entity. The result type will be Nullable, meaning that nested Maybe won't be produced here.

As of v3.6.0.0, this will attempt to combine nested Maybe. If you want to keep nested Maybe, then see ??..

String

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

LOWER function.

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

UPPER function. @since 3.3.0

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

TRIM 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

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

LENGTH 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

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

RIGHT function. @since 3.3.0

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

LIKE operator.

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

ILIKE operator (case-insensitive LIKE).

Supported by PostgreSQL only. Deprecated in version 3.6.0 in favor of the version available from Database.Esqueleto.PostgreSQL.

Since: esqueleto-2.2.3

(%) :: 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" ++. (%)

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

The CONCAT function with a variable number of parameters. Supported by MySQL and PostgreSQL. SQLite supports this in versions after 3.44.0, and persistent-sqlite supports this in versions 2.13.3.0 and after.

(++.) :: 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.

MySQL support requires setting the SQL mode to PIPES_AS_CONCAT or ANSI - see this StackOverflow answer.

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.

SubSelect

subSelect :: (PersistField a, NullableFieldProjection a 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

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

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

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

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

Table

getTable :: GetFirstTable (SqlExpr (Entity t)) ts => ts -> SqlExpr (Entity t) #

Get the first table of a given type from a chain of tables joined with (:&).

This can make it easier to write queries with a large number of join clauses:

select $ do
(people :& followers :& blogPosts) <-
    from $ table @Person
    `innerJoin` table @Follow
    `on` (\(person :& follow) ->
            person ^. PersonId ==. follow ^. FollowFollowed)
    `innerJoin` table @BlogPost
    `on` (\((getTable @Follow -> follow) :& blogPost) ->
            blogPost ^. BlogPostAuthorId ==. follow ^. FollowFollower)
where_ (people1 ^. PersonName ==. val "John")
pure (followers, people2)

This example is a bit trivial, but once you've joined five or six tables it becomes enormously helpful. The above example uses a ViewPattern to call the function and assign the variable directly, but you can also imagine it being written like this:

    `on` (\(prev :& blogPost) ->
            let
                follow = getTable @Follow prev
             in
                blogPost ^. BlogPostAuthorId ==. follow ^. FollowFollower)

This function will pluck out the first table that matches the applied type, so if you join on the same table multiple times, it will always select the first one provided.

The (:&) operator associates so that the left hand side can be a wildcard for an arbitrary amount of nesting, and the "most recent" or "newest" table in a join sequence is always available on the rightmost - so (prev :& bar) is a pattern that matches bar table (the most recent table added) and prev tables (all prior tables in the join match).

By calling getTable on the prev, you can select exactly the table you want, allowing you to omit a large number of spurious pattern matches. Consider a query that does several LEFT JOIN on a first table:

SELECT *
FROM person
LEFT JOIN car
  ON person.id = car.person_id
LEFT JOIN bike
  ON person.id = bike.person_id
LEFT JOIN food
  ON person.id = food.person_id
LEFT JOIN address
  ON person.id = address.person_id

The final on clause in esqueleto would look like this:

    `on` do
        \(person :& _car :& _bike :& _food :& address) ->
            person.id ==. address.personId

First, we can change it to a prev :& newest match. We can do this because of the operator associativity. This is kind of like how a list : operator associates, but in the other direction: a : (b : c) = a : b : c.

    `on` do
        \(prev :& address) ->
            let (person :& _car :& _bike :& _food) = prev
             in person.id ==. address.personId

Then, we can use getTable to select the Person table directly, instead of pattern matching manually.

    `on` do
        \(prev :& address) ->
            let person = getTable @Person prev
             in person.id ==. address.personId

Finally, we can use a ViewPattern language extension to "inline" the access.

    `on` do
        \((getTable @Person -> person) :& address) ->
           person.id ==. address.personId

With this form, you do not need to be concerned about the number and wildcard status of tables that do not matter to the specific ON clause.

Since: esqueleto-3.5.9.0

getTableMaybe :: GetFirstTable (SqlExpr (Maybe (Entity t))) ts => ts -> SqlExpr (Maybe (Entity t)) #

A variant of getTable that operates on possibly-null entities.

Since: esqueleto-3.5.9.0

Update

(=.) :: (PersistEntity val, PersistField typ) => EntityField val typ -> SqlExpr (Value typ) -> 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 a) => EntityField val a -> SqlExpr (Value a) -> SqlExpr (Entity val) -> SqlExpr Update infixr 3 #