{-# language AllowAmbiguousTypes #-}
{-# language ConstraintKinds #-}
{-# language DataKinds #-}
{-# language FlexibleContexts #-}
{-# language NamedFieldPuns #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
{-# language ViewPatterns #-}

module Rel8.Generic.Construction
  ( GGBuildable
  , GGBuild, ggbuild
  , GGConstructable
  , GGConstruct, ggconstruct
  , GGDeconstruct, ggdeconstruct
  , GGName, ggname
  , GGAggregate, ggaggregate
  )
where

-- base
import Data.Bifunctor ( first )
import Data.Kind ( Constraint, Type )
import Data.List.NonEmpty ( NonEmpty( (:|) ) )
import GHC.TypeLits ( Symbol )
import Prelude

-- rel8
import Rel8.Aggregate ( Aggregate( Aggregate ) )
import Rel8.Expr ( Expr )
import Rel8.Expr.Aggregate ( groupByExpr )
import Rel8.Expr.Eq ( (==.) )
import Rel8.Expr.Null ( nullify, snull, unsafeUnnullify )
import Rel8.Expr.Serialize ( litExpr )
import Rel8.FCF ( Eval, Exp, Id )
import Rel8.Generic.Construction.ADT
  ( GConstructorADT, GMakeableADT, gmakeADT
  , GConstructableADT
  , GBuildADT, gbuildADT, gunbuildADT
  , GConstructADT, gconstructADT, gdeconstructADT
  , RepresentableConstructors, GConstructors, gcindex, gctabulate
  , RepresentableFields, gfindex, gftabulate
  )
import Rel8.Generic.Construction.Record
  ( GConstructor
  , GConstructable, GConstruct, gconstruct, gdeconstruct
  , Representable, gindex, gtabulate
  )
import Rel8.Generic.Table ( GGColumns )
import Rel8.Kind.Algebra
  ( SAlgebra( SProduct, SSum )
  , KnownAlgebra, algebraSing
  )
import qualified Rel8.Kind.Algebra as K
import Rel8.Schema.Context.Nullify ( sguard, snullify )
import Rel8.Schema.HTable ( HTable )
import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
import qualified Rel8.Schema.Kind as K
import Rel8.Schema.Name ( Name( Name ) )
import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
import Rel8.Schema.Spec ( Spec( Spec, nullity, info ) )
import Rel8.Table
  ( TTable, TColumns
  , Table, fromColumns, toColumns
  )
import Rel8.Table.Bool ( case_ )
import Rel8.Type.Tag ( Tag )


type GGBuildable :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) -> Constraint
type GGBuildable algebra name rep =
  ( KnownAlgebra algebra
  , Eval (GGColumns algebra TColumns (Eval (rep Aggregate))) ~ Eval (GGColumns algebra TColumns (Eval (rep Expr)))
  , Eval (GGColumns algebra TColumns (Eval (rep Expr))) ~ Eval (GGColumns algebra TColumns (Eval (rep Expr)))
  , Eval (GGColumns algebra TColumns (Eval (rep Name))) ~ Eval (GGColumns algebra TColumns (Eval (rep Expr)))
  , HTable (Eval (GGColumns algebra TColumns (Eval (rep Expr))))
  , GGBuildable' algebra name rep
  )


type GGBuildable' :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) -> Constraint
type family GGBuildable' algebra name rep where
  GGBuildable' 'K.Product name rep =
    ( name ~ GConstructor (Eval (rep Expr))
    , Representable Id (Eval (rep Expr))
    , GConstructable (TTable Expr) TColumns Id Expr (Eval (rep Expr))
    )
  GGBuildable' 'K.Sum name rep =
    ( Representable Id (GConstructorADT name (Eval (rep Expr)))
    , GMakeableADT (TTable Expr) TColumns Id Expr name (Eval (rep Expr))
    )


type GGBuild :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) -> Type -> Type
type family GGBuild algebra name rep r where
  GGBuild 'K.Product _name rep r =
    GConstruct Id (Eval (rep Expr)) r
  GGBuild 'K.Sum name rep r =
    GConstruct Id (GConstructorADT name (Eval (rep Expr))) r


ggbuild :: forall algebra name rep a. GGBuildable algebra name rep
  => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a)
  -> GGBuild algebra name rep a
ggbuild :: (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a)
-> GGBuild algebra name rep a
ggbuild Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a
gfromColumns = case KnownAlgebra algebra => SAlgebra algebra
forall (algebra :: Algebra).
KnownAlgebra algebra =>
SAlgebra algebra
algebraSing @algebra of
  SAlgebra algebra
SProduct ->
    (GFields Id (Eval (rep Expr)) -> a)
-> GConstruct Id (Eval (rep Expr)) a
forall (f :: * -> * -> *) (rep :: * -> *) a.
Representable f rep =>
(GFields f rep -> a) -> GConstruct f rep a
gtabulate @Id @(Eval (rep Expr)) @a ((GFields Id (Eval (rep Expr)) -> a)
 -> GConstruct Id (Eval (rep Expr)) a)
-> (GFields Id (Eval (rep Expr)) -> a)
-> GConstruct Id (Eval (rep Expr)) a
forall a b. (a -> b) -> a -> b
$
    Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a
gfromColumns (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a)
-> (GFields Id (Eval (rep Expr))
    -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)
-> GFields Id (Eval (rep Expr))
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ToColumns (TTable Expr) TColumns Id Expr
-> GFields Id (Eval (rep Expr))
-> GColumns TColumns (Eval (rep Expr)) Expr
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> * -> *)
       (context :: * -> *) (rep :: * -> *).
GConstructable _Table _Columns f context rep =>
ToColumns _Table _Columns f context
-> GFields f rep -> GColumns _Columns rep context
gconstruct
      @(TTable Expr)
      @TColumns
      @Id
      @Expr
      @(Eval (rep Expr))
      ((x -> Columns x Expr) -> proxy x -> x -> Columns x Expr
forall a b. a -> b -> a
const x -> Columns x Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns)
  SAlgebra algebra
SSum ->
    (GFields Id (GConstructorADT name (Eval (rep Expr))) -> a)
-> GConstruct Id (GConstructorADT name (Eval (rep Expr))) a
forall (f :: * -> * -> *) (rep :: * -> *) a.
Representable f rep =>
(GFields f rep -> a) -> GConstruct f rep a
gtabulate @Id @(GConstructorADT name (Eval (rep Expr))) @a ((GFields Id (GConstructorADT name (Eval (rep Expr))) -> a)
 -> GConstruct Id (GConstructorADT name (Eval (rep Expr))) a)
-> (GFields Id (GConstructorADT name (Eval (rep Expr))) -> a)
-> GConstruct Id (GConstructorADT name (Eval (rep Expr))) a
forall a b. (a -> b) -> a -> b
$
    Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a
gfromColumns (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a)
-> (GFields Id (GConstructorADT name (Eval (rep Expr)))
    -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)
-> GFields Id (GConstructorADT name (Eval (rep Expr)))
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ToColumns (TTable Expr) TColumns Id Expr
-> Null Expr
-> Nullifier Expr
-> (Tag -> HIdentity Tag Expr)
-> GFields Id (GConstructorADT name (Eval (rep Expr)))
-> GColumnsADT TColumns (Eval (rep Expr)) Expr
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> * -> *)
       (context :: * -> *) (name :: Symbol) (rep :: * -> *).
GMakeableADT _Table _Columns f context name rep =>
ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> (Tag -> HIdentity Tag context)
-> GFields f (GConstructorADT name rep)
-> GColumnsADT _Columns rep context
gmakeADT
      @(TTable Expr)
      @TColumns
      @Id
      @Expr
      @name
      @(Eval (rep Expr))
      ((x -> Columns x Expr) -> proxy x -> x -> Columns x Expr
forall a b. a -> b -> a
const x -> Columns x Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns)
      (\Spec {TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info :: forall a. Spec a -> TypeInformation (Unnullify a)
info} -> TypeInformation (Unnullify a) -> Expr (Nullify a)
forall a. TypeInformation a -> Expr (Maybe a)
snull TypeInformation (Unnullify a)
info)
      (\Spec {Nullity a
nullity :: Nullity a
nullity :: forall a. Spec a -> Nullity a
nullity} -> case Nullity a
nullity of
        Nullity a
Null -> Expr a -> Expr (Nullify a)
forall a. a -> a
id
        Nullity a
NotNull -> Expr a -> Expr (Nullify a)
forall a. NotNull a => Expr a -> Expr (Maybe a)
nullify)
      (Expr Tag -> HIdentity Tag Expr
forall a (context :: * -> *). context a -> HIdentity a context
HIdentity (Expr Tag -> HIdentity Tag Expr)
-> (Tag -> Expr Tag) -> Tag -> HIdentity Tag Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Expr Tag
forall a. Sql DBType a => a -> Expr a
litExpr)


type GGConstructable :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Constraint
type GGConstructable algebra rep =
  ( KnownAlgebra algebra
  , Eval (GGColumns algebra TColumns (Eval (rep Aggregate))) ~ Eval (GGColumns algebra TColumns (Eval (rep Expr)))
  , Eval (GGColumns algebra TColumns (Eval (rep Expr))) ~ Eval (GGColumns algebra TColumns (Eval (rep Expr)))
  , Eval (GGColumns algebra TColumns (Eval (rep Name))) ~ Eval (GGColumns algebra TColumns (Eval (rep Expr)))
  , HTable (Eval (GGColumns algebra TColumns (Eval (rep Expr))))
  , GGConstructable' algebra rep
  )


type GGConstructable' :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Constraint
type family GGConstructable' algebra rep where
  GGConstructable' 'K.Product rep =
    ( Representable Id (Eval (rep Aggregate))
    , Representable Id (Eval (rep Expr))
    , Representable Id (Eval (rep Name))
    , GConstructable (TTable Aggregate) TColumns Id Aggregate (Eval (rep Aggregate))
    , GConstructable (TTable Expr) TColumns Id Expr (Eval (rep Expr))
    , GConstructable (TTable Name) TColumns Id Name (Eval (rep Name))
    )
  GGConstructable' 'K.Sum rep =
    ( RepresentableConstructors Id (Eval (rep Expr))
    , RepresentableFields Id (Eval (rep Aggregate))
    , RepresentableFields Id (Eval (rep Expr))
    , RepresentableFields Id (Eval (rep Name))
    , Functor (GConstructors Id (Eval (rep Expr)))
    , GConstructableADT (TTable Aggregate) TColumns Id Aggregate (Eval (rep Aggregate))
    , GConstructableADT (TTable Expr) TColumns Id Expr (Eval (rep Expr))
    , GConstructableADT (TTable Name) TColumns Id Name (Eval (rep Name))
    )


type GGConstruct :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type
type family GGConstruct algebra rep r where
  GGConstruct 'K.Product rep r = GConstruct Id (Eval (rep Expr)) r -> r
  GGConstruct 'K.Sum rep r = GConstructADT Id (Eval (rep Expr)) r r


ggconstruct :: forall algebra rep a. GGConstructable algebra rep
  => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a)
  -> GGConstruct algebra rep a -> a
