git.iko.soy/rel8
on def349e help sign in
rel8/src/Rel8/Generic/Construction.hs
531 lines 20 kB history raw
1{-# language AllowAmbiguousTypes #-}
2{-# language ConstraintKinds #-}
3{-# language DataKinds #-}
4{-# language FlexibleContexts #-}
5{-# language FlexibleInstances #-}
6{-# language LambdaCase #-}
7{-# language MultiParamTypeClasses #-}
8{-# language NamedFieldPuns #-}
9{-# language ScopedTypeVariables #-}
10{-# language StandaloneKindSignatures #-}
11{-# language TypeApplications #-}
12{-# language TypeFamilies #-}
13{-# language UndecidableInstances #-}
14{-# language ViewPatterns #-}
16module Rel8.Generic.Construction
17 ( GGBuildable
18 , GGBuild, ggbuild
19 , GGInsert, gginsert
20 , GGConstructable
21 , GGConstruct, ggconstruct
22 , GGDeconstruct, ggdeconstruct
23 , GGName, ggname
24 , GGAggregate, ggaggregate
25 , GGAggregate', ggaggregate'
26 )
27where
29-- base
30import Data.Bifunctor ( first )
31import Data.Kind ( Constraint, Type )
32import Data.List.NonEmpty ( NonEmpty( (:|) ) )
33import Data.Type.Equality ( (:~:)( Refl ) )
34import GHC.TypeLits ( Symbol )
35import Prelude
37-- rel8
38import Rel8.Aggregate ( Col( Aggregation ), Aggregate )
39import Rel8.Expr ( Col( DB ), Expr )
40import Rel8.Expr.Aggregate ( groupByExpr )
41import Rel8.Expr.Eq ( (==.) )
42import Rel8.Expr.Null ( nullify, snull, unsafeUnnullify )
43import Rel8.Expr.Serialize ( litExpr )
44import Rel8.FCF ( Compose, Eval, Exp )
45import Rel8.Generic.Construction.ADT
46 ( GConstructorADT, GMakeableADT, gmakeADT
47 , GConstructableADT
48 , GBuildADT, gbuildADT, gunbuildADT
49 , GConstructADT, gconstructADT, gdeconstructADT
50 , CorepConstructors, GConstructors, gcindex, gctabulate
51 , CorepFields, gfindex, gftabulate, gftraverse
52 )
53import Rel8.Generic.Construction.Record
54 ( GConstructor
55 , GConstructable, GConstruct, gconstruct, gdeconstruct
56 , Corep, gindex, gtabulate, gtraverse
57 )
58import Rel8.Generic.Table ( GGColumns )
59import Rel8.Kind.Algebra
60 ( SAlgebra( SProduct, SSum )
61 , KnownAlgebra, algebraSing
62 )
63import qualified Rel8.Kind.Algebra as K
64import Rel8.Kind.Necessity ( SNecessity( SOptional, SRequired ) )
65import Rel8.Schema.Context.Nullify ( runTag )
66import Rel8.Schema.HTable ( HTable )
67import Rel8.Schema.HTable.Identity ( HIdentity( HType ) )
68import Rel8.Schema.Insert ( Col( OptionalInsert, RequiredInsert ), Insert )
69import qualified Rel8.Schema.Kind as K
70import Rel8.Schema.Name ( Col( NameCol ), Name( Name ) )
71import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
72import Rel8.Schema.Spec ( SSpec( SSpec, necessity, nullity, info ) )
73import Rel8.Schema.Reify ( Col( Reify ), Reify, hreify, hunreify )
74import Rel8.Schema.Result ( Result )
75import Rel8.Table
76 ( TTable, TColumns, TUnreify
77 , Table, fromColumns, toColumns, reify, unreify
78 )
79import Rel8.Table.Bool ( case_ )
80import Rel8.Type.Tag ( Tag )
82-- semigroupoids
83import Data.Functor.Apply ( Apply, MaybeApply( MaybeApply ), liftF2 )
86type GGBuildable :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) -> Constraint
87type GGBuildable algebra name rep =
88 ( KnownAlgebra algebra
89 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Aggregate)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
90 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Expr)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
91 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Insert)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
92 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Name)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
93 , HTable (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))))
94 , GGBuildable' algebra name rep
95 )
98type GGBuildable' :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) -> Constraint
99type family GGBuildable' algebra name rep where
100 GGBuildable' 'K.Product name rep =
101 ( name ~ GConstructor (Eval (rep (Reify Expr)))
102 , name ~ GConstructor (Eval (rep (Reify Insert)))
103 , Corep TUnreify (Eval (rep (Reify Expr)))
104 , Corep TUnreify (Eval (rep (Reify Insert)))
105 , GConstructable (TTable (Reify Expr)) TColumns TUnreify (Col (Reify Expr)) (Eval (rep (Reify Expr)))
106 , GConstructable (TTable (Reify Insert)) TColumns TUnreify (Col (Reify Insert)) (Eval (rep (Reify Insert)))
107 )
108 GGBuildable' 'K.Sum name rep =
109 ( Corep TUnreify (GConstructorADT name (Eval (rep (Reify Expr))))
110 , Corep TUnreify (GConstructorADT name (Eval (rep (Reify Insert))))
111 , GMakeableADT (TTable (Reify Expr)) TColumns TUnreify (Col (Reify Expr)) name (Eval (rep (Reify Expr)))
112 , GMakeableADT (TTable (Reify Insert)) TColumns TUnreify (Col (Reify Insert)) name (Eval (rep (Reify Insert)))
113 )
116type GGBuild :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) -> Type -> Type
117type family GGBuild algebra name rep r where
118 GGBuild 'K.Product _name rep r =
119 GConstruct TUnreify (Eval (rep (Reify Expr))) r
120 GGBuild 'K.Sum name rep r =
121 GConstruct TUnreify (GConstructorADT name (Eval (rep (Reify Expr)))) r
124ggbuild :: forall algebra name rep a. GGBuildable algebra name rep
125 => (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))) (Col Expr) -> a)
126 -> GGBuild algebra name rep a
127ggbuild gfromColumns = case algebraSing @algebra of
128 SProduct ->
129 gtabulate @TUnreify @(Eval (rep (Reify Expr))) @a $
130 gfromColumns .
131 hunreify .
132 gconstruct
133 @(TTable (Reify Expr))
134 @TColumns
135 @TUnreify
136 @(Col (Reify Expr))
137 @(Eval (rep (Reify Expr)))
138 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
139 SSum ->
140 gtabulate @TUnreify @(GConstructorADT name (Eval (rep (Reify Expr)))) @a $
141 gfromColumns .
142 hunreify .
143 gmakeADT
144 @(TTable (Reify Expr))
145 @TColumns
146 @TUnreify
147 @(Col (Reify Expr))
148 @name
149 @(Eval (rep (Reify Expr)))
150 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
151 (\SSpec {info} -> Reify (DB (snull info)))
152 (\SSpec {nullity} -> case nullity of
153 Null -> id
154 NotNull -> \(Reify (DB a)) -> Reify (DB (nullify a)))
155 (HType . Reify . DB . litExpr)
158type GGInsert :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) -> Type -> Type
159type family GGInsert algebra name rep r where
160 GGInsert 'K.Product _name rep r =
161 GConstruct TUnreify (Eval (rep (Reify Insert))) r
162 GGInsert 'K.Sum name rep r =
163 GConstruct TUnreify (GConstructorADT name (Eval (rep (Reify Insert)))) r
166gginsert :: forall algebra name rep a. GGBuildable algebra name rep
167 => (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))) (Col Insert) -> a)
168 -> GGInsert algebra name rep a
169gginsert gfromColumns = case algebraSing @algebra of
170 SProduct ->
171 gtabulate @TUnreify @(Eval (rep (Reify Insert))) @a $
172 gfromColumns .
173 hunreify .
174 gconstruct
175 @(TTable (Reify Insert))
176 @TColumns
177 @TUnreify
178 @(Col (Reify Insert))
179 @(Eval (rep (Reify Insert)))
180 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
181 SSum ->
182 gtabulate @TUnreify @(GConstructorADT name (Eval (rep (Reify Insert)))) @a $
183 gfromColumns .
184 hunreify .
185 gmakeADT
186 @(TTable (Reify Insert))
187 @TColumns
188 @TUnreify
189 @(Col (Reify Insert))
190 @name
191 @(Eval (rep (Reify Insert)))
192 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
193 (\SSpec {necessity, info} -> Reify $ case necessity of
194 SRequired -> RequiredInsert (snull info)
195 SOptional -> OptionalInsert (Just (snull info)))
196 (\SSpec {nullity} -> case nullity of
197 Null -> id
198 NotNull -> \case
199 Reify (RequiredInsert a) -> Reify (RequiredInsert (nullify a))
200 Reify (OptionalInsert a) -> Reify (OptionalInsert (nullify <$> a)))
201 (HType . Reify . RequiredInsert . litExpr)
204type GGConstructable :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Constraint
205type GGConstructable algebra rep =
206 ( KnownAlgebra algebra
207 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Aggregate)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
208 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Expr)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
209 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Insert)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
210 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Name)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))
211 , HTable (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))))
212 , GGConstructable' algebra rep
213 )
216type GGConstructable' :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Constraint
217type family GGConstructable' algebra rep where
218 GGConstructable' 'K.Product rep =
219 ( Corep (Compose Aggregate TUnreify) (Eval (rep (Reify Expr)))
220 , Corep TUnreify (Eval (rep (Reify Aggregate)))
221 , Corep TUnreify (Eval (rep (Reify Expr)))
222 , Corep TUnreify (Eval (rep (Reify Insert)))
223 , Corep TUnreify (Eval (rep (Reify Name)))
224 , GConstructable (TTable (Reify Aggregate)) TColumns TUnreify (Col (Reify Aggregate)) (Eval (rep (Reify Aggregate)))
225 , GConstructable (TTable (Reify Expr)) TColumns TUnreify (Col (Reify Expr)) (Eval (rep (Reify Expr)))
226 , GConstructable (TTable (Reify Insert)) TColumns TUnreify (Col (Reify Insert)) (Eval (rep (Reify Insert)))
227 , GConstructable (TTable (Reify Name)) TColumns TUnreify (Col (Reify Name)) (Eval (rep (Reify Name)))
228 )
229 GGConstructable' 'K.Sum rep =
230 ( CorepConstructors TUnreify (Eval (rep (Reify Expr)))
231 , CorepConstructors TUnreify (Eval (rep (Reify Insert)))
232 , CorepFields (Compose Aggregate TUnreify) (Eval (rep (Reify Expr)))
233 , CorepFields TUnreify (Eval (rep (Reify Aggregate)))
234 , CorepFields TUnreify (Eval (rep (Reify Expr)))
235 , CorepFields TUnreify (Eval (rep (Reify Name)))
236 , Functor (GConstructors TUnreify (Eval (rep (Reify Expr))))
237 , Functor (GConstructors TUnreify (Eval (rep (Reify Insert))))
238 , GConstructableADT (TTable (Reify Aggregate)) TColumns TUnreify (Col (Reify Aggregate)) (Eval (rep (Reify Aggregate)))
239 , GConstructableADT (TTable (Reify Expr)) TColumns TUnreify (Col (Reify Expr)) (Eval (rep (Reify Expr)))
240 , GConstructableADT (TTable (Reify Insert)) TColumns TUnreify (Col (Reify Insert)) (Eval (rep (Reify Insert)))
241 , GConstructableADT (TTable (Reify Name)) TColumns TUnreify (Col (Reify Name)) (Eval (rep (Reify Name)))
242 )
245type GGConstruct :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type
246type family GGConstruct algebra rep r where
247 GGConstruct 'K.Product rep r =
248 GConstruct TUnreify (Eval (rep (Reify Expr))) r -> r
249 GGConstruct 'K.Sum rep r =
250 GConstructADT TUnreify (Eval (rep (Reify Expr))) r r
253ggconstruct :: forall algebra rep a. GGConstructable algebra rep
254 => (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))) (Col Expr) -> a)
255 -> GGConstruct algebra rep a -> a
256ggconstruct gfromColumns f = case algebraSing @algebra of
257 SProduct ->
258 f $
259 gtabulate @TUnreify @(Eval (rep (Reify Expr))) @a $
260 gfromColumns .
261 hunreify .
262 gconstruct
263 @(TTable (Reify Expr))
264 @TColumns
265 @TUnreify
266 @(Col (Reify Expr))
267 @(Eval (rep (Reify Expr)))
268 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
269 SSum ->
270 gcindex @TUnreify @(Eval (rep (Reify Expr))) @a f $
271 fmap (gfromColumns . hunreify) $
272 gconstructADT
273 @(TTable (Reify Expr))
274 @TColumns
275 @TUnreify
276 @(Col (Reify Expr))
277 @(Eval (rep (Reify Expr)))
278 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
279 (\SSpec {info} -> Reify (DB (snull info)))
280 (\SSpec {nullity} -> case nullity of
281 Null -> id
282 NotNull -> \(Reify (DB a)) -> Reify (DB (nullify a)))
283 (HType . Reify . DB . litExpr)
286type GGDeconstruct :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type -> Type
287type family GGDeconstruct algebra rep a r where
288 GGDeconstruct 'K.Product rep a r =
289 GConstruct TUnreify (Eval (rep (Reify Expr))) r -> a -> r
290 GGDeconstruct 'K.Sum rep a r =
291 GConstructADT TUnreify (Eval (rep (Reify Expr))) r (a -> r)
294ggdeconstruct :: forall algebra rep a r. (GGConstructable algebra rep, Table Expr r)
295 => (a -> Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))) (Col Expr))
296 -> GGDeconstruct algebra rep a r
297ggdeconstruct gtoColumns = case algebraSing @algebra of
298 SProduct -> \build ->
299 gindex @TUnreify @(Eval (rep (Reify Expr))) @r build .
300 gdeconstruct
301 @(TTable (Reify Expr))
302 @TColumns
303 @TUnreify
304 @(Col (Reify Expr))
305 @(Eval (rep (Reify Expr)))
306 (\(_ :: proxy x) -> unreify @_ @x Refl . fromColumns) .
307 hreify .
308 gtoColumns
309 SSum ->
310 gctabulate @TUnreify @(Eval (rep (Reify Expr))) @r @(a -> r) $ \constructors as ->
311 let
312 (HType (Reify (DB tag)), cases) =
313 gdeconstructADT
314 @(TTable (Reify Expr))
315 @TColumns
316 @TUnreify
317 @(Col (Reify Expr))
318 @(Eval (rep (Reify Expr)))
319 (\(_ :: proxy x) -> unreify @_ @x Refl . fromColumns)
320 (\SSpec {nullity} -> case nullity of
321 Null -> id
322 NotNull -> \(Reify (DB a)) -> Reify (DB (unsafeUnnullify a)))
323 constructors $
324 hreify $
325 gtoColumns as
326 in
327 case cases of
328 ((_, r) :| (map (first ((tag ==.) . litExpr)) -> cases')) ->
329 case_ cases' r
332type GGName :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type
333type family GGName algebra rep a where
334 GGName 'K.Product rep a = GConstruct TUnreify (Eval (rep (Reify Name))) a
335 GGName 'K.Sum rep a = Name Tag -> GBuildADT TUnreify (Eval (rep (Reify Name))) a
338ggname :: forall algebra rep a. GGConstructable algebra rep
339 => (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))) (Col Name) -> a)
340 -> GGName algebra rep a
341ggname gfromColumns = case algebraSing @algebra of
342 SProduct ->
343 gtabulate @TUnreify @(Eval (rep (Reify Name))) @a $
344 gfromColumns .
345 hunreify .
346 gconstruct
347 @(TTable (Reify Name))
348 @TColumns
349 @TUnreify
350 @(Col (Reify Name))
351 @(Eval (rep (Reify Name)))
352 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
353 SSum -> \tag ->
354 gftabulate @TUnreify @(Eval (rep (Reify Name))) @a $
355 gfromColumns .
356 hunreify .
357 gbuildADT
358 @(TTable (Reify Name))
359 @TColumns
360 @TUnreify
361 @(Col (Reify Name))
362 @(Eval (rep (Reify Name)))
363 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
364 (\_ _ (Reify (NameCol a)) -> Reify (NameCol a))
365 (HType ((\(Name a) -> Reify (NameCol a)) tag))
368type GGAggregate :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type
369type family GGAggregate algebra rep r where
370 GGAggregate 'K.Product rep r =
371 GConstruct (Compose Aggregate TUnreify) (Eval (rep (Reify Expr))) r ->
372 GConstruct TUnreify (Eval (rep (Reify Expr))) r
373 GGAggregate 'K.Sum rep r =
374 GBuildADT (Compose Aggregate TUnreify) (Eval (rep (Reify Expr))) r ->
375 GBuildADT TUnreify (Eval (rep (Reify Expr))) r
378ggaggregate :: forall algebra rep a. GGConstructable algebra rep
379 => (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))) (Col Expr) -> a)
380 -> (a -> Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))) (Col Expr))
381 -> GGAggregate algebra rep (Aggregate a) -> a -> Aggregate a
382ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of
383 SProduct -> flip f exprs $
384 fmap
385 ( gfromColumns
386 . hunreify
387 . gconstruct
388 @(TTable (Reify Expr))
389 @TColumns
390 @TUnreify
391 @(Col (Reify Expr))
392 @(Eval (rep (Reify Expr)))
393 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
394 ) .
395 liftF½ .
396 gtraverse @TUnreify @(Eval (rep (Reify Expr))) @_ @Aggregate (MaybeApply . Left)
397 where
398 f =
399 gindex @TUnreify @(Eval (rep (Reify Expr))) @(Aggregate a) .
400 agg .
401 gtabulate @(Compose Aggregate TUnreify) @(Eval (rep (Reify Expr))) @(Aggregate a)
402 exprs =
403 gdeconstruct
404 @(TTable (Reify Expr))
405 @TColumns
406 @TUnreify
407 @(Col (Reify Expr))
408 @(Eval (rep (Reify Expr)))
409 (\(_ :: proxy x) -> unreify @_ @x Refl . fromColumns) $
410 hreify $
411 gtoColumns es
412 SSum -> flip f exprs $
413 liftF1½
414 (\tag' ->
415 gfromColumns .
416 hunreify .
417 gbuildADT
418 @(TTable (Reify Expr))
419 @TColumns
420 @TUnreify
421 @(Col (Reify Expr))
422 @(Eval (rep (Reify Expr)))
423 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
424 (\tag'' SSpec {nullity} (Reify (DB a)) ->
425 Reify $ DB $ runTag nullity (tag ==. litExpr tag'') a)
426 (HType (Reify (DB tag'))))
427 (groupByExpr tag) .
428 gftraverse @TUnreify @(Eval (rep (Reify Expr))) @_ @Aggregate (MaybeApply . Left)
429 where
430 f =
431 gfindex @TUnreify @(Eval (rep (Reify Expr))) @(Aggregate a) .
432 agg .
433 gftabulate @(Compose Aggregate TUnreify) @(Eval (rep (Reify Expr))) @(Aggregate a)
434 (HType (Reify (DB tag)), exprs) =
435 gunbuildADT
436 @(TTable (Reify Expr))
437 @TColumns
438 @TUnreify
439 @(Col (Reify Expr))
440 @(Eval (rep (Reify Expr)))
441 (\(_ :: proxy x) -> unreify @_ @x Refl . fromColumns)
442 (\SSpec {nullity} -> case nullity of
443 Null -> id
444 NotNull -> \(Reify (DB a)) -> Reify (DB (unsafeUnnullify a))) $
445 hreify $
446 gtoColumns es
449type GGAggregate' :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type
450type family GGAggregate' algebra rep r where
451 GGAggregate' 'K.Product rep r =
452 GConstruct TUnreify (Eval (rep (Reify Aggregate))) r ->
453 GConstruct TUnreify (Eval (rep (Reify Expr))) r
454 GGAggregate' 'K.Sum rep r =
455 GBuildADT TUnreify (Eval (rep (Reify Aggregate))) r ->
456 GBuildADT TUnreify (Eval (rep (Reify Expr))) r
459ggaggregate' :: forall algebra rep exprs agg. GGConstructable algebra rep
460 => (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))) (Col Aggregate) -> agg)
461 -> (exprs -> Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))) (Col Expr))
462 -> GGAggregate' algebra rep agg -> exprs -> agg
463ggaggregate' gfromColumns gtoColumns agg es = case algebraSing @algebra of
464 SProduct -> flip f exprs $
465 gfromColumns .
466 hunreify .
467 gconstruct
468 @(TTable (Reify Aggregate))
469 @TColumns
470 @TUnreify
471 @(Col (Reify Aggregate))
472 @(Eval (rep (Reify Aggregate)))
473 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
474 where
475 f =
476 gindex @TUnreify @(Eval (rep (Reify Expr))) @agg .
477 agg .
478 gtabulate @TUnreify @(Eval (rep (Reify Aggregate))) @agg
479 exprs =
480 gdeconstruct
481 @(TTable (Reify Expr))
482 @TColumns
483 @TUnreify
484 @(Col (Reify Expr))
485 @(Eval (rep (Reify Expr)))
486 (\(_ :: proxy x) -> unreify @_ @x Refl . fromColumns) $
487 hreify $
488 gtoColumns es
489 SSum -> flip f exprs $
490 gfromColumns .
491 hunreify .
492 gbuildADT
493 @(TTable (Reify Aggregate))
494 @TColumns
495 @TUnreify
496 @(Col (Reify Aggregate))
497 @(Eval (rep (Reify Aggregate)))
498 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
499 (\tag' SSpec {nullity} (Reify (Aggregation a)) ->
500 Reify $ Aggregation $ runTag nullity (tag ==. litExpr tag') <$> a)
501 (HType (Reify (Aggregation (groupByExpr tag))))
502 where
503 f =
504 gfindex @TUnreify @(Eval (rep (Reify Expr))) @agg .
505 agg .
506 gftabulate @TUnreify @(Eval (rep (Reify Aggregate))) @agg
507 (HType (Reify (DB tag)), exprs) =
508 gunbuildADT
509 @(TTable (Reify Expr))
510 @TColumns
511 @TUnreify
512 @(Col (Reify Expr))
513 @(Eval (rep (Reify Expr)))
514 (\(_ :: proxy x) -> unreify @_ @x Refl . fromColumns)
515 (\SSpec {nullity} -> case nullity of
516 Null -> id
517 NotNull -> \(Reify (DB a)) -> Reify (DB (unsafeUnnullify a))) $
518 hreify $
519 gtoColumns es
522liftF½ :: MaybeApply Aggregate a -> Aggregate a
523liftF½ (MaybeApply ma) = case ma of
524 Left a -> a
525 Right a -> a <$ groupByExpr (litExpr False)
528liftF1½ :: Apply v => (a -> b -> c) -> v a -> MaybeApply v b -> v c
529liftF1½ f a (MaybeApply eb) = case eb of
530 Left b -> liftF2 f a b
531 Right b -> fmap (`f` b) a