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

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

module Rel8.Table.These
  ( TheseTable(..)
  , theseTable, thisTable, thatTable, thoseTable
  , isThisTable, isThatTable, isThoseTable
  , hasHereTable, hasThereTable
  , justHereTable, justThereTable
  , alignMaybeTable
  , aggregateTheseTable
  , nameTheseTable
  )
where

-- base
import Data.Bifunctor ( Bifunctor, bimap )
import Data.Kind ( Type )
import Data.Maybe ( isJust )
import Prelude hiding ( null, undefined )

-- rel8
import Rel8.Aggregate ( Aggregate )
import Rel8.Expr ( Expr )
import Rel8.Expr.Bool ( (&&.), (||.), boolExpr, not_ )
import Rel8.Expr.Null ( null, isNonNull )
import Rel8.Kind.Context ( Reifiable )
import Rel8.Schema.Context.Nullify ( Nullifiable )
import Rel8.Schema.Dict ( Dict( Dict ) )
import Rel8.Schema.HTable.Label ( hlabel, hrelabel, hunlabel )
import Rel8.Schema.HTable.Identity ( HIdentity(..) )
import Rel8.Schema.HTable.Maybe ( HMaybeTable(..) )
import Rel8.Schema.HTable.These ( HTheseTable(..) )
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.Eq ( EqTable, eqTable )
import Rel8.Table.Maybe
  ( MaybeTable(..)
  , maybeTable, justTable, nothingTable
  , isJustTable
  , aggregateMaybeTable
  , nameMaybeTable
  )
import Rel8.Table.Nullify ( Nullify, 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 ( MaybeTag )

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

-- these
import Data.These ( These( This, That, These ) )
import Data.These.Combinators ( justHere, justThere )


-- | @TheseTable a b@ is a Rel8 table that contains either the table @a@, the
-- table @b@, or both tables @a@ and @b@. You can construct @TheseTable@s using
-- 'thisTable', 'thatTable' and 'thoseTable'. @TheseTable@s can be
-- eliminated/pattern matched using 'theseTable'.
--
-- @TheseTable@ is operationally the same as Haskell's 'These' type, but
-- adapted to work with Rel8.
type TheseTable :: K.Context -> Type -> Type -> Type
data TheseTable context a b = TheseTable
  { forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context a
here :: MaybeTable context a
  , forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context b
there :: MaybeTable context b
  }
  deriving stock forall a b. a -> TheseTable context a b -> TheseTable context a a
forall a b.
(a -> b) -> TheseTable context a a -> TheseTable 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 -> TheseTable context a b -> TheseTable context a a
forall (context :: * -> *) a a b.
Nullifiable context =>
(a -> b) -> TheseTable context a a -> TheseTable context a b
<$ :: forall a b. a -> TheseTable context a b -> TheseTable context a a
$c<$ :: forall (context :: * -> *) a a b.
Nullifiable context =>
a -> TheseTable context a b -> TheseTable context a a
fmap :: forall a b.
(a -> b) -> TheseTable context a a -> TheseTable context a b
$cfmap :: forall (context :: * -> *) a a b.
Nullifiable context =>
(a -> b) -> TheseTable context a a -> TheseTable context a b
Functor


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


instance Nullifiable context => Bifunctor (TheseTable context) where
  bimap :: forall a b c d.
(a -> b)
-> (c -> d) -> TheseTable context a c -> TheseTable context b d
bimap a -> b
f c -> d
g (TheseTable MaybeTable context a
a MaybeTable context c
b) = forall (context :: * -> *) a b.
MaybeTable context a
-> MaybeTable context b -> TheseTable context a b
TheseTable (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f MaybeTable context a
a) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g MaybeTable context c
b)


instance Projectable (TheseTable context a) where
  project :: forall a b.
Projecting a b =>
Projection a b -> TheseTable context a a -> TheseTable context a b
project Projection a b
f (TheseTable MaybeTable context a
a MaybeTable context a
b) = forall (context :: * -> *) a b.
MaybeTable context a
-> MaybeTable context b -> TheseTable context a b
TheseTable MaybeTable context a
a (forall (f :: * -> *) a b.
(Projectable f, Projecting a b) =>
Projection a b -> f a -> f b
project Projection a b
f MaybeTable context a
b)


instance (context ~ Expr, Table Expr a, Semigroup a) =>
  Apply (TheseTable context a)
 where
  TheseTable context a (a -> b)
