-- | Full outer joins.
-- See "Opaleye.Join" for details on the best way to do other joins in
-- Opaleye.

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Opaleye.FunctionalJoin (
  -- * Full outer join
  fullJoinF,
  ) where

import           Control.Applicative             ((<$>), (<*>))
import           Control.Arrow                   ((<<<))

import qualified Data.Profunctor.Product.Default as D
import qualified Data.Profunctor.Product         as PP

import qualified Opaleye.Field                   as C
import qualified Opaleye.Field                   as F
import qualified Opaleye.Internal.Join           as IJ
import qualified Opaleye.Internal.Operators      as IO
import qualified Opaleye.Internal.Unpackspec     as IU
import qualified Opaleye.Join                    as J
import qualified Opaleye.Select                  as S
import qualified Opaleye.SqlTypes                as T
import qualified Opaleye.Operators               as O

fullJoinF :: (D.Default IO.IfPP fieldsResult fieldsResult,
              D.Default IU.Unpackspec fieldsL fieldsL,
              D.Default IU.Unpackspec fieldsR fieldsR)
          => (fieldsL -> fieldsR -> fieldsResult)
           -- ^ Calculate result row from input rows for rows in the
           -- left and right query satisfying the join condition
          -> (fieldsL -> fieldsResult)
           -- ^ Calculate result row from left input row when there
           -- are /no/ rows in the right query satisfying the join
           -- condition
          -> (fieldsR -> fieldsResult)
           -- ^ Calculate result row from right input row when there
           -- are /no/ rows in the left query satisfying the join
           -- condition
          -> (fieldsL -> fieldsR -> F.Field T.SqlBool)
          -- ^ Condition on which to join
          -> S.Select fieldsL
          -- ^ Left query
          -> S.Select fieldsR
          -- ^ Right query
          -> S.Select fieldsResult
fullJoinF :: forall fieldsResult fieldsL fieldsR.
(Default IfPP fieldsResult fieldsResult,
 Default Unpackspec fieldsL fieldsL,
 Default Unpackspec fieldsR fieldsR) =>
(fieldsL -> fieldsR -> fieldsResult)
-> (fieldsL -> fieldsResult)
-> (fieldsR -> fieldsResult)
-> (fieldsL -> fieldsR -> Field SqlBool)
-> Select fieldsL
-> Select fieldsR
-> Select fieldsResult
fullJoinF fieldsL -> fieldsR -> fieldsResult
f fieldsL -> fieldsResult
fL fieldsR -> fieldsResult
fR fieldsL -> fieldsR -> Field SqlBool
cond Select fieldsL
l Select fieldsR
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a} {a}.
((fieldsL, FieldNullable a), (fieldsR, FieldNullable a))
-> fieldsResult
ret Select
  ((fieldsL, FieldNullable SqlBool),
   (fieldsR, FieldNullable SqlBool))
j
  where a1 :: SelectArr () a -> SelectArr () (a, Field SqlBool)
a1 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> (a
x, Bool -> Field SqlBool
T.sqlBool Bool
True))
        j :: Select
  ((fieldsL, FieldNullable SqlBool),
   (fieldsR, FieldNullable SqlBool))
j  = forall fieldsL fieldsR nullableFieldsL nullableFieldsR.
Unpackspec fieldsL fieldsL
-> Unpackspec fieldsR fieldsR
-> NullMaker fieldsL nullableFieldsL
-> NullMaker fieldsR nullableFieldsR
-> Select fieldsL
-> Select fieldsR
-> ((fieldsL, fieldsR) -> Field SqlBool)
-> Select (nullableFieldsL, nullableFieldsR)
J.fullJoinExplicit forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
                                forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def
                                (forall (p :: * -> * -> *) a0 a1 b0 b1.
ProductProfunctor p =>
(p a0 b0, p a1 b1) -> p (a0, a1) (b0, b1)
PP.p2 (forall a b. (a -> b) -> NullMaker a b
IJ.NullMaker forall a. a -> a
id, NullMaker (Field SqlBool) (FieldNullable SqlBool)
nullmakerBool))
                                (forall (p :: * -> * -> *) a0 a1 b0 b1.
ProductProfunctor p =>
(p a0 b0, p a1 b1) -> p (a0, a1) (b0, b1)
PP.p2 (forall a b. (a -> b) -> NullMaker a b
IJ.NullMaker forall a. a -> a
id, NullMaker (Field SqlBool) (FieldNullable SqlBool)
nullmakerBool))
                                (forall {a}. SelectArr () a -> SelectArr () (a, Field SqlBool)
a1 Select fieldsL
l)
                                (forall {a}. SelectArr () a -> SelectArr () (a, Field SqlBool)
a1 Select fieldsR
r)
                                (\((fieldsL
l', Field SqlBool
_), (fieldsR
r', Field SqlBool
_)) -> fieldsL -> fieldsR -> Field SqlBool
cond fieldsL
l' fieldsR
r')

        ret :: ((fieldsL, FieldNullable a), (fieldsR, FieldNullable a))
-> fieldsResult
ret ((fieldsL
lr, FieldNullable a
lc), (fieldsR
rr, FieldNullable a
rc)) = forall fields.
Default IfPP fields fields =>
Field SqlBool -> fields -> fields -> fields
O.ifThenElseMany (forall a. FieldNullable a -> Field SqlBool
C.isNull FieldNullable a
lc)
                                     (fieldsR -> fieldsResult
fR fieldsR
rr)
                                     (forall fields.
Default IfPP fields fields =>
Field SqlBool -> fields -> fields -> fields
O.ifThenElseMany (forall a. FieldNullable a -> Field SqlBool
C.isNull FieldNullable a
rc)
                                        (fieldsL -> fieldsResult
fL fieldsL
lr)
                                        (fieldsL -> fieldsR -> fieldsResult
f fieldsL
lr fieldsR
rr))

        nullmakerBool :: IJ.NullMaker (F.Field T.SqlBool)
                                      (F.FieldNullable T.SqlBool)
        nullmakerBool :: NullMaker (Field SqlBool) (FieldNullable SqlBool)
nullmakerBool = forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def