{-# language FlexibleContexts #-}

module Rel8.Query.These
  ( alignBy
  , keepHereTable, loseHereTable
  , keepThereTable, loseThereTable
  , keepThisTable, loseThisTable
  , keepThatTable, loseThatTable
  , keepThoseTable, loseThoseTable
  , bindTheseTable
  , bitraverseTheseTable
  )
where

-- base
import Prelude

-- opaleye
import qualified Opaleye.Internal.Join as Opaleye
import qualified Opaleye.Internal.PrimQuery as Opaleye

-- rel8
import Rel8.Expr ( Expr )
import Rel8.Expr.Bool ( boolExpr, not_ )
import Rel8.Expr.Eq ( (==.) )
import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )
import Rel8.Expr.Serialize ( litExpr )
import Rel8.Query ( Query )
import Rel8.Query.Filter ( where_ )
import Rel8.Query.Maybe ( optional )
import Rel8.Query.Opaleye ( zipOpaleyeWith )
import Rel8.Table ( Table )
import Rel8.Table.Either ( EitherTable( EitherTable ) )
import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
import Rel8.Table.Opaleye ( unpackspec )
import Rel8.Table.Tag ( Tag(..) )
import Rel8.Table.These
  ( TheseTable( TheseTable )
  , hasHereTable, hasThereTable
  , isThisTable, isThatTable, isThoseTable
  )
import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ) )


-- | Corresponds to a @FULL OUTER JOIN@ between two queries.
alignBy :: (Table Expr a, Table Expr b)
  => (a -> b -> Expr Bool)
  -> Query a -> Query b -> Query (TheseTable a b)
alignBy :: (a -> b -> Expr Bool)
-> Query a -> Query b -> Query (TheseTable a b)
alignBy a -> b -> Expr Bool
condition Query a
as Query b
bs =
  (MaybeTable a -> MaybeTable b -> TheseTable a b)
-> (MaybeTable a, MaybeTable b) -> TheseTable a b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry MaybeTable a -> MaybeTable b -> TheseTable a b
forall a b. MaybeTable a -> MaybeTable b -> TheseTable a b
TheseTable ((MaybeTable a, MaybeTable b) -> TheseTable a b)
-> Query (MaybeTable a, MaybeTable b) -> Query (TheseTable a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Select a -> Select b -> Select (MaybeTable a, MaybeTable b))
-> Query a -> Query b -> Query (MaybeTable a, MaybeTable b)
forall a b c.
(Select a -> Select b -> Select c) -> Query a -> Query b -> Query c
zipOpaleyeWith Select a -> Select b -> Select (MaybeTable a, MaybeTable b)
forall (f :: * -> *) (f :: * -> *).
(Applicative f, Applicative f) =>
Select a -> Select b -> Query (f a, f b)
fullOuterJoin Query a
as Query b
bs
  where
    fullOuterJoin :: Select a -> Select b -> Query (f a, f b)
fullOuterJoin Select a
a Select b
b =
      Unpackspec a a
-> Unpackspec b b
-> (a -> f a)
-> (b -> f b)
-> JoinType
-> Select a
-> Select b
-> ((a, b) -> Column PGBool)
-> Query (f a, f b)
forall columnsA columnsB returnedColumnsA returnedColumnsB.
Unpackspec columnsA columnsA
-> Unpackspec columnsB columnsB
-> (columnsA -> returnedColumnsA)
-> (columnsB -> returnedColumnsB)
-> JoinType
-> Query columnsA
-> Query columnsB
-> ((columnsA, columnsB) -> Column PGBool)
-> Query (returnedColumnsA, returnedColumnsB)
Opaleye.joinExplicit Unpackspec a a
forall a. Table Expr a => Unpackspec a a
unpackspec Unpackspec b b
forall a. Table Expr a => Unpackspec a a
unpackspec a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b -> f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure JoinType
full Select a
a Select b
b (a, b) -> Column PGBool
forall b. (a, b) -> Column b
on
      where
        full :: JoinType