fs <.> :: forall a b.
TheseTable context a (a -> b)
-> TheseTable context a a -> TheseTable context a b
<.> TheseTable context a a
as = TheseTable
    { here :: MaybeTable context a
here = forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context a
here TheseTable context a (a -> b)
fs forall a. Semigroup a => a -> a -> a
<> forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context a
here TheseTable context a a
as
    , there :: MaybeTable context b
there = forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context b
there TheseTable context a (a -> b)
fs forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context b
there TheseTable context a a
as
    }


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


instance (context ~ Expr, Table Expr a, Semigroup a) =>
  Bind (TheseTable context a)
 where
  TheseTable MaybeTable context a
here1 MaybeTable context a
ma >>- :: forall a b.
TheseTable context a a
-> (a -> TheseTable context a b) -> TheseTable context a b
>>- a -> TheseTable context a b
f = case MaybeTable context a
ma forall (m :: * -> *) a b. Bind m => m a -> (a -> m b) -> m b
>>- a -> MaybeTable context (MaybeTable context a, b)
f' of
    MaybeTable context (MaybeTable context a, b)
mtb -> TheseTable
      { here :: MaybeTable context a
here = forall b a. Table Expr b => b -> (a -> b) -> MaybeTable Expr a -> b
maybeTable MaybeTable context a
here1 ((MaybeTable context a
here1 forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) MaybeTable context (MaybeTable context a, b)
mtb
      , there :: MaybeTable context b
there = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeTable context (MaybeTable context a, b)
mtb
      }
    where
      f' :: a -> MaybeTable context (MaybeTable context a, b)
f' a
a = case a -> TheseTable context a b
f a
a of
        TheseTable MaybeTable context a
here2 MaybeTable context b
mb -> (MaybeTable context a
here2,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeTable context b
mb


instance (context ~ Expr, Table Expr a, Semigroup a) =>
  Monad (TheseTable context a)
 where
  >>= :: forall a b.
TheseTable context a a
-> (a -> TheseTable context a b) -> TheseTable 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 a, Semigroup b) =>
  Semigroup (TheseTable context a b)
 where
  TheseTable context a b
a <> :: TheseTable context a b
-> TheseTable context a b -> TheseTable context a b
<> TheseTable context a b
b = TheseTable
    { here :: MaybeTable context a
here = forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context a
here TheseTable context a b
a forall a. Semigroup a => a -> a -> a
<> forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context a
here TheseTable context a b
b
    , there :: MaybeTable context b
there = forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context b
there TheseTable context a b
a forall a. Semigroup a => a -> a -> a
<> forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context b
there TheseTable context a b
b
    }


instance
  ( Table context a, Table context b
  , Reifiable context, context ~ context'
  )
  => Table context' (TheseTable context a b)
 where
  type Columns (TheseTable context a b) = HTheseTable (Columns a) (Columns b)
  type Context (TheseTable context a b) = Context a
  type FromExprs (TheseTable context a b) =
    These (FromExprs a) (FromExprs b)
  type Transpose to (TheseTable context a b) =
    TheseTable to (Transpose to a) (Transpose to b)

  toColumns :: TheseTable context a b -> Columns (TheseTable context a b) context'
toColumns TheseTable {MaybeTable context a
here :: MaybeTable context a
here :: forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context a
here, MaybeTable context b
there :: MaybeTable context b
there :: forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context b
there} = HTheseTable
    { hhereTag :: HLabel "hereTag" (HIdentity (Maybe MaybeTag)) context
hhereTag = 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 forall a b. (a -> b) -> a -> b
$ forall (context :: * -> *) a.
MaybeTable context a -> context (Maybe MaybeTag)
tag MaybeTable context a
here
    , hhere :: HLabel "Here" (HNullify (Columns a)) context
hhere =
        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 (forall (context :: * -> *) a.
MaybeTable context a -> context (Maybe MaybeTag)
tag MaybeTable context a
here) forall a. Maybe a -> Bool
isJust forall a. Expr (Maybe a) -> Expr Bool
isNonNull forall a b. (a -> b) -> a -> b
$ forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns forall a b. (a -> b) -> a -> b
$ forall (context :: * -> *) a.
MaybeTable context a -> Nullify context a
just MaybeTable context a
here
    , hthereTag :: HLabel "thereTag" (HIdentity (Maybe MaybeTag)) context
hthereTag = 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 forall a b. (a -> b) -> a -> b
$ forall (context :: * -> *) a.
MaybeTable context a -> context (Maybe MaybeTag)
tag MaybeTable context b
there
    , hthere :: HLabel "There" (HNullify (Columns b)) context
hthere =
        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 (forall (context :: * -> *) a.
MaybeTable context a -> context (Maybe MaybeTag)
tag MaybeTable context b
there) forall a. Maybe a -> Bool
isJust forall a. Expr (Maybe a) -> Expr Bool
isNonNull forall a b. (a -> b) -> a -> b
$ forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns forall a b. (a -> b) -> a -> b
$ forall (context :: * -> *) a.
MaybeTable context a -> Nullify context a
just MaybeTable context b
there
    }

  fromColumns :: Columns (TheseTable context a b) context' -> TheseTable context a b
fromColumns HTheseTable {HLabel "hereTag" (HIdentity (Maybe MaybeTag)) context
hhereTag :: HLabel "hereTag" (HIdentity (Maybe MaybeTag)) context
hhereTag :: forall (here :: HTable) (there :: HTable) (context :: * -> *).
HTheseTable here there context
-> HLabel "hereTag" (HIdentity (Maybe MaybeTag)) context
hhereTag, HLabel "Here" (HNullify (Columns a)) context
hhere :: HLabel "Here" (HNullify (Columns a)) context
hhere :: forall (here :: HTable) (there :: HTable) (context :: * -> *).
HTheseTable here there context
-> HLabel "Here" (HNullify here) context
hhere, HLabel "thereTag" (HIdentity (Maybe MaybeTag)) context
hthereTag :: HLabel "thereTag" (HIdentity (Maybe MaybeTag)) context
hthereTag :: forall (here :: HTable) (there :: HTable) (context :: * -> *).
HTheseTable here there context
-> HLabel "thereTag" (HIdentity (Maybe MaybeTag)) context
hthereTag, HLabel "There" (HNullify (Columns b)) context
hthere :: HLabel "There" (HNullify (Columns b)) context
hthere :: forall (here :: HTable) (there :: HTable) (context :: * -> *).
HTheseTable here there context
-> HLabel "There" (HNullify there) context
hthere} = TheseTable
    { here :: MaybeTable context a
here = MaybeTable
        { tag :: context (Maybe MaybeTag)
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 "hereTag" (HIdentity (Maybe MaybeTag)) context
hhereTag
        , just :: Nullify context a
just = 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 "Here" (HNullify (Columns a)) context
hhere
        }
    , there :: MaybeTable context b
there = MaybeTable
        { tag :: context (Maybe MaybeTag)
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 "thereTag" (HIdentity (Maybe MaybeTag)) context
hthereTag
        , just :: Nullify context b
just = 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 "There" (HNullify (Columns b)) context
hthere
        }
    }

  toResult :: FromExprs (TheseTable context a b)
-> Columns (TheseTable context a b) Result
toResult FromExprs (TheseTable context a b)
tables = HTheseTable
    { hhereTag :: HLabel "hereTag" (HIdentity (Maybe MaybeTag)) Result
hhereTag = forall (label' :: Symbol) (label :: Symbol) (t :: HTable)
       (context :: * -> *).
HLabel label t context -> HLabel label' t context
hrelabel HLabel "isJust" (HIdentity (Maybe MaybeTag)) Result
hhereTag
    , hhere :: HLabel "Here" (HNullify (Columns a)) Result
hhere = forall (label' :: Symbol) (label :: Symbol) (t :: HTable)
       (context :: * -> *).
HLabel label t context -> HLabel label' t context
hrelabel HLabel "Just" (HNullify (Columns a)) Result
hhere
    , hthereTag :: HLabel "thereTag" (HIdentity (Maybe MaybeTag)) Result
hthereTag = forall (label' :: Symbol) (label :: Symbol) (t :: HTable)
       (context :: * -> *).
HLabel label t context -> HLabel label' t context
hrelabel HLabel "isJust" (HIdentity (Maybe MaybeTag)) Result
hthereTag
    , hthere :: HLabel "There" (HNullify (Columns b)) Result
hthere = forall (label' :: Symbol) (label :: Symbol) (t :: HTable)
       (context :: * -> *).
HLabel label t context -> HLabel label' t context
hrelabel HLabel "Just" (HNullify (Columns b)) Result
hthere
    }
    where
      HMaybeTable
        { htag :: forall (table :: HTable) (context :: * -> *).
HMaybeTable table context
-> HLabel "isJust" (HIdentity (Maybe MaybeTag)) context
htag = HLabel "isJust" (HIdentity (Maybe MaybeTag)) Result
hhereTag
        , hjust :: forall (table :: HTable) (context :: * -> *).
HMaybeTable table context -> HLabel "Just" (HNullify table) context
hjust = HLabel "Just" (HNullify (Columns a)) Result
hhere
        } = forall (context :: * -> *) a.
Table context a =>
FromExprs a -> Columns a Result
toResult @_ @(MaybeTable context a) (forall a b. These a b -> Maybe a
justHere FromExprs (TheseTable context a b)
tables)
      HMaybeTable
        { htag :: forall (table :: HTable) (context :: * -> *).
HMaybeTable table context
-> HLabel "isJust" (HIdentity (Maybe MaybeTag)) context
htag = HLabel "isJust" (HIdentity (Maybe MaybeTag)) Result
hthereTag
        , hjust :: forall (table :: HTable) (context :: * -> *).
HMaybeTable table context -> HLabel "Just" (HNullify table) context
hjust = HLabel "Just" (HNullify (Columns b)) Result
hthere
        } = forall (context :: * -> *) a.
Table context a =>
FromExprs a -> Columns a Result
toResult @_ @(MaybeTable context b) (forall a b. These a b -> Maybe b
justThere FromExprs (TheseTable context a b)
tables)

  fromResult :: Columns (TheseTable context a b) Result
-> FromExprs (TheseTable context a b)
fromResult HTheseTable {HLabel "hereTag" (HIdentity (Maybe MaybeTag)) Result
hhereTag :: HLabel "hereTag" (HIdentity (Maybe MaybeTag)) Result
hhereTag :: forall (here :: HTable) (there :: HTable) (context :: * -> *).
HTheseTable here there context
-> HLabel "hereTag" (HIdentity (Maybe MaybeTag)) context
hhereTag, HLabel "Here" (HNullify (Columns a)) Result
hhere :: HLabel "Here" (HNullify (Columns a)) Result
hhere :: forall (here :: HTable) (there :: HTable) (context :: * -> *).
HTheseTable here there context
-> HLabel "Here" (HNullify here) context
hhere, HLabel "thereTag" (HIdentity (Maybe MaybeTag)) Result
hthereTag :: HLabel "thereTag" (HIdentity (Maybe MaybeTag)) Result
hthereTag :: forall (here :: HTable) (there :: HTable) (context :: * -> *).
HTheseTable here there context
-> HLabel "thereTag" (HIdentity (Maybe MaybeTag)) context
hthereTag, HLabel "There" (HNullify (Columns b)) Result
hthere :: HLabel "There" (HNullify (Columns b)) Result
hthere :: forall (here :: HTable) (there :: HTable) (context :: * -> *).
HTheseTable here there context
-> HLabel "There" (HNullify there) context
hthere} =
    case (FromExprs (MaybeTable context a)
here, FromExprs (MaybeTable context b)
there) of
      (Just FromExprs a
a, Maybe (FromExprs b)
Nothing) -> forall a b. a -> These a b
This FromExprs a
a
      (Maybe (FromExprs a)
Nothing, Just FromExprs b
b) -> forall a b. b -> These a b
That FromExprs b
b
      (Just FromExprs a
a, Just FromExprs b
b) -> forall a b. a -> b -> These a b
These FromExprs a
a FromExprs b
b
      (Maybe (FromExprs a), Maybe (FromExprs b))
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"These.fromColumns: mismatch between tags and data"
    where
      here :: FromExprs (MaybeTable context a)
here = forall (context :: * -> *) a.
Table context a =>
Columns a Result -> FromExprs a
fromResult @_ @(MaybeTable context a) HMaybeTable (Columns a) Result
mhere
      there :: FromExprs (MaybeTable context b)
there = forall (context :: * -> *) a.
Table context a =>
Columns a Result -> FromExprs a
fromResult @_ @(MaybeTable context b) HMaybeTable (Columns b) Result
mthere
      mhere :: HMaybeTable (Columns a) Result
mhere = HMaybeTable
        { htag :: HLabel "isJust" (HIdentity (Maybe MaybeTag)) Result
htag = forall (label' :: Symbol) (label :: Symbol) (t :: HTable)
       (context :: * -> *).
HLabel label t context -> HLabel label' t context
hrelabel HLabel "hereTag" (HIdentity (Maybe MaybeTag)) Result
hhereTag
        , hjust :: HLabel "Just" (HNullify (Columns a)) Result
hjust = forall (label' :: Symbol) (label :: Symbol) (t :: HTable)
       (context :: * -> *).
HLabel label t context -> HLabel label' t context
hrelabel HLabel "Here" (HNullify (Columns a)) Result
hhere
        }
      mthere :: HMaybeTable (Columns b) Result
mthere = HMaybeTable
        { htag :: HLabel "isJust" (HIdentity (Maybe MaybeTag)) Result
htag = forall (label' :: Symbol) (label :: Symbol) (t :: HTable)
       (context :: * -> *).
HLabel label t context -> HLabel label' t context
hrelabel HLabel "thereTag" (HIdentity (Maybe MaybeTag)) Result
hthereTag
        , hjust :: HLabel "Just" (HNullify (Columns b)) Result
hjust = forall (label' :: Symbol) (label :: Symbol) (t :: HTable)
       (context :: * -> *).
HLabel label t context -> HLabel label' t context
hrelabel HLabel "There" (HNullify (Columns b)) Result
hthere
        }


instance (EqTable a, EqTable b, context ~ Expr) =>
  EqTable (TheseTable context a b)
 where
  eqTable :: Columns (TheseTable context a b) (Dict (Sql DBEq))
eqTable = HTheseTable
    { hhereTag :: HLabel "hereTag" (HIdentity (Maybe MaybeTag)) (Dict (Sql DBEq))
hhereTag = 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)
    , hhere :: HLabel "Here" (HNullify (Columns a)) (Dict (Sql DBEq))
hhere = 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))
    , hthereTag :: HLabel "thereTag" (HIdentity (Maybe MaybeTag)) (Dict (Sql DBEq))
hthereTag = 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)
    , hthere :: HLabel "There" (HNullify (Columns b)) (Dict (Sql DBEq))
hthere = 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 (TheseTable context a b)
 where
  ordTable :: Columns (TheseTable context a b) (Dict (Sql DBOrd))
ordTable = HTheseTable
    { hhereTag :: HLabel "hereTag" (HIdentity (Maybe MaybeTag)) (Dict (Sql DBOrd))
hhereTag = 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)
    , hhere :: HLabel "Here" (HNullify (Columns a)) (Dict (Sql DBOrd))
hhere = 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))
    , hthereTag :: HLabel "thereTag" (HIdentity (Maybe MaybeTag)) (Dict (Sql DBOrd))
hthereTag = 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)
    , hthere :: HLabel "There" (HNullify (Columns b)) (Dict (Sql DBOrd))
hthere = 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 ~ TheseTable Expr exprs1 exprs2) =>
  ToExprs x (These a b)


-- | Test if a 'TheseTable' was constructed with 'thisTable'.
--
-- Corresponds to 'Data.These.Combinators.isThis'.
isThisTable :: TheseTable Expr a b -> Expr Bool
isThisTable :: forall a b. TheseTable Expr a b -> Expr Bool
isThisTable TheseTable Expr a b
a = forall a b. TheseTable Expr a b -> Expr Bool
hasHereTable TheseTable Expr a b
a Expr Bool -> Expr Bool -> Expr Bool
&&. Expr Bool -> Expr Bool
not_ (forall a b. TheseTable Expr a b -> Expr Bool
hasThereTable TheseTable Expr a b
a)


-- | Test if a 'TheseTable' was constructed with 'thatTable'.
--
-- Corresponds to 'Data.These.Combinators.isThat'.
isThatTable :: TheseTable Expr a b -> Expr Bool
isThatTable :: forall a b. TheseTable Expr a b -> Expr Bool
isThatTable TheseTable Expr a b
a = Expr Bool -> Expr Bool
not_ (forall a b. TheseTable Expr a b -> Expr Bool
hasHereTable TheseTable Expr a b
a) Expr Bool -> Expr Bool -> Expr Bool
&&. forall a b. TheseTable Expr a b -> Expr Bool
hasThereTable TheseTable Expr a b
a


-- | Test if a 'TheseTable' was constructed with 'thoseTable'.
--
-- Corresponds to 'Data.These.Combinators.isThese'.
isThoseTable :: TheseTable Expr a b -> Expr Bool
isThoseTable :: forall a b. TheseTable Expr a b -> Expr Bool
isThoseTable TheseTable Expr a b
a = forall a b. TheseTable Expr a b -> Expr Bool
hasHereTable TheseTable Expr a b
a Expr Bool -> Expr Bool -> Expr Bool
&&. forall a b. TheseTable Expr a b -> Expr Bool
hasThereTable TheseTable Expr a b
a


-- | Test if the @a@ side of @TheseTable a b@ is present.
--
-- Corresponds to 'Data.These.Combinators.hasHere'.
hasHereTable :: TheseTable Expr a b -> Expr Bool
hasHereTable :: forall a b. TheseTable Expr a b -> Expr Bool
hasHereTable TheseTable {MaybeTable Expr a
here :: MaybeTable Expr a
here :: forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context a
here} = forall a. MaybeTable Expr a -> Expr Bool
isJustTable MaybeTable Expr a
here


-- | Test if the @b@ table of @TheseTable a b@ is present.
--
-- Corresponds to 'Data.These.Combinators.hasThere'.
hasThereTable :: TheseTable Expr a b -> Expr Bool
hasThereTable :: forall a b. TheseTable Expr a b -> Expr Bool
hasThereTable TheseTable {MaybeTable Expr b
there :: MaybeTable Expr b
there :: forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context b
there} = forall a. MaybeTable Expr a -> Expr Bool
isJustTable MaybeTable Expr b
there


-- | Attempt to project out the @a@ table of a @TheseTable a b@.
--
-- Corresponds to 'Data.These.Combinators.justHere'.
justHereTable :: TheseTable context a b -> MaybeTable context a
justHereTable :: forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context a
justHereTable = forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context a
here


-- | Attempt to project out the @b@ table of a @TheseTable a b@.
--
-- Corresponds to 'Data.These.Combinators.justThere'.
justThereTable :: TheseTable context a b -> MaybeTable context b
justThereTable :: forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context b
justThereTable = forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context b
there


-- | Construct a @TheseTable@ from two 'MaybeTable's.
alignMaybeTable :: ()
  => MaybeTable Expr a
  -> MaybeTable Expr b
  -> MaybeTable Expr (TheseTable Expr a b)
alignMaybeTable :: forall a b.
MaybeTable Expr a
-> MaybeTable Expr b -> MaybeTable Expr (TheseTable Expr a b)
alignMaybeTable MaybeTable Expr a
a MaybeTable Expr b
b = forall (context :: * -> *) a.
context (Maybe MaybeTag)
-> Nullify context a -> MaybeTable context a
MaybeTable Expr (Maybe MaybeTag)
tag (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (context :: * -> *) a b.
MaybeTable context a
-> MaybeTable context b -> TheseTable context a b
TheseTable MaybeTable Expr a
a MaybeTable Expr b
b))
  where
    tag :: Expr (Maybe MaybeTag)
tag = forall a. Expr a -> Expr a -> Expr Bool -> Expr a
boolExpr forall a. DBType a => Expr (Maybe a)
null forall a. Monoid a => a
mempty (forall a. MaybeTable Expr a -> Expr Bool
isJustTable MaybeTable Expr a
a Expr Bool -> Expr Bool -> Expr Bool
||. forall a. MaybeTable Expr a -> Expr Bool
isJustTable MaybeTable Expr b
b)


-- | Construct a @TheseTable@. Corresponds to 'This'.
thisTable :: Table Expr b => a -> TheseTable Expr a b
thisTable :: forall b a. Table Expr b => a -> TheseTable Expr a b
thisTable a
a = forall (context :: * -> *) a b.
MaybeTable context a
-> MaybeTable context b -> TheseTable context a b
TheseTable (forall a. a -> MaybeTable Expr a
justTable a
a) forall a. Table Expr a => MaybeTable Expr a
nothingTable


-- | Construct a @TheseTable@. Corresponds to 'That'.
thatTable :: Table Expr a => b -> TheseTable Expr a b
thatTable :: forall a b. Table Expr a => b -> TheseTable Expr a b
thatTable b
b = forall (context :: * -> *) a b.
MaybeTable context a
-> MaybeTable context b -> TheseTable context a b
TheseTable forall a. Table Expr a => MaybeTable Expr a
nothingTable (forall a. a -> MaybeTable Expr a
justTable b
b)


-- | Construct a @TheseTable@. Corresponds to 'These'.
thoseTable :: a -> b -> TheseTable Expr a b
thoseTable :: forall a b. a -> b -> TheseTable Expr a b
thoseTable a
a b
b = forall (context :: * -> *) a b.
MaybeTable context a
-> MaybeTable context b -> TheseTable context a b
TheseTable (forall a. a -> MaybeTable Expr a
justTable a
a) (forall a. a -> MaybeTable Expr a
justTable b
b)


-- | Pattern match on a 'TheseTable'. Corresponds to 'these'.
theseTable :: Table Expr c
  => (a -> c) -> (b -> c) -> (a -> b -> c) -> TheseTable Expr a b -> c
theseTable :: forall c a b.
Table Expr c =>
(a -> c) -> (b -> c) -> (a -> b -> c) -> TheseTable Expr a b -> c
theseTable a -> c
f b -> c
g a -> b -> c
h TheseTable {MaybeTable Expr a
here :: MaybeTable Expr a
here :: forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context a
here, MaybeTable Expr b
there :: MaybeTable Expr b
there :: forall (context :: * -> *) a b.
TheseTable context a b -> MaybeTable context b
there} =
  forall b a. Table Expr b => b -> (a -> b) -> MaybeTable Expr a -> b
maybeTable
    (forall b a. Table Expr b => b -> (a -> b) -> MaybeTable Expr a -> b
maybeTable forall a. Table Expr a => a
undefined a -> c
f MaybeTable Expr a
here)
    (\b
b -> forall b a. Table Expr b => b -> (a -> b) -> MaybeTable Expr a -> b
maybeTable (b -> c
g b
b) (a -> b -> c
`h` b
b) MaybeTable Expr a
here)
    MaybeTable Expr b
there


-- | Lift a pair of aggregating functions to operate on an 'TheseTable'.
-- @thisTable@s, @thatTable@s and @thoseTable@s are grouped separately.
aggregateTheseTable :: ()
  => (exprs -> aggregates)
  -> (exprs' -> aggregates')
  -> TheseTable Expr exprs exprs'
  -> TheseTable Aggregate aggregates aggregates'
aggregateTheseTable :: forall exprs aggregates exprs' aggregates'.
(exprs -> aggregates)
-> (exprs' -> aggregates')
-> TheseTable Expr exprs exprs'
-> TheseTable Aggregate aggregates aggregates'
aggregateTheseTable exprs -> aggregates
f exprs' -> aggregates'
g (TheseTable MaybeTable Expr exprs
here MaybeTable Expr exprs'
there) = TheseTable
  { here :: MaybeTable Aggregate aggregates
here = forall exprs aggregates.
(exprs -> aggregates)
-> MaybeTable Expr exprs -> MaybeTable Aggregate aggregates
aggregateMaybeTable exprs -> aggregates
f MaybeTable Expr exprs
here
  , there :: MaybeTable Aggregate aggregates'
there = forall exprs aggregates.
(exprs -> aggregates)
-> MaybeTable Expr exprs -> MaybeTable Aggregate aggregates
aggregateMaybeTable exprs' -> aggregates'
g MaybeTable Expr exprs'
there
  }


-- | Construct a 'TheseTable' in the 'Name' context. This can be useful if you
-- have a 'TheseTable' that you are storing in a table and need to construct a
-- 'TableSchema'.
nameTheseTable :: ()
  => Name (Maybe MaybeTag)
     -- ^ The name of the column to track the presence of the @a@ table.
  -> Name (Maybe MaybeTag)
     -- ^ The name of the column to track the presence of the @b@ table.
  -> a
     -- ^ Names of the columns in the @a@ table.
  -> b
     -- ^ Names of the columns in the @b@ table.
  -> TheseTable Name a b
nameTheseTable :: forall a b.
Name (Maybe MaybeTag)
-> Name (Maybe MaybeTag) -> a -> b -> TheseTable Name a b
nameTheseTable Name (Maybe MaybeTag)
here Name (Maybe MaybeTag)
there a
a b
b =
  TheseTable
    { here :: MaybeTable Name a
here = forall a. Name (Maybe MaybeTag) -> a -> MaybeTable Name a
nameMaybeTable Name (Maybe MaybeTag)
here a
a
    , there :: MaybeTable Name b
there = forall a. Name (Maybe MaybeTag) -> a -> MaybeTable Name a
nameMaybeTable Name (Maybe MaybeTag)
there b
b
    }