Safe Haskell | Safe-Inferred |
---|---|
Language | GHC2021 |
Database.Persist.Sql.Lifted.Expression
Synopsis
- data SqlExpr a
- val :: PersistField typ => typ -> SqlExpr (Value typ)
- not_ :: SqlExpr (Value Bool) -> SqlExpr (Value Bool)
- (&&.) :: SqlExpr (Value Bool) -> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
- (||.) :: SqlExpr (Value Bool) -> SqlExpr (Value Bool) -> SqlExpr (Value Bool)
- case_ :: PersistField a => [(SqlExpr (Value Bool), SqlExpr (Value a))] -> SqlExpr (Value a) -> SqlExpr (Value a)
- when_ :: expr (Value Bool) -> () -> expr a -> (expr (Value Bool), expr a)
- then_ :: ()
- else_ :: expr a -> expr a
- (==.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
- (!=.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
- (>=.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
- (>.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
- (<=.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
- (<.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
- between :: PersistField a => SqlExpr (Value a) -> (SqlExpr (Value a), SqlExpr (Value a)) -> SqlExpr (Value Bool)
- count :: Num a => SqlExpr (Value typ) -> SqlExpr (Value a)
- countRows :: Num a => SqlExpr (Value a)
- countDistinct :: Num a => SqlExpr (Value typ) -> SqlExpr (Value a)
- exists :: SqlQuery () -> SqlExpr (Value Bool)
- notExists :: SqlQuery () -> SqlExpr (Value Bool)
- (<#) :: (a -> b) -> SqlExpr (Value a) -> SqlExpr (Insertion b)
- (<&>) :: SqlExpr (Insertion (a -> b)) -> SqlExpr (Value a) -> SqlExpr (Insertion b)
- toBaseId :: ToBaseId ent => SqlExpr (Value (Key ent)) -> SqlExpr (Value (Key (BaseEnt ent)))
- class ToBaseId ent where
- type BaseEnt ent
- toBaseIdWitness :: Key (BaseEnt ent) -> Key ent
- in_ :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> SqlExpr (Value Bool)
- notIn :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> SqlExpr (Value Bool)
- subList_select :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (ValueList a)
- valList :: PersistField typ => [typ] -> SqlExpr (ValueList typ)
- justList :: SqlExpr (ValueList typ) -> SqlExpr (ValueList (Maybe typ))
- isNothing :: PersistField typ => SqlExpr (Value (Maybe typ)) -> SqlExpr (Value Bool)
- isNothing_ :: PersistField typ => SqlExpr (Value (Maybe typ)) -> SqlExpr (Value Bool)
- just :: NullableFieldProjection typ typ' => SqlExpr (Value typ) -> SqlExpr (Value (Maybe typ'))
- nothing :: SqlExpr (Value (Maybe typ))
- joinV :: NullableFieldProjection typ typ' => SqlExpr (Value (Maybe typ)) -> SqlExpr (Value (Maybe typ'))
- coalesce :: (PersistField a, NullableFieldProjection a a') => [SqlExpr (Value (Maybe a))] -> SqlExpr (Value (Maybe a'))
- coalesceDefault :: PersistField a => [SqlExpr (Value (Maybe a))] -> SqlExpr (Value a) -> SqlExpr (Value a)
- (+.) :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
- (-.) :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
- (/.) :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
- (*.) :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a)
- round_ :: (PersistField a, Num a, PersistField b, Num b) => SqlExpr (Value a) -> SqlExpr (Value b)
- ceiling_ :: (PersistField a, Num a, PersistField b, Num b) => SqlExpr (Value a) -> SqlExpr (Value b)
- floor_ :: (PersistField a, Num a, PersistField b, Num b) => SqlExpr (Value a) -> SqlExpr (Value b)
- min_ :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value (Maybe (Nullable a)))
- max_ :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value (Maybe (Nullable a)))
- sum_ :: (PersistField a, PersistField b) => SqlExpr (Value a) -> SqlExpr (Value (Maybe b))
- avg_ :: (PersistField a, PersistField b) => SqlExpr (Value a) -> SqlExpr (Value (Maybe b))
- castNum :: (Num a, Num b) => SqlExpr (Value a) -> SqlExpr (Value b)
- castNumM :: (Num a, Num b) => SqlExpr (Value (Maybe a)) -> SqlExpr (Value (Maybe b))
- asc :: PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
- desc :: PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
- (^.) :: forall typ val. (PersistEntity val, PersistField typ) => SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
- (?.) :: (PersistEntity val, PersistField typ) => SqlExpr (Maybe (Entity val)) -> EntityField val typ -> SqlExpr (Value (Maybe (Nullable typ)))
- lower_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
- upper_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
- trim_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
- ltrim_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
- rtrim_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s)
- length_ :: (SqlString s, Num a) => SqlExpr (Value s) -> SqlExpr (Value a)
- left_ :: (SqlString s, Num a) => (SqlExpr (Value s), SqlExpr (Value a)) -> SqlExpr (Value s)
- right_ :: (SqlString s, Num a) => (SqlExpr (Value s), SqlExpr (Value a)) -> SqlExpr (Value s)
- like :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
- ilike :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool)
- (%) :: SqlString s => SqlExpr (Value s)
- concat_ :: SqlString s => [SqlExpr (Value s)] -> SqlExpr (Value s)
- (++.) :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value s)
- castString :: (SqlString s, SqlString r) => SqlExpr (Value s) -> SqlExpr (Value r)
- subSelect :: (PersistField a, NullableFieldProjection a a') => SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value (Maybe a'))
- subSelectMaybe :: PersistField a => SqlQuery (SqlExpr (Value (Maybe a))) -> SqlExpr (Value (Maybe a))
- subSelectCount :: (Num a, PersistField a) => SqlQuery ignored -> SqlExpr (Value a)
- subSelectForeign :: (BackendCompatible SqlBackend (PersistEntityBackend val1), PersistEntity val1, PersistEntity val2, PersistField a) => SqlExpr (Entity val2) -> EntityField val2 (Key val1) -> (SqlExpr (Entity val1) -> SqlExpr (Value a)) -> SqlExpr (Value a)
- subSelectList :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (ValueList a)
- subSelectUnsafe :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
- getTable :: GetFirstTable (SqlExpr (Entity t)) ts => ts -> SqlExpr (Entity t)
- getTableMaybe :: GetFirstTable (SqlExpr (Maybe (Entity t))) ts => ts -> SqlExpr (Maybe (Entity t))
- (=.) :: (PersistEntity val, PersistField typ) => EntityField val typ -> SqlExpr (Value typ) -> SqlExpr (Entity val) -> SqlExpr Update
- (+=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> SqlExpr (Entity val) -> SqlExpr Update
- (-=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> SqlExpr (Entity val) -> SqlExpr Update
- (*=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> SqlExpr (Entity val) -> SqlExpr Update
- (/=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> SqlExpr (Entity val) -> SqlExpr Update
Type
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
(TypeError SqlExprFunctorMessage :: Constraint) => Functor SqlExpr | Folks often want the ability to promote a Haskell function into the
fmap :: (a -> b) -> This type signature is making a pretty strong claim: "Give me a Haskell
function from Let's suppose we *could* do this - This is why If you do have a SQL function, then you can provide a safe type and introduce
it with Since: esqueleto-3.5.8.2 |
(PersistEntity rec, PersistField typ, SymbolToField sym rec typ) => HasField (sym :: Symbol) (SqlExpr (Entity rec)) (SqlExpr (Value typ)) | This instance allows you to use Example: -- persistent model: BlogPost authorId PersonId title Text -- query: This is exactly equivalent to the following: blogPost :: SqlExpr (Entity BlogPost) blogPost ^. BlogPostTitle blogPost ^. #title blogPost.title There's another instance defined on Since: esqueleto-3.5.4.0 |
(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 Example: -- persistent model: Person name Text BlogPost title Text authorId PersonId -- query: The following forms are all equivalent: blogPost :: SqlExpr (Maybe (Entity BlogPost)) blogPost ?. BlogPostTitle blogPost ?. #title blogPost.title Since: esqueleto-3.5.4.0 |
(ToFrom a a', SqlSelect b r, ToAlias b, ToAliasReference b, d ~ (a' :& b)) => DoInnerJoin Lateral a (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) d | |
Defined in Database.Esqueleto.Experimental.From.Join | |
(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 | |
Defined in Database.Esqueleto.Experimental.From.Join | |
ToAlias (SqlExpr (Value a)) | |
ToAlias (SqlExpr (Entity a)) | |
ToAlias (SqlExpr (Maybe (Entity a))) | |
ToAliasReference (SqlExpr (Value a)) | |
ToAliasReference (SqlExpr (Entity a)) | |
ToAliasReference (SqlExpr (Maybe (Entity a))) | |
ToMaybe (SqlExpr (Value a)) | |
ToMaybe (SqlExpr (Entity a)) | |
ToMaybe (SqlExpr (Maybe a)) | |
FromPreprocess (SqlExpr (Entity val)) => From (SqlExpr (Entity val)) | |
FromPreprocess (SqlExpr (Maybe (Entity val))) => From (SqlExpr (Maybe (Entity val))) | |
(PersistEntity val, BackendCompatible SqlBackend (PersistEntityBackend val)) => FromPreprocess (SqlExpr (Entity val)) | |
Defined in Database.Esqueleto.Internal.Internal Methods fromPreprocess :: SqlQuery (PreprocessedFrom (SqlExpr (Entity val))) # | |
(PersistEntity val, BackendCompatible SqlBackend (PersistEntityBackend val)) => FromPreprocess (SqlExpr (Maybe (Entity val))) | |
Defined in Database.Esqueleto.Internal.Internal Methods fromPreprocess :: SqlQuery (PreprocessedFrom (SqlExpr (Maybe (Entity val)))) # | |
PersistEntity val => LockableEntity (SqlExpr (Entity val)) | |
Defined in Database.Esqueleto.Internal.Internal Methods flattenLockableEntity :: SqlExpr (Entity val) -> NonEmpty LockableSqlExpr # | |
ToSomeValues (SqlExpr (Value a)) | |
Defined in Database.Esqueleto.Internal.Internal Methods toSomeValues :: SqlExpr (Value a) -> [SomeValue] # | |
a ~ Value b => UnsafeSqlFunctionArgument (SqlExpr a) | |
PersistEntity ent => ToFrom (Table ent) (SqlExpr (Entity ent)) | |
PersistEntity e => SqlSelect (SqlExpr (Insertion e)) (Insertion e) |
|
Defined in Database.Esqueleto.Internal.Internal Methods sqlSelectCols :: IdentInfo -> SqlExpr (Insertion e) -> (Builder, [PersistValue]) # sqlSelectColCount :: Proxy (SqlExpr (Insertion e)) -> Int # sqlSelectProcessRow :: [PersistValue] -> Either Text (Insertion e) # sqlInsertInto :: IdentInfo -> SqlExpr (Insertion e) -> (Builder, [PersistValue]) # | |
PersistField a => SqlSelect (SqlExpr (Value a)) (Value a) | You may return any single value (i.e. a single column) from
a |
Defined in Database.Esqueleto.Internal.Internal Methods sqlSelectCols :: IdentInfo -> SqlExpr (Value a) -> (Builder, [PersistValue]) # sqlSelectColCount :: Proxy (SqlExpr (Value a)) -> Int # sqlSelectProcessRow :: [PersistValue] -> Either Text (Value a) # sqlInsertInto :: IdentInfo -> SqlExpr (Value a) -> (Builder, [PersistValue]) # | |
PersistEntity a => SqlSelect (SqlExpr (Entity a)) (Entity a) | |
Defined in Database.Esqueleto.Internal.Internal Methods sqlSelectCols :: IdentInfo -> SqlExpr (Entity a) -> (Builder, [PersistValue]) # sqlSelectColCount :: Proxy (SqlExpr (Entity a)) -> Int # sqlSelectProcessRow :: [PersistValue] -> Either Text (Entity a) # sqlInsertInto :: IdentInfo -> SqlExpr (Entity a) -> (Builder, [PersistValue]) # | |
PersistEntity a => SqlSelect (SqlExpr (Maybe (Entity a))) (Maybe (Entity a)) | |
Defined in Database.Esqueleto.Internal.Internal Methods sqlSelectCols :: IdentInfo -> SqlExpr (Maybe (Entity a)) -> (Builder, [PersistValue]) # sqlSelectColCount :: Proxy (SqlExpr (Maybe (Entity a))) -> Int # sqlSelectProcessRow :: [PersistValue] -> Either Text (Maybe (Entity a)) # sqlInsertInto :: IdentInfo -> SqlExpr (Maybe (Entity a)) -> (Builder, [PersistValue]) # | |
type ToMaybeT (SqlExpr (Value a)) | |
type ToMaybeT (SqlExpr (Entity a)) | |
type ToMaybeT (SqlExpr (Maybe a)) | |
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
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 -> dowhere_
(p^.
PersonName==.
val
"Mike"))then_
(subSelect
$from
$ \v -> do let sub =from
$ \c -> dowhere_
(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_
andthen_
is mandatory otherwise it will emit an error. - The
else_
is also mandatory, unlike the SQL statement in which if theELSE
is omitted it will return aNULL
. You can reproduce this vianothing
.
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
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 #
(>=.) :: 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
translates to the SQL expression between
(b, c)a >= b AND a <= c
.
It does not use a SQL BETWEEN
operator.
@since: 3.1.0
Count
countDistinct :: Num a => SqlExpr (Value typ) -> SqlExpr (Value a) #
COUNT(DISTINCT x)
.
Since: esqueleto-2.4.1
Exists
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) -> doon
(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 that enables one to use toBaseId
to convert an entity's
key on a query into another (cf. toBaseId
).
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 Person
s 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 -> dowhere_
$ 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.
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
:
Haskell | SQL | |
---|---|---|
Persistent |
| IS NOT NULL |
Esqueleto |
| != NULL |
In SQL, = NULL
and != NULL
return NULL instead of true or false. For this reason, you very likely do not want to use
in Esqueleto.
You may find these !=.
Nothinghlint
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
.
This behavior was changed in v3.6.0.0. If you want to produce nested just
. just
= just
Maybe
,
see just'
.
joinV :: NullableFieldProjection typ typ' => SqlExpr (Value (Maybe typ)) -> SqlExpr (Value (Maybe typ')) #
Join nested Maybe
s 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
as well as SqlExpr
(Value
(Maybe
a))
inputs to make transitioning to SqlExpr
(Value
(Maybe
(Maybe
a)))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
round_ :: (PersistField a, Num a, PersistField b, Num b) => SqlExpr (Value a) -> SqlExpr (Value b) #
ceiling_ :: (PersistField a, Num a, PersistField b, Num b) => SqlExpr (Value a) -> SqlExpr (Value b) #
floor_ :: (PersistField a, Num a, PersistField b, Num b) => SqlExpr (Value a) -> SqlExpr (Value b) #
sum_ :: (PersistField a, PersistField b) => SqlExpr (Value a) -> SqlExpr (Value (Maybe b)) #
avg_ :: (PersistField a, PersistField b) => SqlExpr (Value a) -> SqlExpr (Value (Maybe b)) #
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 #
String
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
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 newtype
s, 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
, then consider using
joinV
. subSelect
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
idiom, where you are calling
joinV
. subSelect
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
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:
- If the query passed has 0 result rows, then it will return a
NULL
value. Thepersistent
parsing operations will fail on an unexpectedNULL
. - 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 #