{-# language FlexibleContexts #-}
module Rel8.Query.Either
( keepLeftTable
, keepRightTable
, bitraverseEitherTable
)
where
import Prelude
import Control.Comonad ( extract )
import Rel8.Expr ( Expr )
import Rel8.Expr.Eq ( (==.) )
import Rel8.Query ( Query )
import Rel8.Query.Filter ( where_ )
import Rel8.Query.Maybe ( optional )
import Rel8.Table.Either
( EitherTable( EitherTable )
, isLeftTable, isRightTable
)
import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
keepLeftTable :: EitherTable Expr a b -> Query a
keepLeftTable :: forall a b. EitherTable Expr a b -> Query a
keepLeftTable e :: EitherTable Expr a b
e@(EitherTable Expr EitherTag
_ Nullify Expr a
a Nullify Expr b
_) = do
Expr Bool -> Query ()
where_ forall a b. (a -> b) -> a -> b
$ forall a b. EitherTable Expr a b -> Expr Bool
isLeftTable EitherTable Expr a b
e
forall (f :: Context) a. Applicative f => a -> f a
pure (forall (w :: Context) a. Comonad w => w a -> a
extract Nullify Expr a
a)
keepRightTable :: EitherTable Expr a b -> Query b
keepRightTable :: forall a b. EitherTable Expr a b -> Query b
keepRightTable e :: EitherTable Expr a b
e@(EitherTable Expr EitherTag
_ Nullify Expr a
_ Nullify Expr b
b) = do
Expr Bool -> Query ()
where_ forall a b. (a -> b) -> a -> b
$ forall a b. EitherTable Expr a b -> Expr Bool
isRightTable EitherTable Expr a b
e
forall (f :: Context) a. Applicative f => a -> f a
pure (forall (w :: Context) a. Comonad w => w a -> a
extract Nullify Expr b
b)
bitraverseEitherTable :: ()
=> (a -> Query c)
-> (b -> Query d)
-> EitherTable Expr a b
-> Query (EitherTable Expr c d)
bitraverseEitherTable :: forall a c b d.
(a -> Query c)
-> (b -> Query d)
-> EitherTable Expr a b
-> Query (EitherTable Expr c d)
bitraverseEitherTable a -> Query c
f b -> Query d
g e :: EitherTable Expr a b
e@(EitherTable Expr EitherTag
tag Nullify Expr a
_ Nullify Expr b
_) = do
mc :: MaybeTable Expr c
mc@(MaybeTable Expr (Maybe MaybeTag)
_ Nullify Expr c
c) <- forall a. Query a -> Query (MaybeTable Expr a)
optional (a -> Query c
f forall (m :: Context) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a b. EitherTable Expr a b -> Query a
keepLeftTable EitherTable Expr a b
e)
md :: MaybeTable Expr d
md@(MaybeTable Expr (Maybe MaybeTag)
_ Nullify Expr d
d) <- forall a. Query a -> Query (MaybeTable Expr a)
optional (b -> Query d
g forall (m :: Context) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a b. EitherTable Expr a b -> Query b
keepRightTable EitherTable Expr a b
e)
Expr Bool -> Query ()
where_ forall a b. (a -> b) -> a -> b
$ forall a. MaybeTable Expr a -> Expr Bool
isJustTable MaybeTable Expr c
mc forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
==. forall a b. EitherTable Expr a b -> Expr Bool
isLeftTable EitherTable Expr a b
e
Expr Bool -> Query ()
where_ forall a b. (a -> b) -> a -> b
$ forall a. MaybeTable Expr a -> Expr Bool
isJustTable MaybeTable Expr d
md forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
==. forall a b. EitherTable Expr a b -> Expr Bool
isRightTable EitherTable Expr a b
e
forall (f :: Context) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (context :: Context) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable Expr EitherTag
tag Nullify Expr c
c Nullify Expr d
d