ggconstruct :: (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a)
-> GGConstruct algebra rep a -> a
ggconstruct Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a
gfromColumns GGConstruct algebra rep a
f = case KnownAlgebra algebra => SAlgebra algebra
forall (algebra :: Algebra).
KnownAlgebra algebra =>
SAlgebra algebra
algebraSing @algebra of
  SAlgebra algebra
SProduct ->
    GGConstruct algebra rep a
GConstruct Id (Eval (rep Expr)) a -> a
f (GConstruct Id (Eval (rep Expr)) a -> a)
-> GConstruct Id (Eval (rep Expr)) a -> a
forall a b. (a -> b) -> a -> b
$
    (GFields Id (Eval (rep Expr)) -> a)
-> GConstruct Id (Eval (rep Expr)) a
forall (f :: * -> * -> *) (rep :: * -> *) a.
Representable f rep =>
(GFields f rep -> a) -> GConstruct f rep a
gtabulate @Id @(Eval (rep Expr)) @a ((GFields Id (Eval (rep Expr)) -> a)
 -> GConstruct Id (Eval (rep Expr)) a)
-> (GFields Id (Eval (rep Expr)) -> a)
-> GConstruct Id (Eval (rep Expr)) a
forall a b. (a -> b) -> a -> b
$
    Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a
