{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Database.Esqueleto.Experimental.From.Join
    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 GHC.TypeLits

-- | 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.
data (:&) a b = a :& b
infixl 2 :&

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)

-- | You may return joined values from a 'select' query - this is
-- identical to the tuple instance, but is provided for convenience.
--
-- @since 3.5.2.0
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 (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

-- | Identical to the tuple instance and provided for convenience.
--
-- @since 3.5.3.0
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 (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

-- | Identical to the tuple instance and provided for convenience.
--
-- @since 3.5.3.0
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 (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)

-- | 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)
-- @
on :: ValidOnClause a => a -> (b -> SqlExpr (Value Bool)) -> (a, b -> SqlExpr (Value Bool))
on :: 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 (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 (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 = () -- Let the compiler handle the type mismatch
    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 ""
                  )


-- | 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
innerJoin :: ( ToFrom a a'
             , ToFrom b b'
             , HasOnClause rhs (a' :& b')
             , rhs ~ (b, (a' :& b') -> SqlExpr (Value Bool))
             ) => a -> rhs -> From (a' :& b')
innerJoin :: a -> rhs -> From (a' :& b')
innerJoin a
lhs (rhs, 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 (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))


-- | 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
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 :: a -> rhs -> From (a' :& b)
innerJoinLateral a
lhs (rhsFn, 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 (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))

-- | CROSS JOIN
--
-- Used as an infix \`crossJoin\`
--
-- @
-- select $ do
-- from $ table \@Person
-- \`crossJoin\` table \@BlogPost
-- @
--
-- @since 3.5.0.0
crossJoin :: ( ToFrom a a'
             , ToFrom b b'
             ) => a -> b -> From (a' :& b')
crossJoin :: 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 (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)

-- | 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
crossJoinLateral :: ( ToFrom a a'
                    , SqlSelect b r
                    , ToAlias b
                    , ToAliasReference b
                    )
                 => a -> (a' -> SqlQuery b) -> From (a' :& b)
crossJoinLateral :: 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 (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)

-- | 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
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 :: a -> rhs -> From (a' :& ToMaybeT b')
leftJoin a
lhs (rhs, 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 (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))

-- | 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
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 :: a -> rhs -> From (a' :& ToMaybeT b)
leftJoinLateral a
lhs (rhsFn, 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 (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))

-- | 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
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 :: a -> rhs -> From (ToMaybeT a' :& b')
rightJoin a
lhs (rhs, 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 (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))

-- | 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
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 :: a -> rhs -> From (ToMaybeT a' :& ToMaybeT b')
fullOuterJoin a
lhs (rhs, 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 (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`


------ Compatibility for old syntax

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
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 (Proxy lateral
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)
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
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 (Proxy lateral
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 (Proxy lateral
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