{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Database.Esqueleto.Experimental.From.Join
( (:&)(..)
, ValidOnClause
, on
, ErrorOnLateral
, fromJoin
, HasOnClause
, innerJoin
, innerJoinLateral
, crossJoin
, crossJoinLateral
, leftJoin
, leftJoinLateral
, rightJoin
, fullOuterJoin
, GetFirstTable(..)
, getTable
, getTableMaybe
, Lateral
, NotLateral
, IsLateral
, DoInnerJoin(..)
, DoLeftJoin(..)
, DoCrossJoin(..)
) where
import Data.Bifunctor (first)
import Data.Kind (Constraint)
import Data.Proxy
import qualified Data.Text.Lazy.Builder as TLB
import Database.Esqueleto.Experimental.From
import Database.Esqueleto.Experimental.ToAlias
import Database.Esqueleto.Experimental.ToAliasReference
import Database.Esqueleto.Experimental.ToMaybe
import Database.Esqueleto.Internal.Internal hiding
(From(..), from, fromJoin, on)
import Database.Esqueleto.Internal.PersistentImport (Entity)
import GHC.TypeLits
instance (ToMaybe a, ToMaybe b) => ToMaybe (a :& b) where
type ToMaybeT (a :& b) = (ToMaybeT a :& ToMaybeT b)
toMaybe :: (a :& b) -> ToMaybeT (a :& b)
toMaybe (a
a :& b
b) = (a -> ToMaybeT a
forall a. ToMaybe a => a -> ToMaybeT a
toMaybe a
a ToMaybeT a -> ToMaybeT b -> ToMaybeT a :& ToMaybeT b
forall a b. a -> b -> a :& b
:& b -> ToMaybeT b
forall a. ToMaybe a => a -> ToMaybeT a
toMaybe b
b)
class ValidOnClause a
instance {-# OVERLAPPABLE #-} ToFrom a a' => ValidOnClause a
instance ValidOnClause (a -> SqlQuery b)
instance (SqlSelect a ra, SqlSelect b rb) => SqlSelect (a :& b) (ra :& rb) where
sqlSelectCols :: IdentInfo -> (a :& b) -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc (a
a :& b
b) = IdentInfo -> (a, b) -> (Builder, [PersistValue])
forall a r.
SqlSelect a r =>
IdentInfo -> a -> (Builder, [PersistValue])
sqlSelectCols IdentInfo
esc (a
a, b
b)
sqlSelectColCount :: Proxy (a :& b) -> Int
sqlSelectColCount = Proxy (a, b) -> Int
forall a r. SqlSelect a r => Proxy a -> Int
sqlSelectColCount (Proxy (a, b) -> Int)
-> (Proxy (a :& b) -> Proxy (a, b)) -> Proxy (a :& b) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (a :& b) -> Proxy (a, b)
toTuple
where
toTuple :: Proxy (a :& b) -> Proxy (a, b)
toTuple :: Proxy (a :& b) -> Proxy (a, b)
toTuple = Proxy (a, b) -> Proxy (a :& b) -> Proxy (a, b)
forall a b. a -> b -> a
const Proxy (a, b)
forall {k} (t :: k). Proxy t
Proxy
sqlSelectProcessRow :: [PersistValue] -> Either Text (ra :& rb)
sqlSelectProcessRow = ((ra, rb) -> ra :& rb)
-> Either Text (ra, rb) -> Either Text (ra :& rb)
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ra -> rb -> ra :& rb) -> (ra, rb) -> ra :& rb
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ra -> rb -> ra :& rb
forall a b. a -> b -> a :& b
(:&)) (Either Text (ra, rb) -> Either Text (ra :& rb))
-> ([PersistValue] -> Either Text (ra, rb))
-> [PersistValue]
-> Either Text (ra :& rb)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PersistValue] -> Either Text (ra, rb)
forall a r. SqlSelect a r => [PersistValue] -> Either Text r
sqlSelectProcessRow
instance (ToAlias a, ToAlias b) => ToAlias (a :& b) where
toAlias :: (a :& b) -> SqlQuery (a :& b)
toAlias (a
a :& b
b) = a -> b -> a :& b
forall a b. a -> b -> a :& b
(:&) (a -> b -> a :& b) -> SqlQuery a -> SqlQuery (b -> a :& b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> SqlQuery a
forall a. ToAlias a => a -> SqlQuery a
toAlias a
a SqlQuery (b -> a :& b) -> SqlQuery b -> SqlQuery (a :& b)
forall a b. SqlQuery (a -> b) -> SqlQuery a -> SqlQuery b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> SqlQuery b
forall a. ToAlias a => a -> SqlQuery a
toAlias b
b
instance (ToAliasReference a, ToAliasReference b) => ToAliasReference (a :& b) where
toAliasReference :: Ident -> (a :& b) -> SqlQuery (a :& b)
toAliasReference Ident
ident (a
a :& b
b) = a -> b -> a :& b
forall a b. a -> b -> a :& b
(:&) (a -> b -> a :& b) -> SqlQuery a -> SqlQuery (b -> a :& b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ident -> a -> SqlQuery a
forall a. ToAliasReference a => Ident -> a -> SqlQuery a
toAliasReference Ident
ident a
a) SqlQuery (b -> a :& b) -> SqlQuery b -> SqlQuery (a :& b)
forall a b. SqlQuery (a -> b) -> SqlQuery a -> SqlQuery b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ident -> b -> SqlQuery b
forall a. ToAliasReference a => Ident -> a -> SqlQuery a
toAliasReference Ident
ident b
b)
on :: ValidOnClause a => a -> (b -> SqlExpr (Value Bool)) -> (a, b -> SqlExpr (Value Bool))
on :: forall a b.
ValidOnClause a =>
a -> (b -> SqlExpr (Value Bool)) -> (a, b -> SqlExpr (Value Bool))
on = (,)
infix 9 `on`
type family ErrorOnLateral a :: Constraint where
ErrorOnLateral (a -> SqlQuery b) = TypeError ('Text "LATERAL can only be used for INNER, LEFT, and CROSS join kinds.")
ErrorOnLateral _ = ()
fromJoin :: TLB.Builder -> RawFn -> RawFn -> Maybe (SqlExpr (Value Bool)) -> RawFn
fromJoin :: Builder -> RawFn -> RawFn -> Maybe (SqlExpr (Value Bool)) -> RawFn
fromJoin Builder
joinKind RawFn
lhs RawFn
rhs Maybe (SqlExpr (Value Bool))
monClause =
\NeedParens
paren IdentInfo
info ->
(Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (NeedParens -> Builder -> Builder
parensM NeedParens
paren) ((Builder, [PersistValue]) -> (Builder, [PersistValue]))
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall a b. (a -> b) -> a -> b
$
[(Builder, [PersistValue])] -> (Builder, [PersistValue])
forall a. Monoid a => [a] -> a
mconcat [ RawFn
lhs NeedParens
Never IdentInfo
info
, (Builder
joinKind, [PersistValue]
forall a. Monoid a => a
mempty)
, RawFn
rhs NeedParens
Parens IdentInfo
info
, (Builder, [PersistValue])
-> (SqlExpr (Value Bool) -> (Builder, [PersistValue]))
-> Maybe (SqlExpr (Value Bool))
-> (Builder, [PersistValue])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Builder, [PersistValue])
forall a. Monoid a => a
mempty (IdentInfo -> SqlExpr (Value Bool) -> (Builder, [PersistValue])
forall {a}. IdentInfo -> SqlExpr a -> (Builder, [PersistValue])
makeOnClause IdentInfo
info) Maybe (SqlExpr (Value Bool))
monClause
]
where
makeOnClause :: IdentInfo -> SqlExpr a -> (Builder, [PersistValue])
makeOnClause IdentInfo
info (ERaw SqlExprMeta
_ RawFn
f) = (Builder -> Builder)
-> (Builder, [PersistValue]) -> (Builder, [PersistValue])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Builder
" ON " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (RawFn
f NeedParens
Never IdentInfo
info)
type family HasOnClause actual expected :: Constraint where
HasOnClause (a, b -> SqlExpr (Value Bool)) c = ()
HasOnClause a expected =
TypeError ( 'Text "Missing ON clause for join with"
':$$: 'ShowType a
':$$: 'Text ""
':$$: 'Text "Expected: "
':$$: 'ShowType a
':$$: 'Text "`on` " ':<>: 'ShowType (expected -> SqlExpr (Value Bool))
':$$: 'Text ""
)
innerJoin :: ( ToFrom a a'
, ToFrom b b'
, HasOnClause rhs (a' :& b')
, rhs ~ (b, (a' :& b') -> SqlExpr (Value Bool))
) => a -> rhs -> From (a' :& b')
innerJoin :: forall a a' b b' rhs.
(ToFrom a a', ToFrom b b', HasOnClause rhs (a' :& b'),
rhs ~ (b, (a' :& b') -> SqlExpr (Value Bool))) =>
a -> rhs -> From (a' :& b')
innerJoin a
lhs (b
rhs, (a' :& b') -> SqlExpr (Value Bool)
on') = SqlQuery (a' :& b', RawFn) -> From (a' :& b')
forall a. SqlQuery (a, RawFn) -> From a
From (SqlQuery (a' :& b', RawFn) -> From (a' :& b'))
-> SqlQuery (a' :& b', RawFn) -> From (a' :& b')
forall a b. (a -> b) -> a -> b
$ do
(a'
leftVal, RawFn
leftFrom) <- From a' -> SqlQuery (a', RawFn)
forall a. From a -> SqlQuery (a, RawFn)
unFrom (a -> From a'
forall a r. ToFrom a r => a -> From r
toFrom a
lhs)
(b'
rightVal, RawFn
rightFrom) <- From b' -> SqlQuery (b', RawFn)
forall a. From a -> SqlQuery (a, RawFn)
unFrom (b -> From b'
forall a r. ToFrom a r => a -> From r
toFrom b
rhs)
let ret :: a' :& b'
ret = a'
leftVal a' -> b' -> a' :& b'
forall a b. a -> b -> a :& b
:& b'
rightVal
(a' :& b', RawFn) -> SqlQuery (a' :& b', RawFn)
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a' :& b', RawFn) -> SqlQuery (a' :& b', RawFn))
-> (a' :& b', RawFn) -> SqlQuery (a' :& b', RawFn)
forall a b. (a -> b) -> a -> b
$ (a' :& b'
ret, Builder -> RawFn -> RawFn -> Maybe (SqlExpr (Value Bool)) -> RawFn
fromJoin Builder
" INNER JOIN " RawFn
leftFrom RawFn
rightFrom (SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool))
forall a. a -> Maybe a
Just (SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool)))
-> SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool))
forall a b. (a -> b) -> a -> b
$ (a' :& b') -> SqlExpr (Value Bool)
on' a' :& b'
ret))
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)
innerJoinLateral :: forall a a' rhs b r.
(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)
innerJoinLateral a
lhs (a' -> SqlQuery b
rhsFn, (a' :& b) -> SqlExpr (Value Bool)
on') = SqlQuery (a' :& b, RawFn) -> From (a' :& b)
forall a. SqlQuery (a, RawFn) -> From a
From (SqlQuery (a' :& b, RawFn) -> From (a' :& b))
-> SqlQuery (a' :& b, RawFn) -> From (a' :& b)
forall a b. (a -> b) -> a -> b
$ do
(a'
leftVal, RawFn
leftFrom) <- From a' -> SqlQuery (a', RawFn)
forall a. From a -> SqlQuery (a, RawFn)
unFrom (a -> From a'
forall a r. ToFrom a r => a -> From r
toFrom a
lhs)
(b
rightVal, RawFn
rightFrom) <- From b -> SqlQuery (b, RawFn)
forall a. From a -> SqlQuery (a, RawFn)
unFrom (SqlQuery b -> From b
forall a r.
(SqlSelect a r, ToAlias a, ToAliasReference a) =>
SqlQuery a -> From a
selectQuery (a' -> SqlQuery b
rhsFn a'
leftVal))
let ret :: a' :& b
ret = a'
leftVal a' -> b -> a' :& b
forall a b. a -> b -> a :& b
:& b
rightVal
(a' :& b, RawFn) -> SqlQuery (a' :& b, RawFn)
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a' :& b, RawFn) -> SqlQuery (a' :& b, RawFn))
-> (a' :& b, RawFn) -> SqlQuery (a' :& b, RawFn)
forall a b. (a -> b) -> a -> b
$ (a' :& b
ret, Builder -> RawFn -> RawFn -> Maybe (SqlExpr (Value Bool)) -> RawFn
fromJoin Builder
" INNER JOIN LATERAL " RawFn
leftFrom RawFn
rightFrom (SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool))
forall a. a -> Maybe a
Just (SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool)))
-> SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool))
forall a b. (a -> b) -> a -> b
$ (a' :& b) -> SqlExpr (Value Bool)
on' a' :& b
ret))
crossJoin :: ( ToFrom a a'
, ToFrom b b'
) => a -> b -> From (a' :& b')
crossJoin :: forall a a' b b'.
(ToFrom a a', ToFrom b b') =>
a -> b -> From (a' :& b')
crossJoin a
lhs b
rhs = SqlQuery (a' :& b', RawFn) -> From (a' :& b')
forall a. SqlQuery (a, RawFn) -> From a
From (SqlQuery (a' :& b', RawFn) -> From (a' :& b'))
-> SqlQuery (a' :& b', RawFn) -> From (a' :& b')
forall a b. (a -> b) -> a -> b
$ do
(a'
leftVal, RawFn
leftFrom) <- From a' -> SqlQuery (a', RawFn)
forall a. From a -> SqlQuery (a, RawFn)
unFrom (a -> From a'
forall a r. ToFrom a r => a -> From r
toFrom a
lhs)
(b'
rightVal, RawFn
rightFrom) <- From b' -> SqlQuery (b', RawFn)
forall a. From a -> SqlQuery (a, RawFn)
unFrom (b -> From b'
forall a r. ToFrom a r => a -> From r
toFrom b
rhs)
let ret :: a' :& b'
ret = a'
leftVal a' -> b' -> a' :& b'
forall a b. a -> b -> a :& b
:& b'
rightVal
(a' :& b', RawFn) -> SqlQuery (a' :& b', RawFn)
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a' :& b', RawFn) -> SqlQuery (a' :& b', RawFn))
-> (a' :& b', RawFn) -> SqlQuery (a' :& b', RawFn)
forall a b. (a -> b) -> a -> b
$ (a' :& b'
ret, Builder -> RawFn -> RawFn -> Maybe (SqlExpr (Value Bool)) -> RawFn
fromJoin Builder
" CROSS JOIN " RawFn
leftFrom RawFn
rightFrom Maybe (SqlExpr (Value Bool))
forall a. Maybe a
Nothing)
crossJoinLateral :: ( ToFrom a a'
, SqlSelect b r
, ToAlias b
, ToAliasReference b
)
=> a -> (a' -> SqlQuery b) -> From (a' :& b)
crossJoinLateral :: forall a a' b r.
(ToFrom a a', SqlSelect b r, ToAlias b, ToAliasReference b) =>
a -> (a' -> SqlQuery b) -> From (a' :& b)
crossJoinLateral a
lhs a' -> SqlQuery b
rhsFn = SqlQuery (a' :& b, RawFn) -> From (a' :& b)
forall a. SqlQuery (a, RawFn) -> From a
From (SqlQuery (a' :& b, RawFn) -> From (a' :& b))
-> SqlQuery (a' :& b, RawFn) -> From (a' :& b)
forall a b. (a -> b) -> a -> b
$ do
(a'
leftVal, RawFn
leftFrom) <- From a' -> SqlQuery (a', RawFn)
forall a. From a -> SqlQuery (a, RawFn)
unFrom (a -> From a'
forall a r. ToFrom a r => a -> From r
toFrom a
lhs)
(b
rightVal, RawFn
rightFrom) <- From b -> SqlQuery (b, RawFn)
forall a. From a -> SqlQuery (a, RawFn)
unFrom (SqlQuery b -> From b
forall a r.
(SqlSelect a r, ToAlias a, ToAliasReference a) =>
SqlQuery a -> From a
selectQuery (a' -> SqlQuery b
rhsFn a'
leftVal))
let ret :: a' :& b
ret = a'
leftVal a' -> b -> a' :& b
forall a b. a -> b -> a :& b
:& b
rightVal
(a' :& b, RawFn) -> SqlQuery (a' :& b, RawFn)
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a' :& b, RawFn) -> SqlQuery (a' :& b, RawFn))
-> (a' :& b, RawFn) -> SqlQuery (a' :& b, RawFn)
forall a b. (a -> b) -> a -> b
$ (a' :& b
ret, Builder -> RawFn -> RawFn -> Maybe (SqlExpr (Value Bool)) -> RawFn
fromJoin Builder
" CROSS JOIN LATERAL " RawFn
leftFrom RawFn
rightFrom Maybe (SqlExpr (Value Bool))
forall a. Maybe a
Nothing)
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')
leftJoin :: forall a a' b b' rhs.
(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')
leftJoin a
lhs (b
rhs, (a' :& ToMaybeT b') -> SqlExpr (Value Bool)
on') = SqlQuery (a' :& ToMaybeT b', RawFn) -> From (a' :& ToMaybeT b')
forall a. SqlQuery (a, RawFn) -> From a
From (SqlQuery (a' :& ToMaybeT b', RawFn) -> From (a' :& ToMaybeT b'))
-> SqlQuery (a' :& ToMaybeT b', RawFn) -> From (a' :& ToMaybeT b')
forall a b. (a -> b) -> a -> b
$ do
(a'
leftVal, RawFn
leftFrom) <- From a' -> SqlQuery (a', RawFn)
forall a. From a -> SqlQuery (a, RawFn)
unFrom (a -> From a'
forall a r. ToFrom a r => a -> From r
toFrom a
lhs)
(b'
rightVal, RawFn
rightFrom) <- From b' -> SqlQuery (b', RawFn)
forall a. From a -> SqlQuery (a, RawFn)
unFrom (b -> From b'
forall a r. ToFrom a r => a -> From r
toFrom b
rhs)
let ret :: a' :& ToMaybeT b'
ret = a'
leftVal a' -> ToMaybeT b' -> a' :& ToMaybeT b'
forall a b. a -> b -> a :& b
:& b' -> ToMaybeT b'
forall a. ToMaybe a => a -> ToMaybeT a
toMaybe b'
rightVal
(a' :& ToMaybeT b', RawFn) -> SqlQuery (a' :& ToMaybeT b', RawFn)
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a' :& ToMaybeT b', RawFn) -> SqlQuery (a' :& ToMaybeT b', RawFn))
-> (a' :& ToMaybeT b', RawFn)
-> SqlQuery (a' :& ToMaybeT b', RawFn)
forall a b. (a -> b) -> a -> b
$ (a' :& ToMaybeT b'
ret, Builder -> RawFn -> RawFn -> Maybe (SqlExpr (Value Bool)) -> RawFn
fromJoin Builder
" LEFT OUTER JOIN " RawFn
leftFrom RawFn
rightFrom (SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool))
forall a. a -> Maybe a
Just (SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool)))
-> SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool))
forall a b. (a -> b) -> a -> b
$ (a' :& ToMaybeT b') -> SqlExpr (Value Bool)
on' a' :& ToMaybeT b'
ret))
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)
leftJoinLateral :: forall a a' b r rhs.
(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)
leftJoinLateral a
lhs (a' -> SqlQuery b
rhsFn, (a' :& ToMaybeT b) -> SqlExpr (Value Bool)
on') = SqlQuery (a' :& ToMaybeT b, RawFn) -> From (a' :& ToMaybeT b)
forall a. SqlQuery (a, RawFn) -> From a
From (SqlQuery (a' :& ToMaybeT b, RawFn) -> From (a' :& ToMaybeT b))
-> SqlQuery (a' :& ToMaybeT b, RawFn) -> From (a' :& ToMaybeT b)
forall a b. (a -> b) -> a -> b
$ do
(a'
leftVal, RawFn
leftFrom) <- From a' -> SqlQuery (a', RawFn)
forall a. From a -> SqlQuery (a, RawFn)
unFrom (a -> From a'
forall a r. ToFrom a r => a -> From r
toFrom a
lhs)
(b
rightVal, RawFn
rightFrom) <- From b -> SqlQuery (b, RawFn)
forall a. From a -> SqlQuery (a, RawFn)
unFrom (SqlQuery b -> From b
forall a r.
(SqlSelect a r, ToAlias a, ToAliasReference a) =>
SqlQuery a -> From a
selectQuery (a' -> SqlQuery b
rhsFn a'
leftVal))
let ret :: a' :& ToMaybeT b
ret = a'
leftVal a' -> ToMaybeT b -> a' :& ToMaybeT b
forall a b. a -> b -> a :& b
:& b -> ToMaybeT b
forall a. ToMaybe a => a -> ToMaybeT a
toMaybe b
rightVal
(a' :& ToMaybeT b, RawFn) -> SqlQuery (a' :& ToMaybeT b, RawFn)
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a' :& ToMaybeT b, RawFn) -> SqlQuery (a' :& ToMaybeT b, RawFn))
-> (a' :& ToMaybeT b, RawFn) -> SqlQuery (a' :& ToMaybeT b, RawFn)
forall a b. (a -> b) -> a -> b
$ (a' :& ToMaybeT b
ret, Builder -> RawFn -> RawFn -> Maybe (SqlExpr (Value Bool)) -> RawFn
fromJoin Builder
" LEFT OUTER JOIN LATERAL " RawFn
leftFrom RawFn
rightFrom (SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool))
forall a. a -> Maybe a
Just (SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool)))
-> SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool))
forall a b. (a -> b) -> a -> b
$ (a' :& ToMaybeT b) -> SqlExpr (Value Bool)
on' a' :& ToMaybeT b
ret))
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')
rightJoin :: forall a a' b b' rhs.
(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')
rightJoin a
lhs (b
rhs, (ToMaybeT a' :& b') -> SqlExpr (Value Bool)
on') = SqlQuery (ToMaybeT a' :& b', RawFn) -> From (ToMaybeT a' :& b')
forall a. SqlQuery (a, RawFn) -> From a
From (SqlQuery (ToMaybeT a' :& b', RawFn) -> From (ToMaybeT a' :& b'))
-> SqlQuery (ToMaybeT a' :& b', RawFn) -> From (ToMaybeT a' :& b')
forall a b. (a -> b) -> a -> b
$ do
(a'
leftVal, RawFn
leftFrom) <- From a' -> SqlQuery (a', RawFn)
forall a. From a -> SqlQuery (a, RawFn)
unFrom (a -> From a'
forall a r. ToFrom a r => a -> From r
toFrom a
lhs)
(b'
rightVal, RawFn
rightFrom) <- From b' -> SqlQuery (b', RawFn)
forall a. From a -> SqlQuery (a, RawFn)
unFrom (b -> From b'
forall a r. ToFrom a r => a -> From r
toFrom b
rhs)
let ret :: ToMaybeT a' :& b'
ret = a' -> ToMaybeT a'
forall a. ToMaybe a => a -> ToMaybeT a
toMaybe a'
leftVal ToMaybeT a' -> b' -> ToMaybeT a' :& b'
forall a b. a -> b -> a :& b
:& b'
rightVal
(ToMaybeT a' :& b', RawFn) -> SqlQuery (ToMaybeT a' :& b', RawFn)
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ToMaybeT a' :& b', RawFn) -> SqlQuery (ToMaybeT a' :& b', RawFn))
-> (ToMaybeT a' :& b', RawFn)
-> SqlQuery (ToMaybeT a' :& b', RawFn)
forall a b. (a -> b) -> a -> b
$ (ToMaybeT a' :& b'
ret, Builder -> RawFn -> RawFn -> Maybe (SqlExpr (Value Bool)) -> RawFn
fromJoin Builder
" RIGHT OUTER JOIN " RawFn
leftFrom RawFn
rightFrom (SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool))
forall a. a -> Maybe a
Just (SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool)))
-> SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool))
forall a b. (a -> b) -> a -> b
$ (ToMaybeT a' :& b') -> SqlExpr (Value Bool)
on' ToMaybeT a' :& b'
ret))
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')
fullOuterJoin :: forall a a' b b' rhs.
(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')
fullOuterJoin a
lhs (b
rhs, (ToMaybeT a' :& ToMaybeT b') -> SqlExpr (Value Bool)
on') = SqlQuery (ToMaybeT a' :& ToMaybeT b', RawFn)
-> From (ToMaybeT a' :& ToMaybeT b')
forall a. SqlQuery (a, RawFn) -> From a
From (SqlQuery (ToMaybeT a' :& ToMaybeT b', RawFn)
-> From (ToMaybeT a' :& ToMaybeT b'))
-> SqlQuery (ToMaybeT a' :& ToMaybeT b', RawFn)
-> From (ToMaybeT a' :& ToMaybeT b')
forall a b. (a -> b) -> a -> b
$ do
(a'
leftVal, RawFn
leftFrom) <- From a' -> SqlQuery (a', RawFn)
forall a. From a -> SqlQuery (a, RawFn)
unFrom (a -> From a'
forall a r. ToFrom a r => a -> From r
toFrom a
lhs)
(b'
rightVal, RawFn
rightFrom) <- From b' -> SqlQuery (b', RawFn)
forall a. From a -> SqlQuery (a, RawFn)
unFrom (b -> From b'
forall a r. ToFrom a r => a -> From r
toFrom b
rhs)
let ret :: ToMaybeT a' :& ToMaybeT b'
ret = a' -> ToMaybeT a'
forall a. ToMaybe a => a -> ToMaybeT a
toMaybe a'
leftVal ToMaybeT a' -> ToMaybeT b' -> ToMaybeT a' :& ToMaybeT b'
forall a b. a -> b -> a :& b
:& b' -> ToMaybeT b'
forall a. ToMaybe a => a -> ToMaybeT a
toMaybe b'
rightVal
(ToMaybeT a' :& ToMaybeT b', RawFn)
-> SqlQuery (ToMaybeT a' :& ToMaybeT b', RawFn)
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ToMaybeT a' :& ToMaybeT b', RawFn)
-> SqlQuery (ToMaybeT a' :& ToMaybeT b', RawFn))
-> (ToMaybeT a' :& ToMaybeT b', RawFn)
-> SqlQuery (ToMaybeT a' :& ToMaybeT b', RawFn)
forall a b. (a -> b) -> a -> b
$ (ToMaybeT a' :& ToMaybeT b'
ret, Builder -> RawFn -> RawFn -> Maybe (SqlExpr (Value Bool)) -> RawFn
fromJoin Builder
" FULL OUTER JOIN " RawFn
leftFrom RawFn
rightFrom (SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool))
forall a. a -> Maybe a
Just (SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool)))
-> SqlExpr (Value Bool) -> Maybe (SqlExpr (Value Bool))
forall a b. (a -> b) -> a -> b
$ (ToMaybeT a' :& ToMaybeT b') -> SqlExpr (Value Bool)
on' ToMaybeT a' :& ToMaybeT b'
ret))
infixl 2 `innerJoin`,
`innerJoinLateral`,
`leftJoin`,
`leftJoinLateral`,
`crossJoin`,
`crossJoinLateral`,
`rightJoin`,
`fullOuterJoin`
class GetFirstTable t ts where
getFirstTable :: ts -> t
instance GetFirstTable t (t :& ts) where
getFirstTable :: (t :& ts) -> t
getFirstTable (t
t :& ts
_) = t
t
instance GetFirstTable t (x :& t) where
getFirstTable :: (x :& t) -> t
getFirstTable (x
_ :& t
t) = t
t
instance {-# OVERLAPPABLE #-} GetFirstTable t ts => GetFirstTable t (ts :& x) where
getFirstTable :: (ts :& x) -> t
getFirstTable (ts
ts :& x
_) = ts -> t
forall t ts. GetFirstTable t ts => ts -> t
getFirstTable ts
ts
getTable :: forall t ts. GetFirstTable (SqlExpr (Entity t)) ts
=> ts
-> SqlExpr (Entity t)
getTable :: forall t ts.
GetFirstTable (SqlExpr (Entity t)) ts =>
ts -> SqlExpr (Entity t)
getTable = ts -> SqlExpr (Entity t)
forall t ts. GetFirstTable t ts => ts -> t
getFirstTable
getTableMaybe :: forall t ts. GetFirstTable (SqlExpr (Maybe (Entity t))) ts
=> ts
-> SqlExpr (Maybe (Entity t))
getTableMaybe :: forall t ts.
GetFirstTable (SqlExpr (Maybe (Entity t))) ts =>
ts -> SqlExpr (Maybe (Entity t))
getTableMaybe = ts -> SqlExpr (Maybe (Entity t))
forall t ts. GetFirstTable t ts => ts -> t
getFirstTable
data Lateral
data NotLateral
type family IsLateral a where
IsLateral (a -> SqlQuery b, c) = Lateral
IsLateral (a -> SqlQuery b) = Lateral
IsLateral a = NotLateral
class DoInnerJoin lateral lhs rhs res | lateral rhs lhs -> res where
doInnerJoin :: Proxy lateral -> lhs -> rhs -> From res
instance ( ToFrom a a'
, ToFrom b b'
, HasOnClause rhs (a' :& b')
, rhs ~ (b, (a' :& b') -> SqlExpr (Value Bool))
) => DoInnerJoin NotLateral a rhs (a' :& b') where
doInnerJoin :: Proxy NotLateral -> a -> rhs -> From (a' :& b')
doInnerJoin Proxy NotLateral
_ = a -> rhs -> From (a' :& b')
forall a a' b b' rhs.
(ToFrom a a', ToFrom b b', HasOnClause rhs (a' :& b'),
rhs ~ (b, (a' :& b') -> SqlExpr (Value Bool))) =>
a -> rhs -> From (a' :& b')
innerJoin
instance ( ToFrom a a'
, SqlSelect b r
, ToAlias b
, ToAliasReference b
, d ~ (a' :& b)
) => DoInnerJoin Lateral a (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) d where
doInnerJoin :: Proxy Lateral
-> a -> (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) -> From d
doInnerJoin Proxy Lateral
_ = a -> (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) -> From d
a
-> (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) -> From (a' :& b)
forall a a' rhs b r.
(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)
innerJoinLateral
instance ( DoInnerJoin lateral lhs rhs r, lateral ~ IsLateral rhs )
=> ToFrom (InnerJoin lhs rhs) r where
toFrom :: InnerJoin lhs rhs -> From r
toFrom (InnerJoin lhs
a rhs
b) = Proxy lateral -> lhs -> rhs -> From r
forall lateral lhs rhs res.
DoInnerJoin lateral lhs rhs res =>
Proxy lateral -> lhs -> rhs -> From res
doInnerJoin (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @lateral) lhs
a rhs
b
class DoLeftJoin lateral lhs rhs res | lateral rhs lhs -> res where
doLeftJoin :: Proxy lateral -> lhs -> rhs -> From res
instance ( 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) where
doLeftJoin :: Proxy NotLateral -> a -> rhs -> From (a' :& mb)
doLeftJoin Proxy NotLateral
_ = a -> rhs -> From (a' :& mb)
a -> rhs -> From (a' :& ToMaybeT b')
forall a a' b b' rhs.
(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')
leftJoin
instance ( 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 where
doLeftJoin :: Proxy Lateral
-> a -> (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) -> From d
doLeftJoin Proxy Lateral
_ = a -> (a' -> SqlQuery b, d -> SqlExpr (Value Bool)) -> From d
a
-> (a' -> SqlQuery b, d -> SqlExpr (Value Bool))
-> From (a' :& ToMaybeT b)
forall a a' b r rhs.
(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)
leftJoinLateral
instance ( DoLeftJoin lateral lhs rhs r, lateral ~ IsLateral rhs )
=> ToFrom (LeftOuterJoin lhs rhs) r where
toFrom :: LeftOuterJoin lhs rhs -> From r
toFrom (LeftOuterJoin lhs
a rhs
b) = Proxy lateral -> lhs -> rhs -> From r
forall lateral lhs rhs res.
DoLeftJoin lateral lhs rhs res =>
Proxy lateral -> lhs -> rhs -> From res
doLeftJoin (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @lateral) lhs
a rhs
b
class DoCrossJoin lateral lhs rhs res | lateral lhs rhs -> res where
doCrossJoin :: Proxy lateral -> lhs -> rhs -> From res
instance (ToFrom a a', ToFrom b b') => DoCrossJoin NotLateral a b (a' :& b') where
doCrossJoin :: Proxy NotLateral -> a -> b -> From (a' :& b')
doCrossJoin Proxy NotLateral
_ = a -> b -> From (a' :& b')
forall a a' b b'.
(ToFrom a a', ToFrom b b') =>
a -> b -> From (a' :& b')
crossJoin
instance (ToFrom a a', SqlSelect b r, ToAlias b, ToAliasReference b)
=> DoCrossJoin Lateral a (a' -> SqlQuery b) (a' :& b) where
doCrossJoin :: Proxy Lateral -> a -> (a' -> SqlQuery b) -> From (a' :& b)
doCrossJoin Proxy Lateral
_ = a -> (a' -> SqlQuery b) -> From (a' :& b)
forall a a' b r.
(ToFrom a a', SqlSelect b r, ToAlias b, ToAliasReference b) =>
a -> (a' -> SqlQuery b) -> From (a' :& b)
crossJoinLateral
instance (DoCrossJoin lateral lhs rhs r, IsLateral rhs ~ lateral)
=> ToFrom (CrossJoin lhs rhs) r where
toFrom :: CrossJoin lhs rhs -> From r
toFrom (CrossJoin lhs
a rhs
b) = Proxy lateral -> lhs -> rhs -> From r
forall lateral lhs rhs res.
DoCrossJoin lateral lhs rhs res =>
Proxy lateral -> lhs -> rhs -> From res
doCrossJoin (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @lateral) lhs
a rhs
b
instance ( 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') where
toFrom :: RightOuterJoin a rhs -> From (ma :& b')
toFrom (RightOuterJoin a
a rhs
b) = a -> rhs -> From (ToMaybeT a' :& b')
forall a a' b b' rhs.
(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')
rightJoin a
a rhs
b
instance ( 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) where
toFrom :: FullOuterJoin a rhs -> From (ma :& mb)
toFrom (FullOuterJoin a
a rhs
b) = a -> rhs -> From (ToMaybeT a' :& ToMaybeT b')
forall a a' b b' rhs.
(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')
fullOuterJoin a
a rhs
b