gfromColumns (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a)
-> (GFields Id (Eval (rep Expr))
    -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)
-> GFields Id (Eval (rep Expr))
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ToColumns (TTable Expr) TColumns Id Expr
-> GFields Id (Eval (rep Expr))
-> GColumns TColumns (Eval (rep Expr)) Expr
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> * -> *)
       (context :: * -> *) (rep :: * -> *).
GConstructable _Table _Columns f context rep =>
ToColumns _Table _Columns f context
-> GFields f rep -> GColumns _Columns rep context
gconstruct
      @(TTable Expr)
      @TColumns
      @Id
      @Expr
      @(Eval (rep Expr))
      ((x -> Columns x Expr) -> proxy x -> x -> Columns x Expr
forall a b. a -> b -> a
const x -> Columns x Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns)
  SAlgebra algebra
SSum ->
    GConstructADT Id (Eval (rep Expr)) a a
-> GConstructors Id (Eval (rep Expr)) a -> a
forall (f :: * -> * -> *) (rep :: * -> *) r a.
RepresentableConstructors f rep =>
GConstructADT f rep r a -> GConstructors f rep r -> a
gcindex @Id @(Eval (rep Expr)) @a GConstructADT Id (Eval (rep Expr)) a a
GGConstruct algebra rep a
f (GConstructors Id (Eval (rep Expr)) a -> a)
-> GConstructors Id (Eval (rep Expr)) a -> a
forall a b. (a -> b) -> a -> b
$
    (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a)
-> GConstructors
     Id
     (Eval (rep Expr))
     (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)
-> GConstructors Id (Eval (rep Expr)) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a
gfromColumns (GConstructors
   Id
   (Eval (rep Expr))
   (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)
 -> GConstructors Id (Eval (rep Expr)) a)
-> GConstructors
     Id
     (Eval (rep Expr))
     (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)
-> GConstructors Id (Eval (rep Expr)) a
forall a b. (a -> b) -> a -> b
$
    ToColumns (TTable Expr) TColumns Id Expr
-> Null Expr
-> Nullifier Expr
-> (Tag -> HIdentity Tag Expr)
-> GConstructors
     Id (Eval (rep Expr)) (GColumnsADT TColumns (Eval (rep Expr)) Expr)
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> * -> *)
       (context :: * -> *) (rep :: * -> *).
