Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- data a :& b = a :& b
- class ValidOnClause a
- on :: ValidOnClause a => a -> (b -> SqlExpr (Value Bool)) -> (a, b -> SqlExpr (Value Bool))
- type family ErrorOnLateral a :: Constraint where ...
- fromJoin :: Builder -> RawFn -> RawFn -> Maybe (SqlExpr (Value Bool)) -> RawFn
- type family HasOnClause actual expected :: Constraint where ...
- innerJoin :: (ToFrom a a', ToFrom b b', HasOnClause rhs (a' :& b'), rhs ~ (b, (a' :& b') -> SqlExpr (Value Bool))) => a -> rhs -> From (a' :& b')
- innerJoinLateral :: (ToFrom a a', HasOnClause rhs (a' :& b), SqlSelect b r, ToAlias b, ToAliasReference b, rhs ~ (a' -> SqlQuery b, (a' :& b) -> SqlExpr (Value Bool))) => a -> rhs -> From (a' :& b)
- crossJoin :: (ToFrom a a', ToFrom b b') => a -> b -> From (a' :& b')
- crossJoinLateral :: (ToFrom a a', SqlSelect b r, ToAlias b, ToAliasReference b) => a -> (a' -> SqlQuery b) -> From (a' :& b)
- leftJoin :: (ToFrom a a', ToFrom b b', ToMaybe b', HasOnClause rhs (a' :& ToMaybeT b'), rhs ~ (b, (a' :& ToMaybeT b') -> SqlExpr (Value Bool))) => a -> rhs -> From (a' :& ToMaybeT b')
- leftJoinLateral :: (ToFrom a a', SqlSelect b r, HasOnClause rhs (a' :& ToMaybeT b), ToAlias b, ToAliasReference b, ToMaybe b, rhs ~ (a' -> SqlQuery b, (a' :& ToMaybeT b) -> SqlExpr (Value Bool))) => a -> rhs -> From (a' :& ToMaybeT b)
- rightJoin :: (ToFrom a a', ToFrom b b', ToMaybe a', HasOnClause rhs (ToMaybeT a' :& b'), rhs ~ (b, (ToMaybeT a' :& b') -> SqlExpr (Value Bool))) => a -> rhs -> From (ToMaybeT a' :& b')
- fullOuterJoin :: (ToFrom a a', ToFrom b b', ToMaybe a', ToMaybe b', HasOnClause rhs (ToMaybeT a' :& ToMaybeT b'), rhs ~ (b, (ToMaybeT a' :& ToMaybeT b') -> SqlExpr (Value Bool))) => a -> rhs -> From (ToMaybeT a' :& ToMaybeT b')
- data Lateral
- data NotLateral
- type family IsLateral a where ...
- class DoInnerJoin lateral lhs rhs res | lateral rhs lhs -> res where
- doInnerJoin :: Proxy lateral -> lhs -> rhs -> From res
- class DoLeftJoin lateral lhs rhs res | lateral rhs lhs -> res where
- doLeftJoin :: Proxy lateral -> lhs -> rhs -> From res
- class DoCrossJoin lateral lhs rhs res | lateral lhs rhs -> res where
- doCrossJoin :: Proxy lateral -> lhs -> rhs -> From res
Documentation
A left-precedence pair. Pronounced "and". Used to represent expressions that have been joined together.
The precedence behavior can be demonstrated by:
a :& b :& c == ((a :& b) :& c)
See the examples at the beginning of this module to see how this
operator is used in JOIN
operations.
a :& b infixl 2 |
Instances
class ValidOnClause a Source #
Instances
ToFrom a a' => ValidOnClause a Source # | |
Defined in Database.Esqueleto.Experimental.From.Join | |
ValidOnClause (a -> SqlQuery b) Source # | |
Defined in Database.Esqueleto.Experimental.From.Join |
on :: ValidOnClause a => a -> (b -> SqlExpr (Value Bool)) -> (a, b -> SqlExpr (Value Bool)) infix 9 Source #
An ON
clause that describes how two tables are related. This should be
used as an infix operator after a JOIN
. For example,
select $ from $ table @Person `innerJoin` table @BlogPost `on` (\(p :& bP) -> p ^. PersonId ==. bP ^. BlogPostAuthorId)
type family ErrorOnLateral a :: Constraint where ... Source #
ErrorOnLateral (a -> SqlQuery b) = TypeError ('Text "LATERAL can only be used for INNER, LEFT, and CROSS join kinds.") | |
ErrorOnLateral _ = () |
type family HasOnClause actual expected :: Constraint where ... Source #
innerJoin :: (ToFrom a a', ToFrom b b', HasOnClause rhs (a' :& b'), rhs ~ (b, (a' :& b') -> SqlExpr (Value Bool))) => a -> rhs -> From (a' :& b') infixl 2 Source #
INNER JOIN
Used as an infix operator `innerJoin`
select $ from $ table @Person `innerJoin` table @BlogPost `on` (\(p :& bp) -> p ^. PersonId ==. bp ^. BlogPostAuthorId)
Since: 3.5.0.0
innerJoinLateral :: (ToFrom a a', HasOnClause rhs (a' :& b), SqlSelect b r, ToAlias b, ToAliasReference b, rhs ~ (a' -> SqlQuery b, (a' :& b) -> SqlExpr (Value Bool))) => a -> rhs -> From (a' :& b) infixl 2 Source #
INNER JOIN LATERAL
A Lateral subquery join allows the joined query to reference entities from the left hand side of the join. Discards rows that don't match the on clause
Used as an infix operator `innerJoinLateral`
See example 6
Since: 3.5.0.0
crossJoin :: (ToFrom a a', ToFrom b b') => a -> b -> From (a' :& b') infixl 2 Source #
CROSS JOIN
Used as an infix `crossJoin`
select $ do from $ table @Person `crossJoin` table @BlogPost
Since: 3.5.0.0
crossJoinLateral :: (ToFrom a a', SqlSelect b r, ToAlias b, ToAliasReference b) => a -> (a' -> SqlQuery b) -> From (a' :& b) infixl 2 Source #
CROSS JOIN LATERAL
A Lateral subquery join allows the joined query to reference entities from the left hand side of the join.
Used as an infix operator `crossJoinLateral`
See example 6
Since: 3.5.0.0
leftJoin :: (ToFrom a a', ToFrom b b', ToMaybe b', HasOnClause rhs (a' :& ToMaybeT b'), rhs ~ (b, (a' :& ToMaybeT b') -> SqlExpr (Value Bool))) => a -> rhs -> From (a' :& ToMaybeT b') infixl 2 Source #
LEFT OUTER JOIN
Join where the right side may not exist. If the on clause fails then the right side will be NULL'ed Because of this the right side needs to be handled as a Maybe
Used as an infix operator `leftJoin`
select $ from $ table @Person `leftJoin` table @BlogPost `on` (\(p :& bp) -> p ^. PersonId ==. bp ?. BlogPostAuthorId)
Since: 3.5.0.0
leftJoinLateral :: (ToFrom a a', SqlSelect b r, HasOnClause rhs (a' :& ToMaybeT b), ToAlias b, ToAliasReference b, ToMaybe b, rhs ~ (a' -> SqlQuery b, (a' :& ToMaybeT b) -> SqlExpr (Value Bool))) => a -> rhs -> From (a' :& ToMaybeT b) infixl 2 Source #
LEFT OUTER JOIN LATERAL
Lateral join where the right side may not exist. In the case that the query returns nothing or the on clause fails the right side of the join will be NULL'ed Because of this the right side needs to be handled as a Maybe
Used as an infix operator `leftJoinLateral`
See example 6 for how to use LATERAL
Since: 3.5.0.0
rightJoin :: (ToFrom a a', ToFrom b b', ToMaybe a', HasOnClause rhs (ToMaybeT a' :& b'), rhs ~ (b, (ToMaybeT a' :& b') -> SqlExpr (Value Bool))) => a -> rhs -> From (ToMaybeT a' :& b') infixl 2 Source #
RIGHT OUTER JOIN
Join where the left side may not exist. If the on clause fails then the left side will be NULL'ed Because of this the left side needs to be handled as a Maybe
Used as an infix operator `rightJoin`
select $ from $ table @Person `rightJoin` table @BlogPost `on` (\(p :& bp) -> p ?. PersonId ==. bp ^. BlogPostAuthorId)
Since: 3.5.0.0
fullOuterJoin :: (ToFrom a a', ToFrom b b', ToMaybe a', ToMaybe b', HasOnClause rhs (ToMaybeT a' :& ToMaybeT b'), rhs ~ (b, (ToMaybeT a' :& ToMaybeT b') -> SqlExpr (Value Bool))) => a -> rhs -> From (ToMaybeT a' :& ToMaybeT b') infixl 2 Source #
FULL OUTER JOIN
Join where both sides of the join may not exist. Because of this the result needs to be handled as a Maybe
Used as an infix operator `fullOuterJoin`
select $ from $ table @Person `fullOuterJoin` table @BlogPost `on` (\(p :& bp) -> p ?. PersonId ==. bp ?. BlogPostAuthorId)
Since: 3.5.0.0
Instances
(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 Source # | |
(ToFrom a a', SqlSelect b r, ToAlias b, ToAliasReference b, d ~ (a' :& b)) => DoInnerJoin Lateral a (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) d Source # | |
(ToFrom a a', SqlSelect b r, ToAlias b, ToAliasReference b) => DoCrossJoin Lateral a (a' -> SqlQuery b) (a' :& b) Source # | |
Defined in Database.Esqueleto.Experimental.From.Join |
data NotLateral Source #
Instances
(ToFrom a a', ToFrom b b') => DoCrossJoin NotLateral a b (a' :& b') Source # | |
Defined in Database.Esqueleto.Experimental.From.Join doCrossJoin :: Proxy NotLateral -> a -> b -> From (a' :& b') Source # | |
(ToFrom a a', ToFrom b b', ToMaybe b', ToMaybeT b' ~ mb, HasOnClause rhs (a' :& mb), rhs ~ (b, (a' :& mb) -> SqlExpr (Value Bool))) => DoLeftJoin NotLateral a rhs (a' :& mb) Source # | |
Defined in Database.Esqueleto.Experimental.From.Join doLeftJoin :: Proxy NotLateral -> a -> rhs -> From (a' :& mb) Source # | |
(ToFrom a a', ToFrom b b', HasOnClause rhs (a' :& b'), rhs ~ (b, (a' :& b') -> SqlExpr (Value Bool))) => DoInnerJoin NotLateral a rhs (a' :& b') Source # | |
Defined in Database.Esqueleto.Experimental.From.Join doInnerJoin :: Proxy NotLateral -> a -> rhs -> From (a' :& b') Source # |
class DoInnerJoin lateral lhs rhs res | lateral rhs lhs -> res where Source #
doInnerJoin :: Proxy lateral -> lhs -> rhs -> From res Source #
Instances
(ToFrom a a', ToFrom b b', HasOnClause rhs (a' :& b'), rhs ~ (b, (a' :& b') -> SqlExpr (Value Bool))) => DoInnerJoin NotLateral a rhs (a' :& b') Source # | |
Defined in Database.Esqueleto.Experimental.From.Join doInnerJoin :: Proxy NotLateral -> a -> rhs -> From (a' :& b') Source # | |
(ToFrom a a', SqlSelect b r, ToAlias b, ToAliasReference b, d ~ (a' :& b)) => DoInnerJoin Lateral a (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) d Source # | |
class DoLeftJoin lateral lhs rhs res | lateral rhs lhs -> res where Source #
doLeftJoin :: Proxy lateral -> lhs -> rhs -> From res Source #
Instances
(ToFrom a a', ToFrom b b', ToMaybe b', ToMaybeT b' ~ mb, HasOnClause rhs (a' :& mb), rhs ~ (b, (a' :& mb) -> SqlExpr (Value Bool))) => DoLeftJoin NotLateral a rhs (a' :& mb) Source # | |
Defined in Database.Esqueleto.Experimental.From.Join doLeftJoin :: Proxy NotLateral -> a -> rhs -> From (a' :& mb) Source # | |
(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 Source # | |
class DoCrossJoin lateral lhs rhs res | lateral lhs rhs -> res where Source #
doCrossJoin :: Proxy lateral -> lhs -> rhs -> From res Source #
Instances
(ToFrom a a', ToFrom b b') => DoCrossJoin NotLateral a b (a' :& b') Source # | |
Defined in Database.Esqueleto.Experimental.From.Join doCrossJoin :: Proxy NotLateral -> a -> b -> From (a' :& b') Source # | |
(ToFrom a a', SqlSelect b r, ToAlias b, ToAliasReference b) => DoCrossJoin Lateral a (a' -> SqlQuery b) (a' :& b) Source # | |
Defined in Database.Esqueleto.Experimental.From.Join |
Orphan instances
(DoLeftJoin lateral lhs rhs r, lateral ~ IsLateral rhs) => ToFrom (LeftOuterJoin lhs rhs) r Source # | |
toFrom :: LeftOuterJoin lhs rhs -> From r Source # | |
(DoCrossJoin lateral lhs rhs r, IsLateral rhs ~ lateral) => ToFrom (CrossJoin lhs rhs) r Source # | |
(DoInnerJoin lateral lhs rhs r, lateral ~ IsLateral rhs) => ToFrom (InnerJoin lhs rhs) r Source # | |
(ToFrom a a', ToFrom b b', ToMaybe a', ToMaybeT a' ~ ma, ToMaybe b', ToMaybeT b' ~ mb, HasOnClause rhs (ma :& mb), ErrorOnLateral b, rhs ~ (b, (ma :& mb) -> SqlExpr (Value Bool))) => ToFrom (FullOuterJoin a rhs) (ma :& mb) Source # | |
(ToFrom a a', ToFrom b b', ToMaybe a', ToMaybeT a' ~ ma, HasOnClause rhs (ma :& b'), ErrorOnLateral b, rhs ~ (b, (ma :& b') -> SqlExpr (Value Bool))) => ToFrom (RightOuterJoin a rhs) (ma :& b') Source # | |