{-# language FlexibleContexts #-}

module Rel8.Query.Either
  ( keepLeftTable
  , keepRightTable
  , bitraverseEitherTable
  )
where

-- base
import Prelude

-- comonad
import Control.Comonad ( extract )

-- rel8
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 )


-- | Filter 'EitherTable's, keeping only 'leftTable's.
keepLeftTable :: EitherTable Expr a b -> Query a
keepLeftTable :: 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_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ EitherTable Expr a b -> Expr Bool
forall a b. EitherTable Expr a b -> Expr Bool
isLeftTable EitherTable Expr a b
e
  a -> Query a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Nullify Expr a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract Nullify Expr a
a)


-- | Filter 'EitherTable's, keeping only 'rightTable's.
keepRightTable :: EitherTable Expr a b -> Query b
keepRightTable :: 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_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ EitherTable Expr a b -> Expr Bool
forall a b. EitherTable Expr a b -> Expr Bool
isRightTable EitherTable Expr a b
e
  b -> Query b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Nullify Expr b -> b
forall (w :: * -> *) a. Comonad w => w a -> a
extract Nullify Expr b
b)


-- | @bitraverseEitherTable f g x@ will pass all @leftTable@s through @f@ and
-- all @rightTable@s through @g@. The results are then lifted back into
-- @leftTable@ and @rightTable@, respectively. This is similar to 'bitraverse'
-- for 'Either'.
--
-- For example,
--
-- >>> :{
-- select do
--   x <- values (map lit [ Left True, Right (42 :: Int32) ])
--   bitraverseEitherTable (\y -> values [y, not_ y]) (\y -> pure (y * 100)) x
-- :}
-- [ Left True
-- , Left False
-- , Right 4200
-- ]
bitraverseEitherTable :: ()
  => (a -> Query c)
  -> (b -> Query d)
  -> EitherTable Expr a b
  -> Query (EitherTable Expr c d)
bitraverseEitherTable :: (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) <- Query c -> Query (MaybeTable Expr c)
forall a. Query a -> Query (MaybeTable Expr a)
optional (a -> Query c
f (a -> Query c) -> Query a -> Query c
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EitherTable Expr a b -> Query a
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) <- Query d -> Query (MaybeTable Expr d)
forall a. Query a -> Query (MaybeTable Expr a)
optional (b -> Query d
g (b -> Query d) -> Query b -> Query d
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EitherTable Expr a b -> Query b
forall a b. EitherTable Expr a b -> Query b
keepRightTable EitherTable Expr a b
e)
  Expr Bool -> Query ()
where_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ MaybeTable Expr c -> Expr Bool
forall a. MaybeTable Expr a -> Expr Bool
isJustTable MaybeTable Expr c
mc Expr Bool -> Expr Bool -> Expr Bool
forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
==. EitherTable Expr a b -> Expr Bool
forall a b. EitherTable Expr a b -> Expr Bool
isLeftTable EitherTable Expr a b
e
  Expr Bool -> Query ()
where_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ MaybeTable Expr d -> Expr Bool
forall a. MaybeTable Expr a -> Expr Bool
isJustTable MaybeTable Expr d
md Expr Bool -> Expr Bool -> Expr Bool
forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
==. EitherTable Expr a b -> Expr Bool
forall a b. EitherTable Expr a b -> Expr Bool
isRightTable EitherTable Expr a b
e
  EitherTable Expr c d -> Query (EitherTable Expr c d)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EitherTable Expr c d -> Query (EitherTable Expr c d))
-> EitherTable Expr c d -> Query (EitherTable Expr c d)
forall a b. (a -> b) -> a -> b
$ Expr EitherTag
-> Nullify Expr c -> Nullify Expr d -> EitherTable Expr c d
forall (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