{-# 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
  , nameEitherTable
  )
where

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

-- rel8
import Rel8.Expr ( Expr )
import Rel8.Expr.Serialize ( litExpr )
import Rel8.Schema.Context.Label
  ( Labelable
  , HLabelable, hlabeler, hunlabeler
  )
import Rel8.Schema.Context.Nullify
  ( Nullifiable, ConstrainTag
  , HNullifiable, HConstrainTag
  , hencodeTag, hdecodeTag
  , hnullifier, hunnullifier
  )
import Rel8.Schema.HTable ( HTable )
import Rel8.Schema.HTable.Either ( HEitherTable(..) )
import Rel8.Schema.HTable.Identity ( HIdentity(..) )
import Rel8.Schema.HTable.Label ( hlabel, hunlabel )
import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )
import Rel8.Schema.Name ( Name )
import Rel8.Table
  ( Table, Columns, Context, fromColumns, toColumns
  , reify, unreify
  )
import Rel8.Table.Bool ( bool )
import Rel8.Table.Eq ( EqTable, eqTable )
import Rel8.Table.Ord ( OrdTable, ordTable )
import Rel8.Table.Recontextualize ( Recontextualize )
import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
import Rel8.Table.Tag ( Tag(..), fromExpr, fromName )
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 :: Type -> Type -> Type
data EitherTable a b = EitherTable
  { EitherTable a b -> Tag "isRight" EitherTag
tag :: Tag "isRight" EitherTag
  , EitherTable a b -> a
left :: a
  , EitherTable a b -> b
right :: b
  }
  deriving stock a -> EitherTable a b -> EitherTable a a
(a -> b) -> EitherTable a a -> EitherTable a b
(forall a b. (a -> b) -> EitherTable a a -> EitherTable a b)
-> (forall a b. a -> EitherTable a b -> EitherTable a a)
-> Functor (EitherTable a)
forall a b. a -> EitherTable a b -> EitherTable a a
forall a b. (a -> b) -> EitherTable a a -> EitherTable a b
forall a a b. a -> EitherTable a b -> EitherTable a a
forall a a b. (a -> b) -> EitherTable a a -> EitherTable a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> EitherTable a b -> EitherTable a a
$c<$ :: forall a a b. a -> EitherTable a b -> EitherTable a a
fmap :: (a -> b) -> EitherTable a a -> EitherTable a b
$cfmap :: forall a a b. (a -> b) -> EitherTable a a -> EitherTable a b
Functor


instance Bifunctor EitherTable where
  bimap :: (a -> b) -> (c -> d) -> EitherTable a c -> EitherTable b d
bimap a -> b
f c -> d
g (EitherTable Tag "isRight" EitherTag
tag a
a c
b) = Tag "isRight" EitherTag -> b -> d -> EitherTable b d
forall a b. Tag "isRight" EitherTag -> a -> b -> EitherTable a b
EitherTable Tag "isRight" EitherTag
tag (a -> b
f a
a) (c -> d
g c
b)


instance Table Expr a => Apply (EitherTable a) where
  EitherTable Tag "isRight" EitherTag
tag a
l1 a -> b
f <.> :: EitherTable a (a -> b) -> EitherTable a a -> EitherTable a b
<.> EitherTable Tag "isRight" EitherTag
tag' a
l2 a
a =
    Tag "isRight" EitherTag -> a -> b -> EitherTable a b
forall a b. Tag "isRight" EitherTag -> a -> b -> EitherTable a b
EitherTable (Tag "isRight" EitherTag
tag Tag "isRight" EitherTag
-> Tag "isRight" EitherTag -> Tag "isRight" EitherTag
forall a. Semigroup a => a -> a -> a
<> Tag "isRight" EitherTag
tag') (a -> a -> Expr Bool -> a
forall a. Table Expr a => a -> a -> Expr Bool -> a
bool a
l1 a
l2 (Expr EitherTag -> Expr Bool
isLeft (Tag "isRight" EitherTag -> Expr EitherTag
forall (label :: Symbol) a. Tag label a -> Expr a
expr Tag "isRight" EitherTag
tag))) (a -> b
f a
a)


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


instance Table Expr a => Bind (EitherTable a) where
  EitherTable Tag "isRight" EitherTag