GConstructableADT _Table _Columns f context rep =>
ToColumns _Table _Columns f context
-> Null context
-> Nullifier context
-> (Tag -> HIdentity Tag context)
-> GConstructors f rep (GColumnsADT _Columns rep context)
gconstructADT
      @(TTable Expr)
      @TColumns
      @Id
      @Expr
      @(Eval (rep Expr))
      ((x -> Columns x Expr) -> proxy x -> x -> Columns x Expr
forall a b. a -> b -> a
const x -> Columns x Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns)
      (\Spec {TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info :: forall a. Spec a -> TypeInformation (Unnullify a)
info} -> TypeInformation (Unnullify a) -> Expr (Nullify a)
forall a. TypeInformation a -> Expr (Maybe a)
snull TypeInformation (Unnullify a)
info)
      (\Spec {Nullity a
nullity :: Nullity a
nullity :: forall a. Spec a -> Nullity a
nullity} -> case Nullity a
nullity of
        Nullity a
Null -> Expr a -> Expr (Nullify a)
forall a. a -> a
id
        Nullity a
NotNull -> Expr a -> Expr (Nullify a)
forall a. NotNull a => Expr a -> Expr (Maybe a)
nullify)
      (Expr Tag -> HIdentity Tag Expr
forall a (context :: * -> *). context a -> HIdentity a context
HIdentity (Expr Tag -> HIdentity Tag Expr)
-> (Tag -> Expr Tag) -> Tag -> HIdentity Tag Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Expr Tag
forall a. Sql DBType a => a -> Expr a
litExpr)


type GGDeconstruct :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type -> Type
type family GGDeconstruct algebra rep a r where
  GGDeconstruct 'K.Product rep a r =
    GConstruct Id (Eval (rep Expr)) r -> a -> r
  GGDeconstruct 'K.Sum rep a r =
    GConstructADT Id (Eval (rep Expr)) r (a -> r)


ggdeconstruct :: forall algebra rep a r. (GGConstructable algebra rep, Table Expr r)
  => (a -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)
  -> GGDeconstruct algebra rep a r
ggdeconstruct :: (a -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)
-> GGDeconstruct algebra rep a r
ggdeconstruct a -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr
gtoColumns = case KnownAlgebra algebra => SAlgebra algebra
forall (algebra :: Algebra).
KnownAlgebra algebra =>
SAlgebra algebra
algebraSing @algebra of
  SAlgebra algebra
SProduct -> \GConstruct Id (Eval (rep Expr)) r
build ->
    GConstruct Id (Eval (rep Expr)) r
-> GFields Id (Eval (rep Expr)) -> r
forall (f :: * -> * -> *) (rep :: * -> *) a.
Representable f rep =>
GConstruct f rep a -> GFields f rep -> a
gindex @Id @(Eval (rep Expr)) @r GConstruct Id (Eval (rep Expr)) r
build (GFields Id (Eval (rep Expr)) -> r)
-> (a -> GFields Id (Eval (rep Expr))) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    FromColumns (TTable Expr) TColumns Id Expr
-> GColumns TColumns (Eval (rep Expr)) Expr
-> GFields Id (Eval (rep Expr))
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> * -> *)
       (context :: * -> *) (rep :: * -> *).
GConstructable _Table _Columns f context rep =>
FromColumns _Table _Columns f context
-> GColumns _Columns rep context -> GFields f rep
gdeconstruct
      @(TTable Expr)
      @TColumns
      @Id
      @Expr
      @(Eval (rep Expr))
      ((Columns x Expr -> x) -> proxy x -> Columns x Expr -> x
forall a b. a -> b -> a
const Columns x Expr -> x
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns) (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr
 -> GFields Id (Eval (rep Expr)))
