{-# 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
import Data.Bifunctor ( first )
import Data.Kind ( Constraint, Type )
import Data.List.NonEmpty ( NonEmpty( (:|) ) )
import GHC.TypeLits ( Symbol )
import Prelude
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 :: forall (algebra :: Algebra) (name :: Symbol)
(rep :: Context -> Exp Context) 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
gfromColumns = case forall (algebra :: Algebra).
KnownAlgebra algebra =>
SAlgebra algebra
algebraSing @algebra of
SAlgebra algebra
SProduct ->
forall (f :: * -> Context) (rep :: Context) a.
Representable f rep =>
(GFields f rep -> a) -> GConstruct f rep a
gtabulate @Id @(Eval (rep Expr)) @a forall a b. (a -> b) -> a -> b
$
Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a
gfromColumns forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp (Exp Context)) (f :: * -> Context)
(context :: Context) (rep :: Context).
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))
(forall a b. a -> b -> a
const forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns)
SAlgebra algebra
SSum ->
forall (f :: * -> Context) (rep :: Context) a.
Representable f rep =>
(GFields f rep -> a) -> GConstruct f rep a
gtabulate @Id @(GConstructorADT name (Eval (rep Expr))) @a forall a b. (a -> b) -> a -> b
$
Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a
gfromColumns forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp (Exp Context)) (f :: * -> Context)
(context :: Context) (name :: Symbol) (rep :: Context).
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))
(forall a b. a -> b -> a
const forall (context :: 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} -> 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 -> forall a. a -> a
id
Nullity a
NotNull -> forall a. NotNull a => Expr a -> Expr (Maybe a)
nullify)
(forall a (context :: Context). context a -> HIdentity a context
HIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (algebra :: Algebra) (rep :: Context -> Exp Context) 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
gfromColumns GGConstruct algebra rep a
f = case forall (algebra :: Algebra).
KnownAlgebra algebra =>
SAlgebra algebra
algebraSing @algebra of
SAlgebra algebra
SProduct ->
GGConstruct algebra rep a
f forall a b. (a -> b) -> a -> b
$
forall (f :: * -> Context) (rep :: Context) a.
Representable f rep =>
(GFields f rep -> a) -> GConstruct f rep a
gtabulate @Id @(Eval (rep Expr)) @a forall a b. (a -> b) -> a -> b
$
Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a
gfromColumns forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp (Exp Context)) (f :: * -> Context)
(context :: Context) (rep :: Context).
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))
(forall a b. a -> b -> a
const forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns)
SAlgebra algebra
SSum ->
forall (f :: * -> Context) (rep :: Context) r a.
RepresentableConstructors f rep =>
GConstructADT f rep r a -> GConstructors f rep r -> a
gcindex @Id @(Eval (rep Expr)) @a GGConstruct algebra rep a
f forall a b. (a -> b) -> a -> b
$
forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
fmap Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a
gfromColumns forall a b. (a -> b) -> a -> b
$
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp (Exp Context)) (f :: * -> Context)
(context :: Context) (rep :: Context).
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))
(forall a b. a -> b -> a
const forall (context :: 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} -> 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 -> forall a. a -> a
id
Nullity a
NotNull -> forall a. NotNull a => Expr a -> Expr (Maybe a)
nullify)
(forall a (context :: Context). context a -> HIdentity a context
HIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (algebra :: Algebra) (rep :: Context -> Exp Context) 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
gtoColumns = case forall (algebra :: Algebra).
KnownAlgebra algebra =>
SAlgebra algebra
algebraSing @algebra of
SAlgebra algebra
SProduct -> \GConstruct Id (Eval (rep Expr)) r
build ->
forall (f :: * -> Context) (rep :: Context) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp (Exp Context)) (f :: * -> Context)
(context :: Context) (rep :: Context).
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))
(forall a b. a -> b -> a
const forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
a -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr
gtoColumns
SAlgebra algebra
SSum ->
forall (f :: * -> Context) (rep :: Context) r a.
RepresentableConstructors f rep =>
(GConstructors f rep r -> a) -> GConstructADT f rep r a
gctabulate @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) =
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp (Exp Context)) (f :: * -> Context)
(context :: Context) (rep :: Context) 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))
(forall a b. a -> b -> a
const forall (context :: 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 -> forall a. a -> a
id
Nullity a
NotNull -> forall a. Expr (Maybe a) -> Expr a
unsafeUnnullify)
GConstructors Id (Eval (rep Expr)) r
constructors 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) :| (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> Context) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Expr Tag
tag forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
==.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Sql DBType a => a -> Expr a
litExpr)) -> [(Expr Bool, r)]
cases')) ->
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 :: forall (algebra :: Algebra) (rep :: Context -> Exp Context) 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
gfromColumns = case forall (algebra :: Algebra).
KnownAlgebra algebra =>
SAlgebra algebra
algebraSing @algebra of
SAlgebra algebra
SProduct ->
forall (f :: * -> Context) (rep :: Context) a.
Representable f rep =>
(GFields f rep -> a) -> GConstruct f rep a
gtabulate @Id @(Eval (rep Name)) @a forall a b. (a -> b) -> a -> b
$
Eval (GGColumns algebra TColumns (Eval (rep Expr))) Name -> a
gfromColumns forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp (Exp Context)) (f :: * -> Context)
(context :: Context) (rep :: Context).
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))
(forall a b. a -> b -> a
const forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns)
SAlgebra algebra
SSum -> \Name Tag
tag ->
forall (f :: * -> Context) (rep :: Context) a.
RepresentableFields f rep =>
(GFieldsADT f rep -> a) -> GBuildADT f rep a
gftabulate @Id @(Eval (rep Name)) @a forall a b. (a -> b) -> a -> b
$
Eval (GGColumns algebra TColumns (Eval (rep Expr))) Name -> a
gfromColumns forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp (Exp Context)) (f :: * -> Context)
(context :: Context) (rep :: Context).
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))
(forall a b. a -> b -> a
const forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns)
(\Tag
_ Spec a
_ (Name String
a) -> forall a. String -> Name a
Name String
a)
(forall a (context :: 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 :: forall (algebra :: Algebra) (rep :: Context -> Exp Context) 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
gfromColumns exprs -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr
gtoColumns GGAggregate algebra rep agg
agg exprs
es = case forall (algebra :: Algebra).
KnownAlgebra algebra =>
SAlgebra algebra
algebraSing @algebra of
SAlgebra algebra
SProduct -> 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 forall a b. (a -> b) -> a -> b
$
Eval (GGColumns algebra TColumns (Eval (rep Expr))) Aggregate
-> agg
gfromColumns forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp (Exp Context)) (f :: * -> Context)
(context :: Context) (rep :: Context).
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))
(forall a b. a -> b -> a
const forall (context :: 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 =
forall (f :: * -> Context) (rep :: Context) a.
Representable f rep =>
GConstruct f rep a -> GFields f rep -> a
gindex @Id @(Eval (rep Expr)) @agg forall b c a. (b -> c) -> (a -> b) -> a -> c
.
GGAggregate algebra rep agg
agg forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (f :: * -> Context) (rep :: Context) 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 =
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp (Exp Context)) (f :: * -> Context)
(context :: Context) (rep :: Context).
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))
(forall a b. a -> b -> a
const forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns) forall a b. (a -> b) -> a -> b
$
exprs -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr
gtoColumns exprs
es
SAlgebra algebra
SSum -> 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 forall a b. (a -> b) -> a -> b
$
Eval (GGColumns algebra TColumns (Eval (rep Expr))) Aggregate
-> agg
gfromColumns forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp (Exp Context)) (f :: * -> Context)
(context :: Context) (rep :: Context).
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))
(forall a b. a -> b -> a
const forall (context :: 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) ->
forall a. Aggregator () (Expr a) -> Aggregate a
Aggregate forall a b. (a -> b) -> a -> b
$ forall a. Expr Bool -> Expr (Maybe a) -> Expr (Maybe a)
sguard (Expr Tag
tag forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
==. forall a. Sql DBType a => a -> Expr a
litExpr Tag
tag') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Nullity a -> Expr a -> Expr (Nullify a)
snullify Nullity a
nullity forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
<$> Aggregator () (Expr a)
a)
(forall a (context :: Context). context a -> HIdentity a context
HIdentity (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 =
forall (f :: * -> Context) (rep :: Context) a.
RepresentableFields f rep =>
GBuildADT f rep a -> GFieldsADT f rep -> a
gfindex @Id @(Eval (rep Expr)) @agg forall b c a. (b -> c) -> (a -> b) -> a -> c
.
GGAggregate algebra rep agg
agg forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (f :: * -> Context) (rep :: Context) 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) =
forall (_Table :: * -> Exp Constraint)
(_Columns :: * -> Exp (Exp Context)) (f :: * -> Context)
(context :: Context) (rep :: Context).
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))
(forall a b. a -> b -> a
const forall (context :: 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 -> forall a. a -> a
id
Nullity a
NotNull -> forall a. Expr (Maybe a) -> Expr a
unsafeUnnullify) forall a b. (a -> b) -> a -> b
$
exprs -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr
gtoColumns exprs
es