tag a
l1 a
a >>- :: EitherTable a a -> (a -> EitherTable a b) -> EitherTable a b
>>- a -> EitherTable a b
f = case a -> EitherTable a b
f a
a of
    EitherTable Tag "isRight" EitherTag
tag' a
l2 b
b ->
      Tag "isRight" EitherTag -> a -> b -> EitherTable a b
forall a b. Tag "isRight" EitherTag -> a -> b -> EitherTable a b
EitherTable (Tag "isRight" EitherTag
tag Tag "isRight" EitherTag
-> Tag "isRight" EitherTag -> Tag "isRight" EitherTag
forall a. Semigroup a => a -> a -> a
<> Tag "isRight" EitherTag
tag') (a -> a -> Expr Bool -> a
forall a. Table Expr a => a -> a -> Expr Bool -> a
bool a
l1 a
l2 (Expr EitherTag -> Expr Bool
isRight (Tag "isRight" EitherTag -> Expr EitherTag
forall (label :: Symbol) a. Tag label a -> Expr a
expr Tag "isRight" EitherTag
tag))) b
b


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


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


instance
  ( Table context a, Table context b
  , Labelable context, Nullifiable context, ConstrainTag context EitherTag
  ) =>
  Table context (EitherTable a b)
 where
  type Columns (EitherTable a b) = HEitherTable (Columns a) (Columns b)
  type Context (EitherTable a b) = Context a

  toColumns :: EitherTable a b -> Columns (EitherTable a b) (Col context)
toColumns = (a -> Columns a (Col context))
-> (b -> Columns b (Col context))
-> EitherTable a b
-> HEitherTable (Columns a) (Columns b) (Col context)
forall (t :: HTable) (u :: HTable) (context :: HContext) a b.
(HTable t, HTable u, HConstrainTag context EitherTag,
 HLabelable context, HNullifiable context) =>
(a -> t context)
-> (b -> u context) -> EitherTable a b -> HEitherTable t u context
toColumns2 a -> Columns a (Col context)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns b -> Columns b (Col context)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns
  fromColumns :: Columns (EitherTable a b) (Col context) -> EitherTable a b
fromColumns = (Columns a (Col context) -> a)
-> (Columns b (Col context) -> b)
-> HEitherTable (Columns a) (Columns b) (Col context)
-> EitherTable a b
forall (t :: HTable) (u :: HTable) (context :: HContext) a b.
(HTable t, HTable u, HConstrainTag context EitherTag,
 HLabelable context, HNullifiable context) =>
(t context -> a)
-> (u context -> b) -> HEitherTable t u context -> EitherTable a b
fromColumns2 Columns a (Col context) -> a
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns Columns b (Col context) -> b
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns
  reify :: (context :~: Reify ctx)
-> Unreify (EitherTable a b) -> EitherTable a b
reify = ((Unreify a -> a)
 -> (Unreify b -> b)
 -> EitherTable (Unreify a) (Unreify b)
 -> EitherTable a b)
-> ((context :~: Reify ctx) -> Unreify a -> a)
-> ((context :~: Reify ctx) -> Unreify b -> b)
-> (context :~: Reify ctx)
-> EitherTable (Unreify a) (Unreify b)
-> EitherTable a b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (Unreify a -> a)
-> (Unreify b -> b)
-> EitherTable (Unreify a) (Unreify b)
-> EitherTable a b
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (context :~: Reify ctx) -> Unreify a -> a
forall (context :: Context) a (ctx :: Context).
Table context a =>
(context :~: Reify ctx) -> Unreify a -> a
reify (context :~: Reify ctx) -> Unreify b -> b
forall (context :: Context) a (ctx :: Context).
Table context a =>
(context :~: Reify ctx) -> Unreify a -> a
reify
  unreify :: (context :~: Reify ctx)
-> EitherTable a b -> Unreify (EitherTable a b)
unreify = ((a -> Unreify a)
 -> (b -> Unreify b)
 -> EitherTable a b
 -> EitherTable (Unreify a) (Unreify b))
