{-# 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 TypeOperators #-}
{-# 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 )

-- profunctors
import Data.Profunctor (lmap)

-- rel8
import Rel8.Aggregate (Aggregator', Aggregator1, toAggregator1)
import Rel8.Expr ( Expr )
import Rel8.Expr.Aggregate (groupByExprOn)
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 :: Context) a b.
EitherTable context a b -> context EitherTag
tag :: context EitherTag
  , forall (context :: Context) a b.
EitherTable context a b -> Nullify context a
left :: Nullify context a
  , forall (context :: Context) a b.
EitherTable context a b -> Nullify context b
right :: Nullify context b
  }
  deriving stock (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 :: Context).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (context :: Context) a a b.
Nullifiable context =>
a -> EitherTable context a b -> EitherTable context a a
forall (context :: Context) a a b.
Nullifiable context =>
(a -> b) -> EitherTable context a a -> EitherTable context a b
$cfmap :: forall (context :: Context) a a b.
Nullifiable context =>
(a -> b) -> EitherTable context a a -> EitherTable context a b
fmap :: forall a b.
(a -> b) -> EitherTable context a a -> EitherTable context a b
$c<$ :: forall (context :: Context) a a b.
Nullifiable context =>
a -> EitherTable context a b -> EitherTable context a a
<$ :: forall a b. a -> EitherTable context a b -> EitherTable context a a
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) =
    context EitherTag