-> (a -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)
-> a
-> GFields Id (Eval (rep Expr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    a -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr
gtoColumns
  SAlgebra algebra
SSum ->
    (GConstructors Id (Eval (rep Expr)) r -> a -> r)
-> GConstructADT Id (Eval (rep Expr)) r (a -> r)
forall (f :: * -> * -> *) (rep :: * -> *) r a.
RepresentableConstructors f rep =>
(GConstructors f rep r -> a) -> GConstructADT f rep r a
gctabulate @Id @(Eval (rep Expr)) @r @(a -> r) ((GConstructors Id (Eval (rep Expr)) r -> a -> r)
 -> GConstructADT Id (Eval (rep Expr)) r (a -> r))
-> (GConstructors Id (Eval (rep Expr)) r -> a -> r)
-> GConstructADT Id (Eval (rep Expr)) r (a -> r)
forall a b. (a -> b) -> a -> b
$ \GConstructors Id (Eval (rep Expr)) r
constructors a
as ->
      let
        (HIdentity Expr Tag
tag, NonEmpty (Tag, r)
cases) =
          FromColumns (TTable Expr) TColumns Id Expr
-> Unnullifier Expr
-> GConstructors Id (Eval (rep Expr)) r
-> GColumnsADT TColumns (Eval (rep Expr)) Expr
-> (HIdentity Tag Expr, NonEmpty (Tag, r))
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> * -> *)
       (context :: * -> *) (rep :: * -> *) r.
GConstructableADT _Table _Columns f context rep =>
FromColumns _Table _Columns f context
-> Unnullifier context
-> GConstructors f rep r
-> GColumnsADT _Columns rep context
-> (HIdentity Tag context, NonEmpty (Tag, r))
gdeconstructADT
            @(TTable Expr)
            @TColumns
            @Id
            @Expr
            @(Eval (rep Expr))
            ((Columns x Expr -> x) -> proxy x -> Columns x Expr -> x
forall a b. a -> b -> a
const Columns x Expr -> x
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns)
            (\Spec {Nullity a
nullity :: Nullity a
nullity :: forall a. Spec a -> Nullity a
nullity} -> case Nullity a
nullity of
              Nullity a
Null -> Expr (Nullify a) -> Expr a
forall a. a -> a
id
              Nullity a
NotNull -> Expr (Nullify a) -> Expr a
forall a. Expr (Maybe a) -> Expr a
unsafeUnnullify)
            GConstructors Id (Eval (rep Expr)) r
constructors (GColumnsADT TColumns (Eval (rep Expr)) Expr
 -> (HIdentity Tag Expr, NonEmpty (Tag, r)))
-> GColumnsADT TColumns (Eval (rep Expr)) Expr
-> (HIdentity Tag Expr, NonEmpty (Tag, r))
forall a b. (a -> b) -> a -> b
$
          a -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr
gtoColumns a
as
      in
        case NonEmpty (Tag, r)
cases of
          ((Tag
_, r
r) :| (((Tag, r) -> (Expr Bool, r)) -> [(Tag, r)] -> [(Expr Bool, r)]
forall a b. (a -> b) -> [a] -> [b]
map ((Tag -> Expr Bool) -> (Tag, r) -> (Expr Bool, r)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Expr Tag
tag Expr Tag -> Expr Tag -> Expr Bool
forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
==.) (Expr Tag -> Expr Bool) -> (Tag -> Expr Tag) -> Tag -> Expr Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Expr Tag
forall a. Sql DBType a => a -> Expr a
litExpr)) -> [(Expr Bool, r)]
cases')) ->
            [(Expr Bool, r)] -> r -> r
forall a. Table Expr a => [(Expr Bool, a)] -> a -> a
case_ [(Expr Bool, r)]
cases' r
r


type GGName :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type
type family GGName algebra rep a where
  GGName 'K.Product rep a = GConstruct Id (Eval (rep Name)) a
  GGName 'K.Sum rep a = Name Tag -> GBuildADT Id (Eval (rep Name)) a


ggname :: forall algebra rep a. GGConstructable algebra rep
  => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Name -> a)
  -> GGName algebra rep a
ggname :: (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Name -> a)
-> GGName algebra rep a
ggname Eval (GGColumns algebra TColumns (Eval (rep Expr))) Name -> a
gfromColumns = case KnownAlgebra algebra => SAlgebra algebra
forall (algebra :: Algebra).
KnownAlgebra algebra =>
SAlgebra algebra
algebraSing @algebra of
  SAlgebra algebra
SProduct ->
    (GFields Id (Eval (rep Name)) -> a)
-> GConstruct Id (Eval (rep Name)) a
forall (f :: * -> * -> *) (rep :: * -> *) a.
Representable f rep =>
(GFields f rep -> a) -> GConstruct f rep a
gtabulate @Id @(Eval (rep Name)) @a ((GFields Id (Eval (rep Name)) -> a)
 -> GConstruct Id (Eval (rep Name)) a)
-> (GFields Id (Eval (rep Name)) -> a)
-> GConstruct Id (Eval (rep Name)) a
forall a b. (a -> b) -> a -> b
$
    Eval (GGColumns algebra TColumns (Eval (rep Expr))) Name -> a
gfromColumns (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Name -> a)
-> (GFields Id (Eval (rep Name))
    -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Name)
-> GFields Id (Eval (rep Name))
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ToColumns (TTable Name) TColumns Id Name
-> GFields Id (Eval (rep Name))
-> GColumns TColumns (Eval (rep Name)) Name
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> * -> *)
       (context :: * -> *) (rep :: * -> *).
GConstructable _Table _Columns f context rep =>
ToColumns _Table _Columns f context
-> GFields f rep -> GColumns _Columns rep context
gconstruct
      @(TTable Name)
      @TColumns
      @Id
      @Name
      @(Eval (rep Name))
      ((x -> Columns x Name) -> proxy x -> x -> Columns x Name
forall a b. a -> b -> a
const x -> Columns x Name
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns)
  SAlgebra algebra
SSum -> \Name Tag
tag ->
    (GFieldsADT Id (Eval (rep Name)) -> a)
-> GBuildADT Id (Eval (rep Name)) a
forall (f :: * -> * -> *) (rep :: * -> *) a.
RepresentableFields f rep =>
(GFieldsADT f rep -> a) -> GBuildADT f rep a
gftabulate @Id @(Eval (rep Name)) @a ((GFieldsADT Id (Eval (rep Name)) -> a)
 -> GBuildADT Id (Eval (rep Name)) a)