-> ((context :~: Reify ctx) -> a -> Unreify a)
-> ((context :~: Reify ctx) -> b -> Unreify b)
-> (context :~: Reify ctx)
-> EitherTable a b
-> EitherTable (Unreify a) (Unreify b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (a -> Unreify a)
-> (b -> Unreify b)
-> EitherTable a b
-> EitherTable (Unreify a) (Unreify b)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (context :~: Reify ctx) -> a -> Unreify a
forall (context :: Context) a (ctx :: Context).
Table context a =>
(context :~: Reify ctx) -> a -> Unreify a
unreify (context :~: Reify ctx) -> b -> Unreify b
forall (context :: Context) a (ctx :: Context).
Table context a =>
(context :~: Reify ctx) -> a -> Unreify a
unreify


instance
  ( Nullifiable from, Labelable from, ConstrainTag from EitherTag
  , Nullifiable to, Labelable to, ConstrainTag to EitherTag
  , Recontextualize from to a1 b1
  , Recontextualize from to a2 b2
  )
  => Recontextualize from to (EitherTable a1 a2) (EitherTable b1 b2)


instance (EqTable a, EqTable b) => EqTable (EitherTable a b) where
  eqTable :: Columns (EitherTable a b) (Dict (ConstrainDBType DBEq))
eqTable = (Columns a (Dict (ConstrainDBType DBEq))
 -> Columns a (Dict (ConstrainDBType DBEq)))
-> (Columns b (Dict (ConstrainDBType DBEq))
    -> Columns b (Dict (ConstrainDBType DBEq)))
-> EitherTable
     (Columns a (Dict (ConstrainDBType DBEq)))
     (Columns b (Dict (ConstrainDBType DBEq)))
-> HEitherTable
     (Columns a) (Columns b) (Dict (ConstrainDBType DBEq))
forall (t :: HTable) (u :: HTable) (context :: HContext) a b.
(HTable t, HTable u, HConstrainTag context EitherTag,
 HLabelable context, HNullifiable context) =>
(a -> t context)
-> (b -> u context) -> EitherTable a b -> HEitherTable t u context
toColumns2 Columns a (Dict (ConstrainDBType DBEq))
-> Columns a (Dict (ConstrainDBType DBEq))
forall a. a -> a
id Columns b (Dict (ConstrainDBType DBEq))
-> Columns b (Dict (ConstrainDBType DBEq))
forall a. a -> a
id (Columns a (Dict (ConstrainDBType DBEq))
-> Columns b (Dict (ConstrainDBType DBEq))
-> EitherTable
     (Columns a (Dict (ConstrainDBType DBEq)))
     (Columns b (Dict (ConstrainDBType DBEq)))
forall a b. a -> b -> EitherTable a b
rightTableWith (EqTable a => Columns a (Dict (ConstrainDBType DBEq))
forall a. EqTable a => Columns a (Dict (ConstrainDBType DBEq))
eqTable @a) (EqTable b => Columns b (Dict (ConstrainDBType DBEq))
forall a. EqTable a => Columns a (Dict (ConstrainDBType DBEq))
eqTable @b))


instance (OrdTable a, OrdTable b) => OrdTable (EitherTable a b) where
  ordTable :: Columns (EitherTable a b) (Dict (ConstrainDBType DBOrd))
ordTable = (Columns a (Dict (ConstrainDBType DBOrd))
 -> Columns a (Dict (ConstrainDBType DBOrd)))
-> (Columns b (Dict (ConstrainDBType DBOrd))
    -> Columns b (Dict (ConstrainDBType DBOrd)))
-> EitherTable
     (Columns a (Dict (ConstrainDBType DBOrd)))
     (Columns b (Dict (ConstrainDBType DBOrd)))
-> HEitherTable
     (Columns a) (Columns b) (Dict (ConstrainDBType DBOrd))
forall (t :: HTable) (u :: HTable) (context :: HContext) a b.
(HTable t, HTable u, HConstrainTag context EitherTag,
 HLabelable context, HNullifiable context) =>
(a -> t context)
-> (b -> u context) -> EitherTable a b -> HEitherTable t u context
toColumns2 Columns a (Dict (ConstrainDBType DBOrd))
-> Columns a (Dict (ConstrainDBType DBOrd))
forall a. a -> a
id Columns b (Dict (ConstrainDBType DBOrd))
-> Columns b (Dict (ConstrainDBType DBOrd))
forall a. a -> a
id (Columns a (Dict (ConstrainDBType DBOrd))
-> Columns b (Dict (ConstrainDBType DBOrd))
-> EitherTable
     (Columns a (Dict (ConstrainDBType DBOrd)))
     (Columns b (Dict (ConstrainDBType DBOrd)))
forall a b. a -> b -> EitherTable a b
rightTableWith (OrdTable a => Columns a (Dict (ConstrainDBType DBOrd))
forall a. OrdTable a => Columns a (Dict (ConstrainDBType DBOrd))
ordTable @a) (OrdTable b => Columns b (Dict (ConstrainDBType DBOrd))
forall a. OrdTable a => Columns a (Dict (ConstrainDBType DBOrd))
ordTable @b))


type instance FromExprs (EitherTable a b) = Either (FromExprs a) (FromExprs b)


instance (ToExprs exprs1 a, ToExprs exprs2 b, x ~ EitherTable exprs1 exprs2) =>
  ToExprs x (Either a b)
 where
  fromResult :: Columns x (Col Result) -> Either a b
fromResult =
    (Columns exprs1 (Col Result) -> a)
-> (Columns exprs2 (Col Result) -> b)
-> Either
     (Columns exprs1 (Col Result)) (Columns exprs2 (Col Result))
-> Either a b
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall a. ToExprs exprs1 a => Columns exprs1 (Col Result) -> a
forall exprs a. ToExprs exprs a => Columns exprs (Col Result) -> a
fromResult @exprs1) (forall a. ToExprs exprs2 a => Columns exprs2 (Col Result) -> a
forall exprs a. ToExprs exprs a => Columns exprs (Col Result) -> a
fromResult @exprs2) (Either (Columns exprs1 (Col Result)) (Columns exprs2 (Col Result))
 -> Either a b)