full = JoinType
Opaleye.FullJoin
        on :: (a, b) -> Column b
on = PrimExpr -> Column b
forall b. PrimExpr -> Column b
toColumn (PrimExpr -> Column b)
-> ((a, b) -> PrimExpr) -> (a, b) -> Column b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr Bool -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr (Expr Bool -> PrimExpr)
-> ((a, b) -> Expr Bool) -> (a, b) -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> Expr Bool) -> (a, b) -> Expr Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> Expr Bool
condition


keepHereTable :: TheseTable a b -> Query (a, MaybeTable b)
keepHereTable :: TheseTable a b -> Query (a, MaybeTable b)
keepHereTable = TheseTable a b -> Query (a, MaybeTable b)
forall a b. TheseTable a b -> Query (a, MaybeTable b)
loseThatTable


loseHereTable :: TheseTable a b -> Query b
loseHereTable :: TheseTable a b -> Query b
loseHereTable = TheseTable a b -> Query b
forall a b. TheseTable a b -> Query b
keepThatTable


keepThereTable :: TheseTable a b -> Query (MaybeTable a, b)
keepThereTable :: TheseTable a b -> Query (MaybeTable a, b)
keepThereTable = TheseTable a b -> Query (MaybeTable a, b)
forall a b. TheseTable a b -> Query (MaybeTable a, b)
loseThisTable


loseThereTable :: TheseTable a b -> Query a
loseThereTable :: TheseTable a b -> Query a
loseThereTable = TheseTable a b -> Query a
forall a b. TheseTable a b -> Query a
keepThisTable


keepThisTable :: TheseTable a b -> Query a
keepThisTable :: TheseTable a b -> Query a
keepThisTable t :: TheseTable a b
t@(TheseTable (MaybeTable Tag "isJust" (Maybe MaybeTag)
_ a
a) MaybeTable b
_) = do
  Expr Bool -> Query ()
where_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ TheseTable a b -> Expr Bool
forall a b. TheseTable a b -> Expr Bool
isThisTable TheseTable a b
t
  a -> Query a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a


loseThisTable :: TheseTable a b -> Query (MaybeTable a, b)
loseThisTable :: TheseTable a b -> Query (MaybeTable a, b)
loseThisTable t :: TheseTable a b
t@(TheseTable MaybeTable a
ma (MaybeTable Tag "isJust" (Maybe MaybeTag)
_ b
b)) = do
  Expr Bool -> Query ()
where_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ Expr Bool -> Expr Bool
not_ (Expr Bool -> Expr Bool) -> Expr Bool -> Expr Bool
forall a b. (a -> b) -> a -> b
$ TheseTable a b -> Expr Bool
forall a b. TheseTable a b -> Expr Bool
isThisTable TheseTable a b
t
  (MaybeTable a, b) -> Query (MaybeTable a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MaybeTable a
ma, b
b)


keepThatTable :: TheseTable a b -> Query b
keepThatTable :: TheseTable a b -> Query b
keepThatTable t :: TheseTable a b
t@(TheseTable MaybeTable a
_ (MaybeTable Tag "isJust" (Maybe MaybeTag)
_ b
b)) = do
  Expr Bool -> Query ()
where_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ TheseTable a b -> Expr Bool
forall a b. TheseTable a b -> Expr Bool
isThatTable TheseTable a b
t
  b -> Query b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b


loseThatTable :: TheseTable a b -> Query (a, MaybeTable b)
loseThatTable :: TheseTable a b -> Query (a, MaybeTable b)
loseThatTable t :: TheseTable a b
t@(TheseTable (MaybeTable Tag "isJust" (Maybe MaybeTag)
_ a
a) MaybeTable b
mb) = do
  Expr Bool -> Query ()