-> (GFieldsADT Id (Eval (rep Name)) -> a)
-> GBuildADT Id (Eval (rep Name)) a
forall a b. (a -> b) -> a -> b
$
    Eval (GGColumns algebra TColumns (Eval (rep Expr))) Name -> a
gfromColumns (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Name -> a)
-> (GFieldsADT Id (Eval (rep Name))
    -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Name)
-> GFieldsADT Id (Eval (rep Name))
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ToColumns (TTable Name) TColumns Id Name
-> (Tag -> Nullifier Name)
-> HIdentity Tag Name
-> GFieldsADT Id (Eval (rep Name))
-> GColumnsADT TColumns (Eval (rep Name)) Name
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> * -> *)
       (context :: * -> *) (rep :: * -> *).
GConstructableADT _Table _Columns f context rep =>
ToColumns _Table _Columns f context
-> (Tag -> Nullifier context)
-> HIdentity Tag context
-> GFieldsADT f rep
-> GColumnsADT _Columns rep context
gbuildADT
      @(TTable Name)
      @TColumns
      @Id
      @Name
      @(Eval (rep Name))
      ((x -> Columns x Name) -> proxy x -> x -> Columns x Name
forall a b. a -> b -> a
const x -> Columns x Name
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns)
      (\Tag
_ Spec a
_ (Name String
a) -> String -> Name (Nullify a)
forall a. String -> Name a
Name String
a)
      (Name Tag -> HIdentity Tag Name
forall a (context :: * -> *). context a -> HIdentity a context
HIdentity Name Tag
tag)


type GGAggregate :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type
type family GGAggregate algebra rep r where
  GGAggregate 'K.Product rep r =
    GConstruct Id (Eval (rep Aggregate)) r ->
      GConstruct Id (Eval (rep Expr)) r
  GGAggregate 'K.Sum rep r =
    GBuildADT Id (Eval (rep Aggregate)) r ->
      GBuildADT Id (Eval (rep Expr)) r


ggaggregate :: forall algebra rep exprs agg. GGConstructable algebra rep
  => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Aggregate -> agg)
  -> (exprs -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)
  -> GGAggregate algebra rep agg -> exprs -> agg
ggaggregate :: (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Aggregate
 -> agg)
-> (exprs
    -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)
-> GGAggregate algebra rep agg
-> exprs
-> agg
ggaggregate Eval (GGColumns algebra TColumns (Eval (rep Expr))) Aggregate
-> agg
gfromColumns exprs -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr
gtoColumns GGAggregate algebra rep agg
agg exprs
es = case KnownAlgebra algebra => SAlgebra algebra
forall (algebra :: Algebra).
KnownAlgebra algebra =>
SAlgebra algebra
algebraSing @algebra of
  SAlgebra algebra
SProduct -> ((GFields Id (Eval (rep Aggregate)) -> agg)
 -> GFields Id (Eval (rep Expr)) -> agg)
-> GFields Id (Eval (rep Expr))
-> (GFields Id (Eval (rep Aggregate)) -> agg)
-> agg
forall a b c. (a -> b -> c) -> b -> a -> c
flip (GFields Id (Eval (rep Aggregate)) -> agg)
-> GFields Id (Eval (rep Expr)) -> agg
f GFields Id (Eval (rep Expr))
exprs ((GFields Id (Eval (rep Aggregate)) -> agg) -> agg)
-> (GFields Id (Eval (rep Aggregate)) -> agg) -> agg
forall a b. (a -> b) -> a -> b
$
    Eval (GGColumns algebra TColumns (Eval (rep Expr))) Aggregate
-> agg
gfromColumns (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Aggregate
 -> agg)
-> (GFields Id (Eval (rep Aggregate))
    -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Aggregate)
-> GFields Id (Eval (rep Aggregate))
-> agg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ToColumns (TTable Aggregate) TColumns Id Aggregate
-> GFields Id (Eval (rep Aggregate))
-> GColumns TColumns (Eval (rep Aggregate)) Aggregate
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> * -> *)
       (context :: * -> *) (rep :: * -> *).
GConstructable _Table _Columns f context rep =>
ToColumns _Table _Columns f context
-> GFields f rep -> GColumns _Columns rep context
gconstruct
      @(TTable Aggregate)
      @TColumns
      @Id
      @Aggregate
      @(Eval (rep Aggregate))
      ((x -> Columns x Aggregate) -> proxy x -> x -> Columns x Aggregate
forall a b. a -> b -> a
const x -> Columns x Aggregate
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns)
    where
      f :: (GFields Id (Eval (rep Aggregate)) -> agg)
-> GFields Id (Eval (rep Expr)) -> agg
f =
        GConstruct Id (Eval (rep Expr)) agg
-> GFields Id (Eval (rep Expr)) -> agg
forall (f :: * -> * -> *) (rep :: * -> *) a.
Representable f rep =>
GConstruct f rep a -> GFields f rep -> a
gindex @Id @(Eval (rep Expr)) @agg (GConstruct Id (Eval (rep Expr)) agg
 -> GFields Id (Eval (rep Expr)) -> agg)