-> (HEitherTable (Columns exprs1) (Columns exprs2) (Col Result)
    -> Either
         (Columns exprs1 (Col Result)) (Columns exprs2 (Col Result)))
-> HEitherTable (Columns exprs1) (Columns exprs2) (Col Result)
-> Either a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    HEitherTable (Columns exprs1) (Columns exprs2) (Col Result)
-> Either
     (Columns exprs1 (Col Result)) (Columns exprs2 (Col Result))
forall (context :: Context) a.
Table context a =>
Columns a (Col context) -> a
fromColumns
  toResult :: Either a b -> Columns x (Col Result)
toResult =
    Either (Columns exprs1 (Col Result)) (Columns exprs2 (Col Result))
-> HEitherTable (Columns exprs1) (Columns exprs2) (Col Result)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns (Either (Columns exprs1 (Col Result)) (Columns exprs2 (Col Result))
 -> HEitherTable (Columns exprs1) (Columns exprs2) (Col Result))
-> (Either a b
    -> Either
         (Columns exprs1 (Col Result)) (Columns exprs2 (Col Result)))
-> Either a b
-> HEitherTable (Columns exprs1) (Columns exprs2) (Col Result)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (a -> Columns exprs1 (Col Result))
-> (b -> Columns exprs2 (Col Result))
-> Either a b
-> Either
     (Columns exprs1 (Col Result)) (Columns exprs2 (Col Result))
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall a. ToExprs exprs1 a => a -> Columns exprs1 (Col Result)
forall exprs a. ToExprs exprs a => a -> Columns exprs (Col Result)
toResult @exprs1) (forall a. ToExprs exprs2 a => a -> Columns exprs2 (Col Result)
forall exprs a. ToExprs exprs a => a -> Columns exprs (Col Result)
toResult @exprs2)


-- | Test if an 'EitherTable' is a 'leftTable'.
isLeftTable :: EitherTable a b -> Expr Bool
isLeftTable :: EitherTable a b -> Expr Bool
isLeftTable = Expr EitherTag -> Expr Bool
isLeft (Expr EitherTag -> Expr Bool)
-> (EitherTable a b -> Expr EitherTag)
-> EitherTable a b
-> Expr Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag "isRight" EitherTag -> Expr EitherTag
forall (label :: Symbol) a. Tag label a -> Expr a
expr (Tag "isRight" EitherTag -> Expr EitherTag)
-> (EitherTable a b -> Tag "isRight" EitherTag)
-> EitherTable a b
-> Expr EitherTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EitherTable a b -> Tag "isRight" EitherTag
forall a b. EitherTable a b -> Tag "isRight" EitherTag
tag


