{-# 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
  { EitherTable context a b -> context EitherTag
tag :: context EitherTag
  , EitherTable context a b -> Nullify context a
left :: Nullify context a
  , EitherTable context a b -> Nullify context b
right :: Nullify context b
  }
  deriving stock a -> EitherTable context a b -> EitherTable context a a
(a -> b) -> EitherTable context a a -> EitherTable context a b
(forall a b.
 (a -> b) -> EitherTable context a a -> EitherTable context a b)
-> (forall a b.
    a -> EitherTable context a b -> EitherTable context a a)
-> Functor (EitherTable context a)
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
<$ :: 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 :: (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 :: 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) =
    context EitherTag
-> Nullify context b
-> Nullify context d
-> EitherTable context b d
forall (context :: * -> *) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable context EitherTag
tag (Projection a b -> Nullify context a -> Nullify context b
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) (Projection c d -> Nullify context c -> Nullify context d
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 :: (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) = context EitherTag
-> Nullify context b
-> Nullify context d
-> EitherTable context b d
forall (context :: * -> *) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable context EitherTag
tag ((a -> b) -> Nullify context a -> Nullify context b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Nullify context a
a) ((c -> d) -> Nullify context c -> Nullify context d
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 :: 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) = context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable 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 (Projection a b -> Nullify context a -> Nullify context b
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 <.> :: 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 =
    context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
forall (context :: * -> *) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable (context EitherTag
tag context EitherTag -> context EitherTag -> context EitherTag
forall a. Semigroup a => a -> a -> a
<> context EitherTag
tag') (Nullify context a
-> Nullify context a -> Expr Bool -> Nullify context a
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
Expr EitherTag
tag)) (Nullify context (a -> b)
f Nullify context (a -> b) -> Nullify context a -> Nullify context b
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 :: a -> EitherTable context a a
pure = a -> EitherTable context a a
forall a b. Table Expr a => b -> EitherTable Expr a b
rightTable
  <*> :: EitherTable context a (a -> b)
-> EitherTable context a a -> EitherTable context 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 >>- :: 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 (Nullify context a -> a
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 ->
      context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
forall (context :: * -> *) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable (context EitherTag
tag context EitherTag -> context EitherTag -> context EitherTag
forall a. Semigroup a => a -> a -> a
<> context EitherTag
tag') (Nullify context a
-> Nullify context a -> Expr Bool -> Nullify context a
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
Expr EitherTag
tag)) Nullify context b
b


instance (context ~ Expr, Table Expr a) => Monad (EitherTable context a) where
  >>= :: EitherTable context a a
-> (a -> EitherTable context a b) -> EitherTable context 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 = EitherTable context a b
-> EitherTable context a b -> Expr Bool -> EitherTable context a b
forall a. Table Expr a => a -> a -> Expr Bool -> a
bool EitherTable context a b
a EitherTable context a b
b (EitherTable Expr a b -> Expr Bool
forall a b. EitherTable Expr a b -> Expr Bool
isRightTable EitherTable context a b
EitherTable Expr 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 :: forall (left :: HTable) (right :: HTable) (context :: * -> *).
HLabel "isRight" (HIdentity EitherTag) context
-> HLabel "Left" (HNullify left) context
-> HLabel "Right" (HNullify right) context
-> HEitherTable left right context
HEitherTable
    { htag :: HLabel "isRight" (HIdentity EitherTag) context
htag = HIdentity EitherTag context
-> HLabel "isRight" (HIdentity EitherTag) context
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (HIdentity EitherTag context
 -> HLabel "isRight" (HIdentity EitherTag) context)
-> HIdentity EitherTag context
-> HLabel "isRight" (HIdentity EitherTag) context
forall a b. (a -> b) -> a -> b
$ context EitherTag -> HIdentity EitherTag context
forall a (context :: * -> *). context a -> HIdentity a context
HIdentity context EitherTag
tag
    , hleft :: HLabel "Left" (HNullify (Columns a)) context
hleft = HNullify (Columns a) context
-> HLabel "Left" (HNullify (Columns a)) context
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (HNullify (Columns a) context
 -> HLabel "Left" (HNullify (Columns a)) context)
-> HNullify (Columns a) context
-> HLabel "Left" (HNullify (Columns a)) context
forall a b. (a -> b) -> a -> b
$ context EitherTag
-> (EitherTag -> Bool)
-> (Expr EitherTag -> Expr Bool)
-> HNullify (Columns a) context
-> HNullify (Columns a) context
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 (EitherTag -> EitherTag -> Bool
forall a. Eq a => a -> a -> Bool
== EitherTag
IsLeft) Expr EitherTag -> Expr Bool
isLeft (HNullify (Columns a) context -> HNullify (Columns a) context)
-> HNullify (Columns a) context -> HNullify (Columns a) context
forall a b. (a -> b) -> a -> b
$ Nullify context a -> Columns (Nullify context a) context'
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns Nullify context a
left
    , hright :: HLabel "Right" (HNullify (Columns b)) context
hright = HNullify (Columns b) context
-> HLabel "Right" (HNullify (Columns b)) context
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (HNullify (Columns b) context
 -> HLabel "Right" (HNullify (Columns b)) context)
-> HNullify (Columns b) context
-> HLabel "Right" (HNullify (Columns b)) context
forall a b. (a -> b) -> a -> b
$ context EitherTag
-> (EitherTag -> Bool)
-> (Expr EitherTag -> Expr Bool)
-> HNullify (Columns b) context
-> HNullify (Columns b) context
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 (EitherTag -> EitherTag -> Bool
forall a. Eq a => a -> a -> Bool
== EitherTag
IsRight) Expr EitherTag -> Expr Bool
isRight (HNullify (Columns b) context -> HNullify (Columns b) context)
-> HNullify (Columns b) context -> HNullify (Columns b) context
forall a b. (a -> b) -> a -> b
$ Nullify context b -> Columns (Nullify context b) context'
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 {htag, hleft, hright} = EitherTable :: forall (context :: * -> *) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable
    { tag :: context EitherTag
tag = HIdentity EitherTag context -> context EitherTag
forall a (context :: * -> *). HIdentity a context -> context a
unHIdentity (HIdentity EitherTag context -> context EitherTag)
-> HIdentity EitherTag context -> context EitherTag
forall a b. (a -> b) -> a -> b
$ HLabel "isRight" (HIdentity EitherTag) context
-> HIdentity EitherTag context
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
HLabel label t context -> t context
hunlabel HLabel "isRight" (HIdentity EitherTag) context
htag
    , left :: Nullify context a
left = Columns (Nullify context a) context' -> Nullify context a
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (Columns (Nullify context a) context' -> Nullify context a)
-> Columns (Nullify context a) context' -> Nullify context a
forall a b. (a -> b) -> a -> b
$ HLabel "Left" (HNullify (Columns a)) context
-> HNullify (Columns a) context
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 = Columns (Nullify context b) context' -> Nullify context b
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (Columns (Nullify context b) context' -> Nullify context b)
-> Columns (Nullify context b) context' -> Nullify context b
forall a b. (a -> b) -> a -> b
$ HLabel "Right" (HNullify (Columns b)) context
-> HNullify (Columns b) context
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 table -> HEitherTable :: forall (left :: HTable) (right :: HTable) (context :: * -> *).
HLabel "isRight" (HIdentity EitherTag) context
-> HLabel "Left" (HNullify left) context
-> HLabel "Right" (HNullify right) context
-> HEitherTable left right context
HEitherTable
      { htag :: HLabel "isRight" (HIdentity EitherTag) Result
htag = HIdentity EitherTag Result
-> HLabel "isRight" (HIdentity EitherTag) Result
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (Identity EitherTag -> HIdentity EitherTag Result
forall a (context :: * -> *). context a -> HIdentity a context
HIdentity (EitherTag -> Identity EitherTag
forall a. a -> Identity a
Identity EitherTag
IsLeft))
      , hleft :: HLabel "Left" (HNullify (Columns a)) Result
hleft = HNullify (Columns a) Result
-> HLabel "Left" (HNullify (Columns a)) Result
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (FromExprs (Nullify context a) -> Columns (Nullify context a) Result
forall (context :: * -> *) a.
Table context a =>
FromExprs a -> Columns a Result
toResult @_ @(Nullify context a) (FromExprs a -> Maybe (FromExprs a)
forall a. a -> Maybe a
Just FromExprs a
table))
      , hright :: HLabel "Right" (HNullify (Columns b)) Result
hright = HNullify (Columns b) Result
-> HLabel "Right" (HNullify (Columns b)) Result
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (FromExprs (Nullify context b) -> Columns (Nullify context b) Result
forall (context :: * -> *) a.
Table context a =>
FromExprs a -> Columns a Result
toResult @_ @(Nullify context b) FromExprs (Nullify context b)
forall a. Maybe a
Nothing)
      }
    Right table -> HEitherTable :: forall (left :: HTable) (right :: HTable) (context :: * -> *).
HLabel "isRight" (HIdentity EitherTag) context
-> HLabel "Left" (HNullify left) context
-> HLabel "Right" (HNullify right) context
-> HEitherTable left right context
HEitherTable
      { htag :: HLabel "isRight" (HIdentity EitherTag) Result
htag = HIdentity EitherTag Result
-> HLabel "isRight" (HIdentity EitherTag) Result
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (Identity EitherTag -> HIdentity EitherTag Result
forall a (context :: * -> *). context a -> HIdentity a context
HIdentity (EitherTag -> Identity EitherTag
forall a. a -> Identity a
Identity EitherTag
IsRight))
      , hleft :: HLabel "Left" (HNullify (Columns a)) Result
hleft = HNullify (Columns a) Result
-> HLabel "Left" (HNullify (Columns a)) Result
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (FromExprs (Nullify context a) -> Columns (Nullify context a) Result
forall (context :: * -> *) a.
Table context a =>
FromExprs a -> Columns a Result
toResult @_ @(Nullify context a) FromExprs (Nullify context a)
forall a. Maybe a
Nothing)
      , hright :: HLabel "Right" (HNullify (Columns b)) Result
hright = HNullify (Columns b) Result
-> HLabel "Right" (HNullify (Columns b)) Result
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (FromExprs (Nullify context b) -> Columns (Nullify context b) Result
forall (context :: * -> *) a.
Table context a =>
FromExprs a -> Columns a Result
toResult @_ @(Nullify context b) (FromExprs b -> Maybe (FromExprs b)
forall a. a -> Maybe a
Just FromExprs b
table))
      }

  fromResult :: Columns (EitherTable context a b) Result
-> FromExprs (EitherTable context a b)
fromResult HEitherTable {htag, hleft, hright} = case HLabel "isRight" (HIdentity EitherTag) Result
-> HIdentity EitherTag Result
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 -> Either (FromExprs a) (FromExprs b)
-> (FromExprs a -> Either (FromExprs a) (FromExprs b))
-> Maybe (FromExprs a)
-> Either (FromExprs a) (FromExprs b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either (FromExprs a) (FromExprs b)
forall a. a
err FromExprs a -> Either (FromExprs a) (FromExprs b)
forall a b. a -> Either a b
Left (Maybe (FromExprs a) -> Either (FromExprs a) (FromExprs b))
-> Maybe (FromExprs a) -> Either (FromExprs a) (FromExprs b)
forall a b. (a -> b) -> a -> b
$ Columns (Nullify context a) Result -> FromExprs (Nullify context a)
forall (context :: * -> *) a.
Table context a =>
Columns a Result -> FromExprs a
fromResult @_ @(Nullify context a) (HLabel "Left" (HNullify (Columns a)) Result
-> HNullify (Columns a) Result
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
HLabel label t context -> t context
hunlabel HLabel "Left" (HNullify (Columns a)) Result
hleft)
      EitherTag
IsRight -> Either (FromExprs a) (FromExprs b)
-> (FromExprs b -> Either (FromExprs a) (FromExprs b))
-> Maybe (FromExprs b)
-> Either (FromExprs a) (FromExprs b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either (FromExprs a) (FromExprs b)
forall a. a
err FromExprs b -> Either (FromExprs a) (FromExprs b)
forall a b. b -> Either a b
Right (Maybe (FromExprs b) -> Either (FromExprs a) (FromExprs b))
-> Maybe (FromExprs b) -> Either (FromExprs a) (FromExprs b)
forall a b. (a -> b) -> a -> b
$ Columns (Nullify context b) Result -> FromExprs (Nullify context b)
forall (context :: * -> *) a.
Table context a =>
Columns a Result -> FromExprs a
fromResult @_ @(Nullify context b) (HLabel "Right" (HNullify (Columns b)) Result
-> HNullify (Columns b) Result
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
HLabel label t context -> t context
hunlabel HLabel "Right" (HNullify (Columns b)) Result
hright)
    where
      err :: a
err = [Char] -> a
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 :: forall (left :: HTable) (right :: HTable) (context :: * -> *).
HLabel "isRight" (HIdentity EitherTag) context
-> HLabel "Left" (HNullify left) context
-> HLabel "Right" (HNullify right) context
-> HEitherTable left right context
HEitherTable
    { htag :: HLabel "isRight" (HIdentity EitherTag) (Dict (Sql DBEq))
htag = HIdentity EitherTag (Dict (Sql DBEq))
-> HLabel "isRight" (HIdentity EitherTag) (Dict (Sql DBEq))
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (Dict (Sql DBEq) EitherTag -> HIdentity EitherTag (Dict (Sql DBEq))
forall a (context :: * -> *). context a -> HIdentity a context
HIdentity Dict (Sql DBEq) EitherTag
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict)
    , hleft :: HLabel "Left" (HNullify (Columns a)) (Dict (Sql DBEq))
hleft = HNullify (Columns a) (Dict (Sql DBEq))
-> HLabel "Left" (HNullify (Columns a)) (Dict (Sql DBEq))
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (EqTable (Nullify context a) =>
Columns (Nullify context a) (Dict (Sql DBEq))
forall a. EqTable a => Columns a (Dict (Sql DBEq))
eqTable @(Nullify context a))
    , hright :: HLabel "Right" (HNullify (Columns b)) (Dict (Sql DBEq))
hright = HNullify (Columns b) (Dict (Sql DBEq))
-> HLabel "Right" (HNullify (Columns b)) (Dict (Sql DBEq))
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (EqTable (Nullify context b) =>
Columns (Nullify context b) (Dict (Sql DBEq))
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 :: forall (left :: HTable) (right :: HTable) (context :: * -> *).
HLabel "isRight" (HIdentity EitherTag) context
-> HLabel "Left" (HNullify left) context
-> HLabel "Right" (HNullify right) context
-> HEitherTable left right context
HEitherTable
    { htag :: HLabel "isRight" (HIdentity EitherTag) (Dict (Sql DBOrd))
htag = HIdentity EitherTag (Dict (Sql DBOrd))
-> HLabel "isRight" (HIdentity EitherTag) (Dict (Sql DBOrd))
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (Dict (Sql DBOrd) EitherTag
-> HIdentity EitherTag (Dict (Sql DBOrd))
forall a (context :: * -> *). context a -> HIdentity a context
HIdentity Dict (Sql DBOrd) EitherTag
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict)
    , hleft :: HLabel "Left" (HNullify (Columns a)) (Dict (Sql DBOrd))
hleft = HNullify (Columns a) (Dict (Sql DBOrd))
-> HLabel "Left" (HNullify (Columns a)) (Dict (Sql DBOrd))
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (OrdTable (Nullify context a) =>
Columns (Nullify context a) (Dict (Sql DBOrd))
forall a. OrdTable a => Columns a (Dict (Sql DBOrd))
ordTable @(Nullify context a))
    , hright :: HLabel "Right" (HNullify (Columns b)) (Dict (Sql DBOrd))
hright = HNullify (Columns b) (Dict (Sql DBOrd))
-> HLabel "Right" (HNullify (Columns b)) (Dict (Sql DBOrd))
forall (label :: Symbol) (t :: HTable) (context :: * -> *).
t context -> HLabel label t context
hlabel (OrdTable (Nullify context b) =>
Columns (Nullify context b) (Dict (Sql DBOrd))
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 :: 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 :: 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 :: (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} =
  c -> c -> Expr Bool -> c
forall a. Table Expr a => a -> a -> Expr Bool -> a
bool (a -> c
f (Nullify Expr a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract Nullify Expr a
left)) (b -> c
g (Nullify Expr b -> b
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 :: a -> EitherTable Expr a b
leftTable a
a = Expr EitherTag
-> Nullify Expr a -> Nullify Expr b -> EitherTable Expr a b
forall (context :: * -> *) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable (EitherTag -> Expr EitherTag
forall a. Sql DBType a => a -> Expr a
litExpr EitherTag
IsLeft) (a -> Nullify Expr a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) Nullify Expr b
forall a. Table Expr a => a
undefined


-- | Construct a right 'EitherTable'. Like 'Right'.
rightTable :: Table Expr a => b -> EitherTable Expr a b
rightTable :: b -> EitherTable Expr a b
rightTable = Expr EitherTag
-> Nullify Expr a -> Nullify Expr b -> EitherTable Expr a b
forall (context :: * -> *) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable (EitherTag -> Expr EitherTag
forall a. Sql DBType a => a -> Expr a
litExpr EitherTag
IsRight) Nullify Expr a
forall a. Table Expr a => a
undefined (Nullify Expr b -> EitherTable Expr a b)
-> (b -> Nullify Expr b) -> b -> EitherTable Expr a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Nullify Expr b
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 :: (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 :: forall (context :: * -> *) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable
  { tag :: Aggregate EitherTag
tag = Expr EitherTag -> Aggregate EitherTag
forall a. Sql DBEq a => Expr a -> Aggregate a
groupByExpr Expr EitherTag
tag
  , left :: Nullify Aggregate aggregates
left = (exprs -> aggregates)
-> Nullify Expr exprs -> Nullify Aggregate aggregates
forall exprs aggregates.
(exprs -> aggregates)
-> Nullify Expr exprs -> Nullify Aggregate aggregates
aggregateNullify exprs -> aggregates
f Nullify Expr exprs
a
  , right :: Nullify Aggregate aggregates'
right = (exprs' -> aggregates')
-> Nullify Expr exprs' -> Nullify Aggregate aggregates'
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 :: Name EitherTag -> a -> b -> EitherTable Name a b
nameEitherTable Name EitherTag
tag a
left b
right = Name EitherTag
-> Nullify Name a -> Nullify Name b -> EitherTable Name a b
forall (context :: * -> *) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable Name EitherTag
tag (a -> Nullify Name a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
left) (b -> Nullify Name b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
right)