-> ((GFields Id (Eval (rep Aggregate)) -> agg)
    -> GConstruct Id (Eval (rep Expr)) agg)
-> (GFields Id (Eval (rep Aggregate)) -> agg)
-> GFields Id (Eval (rep Expr))
-> agg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        GGAggregate algebra rep agg
GConstruct Id (Eval (rep Aggregate)) agg
-> GConstruct Id (Eval (rep Expr)) agg
agg (GConstruct Id (Eval (rep Aggregate)) agg
 -> GConstruct Id (Eval (rep Expr)) agg)
-> ((GFields Id (Eval (rep Aggregate)) -> agg)
    -> GConstruct Id (Eval (rep Aggregate)) agg)
-> (GFields Id (Eval (rep Aggregate)) -> agg)
-> GConstruct Id (Eval (rep Expr)) agg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (GFields Id (Eval (rep Aggregate)) -> agg)
-> GConstruct Id (Eval (rep Aggregate)) agg
forall (f :: * -> * -> *) (rep :: * -> *) a.
Representable f rep =>
(GFields f rep -> a) -> GConstruct f rep a
gtabulate @Id @(Eval (rep Aggregate)) @agg
      exprs :: GFields Id (Eval (rep Expr))
exprs =
        FromColumns (TTable Expr) TColumns Id Expr
-> GColumns TColumns (Eval (rep Expr)) Expr
-> GFields Id (Eval (rep Expr))
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> * -> *)
       (context :: * -> *) (rep :: * -> *).
GConstructable _Table _Columns f context rep =>
FromColumns _Table _Columns f context
-> GColumns _Columns rep context -> GFields f rep
gdeconstruct
          @(TTable Expr)
          @TColumns
          @Id
          @Expr
          @(Eval (rep Expr))
          ((Columns x Expr -> x) -> proxy x -> Columns x Expr -> x
forall a b. a -> b -> a
const Columns x Expr -> x
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns) (GColumns TColumns (Eval (rep Expr)) Expr
 -> GFields Id (Eval (rep Expr)))
-> GColumns TColumns (Eval (rep Expr)) Expr
-> GFields Id (Eval (rep Expr))
forall a b. (a -> b) -> a -> b
$
        exprs -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr
gtoColumns exprs
es
  SAlgebra algebra
SSum -> ((GFieldsADT Id (Eval (rep Aggregate)) -> agg)
 -> GFieldsADT Id (Eval (rep Expr)) -> agg)
-> GFieldsADT Id (Eval (rep Expr))
-> (GFieldsADT Id (Eval (rep Aggregate)) -> agg)
-> agg
forall a b c. (a -> b -> c) -> b -> a -> c
flip (GFieldsADT Id (Eval (rep Aggregate)) -> agg)
-> GFieldsADT Id (Eval (rep Expr)) -> agg
f GFieldsADT Id (Eval (rep Expr))
exprs ((GFieldsADT Id (Eval (rep Aggregate)) -> agg) -> agg)
-> (GFieldsADT Id (Eval (rep Aggregate)) -> agg) -> agg
forall a b. (a -> b) -> a -> b
$
    Eval (GGColumns algebra TColumns (Eval (rep Expr))) Aggregate
-> agg
gfromColumns (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Aggregate
 -> agg)
-> (GFieldsADT Id (Eval (rep Aggregate))
    -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Aggregate)
-> GFieldsADT Id (Eval (rep Aggregate))
-> agg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ToColumns (TTable Aggregate) TColumns Id Aggregate
-> (Tag -> Nullifier Aggregate)
-> HIdentity Tag Aggregate
-> GFieldsADT Id (Eval (rep Aggregate))
-> GColumnsADT TColumns (Eval (rep Aggregate)) Aggregate
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> * -> *)
       (context :: * -> *) (rep :: * -> *).
GConstructableADT _Table _Columns f context rep =>
ToColumns _Table _Columns f context
-> (Tag -> Nullifier context)
-> HIdentity Tag context
-> GFieldsADT f rep
-> GColumnsADT _Columns rep context
gbuildADT
      @(TTable Aggregate)
      @TColumns
      @Id
      @Aggregate
      @(Eval (rep Aggregate))
      ((x -> Columns x Aggregate) -> proxy x -> x -> Columns x Aggregate
forall a b. a -> b -> a
const x -> Columns x Aggregate
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns)
      (\Tag
tag' Spec {Nullity a
nullity :: Nullity a
nullity :: forall a. Spec a -> Nullity a
nullity} (Aggregate Aggregator () (Expr a)
a) ->
        Aggregator () (Expr (Nullify a)) -> Aggregate (Nullify a)