-- | Test if an 'EitherTable' is a 'rightTable'.
isRightTable :: EitherTable a b -> Expr Bool
isRightTable :: EitherTable a b -> Expr Bool
isRightTable = Expr EitherTag -> Expr Bool
isRight (Expr EitherTag -> Expr Bool)
-> (EitherTable a b -> Expr EitherTag)
-> EitherTable a b
-> Expr Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag "isRight" EitherTag -> Expr EitherTag
forall (label :: Symbol) a. Tag label a -> Expr a
expr (Tag "isRight" EitherTag -> Expr EitherTag)
-> (EitherTable a b -> Tag "isRight" EitherTag)
-> EitherTable a b
-> Expr EitherTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EitherTable a b -> Tag "isRight" EitherTag
forall a b. EitherTable a b -> Tag "isRight" EitherTag
tag


-- | Pattern match/eliminate an 'EitherTable', by providing mappings from a
-- 'leftTable' and 'rightTable'.
eitherTable :: Table Expr c
  => (a -> c) -> (b -> c) -> EitherTable a b -> c
eitherTable :: (a -> c) -> (b -> c) -> EitherTable a b -> c
eitherTable a -> c
f b -> c
g EitherTable {Tag "isRight" EitherTag
tag :: Tag "isRight" EitherTag
tag :: forall a b. EitherTable a b -> Tag "isRight" EitherTag
tag, a
left :: a
left :: forall a b. EitherTable a b -> a
left, b
right :: b
right :: forall a b. EitherTable a b -> b
right} =
  c -> c -> Expr Bool -> c
forall a. Table Expr a => a -> a -> Expr Bool -> a
bool (a -> c
f a
left) (b -> c
g b
right) (Expr EitherTag -> Expr Bool
isRight (Tag "isRight" EitherTag -> Expr EitherTag
forall (label :: Symbol) a. Tag label a -> Expr a
expr Tag "isRight" EitherTag
tag))


-- | Construct a left 'EitherTable'. Like 'Left'.
leftTable :: Table Expr b => a -> EitherTable a b
leftTable :: a -> EitherTable a b
leftTable a
a = Tag "isRight" EitherTag -> a -> b -> EitherTable a b
forall a b. Tag "isRight" EitherTag -> a -> b -> EitherTable a b
EitherTable (Expr EitherTag -> Tag "isRight" EitherTag
forall (label :: Symbol) a.
(KnownSymbol label, Taggable a) =>
Expr a -> Tag label a
fromExpr (EitherTag -> Expr EitherTag
forall a. Sql DBType a => a -> Expr a
litExpr EitherTag
IsLeft)) a
a b
forall a. Table Expr a => a
undefined


-- | Construct a right 'EitherTable'. Like 'Right'.
rightTable :: Table Expr a => b -> EitherTable a b
rightTable :: b -> EitherTable a b
rightTable = a -> b -> EitherTable a b
forall a b. a -> b -> EitherTable a b
rightTableWith a
forall a. Table Expr a => a
undefined


rightTableWith :: a -> b -> EitherTable a b
rightTableWith :: a -> b -> EitherTable a b
rightTableWith = Tag "isRight" EitherTag -> a -> b -> EitherTable a b
forall a b. Tag "isRight" EitherTag -> a -> b -> EitherTable a b
EitherTable (Expr EitherTag -> Tag "isRight" EitherTag
forall (label :: Symbol) a.
(KnownSymbol label, Taggable a) =>
Expr a -> Tag label a
fromExpr (EitherTag -> Expr EitherTag
forall a. Sql DBType a => a -> Expr a
litExpr EitherTag
IsRight))


-- | 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 a b
nameEitherTable :: Name EitherTag -> a -> b -> EitherTable a b
nameEitherTable = Tag "isRight" EitherTag -> a -> b -> EitherTable a b
forall a b. Tag "isRight" EitherTag -> a -> b -> EitherTable a b
EitherTable (Tag "isRight" EitherTag -> a -> b -> EitherTable a b)
-> (Name EitherTag -> Tag "isRight" EitherTag)
-> Name EitherTag
-> a
-> b
-> EitherTable a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name EitherTag -> Tag "isRight" EitherTag
forall a (label :: Symbol). Taggable a => Name a -> Tag label a
fromName


