{-# language FlexibleContexts #-}

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

-- base
import Data.Functor ( (<&>) )
import Prelude

-- 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 ( Table )
import Rel8.Table.Bool ( bool )
import Rel8.Table.Either
  ( EitherTable( EitherTable )
  , isLeftTable, isRightTable
  )
import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )


keepLeftTable :: EitherTable a b -> Query a
keepLeftTable :: EitherTable a b -> Query a
keepLeftTable e :: EitherTable a b
e@(EitherTable Tag "isRight" EitherTag
_ a
a b
_) = do
  Expr Bool -> Query ()
where_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ EitherTable a b -> Expr Bool
forall a b. EitherTable a b -> Expr Bool
isLeftTable EitherTable a b
e
  a -> Query a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a


keepRightTable :: EitherTable a b -> Query b
keepRightTable :: EitherTable a b -> Query b
keepRightTable e :: EitherTable a b
e@(EitherTable Tag "isRight" EitherTag
_ a
_ b
b) = do
  Expr Bool -> Query ()
where_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ EitherTable a b -> Expr Bool
forall a b. EitherTable a b -> Expr Bool
isRightTable EitherTable a b
e
  b -> Query b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b


bindEitherTable :: (Table Expr a, Functor m)
  => (i -> m (EitherTable a b)) -> EitherTable a i -> m (EitherTable a b)
bindEitherTable :: (i -> m (EitherTable a b))
-> EitherTable a i -> m (EitherTable a b)
bindEitherTable i -> m (EitherTable a b)
query e :: EitherTable a i
e@(EitherTable Tag "isRight" EitherTag
input a
a i
i) = do
  i -> m (EitherTable a b)
query i
i m (EitherTable a b)
-> (EitherTable a b -> EitherTable a b) -> m (EitherTable a b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(EitherTable Tag "isRight" EitherTag
output a
a' b
b) ->
    Tag "isRight" EitherTag -> a -> b -> EitherTable a b
forall a b. Tag "isRight" EitherTag -> a -> b -> EitherTable a b
EitherTable (Tag "isRight" EitherTag
input Tag "isRight" EitherTag
-> Tag "isRight" EitherTag -> Tag "isRight" EitherTag
forall a. Semigroup a => a -> a -> a
<> Tag "isRight" EitherTag
output) (a -> a -> Expr Bool -> a
forall a. Table Expr a => a -> a -> Expr Bool -> a
bool a
a a
a' (EitherTable a i -> Expr Bool
forall a b. EitherTable a b -> Expr Bool
isRightTable EitherTable a i
e)) b
b


bitraverseEitherTable :: ()
  => (a -> Query c)
  -> (b -> Query d)
  -> EitherTable a b
  -> Query (EitherTable c d)
bitraverseEitherTable :: (a -> Query c)
-> (b -> Query d) -> EitherTable a b -> Query (EitherTable c d)
bitraverseEitherTable a -> Query c
f b -> Query d
g e :: EitherTable a b
e@(EitherTable Tag "isRight" EitherTag
tag a
_ b
_) = do
  mc :: MaybeTable c
mc@(MaybeTable Tag "isJust" (Maybe MaybeTag)
_ c
c) <- Query c -> Query (MaybeTable c)
forall a. Query a -> Query (MaybeTable 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 a b -> Query a
forall a b. EitherTable a b -> Query a
keepLeftTable EitherTable a b
e)
  md :: MaybeTable d
md@(MaybeTable Tag "isJust" (Maybe MaybeTag)
_ d
d) <- Query d -> Query (MaybeTable d)
forall a. Query a -> Query (MaybeTable 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 a b -> Query b
forall a b. EitherTable a b -> Query b
keepRightTable EitherTable a b
e)
  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
==. EitherTable a b -> Expr Bool
forall a b. EitherTable a b -> Expr Bool
isLeftTable EitherTable a b
e
  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
==. EitherTable a b -> Expr Bool
forall a b. EitherTable a b -> Expr Bool
isRightTable EitherTable a b
e
  EitherTable c d -> Query (EitherTable c d)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EitherTable c d -> Query (EitherTable c d))
-> EitherTable c d -> Query (EitherTable c d)
forall a b. (a -> b) -> a -> b
$ Tag "isRight" EitherTag -> c -> d -> EitherTable c d
forall a b. Tag "isRight" EitherTag -> a -> b -> EitherTable a b
EitherTable Tag "isRight" EitherTag
tag c
c d
d