-> Nullify context b
-> Nullify context d
-> EitherTable context b d
forall (context :: 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 a b.
Projecting a b =>
Projection a b -> Nullify context a -> Nullify context b
forall (f :: Context) 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 a b.
Projecting a b =>
Projection a b -> Nullify context a -> Nullify context b
forall (f :: Context) 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) = context EitherTag
-> Nullify context b
-> Nullify context d
-> EitherTable context b d
forall (context :: 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 a b. (a -> b) -> Nullify context a -> Nullify context b
forall (f :: Context) 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 a b. (a -> b) -> Nullify context a -> Nullify context b
forall (f :: Context) 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) = context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
forall (context :: 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 a b.
Projecting a b =>
Projection a b -> Nullify context a -> Nullify context b
forall (f :: Context) 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 =
    context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
forall (context :: 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 a b.
Nullify context (a -> b) -> Nullify context a -> Nullify context b
forall (f :: Context) 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 = a -> EitherTable context a a
a -> EitherTable Expr a a
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
(<*>) = EitherTable context a (a -> b)
-> EitherTable context a a -> EitherTable context a b
forall a b.
EitherTable context a (a -> b)
-> EitherTable context a a -> EitherTable context a b
forall (f :: Context) 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 (Nullify context a -> a
forall a. Nullify context a -> a
forall (w :: Context) 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 :: 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
  >>= :: forall a b.
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 a b.
EitherTable context a a
-> (a -> EitherTable context a b) -> EitherTable context a b
forall (m :: Context) 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 :: forall (context :: Context) a b.
EitherTable context a b -> context EitherTag
tag :: context EitherTag
tag, Nullify context a
left :: forall (context :: Context) a b.
EitherTable context a b -> Nullify context a
left :: Nullify context a
left, Nullify context b
right :: forall (context :: Context) a b.
EitherTable context a b -> Nullify context b
right :: Nullify context b
right} = HEitherTable
    { htag :: HLabel "isRight" (HIdentity EitherTag) context
htag = HIdentity EitherTag context
-> HLabel "isRight" (HIdentity EitherTag) context
forall (label :: Symbol) (t :: HTable) (context :: 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). 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: forall (left :: HTable) (right :: HTable) (context :: Context).
HEitherTable left right context
-> HLabel "isRight" (HIdentity EitherTag) context
htag :: HLabel "isRight" (HIdentity EitherTag) context
htag, HLabel "Left" (HNullify (Columns a)) context
hleft :: forall (left :: HTable) (right :: HTable) (context :: Context).
HEitherTable left right context
-> HLabel "Left" (HNullify left) context
hleft :: HLabel "Left" (HNullify (Columns a)) context
hleft, HLabel "Right" (HNullify (Columns b)) context
hright :: forall (left :: HTable) (right :: HTable) (context :: Context).
HEitherTable left right context
-> HLabel "Right" (HNullify right) context
hright :: HLabel "Right" (HNullify (Columns b)) context
hright} = EitherTable
    { tag :: context EitherTag
tag = HIdentity EitherTag context -> context EitherTag
forall a (context :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 = HIdentity EitherTag Result
-> HLabel "isRight" (HIdentity EitherTag) Result
forall (label :: Symbol) (t :: HTable) (context :: Context).
t context -> HLabel label t context
hlabel (Identity EitherTag -> HIdentity EitherTag Result
forall a (context :: 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 :: Context).
t context -> HLabel label t context
hlabel (forall (context :: 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 :: Context).
t context -> HLabel label t context
hlabel (forall (context :: Context) a.
Table context a =>
FromExprs a -> Columns a Result
toResult @_ @(Nullify context b) Maybe (FromExprs b)
FromExprs (Nullify context b)
forall a. Maybe a
Nothing)
      }
    Right FromExprs b
table -> HEitherTable
      { htag :: HLabel "isRight" (HIdentity EitherTag) Result
htag = HIdentity EitherTag Result
-> HLabel "isRight" (HIdentity EitherTag) Result
forall (label :: Symbol) (t :: HTable) (context :: Context).
t context -> HLabel label t context
hlabel (Identity EitherTag -> HIdentity EitherTag Result
forall a (context :: 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 :: Context).
t context -> HLabel label t context
hlabel (forall (context :: Context) a.
Table context a =>
FromExprs a -> Columns a Result
toResult @_ @(Nullify context a) Maybe (FromExprs 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 :: Context).
t context -> HLabel label t context
hlabel (forall (context :: 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 {HLabel "isRight" (HIdentity EitherTag) Result
htag :: forall (left :: HTable) (right :: HTable) (context :: Context).
HEitherTable left right context
-> HLabel "isRight" (HIdentity EitherTag) context
htag :: HLabel "isRight" (HIdentity EitherTag) Result
htag, HLabel "Left" (HNullify (Columns a)) Result
hleft :: forall (left :: HTable) (right :: HTable) (context :: Context).
HEitherTable left right context
-> HLabel "Left" (HNullify left) context
hleft :: HLabel "Left" (HNullify (Columns a)) Result
hleft, HLabel "Right" (HNullify (Columns b)) Result
hright :: forall (left :: HTable) (right :: HTable) (context :: Context).
HEitherTable left right context
-> HLabel "Right" (HNullify right) context
hright :: HLabel "Right" (HNullify (Columns b)) Result
hright} = case HLabel "isRight" (HIdentity EitherTag) Result
-> HIdentity EitherTag Result
forall (label :: Symbol) (t :: HTable) (context :: 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 -> FromExprs (EitherTable context a b)
-> (FromExprs a -> FromExprs (EitherTable context a b))
-> Maybe (FromExprs a)
-> FromExprs (EitherTable context a b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either (FromExprs a) (FromExprs b)
FromExprs (EitherTable context a b)
forall {a}. a
err FromExprs a -> Either (FromExprs a) (FromExprs b)
FromExprs a -> FromExprs (EitherTable context a b)
forall a b. a -> Either a b
Left (Maybe (FromExprs a) -> FromExprs (EitherTable context a b))
-> Maybe (FromExprs a) -> FromExprs (EitherTable context a b)
forall a b. (a -> b) -> a -> b
$ forall (context :: 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 :: Context).
HLabel label t context -> t context
hunlabel HLabel "Left" (HNullify (Columns a)) Result
hleft)
      EitherTag
IsRight -> FromExprs (EitherTable context a b)
-> (FromExprs b -> FromExprs (EitherTable context a b))
-> Maybe (FromExprs b)
-> FromExprs (EitherTable context a b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either (FromExprs a) (FromExprs b)
FromExprs (EitherTable context a b)
forall {a}. a
err FromExprs b -> Either (FromExprs a) (FromExprs b)
FromExprs b -> FromExprs (EitherTable context a b)
forall a b. b -> Either a b
Right (Maybe (FromExprs b) -> FromExprs (EitherTable context a b))
-> Maybe (FromExprs b) -> FromExprs (EitherTable context a b)
forall a b. (a -> b) -> a -> b
$ forall (context :: 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 :: 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
    { 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 :: Context).
t context -> HLabel label t context
hlabel (Dict (Sql DBEq) EitherTag -> HIdentity EitherTag (Dict (Sql DBEq))
forall a (context :: Context). context a -> HIdentity a context
HIdentity Dict (Sql DBEq) EitherTag
forall {a} (c :: a -> Constraint) (a1 :: a). c a1 => Dict c a1
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 :: 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 = HNullify (Columns b) (Dict (Sql DBEq))
-> HLabel "Right" (HNullify (Columns b)) (Dict (Sql DBEq))
forall (label :: Symbol) (t :: HTable) (context :: 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 = HIdentity EitherTag (Dict (Sql DBOrd))
-> HLabel "isRight" (HIdentity EitherTag) (Dict (Sql DBOrd))
forall (label :: Symbol) (t :: HTable) (context :: Context).
t context -> HLabel label t context
hlabel (Dict (Sql DBOrd) EitherTag
-> HIdentity EitherTag (Dict (Sql DBOrd))
forall a (context :: Context). context a -> HIdentity a context
HIdentity Dict (Sql DBOrd) EitherTag
forall {a} (c :: a -> Constraint) (a1 :: a). c a1 => Dict c a1
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 :: 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 = HNullify (Columns b) (Dict (Sql DBOrd))
-> HLabel "Right" (HNullify (Columns b)) (Dict (Sql DBOrd))
forall (label :: Symbol) (t :: HTable) (context :: 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 :: forall (context :: Context) a b.
EitherTable context a b -> context EitherTag
tag :: Expr 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 :: forall (context :: Context) a b.
EitherTable context a b -> context EitherTag
tag :: Expr 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 :: forall (context :: Context) a b.
EitherTable context a b -> context EitherTag
tag :: Expr EitherTag
tag, Nullify Expr a
left :: forall (context :: Context) a b.
EitherTable context a b -> Nullify context a
left :: Nullify Expr a
left, Nullify Expr b
right :: forall (context :: Context) a b.
EitherTable context a b -> Nullify context b
right :: Nullify Expr 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 a. Nullify Expr a -> a
forall (w :: Context) a. Comonad w => w a -> a
extract Nullify Expr a
left)) (b -> c
g (Nullify Expr b -> b
forall a. Nullify Expr a -> a
forall (w :: Context) 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 = Expr EitherTag
-> Nullify Expr a -> Nullify Expr b -> EitherTable Expr a b
forall (context :: 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 a. a -> Nullify Expr a
forall (f :: Context) 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 :: forall a b. Table Expr a => b -> EitherTable Expr a b
rightTable = Expr EitherTag
-> Nullify Expr a -> Nullify Expr b -> EitherTable Expr a b
forall (context :: 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 a. a -> Nullify Expr a
forall (f :: Context) a. Applicative f => a -> f a
pure


-- | Lift a pair aggregators to operate on an 'EitherTable'. @leftTable@s and
-- @rightTable@s are grouped separately.
aggregateEitherTable :: ()
  => Aggregator' fold i a
  -> Aggregator' fold' i' b
  -> Aggregator1 (EitherTable Expr i i') (EitherTable Expr a b)
aggregateEitherTable :: forall (fold :: Fold) i a (fold' :: Fold) i' b.
Aggregator' fold i a
-> Aggregator' fold' i' b
-> Aggregator1 (EitherTable Expr i i') (EitherTable Expr a b)
aggregateEitherTable Aggregator' fold i a
a Aggregator' fold' i' b
b =
  Expr EitherTag
-> Nullify Expr a -> Nullify Expr b -> EitherTable Expr a b
forall (context :: Context) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable
    (Expr EitherTag
 -> Nullify Expr a -> Nullify Expr b -> EitherTable Expr a b)
-> Aggregator' 'Semi (EitherTable Expr i i') (Expr EitherTag)
-> Aggregator'
     'Semi
     (EitherTable Expr i i')
     (Nullify Expr a -> Nullify Expr b -> EitherTable Expr a b)
forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
<$> (EitherTable Expr i i' -> Expr EitherTag)
-> Aggregator' 'Semi (EitherTable Expr i i') (Expr EitherTag)
forall a i. Sql DBEq a => (i -> Expr a) -> Aggregator1 i (Expr a)
groupByExprOn EitherTable Expr i i' -> Expr EitherTag
forall (context :: Context) a b.
EitherTable context a b -> context EitherTag
tag
    Aggregator'
  'Semi
  (EitherTable Expr i i')
  (Nullify Expr a -> Nullify Expr b -> EitherTable Expr a b)
-> Aggregator' 'Semi (EitherTable Expr i i') (Nullify Expr a)
-> Aggregator'
     'Semi
     (EitherTable Expr i i')
     (Nullify Expr b -> EitherTable Expr a b)
forall a b.
Aggregator' 'Semi (EitherTable Expr i i') (a -> b)
-> Aggregator' 'Semi (EitherTable Expr i i') a
-> Aggregator' 'Semi (EitherTable Expr i i') b
forall (f :: Context) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (EitherTable Expr i i' -> Nullify Expr i)
-> Aggregator' 'Semi (Nullify Expr i) (Nullify Expr a)
-> Aggregator' 'Semi (EitherTable Expr i i') (Nullify Expr a)
forall a b c.
(a -> b) -> Aggregator' 'Semi b c -> Aggregator' 'Semi a c
forall (p :: * -> Context) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap EitherTable Expr i i' -> Nullify Expr i
forall (context :: Context) a b.
EitherTable context a b -> Nullify context a
left (Aggregator' fold (Nullify Expr i) (Nullify Expr a)
-> Aggregator' 'Semi (Nullify Expr i) (Nullify Expr a)
forall (fold :: Fold) i a. Aggregator' fold i a -> Aggregator1 i a
toAggregator1 (Aggregator' fold i a
-> Aggregator' fold (Nullify Expr i) (Nullify Expr a)
forall (fold :: Fold) i a.
Aggregator' fold i a
-> Aggregator' fold (Nullify Expr i) (Nullify Expr a)
aggregateNullify Aggregator' fold i a
a))
    Aggregator'
  'Semi
  (EitherTable Expr i i')
  (Nullify Expr b -> EitherTable Expr a b)
-> Aggregator' 'Semi (EitherTable Expr i i') (Nullify Expr b)
-> Aggregator' 'Semi (EitherTable Expr i i') (EitherTable Expr a b)
forall a b.
Aggregator' 'Semi (EitherTable Expr i i') (a -> b)
-> Aggregator' 'Semi (EitherTable Expr i i') a
-> Aggregator' 'Semi (EitherTable Expr i i') b
forall (f :: Context) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (EitherTable Expr i i' -> Nullify Expr i')
-> Aggregator' 'Semi (Nullify Expr i') (Nullify Expr b)
-> Aggregator' 'Semi (EitherTable Expr i i') (Nullify Expr b)
forall a b c.
(a -> b) -> Aggregator' 'Semi b c -> Aggregator' 'Semi a c
forall (p :: * -> Context) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap EitherTable Expr i i' -> Nullify Expr i'
forall (context :: Context) a b.
EitherTable context a b -> Nullify context b
right (Aggregator' fold' (Nullify Expr i') (Nullify Expr b)
-> Aggregator' 'Semi (Nullify Expr i') (Nullify Expr b)
forall (fold :: Fold) i a. Aggregator' fold i a -> Aggregator1 i a
toAggregator1 (Aggregator' fold' i' b
-> Aggregator' fold' (Nullify Expr i') (Nullify Expr b)
forall (fold :: Fold) i a.
Aggregator' fold i a
-> Aggregator' fold (Nullify Expr i) (Nullify Expr a)
aggregateNullify Aggregator' fold' i' b
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 = Name EitherTag
-> Nullify Name a -> Nullify Name b -> EitherTable Name a b
forall (context :: Context) a b.
context EitherTag
-> Nullify context a
-> Nullify context b
-> EitherTable context a b
EitherTable Name EitherTag
tag (a -> Nullify Name a
forall a. a -> Nullify Name a
forall (f :: Context) a. Applicative f => a -> f a
pure a
left) (b -> Nullify Name b
forall a. a -> Nullify Name a
forall (f :: Context) a. Applicative f => a -> f a
pure b
right)