toColumns2 ::
  ( HTable t
  , HTable u
  , HConstrainTag context EitherTag
  , HLabelable context
  , HNullifiable context
  )
  => (a -> t context)
  -> (b -> u context)
  -> EitherTable a b
  -> HEitherTable t u context
toColumns2 :: (a -> t context)
-> (b -> u context) -> EitherTable a b -> HEitherTable t u context
toColumns2 a -> t context
f b -> u context
g EitherTable {Tag "isRight" EitherTag
tag :: Tag "isRight" EitherTag
tag :: forall a b. EitherTable a b -> Tag "isRight" EitherTag
tag, a
left :: a
left :: forall a b. EitherTable a b -> a
left, b
right :: b
right :: forall a b. EitherTable a b -> b
right} = HEitherTable :: forall (left :: HTable) (right :: HTable) (context :: HContext).
HIdentity ('Spec '["isRight"] EitherTag) context
-> HLabel "Left" (HNullify left) context
-> HLabel "Right" (HNullify right) context
-> HEitherTable left right context
HEitherTable
  { HIdentity ('Spec '["isRight"] EitherTag) context
htag :: HIdentity ('Spec '["isRight"] EitherTag) context
htag :: HIdentity ('Spec '["isRight"] EitherTag) context
htag
  , hleft :: HLabel "Left" (HNullify t) context
hleft = (forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec ("Left" : labels) a))
-> HNullify t context -> HLabel "Left" (HNullify t) context
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec (label : labels) a))
-> t context -> HLabel label t context
hlabel forall (labels :: Labels) a.
context ('Spec labels a) -> context ('Spec ("Left" : labels) a)
forall (context :: HContext) (labels :: Labels) a
       (label :: Symbol).