forall a. Aggregator () (Expr a) -> Aggregate a
Aggregate (Aggregator () (Expr (Nullify a)) -> Aggregate (Nullify a))
-> Aggregator () (Expr (Nullify a)) -> Aggregate (Nullify a)
forall a b. (a -> b) -> a -> b
$ Expr Bool -> Expr (Nullify a) -> Expr (Nullify a)
forall a. Expr Bool -> Expr (Maybe a) -> Expr (Maybe a)
sguard (Expr Tag
tag Expr Tag -> Expr Tag -> Expr Bool
forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
==. Tag -> Expr Tag
forall a. Sql DBType a => a -> Expr a
litExpr Tag
tag') (Expr (Nullify a) -> Expr (Nullify a))
-> (Expr a -> Expr (Nullify a)) -> Expr a -> Expr (Nullify a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nullity a -> Expr a -> Expr (Nullify a)
forall a. Nullity a -> Expr a -> Expr (Nullify a)
snullify Nullity a
nullity (Expr a -> Expr (Nullify a))
-> Aggregator () (Expr a) -> Aggregator () (Expr (Nullify a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Aggregator () (Expr a)
a)
      (Aggregate Tag -> HIdentity Tag Aggregate
forall a (context :: * -> *). context a -> HIdentity a context
HIdentity (Expr Tag -> Aggregate Tag
forall a. Sql DBEq a => Expr a -> Aggregate a
groupByExpr Expr Tag
tag))
    where
      f :: (GFieldsADT Id (Eval (rep Aggregate)) -> agg)
-> GFieldsADT Id (Eval (rep Expr)) -> agg
f =
        GBuildADT Id (Eval (rep Expr)) agg
-> GFieldsADT Id (Eval (rep Expr)) -> agg
forall (f :: * -> * -> *) (rep :: * -> *) a.
RepresentableFields f rep =>
GBuildADT f rep a -> GFieldsADT f rep -> a
gfindex @Id @(Eval (rep Expr)) @agg (GBuildADT Id (Eval (rep Expr)) agg
 -> GFieldsADT Id (Eval (rep Expr)) -> agg)
-> ((GFieldsADT Id (Eval (rep Aggregate)) -> agg)
    -> GBuildADT Id (Eval (rep Expr)) agg)
-> (GFieldsADT Id (Eval (rep Aggregate)) -> agg)
-> GFieldsADT Id (Eval (rep Expr))
-> agg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        GGAggregate algebra rep agg
GBuildADT Id (Eval (rep Aggregate)) agg
-> GBuildADT Id (Eval (rep Expr)) agg
agg (GBuildADT Id (Eval (rep Aggregate)) agg
 -> GBuildADT Id (Eval (rep Expr)) agg)
-> ((GFieldsADT Id (Eval (rep Aggregate)) -> agg)
    -> GBuildADT Id (Eval (rep Aggregate)) agg)
-> (GFieldsADT Id (Eval (rep Aggregate)) -> agg)
-> GBuildADT Id (Eval (rep Expr)) agg
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (GFieldsADT Id (Eval (rep Aggregate)) -> agg)
-> GBuildADT Id (Eval (rep Aggregate)) agg
forall (f :: * -> * -> *) (rep :: * -> *) a.
RepresentableFields f rep =>
(GFieldsADT f rep -> a) -> GBuildADT f rep a
gftabulate @Id @(Eval (rep Aggregate)) @agg
      (HIdentity Expr Tag
tag, GFieldsADT Id (Eval (rep Expr))
exprs) =
        FromColumns (TTable Expr) TColumns Id Expr
-> Unnullifier Expr
-> GColumnsADT TColumns (Eval (rep Expr)) Expr
-> (HIdentity Tag Expr, GFieldsADT Id (Eval (rep Expr)))
forall (_Table :: * -> Exp Constraint)
       (_Columns :: * -> Exp HTable) (f :: * -> * -> *)
       (context :: * -> *) (rep :: * -> *).
GConstructableADT _Table _Columns f context rep =>
FromColumns _Table _Columns f context
-> Unnullifier context
-> GColumnsADT _Columns rep context
-> (HIdentity Tag context, GFieldsADT f rep)
gunbuildADT
          @(TTable Expr)
          @TColumns
          @Id
          @Expr
          @(Eval (rep Expr))
          ((Columns x Expr -> x) -> proxy x -> Columns x Expr -> x
forall a b. a -> b -> a
const Columns x Expr -> x
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns)
          (\Spec {Nullity a
nullity :: Nullity a
nullity :: forall a. Spec a -> Nullity a
nullity} -> case Nullity a
nullity of
            Nullity a
Null -> Expr (Nullify a) -> Expr a
forall a. a -> a
id
            Nullity a
NotNull -> Expr (Nullify a) -> Expr a
forall a. Expr (Maybe a) -> Expr a
unsafeUnnullify) (GColumnsADT TColumns (Eval (rep Expr)) Expr
 -> (HIdentity Tag Expr, GFieldsADT Id (Eval (rep Expr))))
-> GColumnsADT TColumns (Eval (rep Expr)) Expr
-> (HIdentity Tag Expr, GFieldsADT Id (Eval (rep Expr)))
forall a b. (a -> b) -> a -> b
$
        exprs -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr
gtoColumns exprs
es