where_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ Expr Bool -> Expr Bool
not_ (Expr Bool -> Expr Bool) -> Expr Bool -> Expr Bool
forall a b. (a -> b) -> a -> b
$ TheseTable a b -> Expr Bool
forall a b. TheseTable a b -> Expr Bool
isThatTable TheseTable a b
t
  (a, MaybeTable b) -> Query (a, MaybeTable b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, MaybeTable b
mb)


keepThoseTable :: TheseTable a b -> Query (a, b)
keepThoseTable :: TheseTable a b -> Query (a, b)
keepThoseTable t :: TheseTable a b
t@(TheseTable (MaybeTable Tag "isJust" (Maybe MaybeTag)
_ a
a) (MaybeTable Tag "isJust" (Maybe MaybeTag)
_ b
b)) = do
  Expr Bool -> Query ()
where_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ TheseTable a b -> Expr Bool
forall a b. TheseTable a b -> Expr Bool
isThoseTable TheseTable a b
t
  (a, b) -> Query (a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b)


loseThoseTable :: TheseTable a b -> Query (EitherTable a b)
loseThoseTable :: TheseTable a b -> Query (EitherTable a b)
loseThoseTable t :: TheseTable a b
t@(TheseTable (MaybeTable Tag "isJust" (Maybe MaybeTag)
_ a
a) (MaybeTable Tag "isJust" (Maybe MaybeTag)
_ b
b)) = do
  Expr Bool -> Query ()
where_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ Expr Bool -> Expr Bool
not_ (Expr Bool -> Expr Bool) -> Expr Bool -> Expr Bool
forall a b. (a -> b) -> a -> b
$ TheseTable a b -> Expr Bool
forall a b. TheseTable a b -> Expr Bool
isThoseTable TheseTable a b
t
  EitherTable a b -> Query (EitherTable a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EitherTable a b -> Query (EitherTable a b))
-> EitherTable a b -> Query (EitherTable a b)
forall a b. (a -> b) -> a -> b
$ Tag "isRight" EitherTag -> a -> b -> EitherTable a b
forall a b. Tag "isRight" EitherTag -> a -> b -> EitherTable a b
EitherTable Tag "isRight" EitherTag
result a
a b
b
  where
    tag :: Expr EitherTag
tag = Expr EitherTag -> Expr EitherTag -> Expr Bool -> Expr EitherTag
forall a. Expr a -> Expr a -> Expr Bool -> Expr a
boolExpr (EitherTag -> Expr EitherTag
forall a. Sql DBType a => a -> Expr a
litExpr EitherTag
IsLeft) (EitherTag -> Expr EitherTag
forall a. Sql DBType a => a -> Expr a
litExpr EitherTag
IsRight) (TheseTable a b -> Expr Bool
forall a b. TheseTable a b -> Expr Bool
isThatTable TheseTable a b
t)
    result :: Tag "isRight" EitherTag
result = (Tag "isRight" EitherTag
forall a. Monoid a => a
mempty Tag "isRight" EitherTag
-> Tag "isRight" EitherTag -> Tag "isRight" EitherTag
forall a. a -> a -> a
`asTypeOf` Tag "isRight" EitherTag
result) {expr :: Expr EitherTag
expr = Expr EitherTag
tag}


bindTheseTable :: (Table Expr a, Semigroup a, Monad m)
  => (i -> m (TheseTable a b)) -> TheseTable a i -> m (TheseTable a b)
bindTheseTable :: (i -> m (TheseTable a b)) -> TheseTable a i -> m (TheseTable a b)
bindTheseTable i -> m (TheseTable a b)
query (TheseTable MaybeTable a
here (MaybeTable Tag "isJust" (Maybe MaybeTag)
input i
i)) = do
  TheseTable MaybeTable a
here' (MaybeTable Tag "isJust" (Maybe MaybeTag)
output b
b) <- i -> m (TheseTable a b)
query i
i
  TheseTable a b -> m (TheseTable a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TheseTable a b -> m (TheseTable a b))
