{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Opaleye.FunctionalJoin 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
joinF :: (fieldsL -> fieldsR -> fieldsResult)
-> (fieldsL -> fieldsR -> F.Field T.SqlBool)
-> S.Select fieldsL
-> S.Select fieldsR
-> S.Select fieldsResult
joinF f cond l r =
fmap (uncurry f) (O.keepWhen (uncurry cond) <<< ((,) <$> l <*> r))
leftJoinF :: (D.Default IO.IfPP fieldsResult fieldsResult,
D.Default IU.Unpackspec fieldsL fieldsL,
D.Default IU.Unpackspec fieldsR fieldsR)
=> (fieldsL -> fieldsR -> fieldsResult)
-> (fieldsL -> fieldsResult)
-> (fieldsL -> fieldsR -> F.Field T.SqlBool)
-> S.Select fieldsL
-> S.Select fieldsR
-> S.Select fieldsResult
leftJoinF f fL cond l r = fmap ret j
where a1 = fmap (\x -> (x, T.sqlBool True))
j = J.leftJoinExplicit D.def
D.def
(PP.p2 (IJ.NullMaker id, nullmakerBool))
l
(a1 r)
(\(l', (r', _)) -> cond l' r')
ret (lr, (rr, rc)) = O.ifThenElseMany (C.isNull rc) (fL lr) (f lr rr)
nullmakerBool :: IJ.NullMaker (F.Field T.SqlBool)
(F.FieldNullable T.SqlBool)
nullmakerBool = D.def
rightJoinF :: (D.Default IO.IfPP fieldsResult fieldsResult,
D.Default IU.Unpackspec fieldsL fieldsL,
D.Default IU.Unpackspec fieldsR fieldsR)
=> (fieldsL -> fieldsR -> fieldsResult)
-> (fieldsR -> fieldsResult)
-> (fieldsL -> fieldsR -> F.Field T.SqlBool)
-> S.Select fieldsL
-> S.Select fieldsR
-> S.Select fieldsResult
rightJoinF f fR cond l r = fmap ret j
where a1 = fmap (\x -> (x, T.sqlBool True))
j = J.rightJoinExplicit D.def
D.def
(PP.p2 (IJ.NullMaker id, nullmakerBool))
(a1 l)
r
(\((l', _), r') -> cond l' r')
ret ((lr, lc), rr) = O.ifThenElseMany (C.isNull lc) (fR rr) (f lr rr)
nullmakerBool :: IJ.NullMaker (F.Field T.SqlBool)
(F.FieldNullable T.SqlBool)
nullmakerBool = D.def
fullJoinF :: (D.Default IO.IfPP fieldsResult fieldsResult,
D.Default IU.Unpackspec fieldsL fieldsL,
D.Default IU.Unpackspec fieldsR fieldsR)
=> (fieldsL -> fieldsR -> fieldsResult)
-> (fieldsL -> fieldsResult)
-> (fieldsR -> fieldsResult)
-> (fieldsL -> fieldsR -> F.Field T.SqlBool)
-> S.Select fieldsL
-> S.Select fieldsR
-> S.Select fieldsResult
fullJoinF f fL fR cond l r = fmap ret j
where a1 = fmap (\x -> (x, T.sqlBool True))
j = J.fullJoinExplicit D.def
D.def
(PP.p2 (IJ.NullMaker id, nullmakerBool))
(PP.p2 (IJ.NullMaker id, nullmakerBool))
(a1 l)
(a1 r)
(\((l', _), (r', _)) -> cond l' r')
ret ((lr, lc), (rr, rc)) = O.ifThenElseMany (C.isNull lc)
(fR rr)
(O.ifThenElseMany (C.isNull rc)
(fL lr)
(f lr rr))
nullmakerBool :: IJ.NullMaker (F.Field T.SqlBool)
(F.FieldNullable T.SqlBool)
nullmakerBool = D.def