HLabelable context =>
context ('Spec labels a) -> context ('Spec (label : labels) a)
hlabeler (HNullify t context -> HLabel "Left" (HNullify t) context)
-> HNullify t context -> HLabel "Left" (HNullify t) context
forall a b. (a -> b) -> a -> b
$ (forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> context ('Spec labels a) -> context ('Spec labels (Nullify a)))
-> t context -> HNullify t context
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> context ('Spec labels a) -> context ('Spec labels (Nullify a)))
-> t context -> HNullify t context
hnullify (Tag "isRight" EitherTag
-> (Expr EitherTag -> Expr Bool)
-> SSpec ('Spec labels a)
-> context ('Spec labels a)
-> context ('Spec labels (Nullify a))
forall (context :: HContext) (label :: Symbol) a (labels :: Labels)
       x.
HNullifiable context =>
Tag label a
-> (Expr a -> Expr Bool)
-> SSpec ('Spec labels x)
-> context ('Spec labels x)
-> context ('Spec labels (Nullify x))
hnullifier Tag "isRight" EitherTag
tag Expr EitherTag -> Expr Bool
isLeft) (t context -> HNullify t context)
-> t context -> HNullify t context
forall a b. (a -> b) -> a -> b
$ a -> t context
f a
left
  , hright :: HLabel "Right" (HNullify u) context
hright = (forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec ("Right" : labels) a))
-> HNullify u context -> HLabel "Right" (HNullify u) context
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) a.
 context ('Spec labels a) -> context ('Spec (label : labels) a))
-> t context -> HLabel label t context
hlabel forall (labels :: Labels) a.
context ('Spec labels a) -> context ('Spec ("Right" : labels) a)
forall (context :: HContext) (labels :: Labels) a
       (label :: Symbol).
HLabelable context =>
context ('Spec labels a) -> context ('Spec (label : labels) a)
hlabeler (HNullify u context -> HLabel "Right" (HNullify u) context)
-> HNullify u context -> HLabel "Right" (HNullify u) context
forall a b. (a -> b) -> a -> b
$ (forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> context ('Spec labels a) -> context ('Spec labels (Nullify a)))
-> u context -> HNullify u context
forall (t :: HTable) (context :: HContext).
HTable t =>
(forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> context ('Spec labels a) -> context ('Spec labels (Nullify a)))
-> t context -> HNullify t context
hnullify (Tag "isRight" EitherTag
-> (Expr EitherTag -> Expr Bool)
-> SSpec ('Spec labels a)
-> context ('Spec labels a)
-> context ('Spec labels (Nullify a))
forall (context :: HContext) (label :: Symbol) a (labels :: Labels)
       x.
HNullifiable context =>
Tag label a
-> (Expr a -> Expr Bool)
-> SSpec ('Spec labels x)
-> context ('Spec labels x)
-> context ('Spec labels (Nullify x))
hnullifier Tag "isRight" EitherTag
tag Expr EitherTag -> Expr Bool
isRight) (u context -> HNullify u context)
-> u context -> HNullify u context
forall a b. (a -> b) -> a -> b
$ b -> u context
g b
right
  }
  where
    htag :: HIdentity ('Spec '["isRight"] EitherTag) context
htag = context ('Spec '["isRight"] EitherTag)
-> HIdentity ('Spec '["isRight"] EitherTag) context
forall (spec :: Spec) (context :: HContext).
context spec -> HIdentity spec context
HIdentity (Tag "isRight" EitherTag -> context ('Spec '["isRight"] EitherTag)
forall (context :: HContext) a (label :: Symbol)
       (labels :: Labels).
(HNullifiable context, Sql (HConstrainTag context) a,
 KnownSymbol label, Taggable a) =>
Tag label a -> context ('Spec labels a)
hencodeTag Tag "isRight" EitherTag
tag)


fromColumns2 ::
  ( HTable t
  , HTable u
  , HConstrainTag context EitherTag
  , HLabelable context
  , HNullifiable context
  )
  => (t context -> a)
  -> (u context -> b)
  -> HEitherTable t u context
  -> EitherTable a b
fromColumns2 :: (t context -> a)
-> (u context -> b) -> HEitherTable t u context -> EitherTable a b
fromColumns2 t context -> a
f u context -> b
g HEitherTable {HIdentity ('Spec '["isRight"] EitherTag) context
htag :: HIdentity ('Spec '["isRight"] EitherTag) context
htag :: forall (left :: HTable) (right :: HTable) (context :: HContext).
HEitherTable left right context
-> HIdentity ('Spec '["isRight"] EitherTag) context
htag, HLabel "Left" (HNullify t) context
hleft :: HLabel "Left" (HNullify t) context
hleft :: forall (left :: HTable) (right :: HTable) (context :: HContext).
HEitherTable left right context
-> HLabel "Left" (HNullify left) context
hleft, HLabel "Right" (HNullify u) context
hright :: HLabel "Right" (HNullify u) context
hright :: forall (left :: HTable) (right :: HTable) (context :: HContext).
HEitherTable left right context
-> HLabel "Right" (HNullify right) context
hright} = EitherTable :: forall a b. Tag "isRight" EitherTag -> a -> b -> EitherTable a b
EitherTable
  { Tag "isRight" EitherTag
tag :: Tag "isRight" EitherTag
tag :: Tag "isRight" EitherTag
tag
  , left :: a
left = t context -> a
f (t context -> a) -> t context -> a
forall a b. (a -> b) -> a -> b
$ Identity (t context) -> t context
forall a. Identity a -> a
runIdentity (Identity (t context) -> t context)
-> Identity (t context) -> t context
forall a b. (a -> b) -> a -> b
$
     (forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> context ('Spec labels (Nullify a))
 -> Identity (context ('Spec labels a)))
-> HNullify t context -> Identity (t context)
forall (t :: HTable) (m :: * -> *) (context :: HContext).
(HTable t, Apply m) =>
(forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> context ('Spec labels (Nullify a))
 -> m (context ('Spec labels a)))
-> HNullify t context -> m (t context)
hunnullify (\SSpec ('Spec labels a)
a -> context ('Spec labels a) -> Identity (context ('Spec labels a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (context ('Spec labels a) -> Identity (context ('Spec labels a)))
-> (context ('Spec labels (Nullify a)) -> context ('Spec labels a))
-> context ('Spec labels (Nullify a))
-> Identity (context ('Spec labels a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SSpec ('Spec labels a)
-> context ('Spec labels (Nullify a)) -> context ('Spec labels a)
forall (context :: HContext) (labels :: Labels) x.
HNullifiable context =>
SSpec ('Spec labels x)
-> context ('Spec labels (Nullify x)) -> context ('Spec labels x)
hunnullifier SSpec ('Spec labels a)
a) (HNullify t context -> Identity (t context))
-> HNullify t context -> Identity (t context)
forall a b. (a -> b) -> a -> b
$
     (forall (labels :: Labels) a.
 context ('Spec ("Left" : labels) a) -> context ('Spec labels a))
-> HLabel "Left" (HNullify t) context -> HNullify t context
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) a.
 context ('Spec (label : labels) a) -> context ('Spec labels a))
-> HLabel label t context -> t context
hunlabel forall (labels :: Labels) a.
context ('Spec ("Left" : labels) a) -> context ('Spec labels a)
forall (context :: HContext) (label :: Symbol) (labels :: Labels)
       a.
HLabelable context =>
context ('Spec (label : labels) a) -> context ('Spec labels a)
hunlabeler
     HLabel "Left" (HNullify t) context
hleft
  , right :: b
right = u context -> b
g (u context -> b) -> u context -> b
forall a b. (a -> b) -> a -> b
$ Identity (u context) -> u context
forall a. Identity a -> a
runIdentity (Identity (u context) -> u context)
-> Identity (u context) -> u context
forall a b. (a -> b) -> a -> b
$
     (forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> context ('Spec labels (Nullify a))
 -> Identity (context ('Spec labels a)))
-> HNullify u context -> Identity (u context)
forall (t :: HTable) (m :: * -> *) (context :: HContext).
(HTable t, Apply m) =>
(forall (labels :: Labels) a.
 SSpec ('Spec labels a)
 -> context ('Spec labels (Nullify a))
 -> m (context ('Spec labels a)))
-> HNullify t context -> m (t context)
hunnullify (\SSpec ('Spec labels a)
a -> context ('Spec labels a) -> Identity (context ('Spec labels a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (context ('Spec labels a) -> Identity (context ('Spec labels a)))
-> (context ('Spec labels (Nullify a)) -> context ('Spec labels a))
-> context ('Spec labels (Nullify a))
-> Identity (context ('Spec labels a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SSpec ('Spec labels a)
-> context ('Spec labels (Nullify a)) -> context ('Spec labels a)
forall (context :: HContext) (labels :: Labels) x.
HNullifiable context =>
SSpec ('Spec labels x)
-> context ('Spec labels (Nullify x)) -> context ('Spec labels x)
hunnullifier SSpec ('Spec labels a)
a) (HNullify u context -> Identity (u context))
-> HNullify u context -> Identity (u context)
forall a b. (a -> b) -> a -> b
$
     (forall (labels :: Labels) a.
 context ('Spec ("Right" : labels) a) -> context ('Spec labels a))
-> HLabel "Right" (HNullify u) context -> HNullify u context
forall (t :: HTable) (label :: Symbol) (context :: HContext).
(HTable t, KnownSymbol label) =>
(forall (labels :: Labels) a.
 context ('Spec (label : labels) a) -> context ('Spec labels a))
-> HLabel label t context -> t context
hunlabel forall (labels :: Labels) a.
context ('Spec ("Right" : labels) a) -> context ('Spec labels a)
forall (context :: HContext) (label :: Symbol) (labels :: Labels)
       a.
HLabelable context =>
context ('Spec (label : labels) a) -> context ('Spec labels a)
hunlabeler
     HLabel "Right" (HNullify u) context
hright
  }
  where
    tag :: Tag "isRight" EitherTag
tag = context ('Spec '["isRight"] EitherTag) -> Tag "isRight" EitherTag
forall (context :: HContext) a (label :: Symbol)
       (labels :: Labels).
(HNullifiable context, Sql (HConstrainTag context) a,
 KnownSymbol label, Taggable a) =>
context ('Spec labels a) -> Tag label a
hdecodeTag (context ('Spec '["isRight"] EitherTag) -> Tag "isRight" EitherTag)
-> context ('Spec '["isRight"] EitherTag)
-> Tag "isRight" EitherTag
forall a b. (a -> b) -> a -> b
$ HIdentity ('Spec '["isRight"] EitherTag) context
-> context ('Spec '["isRight"] EitherTag)
forall (spec :: Spec) (context :: HContext).
HIdentity spec context -> context spec
unHIdentity HIdentity ('Spec '["isRight"] EitherTag) context
htag