-> TheseTable a b -> m (TheseTable a b)
forall a b. (a -> b) -> a -> b
$ MaybeTable a -> MaybeTable b -> TheseTable a b
forall a b. MaybeTable a -> MaybeTable b -> TheseTable a b
TheseTable (MaybeTable a
here MaybeTable a -> MaybeTable a -> MaybeTable a
forall a. Semigroup a => a -> a -> a
<> MaybeTable a
here') (Tag "isJust" (Maybe MaybeTag) -> b -> MaybeTable b
forall a. Tag "isJust" (Maybe MaybeTag) -> a -> MaybeTable a
MaybeTable (Tag "isJust" (Maybe MaybeTag)
input Tag "isJust" (Maybe MaybeTag)
-> Tag "isJust" (Maybe MaybeTag) -> Tag "isJust" (Maybe MaybeTag)
forall a. Semigroup a => a -> a -> a
<> Tag "isJust" (Maybe MaybeTag)
output) b
b)


bitraverseTheseTable :: ()
  => (a -> Query c)
  -> (b -> Query d)
  -> TheseTable a b
  -> Query (TheseTable c d)
bitraverseTheseTable :: (a -> Query c)
-> (b -> Query d) -> TheseTable a b -> Query (TheseTable c d)
bitraverseTheseTable a -> Query c
f b -> Query d
g TheseTable a b
t = do
  MaybeTable c
mc <- Query c -> Query (MaybeTable c)
forall a. Query a -> Query (MaybeTable a)
optional (a -> Query c
f (a -> Query c)
-> ((a, MaybeTable b) -> a) -> (a, MaybeTable b) -> Query c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, MaybeTable b) -> a
forall a b. (a, b) -> a
fst ((a, MaybeTable b) -> Query c)
-> Query (a, MaybeTable b) -> Query c
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TheseTable a b -> Query (a, MaybeTable b)
forall a b. TheseTable a b -> Query (a, MaybeTable b)
keepHereTable TheseTable a b
t)
  MaybeTable d
md <- Query d -> Query (MaybeTable d)
forall a. Query a -> Query (MaybeTable a)
optional (b -> Query d
g (b -> Query d)
-> ((MaybeTable a, b) -> b) -> (MaybeTable a, b) -> Query d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MaybeTable a, b) -> b
forall a b. (a, b) -> b
snd ((MaybeTable a, b) -> Query d)
-> Query (MaybeTable a, b) -> Query d
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TheseTable a b -> Query (MaybeTable a, b)
forall a b. TheseTable a b -> Query (MaybeTable a, b)
keepThereTable TheseTable a b
t)
  Expr Bool -> Query ()
where_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ MaybeTable c -> Expr Bool
forall a. MaybeTable a -> Expr Bool
isJustTable MaybeTable c
mc Expr Bool -> Expr Bool -> Expr Bool
forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
==. TheseTable a b -> Expr Bool
forall a b. TheseTable a b -> Expr Bool
hasHereTable TheseTable a b
t
  Expr Bool -> Query ()
where_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ MaybeTable d -> Expr Bool
forall a. MaybeTable a -> Expr Bool
isJustTable MaybeTable d
md Expr Bool -> Expr Bool -> Expr Bool
forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
==. TheseTable a b -> Expr Bool
forall a b. TheseTable a b -> Expr Bool
hasThereTable TheseTable a b
t
  TheseTable c d -> Query (TheseTable c d)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TheseTable c d -> Query (TheseTable c d))
-> TheseTable c d -> Query (TheseTable c d)
forall a b. (a -> b) -> a -> b
$ MaybeTable c -> MaybeTable d -> TheseTable c d
forall a b. MaybeTable a -> MaybeTable b -> TheseTable a b
TheseTable MaybeTable c
mc MaybeTable d
md