{-# language DataKinds #-}
{-# language DeriveFunctor #-}
{-# language DerivingStrategies #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language LambdaCase #-}
{-# language MultiParamTypeClasses #-}
{-# language NamedFieldPuns #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}

{-# options_ghc -fno-warn-orphans #-}

module Rel8.Table.Either
  ( EitherTable(..)
  , eitherTable, leftTable, rightTable
  , isLeftTable, isRightTable
  , aggregateEitherTable
  , nameEitherTable
  )
where

-- base
import Data.Bifunctor ( Bifunctor, bimap )
import Data.Functor.Identity ( Identity( Identity ) )
import Data.Kind ( Type )
import Prelude hiding ( undefined )

-- comonad
import Control.Comonad ( extract )

-- rel8
import Rel8.Aggregate ( Aggregate )
import Rel8.Expr ( Expr )
import Rel8.Expr.Aggregate ( groupByExpr )
import Rel8.Expr.Serialize ( litExpr )
import Rel8.Kind.Context ( Reifiable )
import Rel8.Schema.Context.Nullify ( Nullifiable )
import Rel8.Schema.Dict ( Dict( Dict ) )
import Rel8.Schema.HTable.Either ( HEitherTable(..) )
import Rel8.Schema.HTable.Identity ( HIdentity(..) )
import Rel8.Schema.HTable.Label ( hlabel, hunlabel )
import qualified Rel8.Schema.Kind as K
import Rel8.Schema.Name ( Name )
import Rel8.Table
  ( Table, Columns, Context, fromColumns, toColumns
  , FromExprs, fromResult, toResult
  , Transpose
  )
import Rel8.Table.Bool ( bool )
import Rel8.Table.Eq ( EqTable, eqTable )
import Rel8.Table.Nullify ( Nullify, aggregateNullify, guard )
import Rel8.Table.Ord ( OrdTable, ordTable )
import Rel8.Table.Projection ( Biprojectable, Projectable, biproject, project )
import Rel8.Table.Serialize ( ToExprs )
import Rel8.Table.Undefined ( undefined )
import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ), isLeft, isRight )

-- semigroupoids
import Data.Functor.Apply ( Apply, (<.>) )
import Data.Functor.Bind ( Bind, (>>-) )


-- | An @EitherTable a b@ is a Rel8 table that contains either the table @a@ or
-- the table @b@. You can construct an @EitherTable@ using 'leftTable' and
-- 'rightTable', and eliminate/pattern match using 'eitherTable'.
--
-- An @EitherTable@ is operationally the same as Haskell's 'Either' type, but
-- adapted to work with Rel8.
type EitherTable :: K.Context -> Type -> Type -> Type
data EitherTable context a b = EitherTable
  { forall (context :: * -> *) a b.
EitherTable context a b -> context EitherTag
tag :: context EitherTag
  , forall (context :: * -> *) a b.
EitherTable context a b -> Nullify context a
left :: Nullify context a
  , forall (context :: * -> *) a b.
EitherTable context a b -> Nullify context b
right :: Nullify context b
  }
  deriving stock forall a b. a -> EitherTable context a b -> EitherTable context a a
forall a b.
(a -> b) -> EitherTable context a a -> EitherTable context a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (context :: * -> *) a a b.
Nullifiable context =>
a -> EitherTable context a b -> EitherTable context a a
forall (context :: * -> *) a a b.
Nullifiable context =>
(a -> b) -> EitherTable context a a -> EitherTable context a b
<$ :: forall a b. a -> EitherTable context a b -> EitherTable context a a
$c<$ :: forall (context :: * -> *) a a b.
Nullifiable context =>
a -> EitherTable context a b -> EitherTable context a a
fmap :: forall a b.
(a -> b) -> EitherTable context a a -> EitherTable context a b
$cfmap :: forall (context :: * -> *) a a b.
Nullifiable context =>
(a -> b) -> EitherTable context a a -> EitherTable context a b
Functor


instance Biprojectable (EitherTable context) where
  biproject :: forall a b c d.
(Projecting a b, Projecting c d) =>
Projection a b
-> Projection c d
-> EitherTable context a c
-> EitherTable context b d
biproject Projection a b
f Projection c d
g (EitherTable context EitherTag
tag Nullify context a
a Nullify context c
b) =
    forall (context :: * -> *) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable context EitherTag
tag (forall (f :: * -> *) a b.
(Projectable f, Projecting a b) =>
Projection a b -> f a -> f b
project Projection a b
f Nullify context a
a) (forall (f :: * -> *) a b.
(Projectable f, Projecting a b) =>
Projection a b -> f a -> f b
project Projection c d
g Nullify context c
b)


instance Nullifiable context => Bifunctor (EitherTable context) where
  bimap :: forall a b c d.
(a -> b)
-> (c -> d) -> EitherTable context a c -> EitherTable context b d
bimap a -> b
f c -> d
g (EitherTable context EitherTag
tag Nullify context a
a Nullify context c
b) = forall (context :: * -> *) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable context EitherTag
tag (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Nullify context a
a) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g Nullify context c
b)


instance Projectable (EitherTable context a) where
  project :: forall a b.
Projecting a b =>
Projection a b
-> EitherTable context a a -> EitherTable context a b
project Projection a b
f (EitherTable context EitherTag
tag Nullify context a
a Nullify context a
b) = forall (context :: * -> *) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable context EitherTag
tag Nullify context a
a (forall (f :: * -> *) a b.
(Projectable f, Projecting a b) =>
Projection a b -> f a -> f b
project Projection a b
f Nullify context a
b)


instance (context ~ Expr, Table Expr a) => Apply (EitherTable context a) where
  EitherTable context EitherTag
tag Nullify context a
l1 Nullify context (a -> b)
f <.> :: forall a b.
EitherTable context a (a -> b)
-> EitherTable context a a -> EitherTable context a b
<.> EitherTable context EitherTag
tag' Nullify context a
l2 Nullify context a
a =
    forall (context :: * -> *) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable (context EitherTag
tag forall a. Semigroup a => a -> a -> a
<> context EitherTag
tag') (forall a. Table Expr a => a -> a -> Expr Bool -> a
bool Nullify context a
l1 Nullify context a
l2 (Expr EitherTag -> Expr Bool
isLeft context EitherTag
tag)) (Nullify context (a -> b)
f forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> Nullify context a
a)


instance (context ~ Expr, Table Expr a) => Applicative (EitherTable context a) where
  pure :: forall a. a -> EitherTable context a a
pure = forall a b. Table Expr a => b -> EitherTable Expr a b
rightTable
  <*> :: forall a b.
EitherTable context a (a -> b)
-> EitherTable context a a -> EitherTable context a b
(<*>) = forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)


instance (context ~ Expr, Table Expr a) => Bind (EitherTable context a) where
  EitherTable context EitherTag
tag Nullify context a
l1 Nullify context a
a >>- :: forall a b.
EitherTable context a a
-> (a -> EitherTable context a b) -> EitherTable context a b
>>- a -> EitherTable context a b
f = case a -> EitherTable context a b
f (forall (w :: * -> *) a. Comonad w => w a -> a
extract Nullify context a
a) of
    EitherTable context EitherTag
tag' Nullify context a
l2 Nullify context b
b ->
      forall (context :: * -> *) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable (context EitherTag
tag forall a. Semigroup a => a -> a -> a
<> context EitherTag
tag') (forall a. Table Expr a => a -> a -> Expr Bool -> a
bool Nullify context a
l1 Nullify context a
l2 (Expr EitherTag -> Expr Bool
isRight context EitherTag
tag)) Nullify context b
b


instance (context ~ Expr, Table Expr a) => Monad (EitherTable context a) where
  >>= :: forall a b.
EitherTable context a a
-> (a -> EitherTable context a b) -> EitherTable context a b
(>>=) = forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
(>>-)


instance (context ~ Expr, Table Expr a, Table Expr b) =>
  Semigroup (EitherTable context a b)
 where
  EitherTable context a b
a <> :: EitherTable context a b
-> EitherTable context a b -> EitherTable context a b
<> EitherTable context a b
b = forall a. Table Expr a => a -> a -> Expr Bool -> a
bool EitherTable context a b
a EitherTable context a b
b (forall a b. EitherTable Expr a b -> Expr Bool
isRightTable EitherTable context a b
a)


instance
  ( Table context a, Table context b
  , Reifiable context, context ~ context'
  )
  => Table context' (EitherTable context a b)
 where
  type Columns (EitherTable context a b) = HEitherTable (Columns a) (Columns b)
  type Context (EitherTable context a b) = Context a
  type FromExprs (EitherTable context a b) = Either (FromExprs a) (FromExprs b)
  type Transpose to (EitherTable context a b) =
    EitherTable to (Transpose to a) (Transpose to b)

  toColumns :: EitherTable context a b
-> Columns (EitherTable context a b) context'
toColumns EitherTable {context EitherTag
tag :: context EitherTag
tag :: forall (context :: * -> *) a b.
EitherTable context a b -> context EitherTag
tag, Nullify context a
left :: Nullify context a
left :: forall (context :: * -> *) a b.
EitherTable context a b -> Nullify context a
left, Nullify context b
right :: Nullify context b
right :: forall (context :: * -> *) a b.
EitherTable context a b -> Nullify context b
right} = HEitherTable
    { htag :: HLabel "isRight" (HIdentity EitherTag) context
htag = forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel forall a b. (a -> b) -> a -> b
$ forall a (context :: * -> *). context a -> HIdentity a context
HIdentity context EitherTag
tag
    , hleft :: HLabel "Left" (HNullify (Columns a)) context
hleft = forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel forall a b. (a -> b) -> a -> b
$ forall (context :: * -> *) (t :: HTable) tag.
(Reifiable context, HTable t) =>
context tag
-> (tag -> Bool)
-> (Expr tag -> Expr Bool)
-> HNullify t context
-> HNullify t context
guard context EitherTag
tag (forall a. Eq a => a -> a -> Bool
== EitherTag
IsLeft) Expr EitherTag -> Expr Bool
isLeft forall a b. (a -> b) -> a -> b
$ forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns Nullify context a
left
    , hright :: HLabel "Right" (HNullify (Columns b)) context
hright = forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel forall a b. (a -> b) -> a -> b
$ forall (context :: * -> *) (t :: HTable) tag.
(Reifiable context, HTable t) =>
context tag
-> (tag -> Bool)
-> (Expr tag -> Expr Bool)
-> HNullify t context
-> HNullify t context
guard context EitherTag
tag (forall a. Eq a => a -> a -> Bool
== EitherTag
IsRight) Expr EitherTag -> Expr Bool
isRight forall a b. (a -> b) -> a -> b
$ forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns Nullify context b
right
    }

  fromColumns :: Columns (EitherTable context a b) context'
-> EitherTable context a b
fromColumns HEitherTable {HLabel "isRight" (HIdentity EitherTag) context
htag :: HLabel "isRight" (HIdentity EitherTag) context
htag :: forall (left :: HTable) (right :: HTable) (context :: * -> *).
HEitherTable left right context
-> HLabel "isRight" (HIdentity EitherTag) context
htag, HLabel "Left" (HNullify (Columns a)) context
hleft :: HLabel "Left" (HNullify (Columns a)) context
hleft :: forall (left :: HTable) (right :: HTable) (context :: * -> *).
HEitherTable left right context
-> HLabel "Left" (HNullify left) context
hleft, HLabel "Right" (HNullify (Columns b)) context
hright :: HLabel "Right" (HNullify (Columns b)) context
hright :: forall (left :: HTable) (right :: HTable) (context :: * -> *).
HEitherTable left right context
-> HLabel "Right" (HNullify right) context
hright} = EitherTable
    { tag :: context EitherTag
tag = forall a (context :: * -> *). HIdentity a context -> context a
unHIdentity forall a b. (a -> b) -> a -> b
$ forall (label :: Symbol) (t :: HTable) (context :: * -> *).
HLabel label t context -> t context
hunlabel HLabel "isRight" (HIdentity EitherTag) context
htag
    , left :: Nullify context a
left = forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns forall a b. (a -> b) -> a -> b
$ forall (label :: Symbol) (t :: HTable) (context :: * -> *).
HLabel label t context -> t context
hunlabel HLabel "Left" (HNullify (Columns a)) context
hleft
    , right :: Nullify context b
right = forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns forall a b. (a -> b) -> a -> b
$ forall (label :: Symbol) (t :: HTable) (context :: * -> *).
HLabel label t context -> t context
hunlabel HLabel "Right" (HNullify (Columns b)) context
hright
    }

  toResult :: FromExprs (EitherTable context a b)
-> Columns (EitherTable context a b) Result
toResult = \case
    Left FromExprs a
table -> HEitherTable
      { htag :: HLabel "isRight" (HIdentity EitherTag) Result
htag = forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (forall a (context :: * -> *). context a -> HIdentity a context
HIdentity (forall a. a -> Identity a
Identity EitherTag
IsLeft))
      , hleft :: HLabel "Left" (HNullify (Columns a)) Result
hleft = forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (forall (context :: * -> *) a.
Table context a =>
FromExprs a -> Columns a Result
toResult @_ @(Nullify context a) (forall a. a -> Maybe a
Just FromExprs a
table))
      , hright :: HLabel "Right" (HNullify (Columns b)) Result
hright = forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (forall (context :: * -> *) a.
Table context a =>
FromExprs a -> Columns a Result
toResult @_ @(Nullify context b) forall a. Maybe a
Nothing)
      }
    Right FromExprs b
table -> HEitherTable
      { htag :: HLabel "isRight" (HIdentity EitherTag) Result
htag = forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (forall a (context :: * -> *). context a -> HIdentity a context
HIdentity (forall a. a -> Identity a
Identity EitherTag
IsRight))
      , hleft :: HLabel "Left" (HNullify (Columns a)) Result
hleft = forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (forall (context :: * -> *) a.
Table context a =>
FromExprs a -> Columns a Result
toResult @_ @(Nullify context a) forall a. Maybe a
Nothing)
      , hright :: HLabel "Right" (HNullify (Columns b)) Result
hright = forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (forall (context :: * -> *) a.
Table context a =>
FromExprs a -> Columns a Result
toResult @_ @(Nullify context b) (forall a. a -> Maybe a
Just FromExprs b
table))
      }

  fromResult :: Columns (EitherTable context a b) Result
-> FromExprs (EitherTable context a b)
fromResult HEitherTable {HLabel "isRight" (HIdentity EitherTag) Result
htag :: HLabel "isRight" (HIdentity EitherTag) Result
htag :: forall (left :: HTable) (right :: HTable) (context :: * -> *).
HEitherTable left right context
-> HLabel "isRight" (HIdentity EitherTag) context
htag, HLabel "Left" (HNullify (Columns a)) Result
hleft :: HLabel "Left" (HNullify (Columns a)) Result
hleft :: forall (left :: HTable) (right :: HTable) (context :: * -> *).
HEitherTable left right context
-> HLabel "Left" (HNullify left) context
hleft, HLabel "Right" (HNullify (Columns b)) Result
hright :: HLabel "Right" (HNullify (Columns b)) Result
hright :: forall (left :: HTable) (right :: HTable) (context :: * -> *).
HEitherTable left right context
-> HLabel "Right" (HNullify right) context
hright} = case forall (label :: Symbol) (t :: HTable) (context :: * -> *).
HLabel label t context -> t context
hunlabel HLabel "isRight" (HIdentity EitherTag) Result
htag of
    HIdentity (Identity EitherTag
tag) -> case EitherTag
tag of
      EitherTag
IsLeft -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. a
err forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall (context :: * -> *) a.
Table context a =>
Columns a Result -> FromExprs a
fromResult @_ @(Nullify context a) (forall (label :: Symbol) (t :: HTable) (context :: * -> *).
HLabel label t context -> t context
hunlabel HLabel "Left" (HNullify (Columns a)) Result
hleft)
      EitherTag
IsRight -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. a
err forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (context :: * -> *) a.
Table context a =>
Columns a Result -> FromExprs a
fromResult @_ @(Nullify context b) (forall (label :: Symbol) (t :: HTable) (context :: * -> *).
HLabel label t context -> t context
hunlabel HLabel "Right" (HNullify (Columns b)) Result
hright)
    where
      err :: a
err = forall a. HasCallStack => [Char] -> a
error [Char]
"Either.fromColumns: mismatch between tag and data"


instance (EqTable a, EqTable b, context ~ Expr) =>
  EqTable (EitherTable context a b)
 where
  eqTable :: Columns (EitherTable context a b) (Dict (Sql DBEq))
eqTable = HEitherTable
    { htag :: HLabel "isRight" (HIdentity EitherTag) (Dict (Sql DBEq))
htag = forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (forall a (context :: * -> *). context a -> HIdentity a context
HIdentity forall {a} (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict)
    , hleft :: HLabel "Left" (HNullify (Columns a)) (Dict (Sql DBEq))
hleft = forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (forall a. EqTable a => Columns a (Dict (Sql DBEq))
eqTable @(Nullify context a))
    , hright :: HLabel "Right" (HNullify (Columns b)) (Dict (Sql DBEq))
hright = forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (forall a. EqTable a => Columns a (Dict (Sql DBEq))
eqTable @(Nullify context b))
    }


instance (OrdTable a, OrdTable b, context ~ Expr) =>
  OrdTable (EitherTable context a b)
 where
  ordTable :: Columns (EitherTable context a b) (Dict (Sql DBOrd))
ordTable = HEitherTable
    { htag :: HLabel "isRight" (HIdentity EitherTag) (Dict (Sql DBOrd))
htag = forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (forall a (context :: * -> *). context a -> HIdentity a context
HIdentity forall {a} (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict)
    , hleft :: HLabel "Left" (HNullify (Columns a)) (Dict (Sql DBOrd))
hleft = forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (forall a. OrdTable a => Columns a (Dict (Sql DBOrd))
ordTable @(Nullify context a))
    , hright :: HLabel "Right" (HNullify (Columns b)) (Dict (Sql DBOrd))
hright = forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (forall a. OrdTable a => Columns a (Dict (Sql DBOrd))
ordTable @(Nullify context b))
    }


instance (ToExprs exprs1 a, ToExprs exprs2 b, x ~ EitherTable Expr exprs1 exprs2) =>
  ToExprs x (Either a b)


-- | Test if an 'EitherTable' is a 'leftTable'.
isLeftTable :: EitherTable Expr a b -> Expr Bool
isLeftTable :: forall a b. EitherTable Expr a b -> Expr Bool
isLeftTable EitherTable {Expr EitherTag
tag :: Expr EitherTag
tag :: forall (context :: * -> *) a b.
EitherTable context a b -> context EitherTag
tag} = Expr EitherTag -> Expr Bool
isLeft Expr EitherTag
tag


-- | Test if an 'EitherTable' is a 'rightTable'.
isRightTable :: EitherTable Expr a b -> Expr Bool
isRightTable :: forall a b. EitherTable Expr a b -> Expr Bool
isRightTable EitherTable {Expr EitherTag
tag :: Expr EitherTag
tag :: forall (context :: * -> *) a b.
EitherTable context a b -> context EitherTag
tag} = Expr EitherTag -> Expr Bool
isRight Expr EitherTag
tag


-- | Pattern match/eliminate an 'EitherTable', by providing mappings from a
-- 'leftTable' and 'rightTable'.
eitherTable :: Table Expr c
  => (a -> c) -> (b -> c) -> EitherTable Expr a b -> c
eitherTable :: forall c a b.
Table Expr c =>
(a -> c) -> (b -> c) -> EitherTable Expr a b -> c
eitherTable a -> c
f b -> c
g EitherTable {Expr EitherTag
tag :: Expr EitherTag
tag :: forall (context :: * -> *) a b.
EitherTable context a b -> context EitherTag
tag, Nullify Expr a
left :: Nullify Expr a
left :: forall (context :: * -> *) a b.
EitherTable context a b -> Nullify context a
left, Nullify Expr b
right :: Nullify Expr b
right :: forall (context :: * -> *) a b.
EitherTable context a b -> Nullify context b
right} =
  forall a. Table Expr a => a -> a -> Expr Bool -> a
bool (a -> c
f (forall (w :: * -> *) a. Comonad w => w a -> a
extract Nullify Expr a
left)) (b -> c
g (forall (w :: * -> *) a. Comonad w => w a -> a
extract Nullify Expr b
right)) (Expr EitherTag -> Expr Bool
isRight Expr EitherTag
tag)


-- | Construct a left 'EitherTable'. Like 'Left'.
leftTable :: Table Expr b => a -> EitherTable Expr a b
leftTable :: forall b a. Table Expr b => a -> EitherTable Expr a b
leftTable a
a = forall (context :: * -> *) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable (forall a. Sql DBType a => a -> Expr a
litExpr EitherTag
IsLeft) (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) forall a. Table Expr a => a
undefined


-- | Construct a right 'EitherTable'. Like 'Right'.
rightTable :: Table Expr a => b -> EitherTable Expr a b
rightTable :: forall a b. Table Expr a => b -> EitherTable Expr a b
rightTable = forall (context :: * -> *) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable (forall a. Sql DBType a => a -> Expr a
litExpr EitherTag
IsRight) forall a. Table Expr a => a
undefined forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure


-- | Lift a pair of aggregating functions to operate on an 'EitherTable'.
-- @leftTable@s and @rightTable@s are grouped separately.
aggregateEitherTable :: ()
  => (exprs -> aggregates)
  -> (exprs' -> aggregates')
  -> EitherTable Expr exprs exprs'
  -> EitherTable Aggregate aggregates aggregates'
aggregateEitherTable :: forall exprs aggregates exprs' aggregates'.
(exprs -> aggregates)
-> (exprs' -> aggregates')
-> EitherTable Expr exprs exprs'
-> EitherTable Aggregate aggregates aggregates'
aggregateEitherTable exprs -> aggregates
f exprs' -> aggregates'
g (EitherTable Expr EitherTag
tag Nullify Expr exprs
a Nullify Expr exprs'
b) = EitherTable
  { tag :: Aggregate EitherTag
tag = forall a. Sql DBEq a => Expr a -> Aggregate a
groupByExpr Expr EitherTag
tag
  , left :: Nullify Aggregate aggregates
left = forall exprs aggregates.
(exprs -> aggregates)
-> Nullify Expr exprs -> Nullify Aggregate aggregates
aggregateNullify exprs -> aggregates
f Nullify Expr exprs
a
  , right :: Nullify Aggregate aggregates'
right = forall exprs aggregates.
(exprs -> aggregates)
-> Nullify Expr exprs -> Nullify Aggregate aggregates
aggregateNullify exprs' -> aggregates'
g Nullify Expr exprs'
b
  }


-- | Construct a 'EitherTable' in the 'Name' context. This can be useful if you
-- have a 'EitherTable' that you are storing in a table and need to construct a
-- 'TableSchema'.
nameEitherTable
  :: Name EitherTag
     -- ^ The name of the column to track whether a row is a 'leftTable' or
     -- 'rightTable'.
  -> a
     -- ^ Names of the columns in the @a@ table.
  -> b
     -- ^ Names of the columns in the @b@ table.
  -> EitherTable Name a b
nameEitherTable :: forall a b. Name EitherTag -> a -> b -> EitherTable Name a b
nameEitherTable Name EitherTag
tag a
left b
right = forall (context :: * -> *) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable Name EitherTag
tag (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
left) (forall (f :: * -> *) a. Applicative f => a -> f a
pure b
right)