git.iko.soy/rel8
on b2c47ab help sign in
rel8/src/Rel8/Schema/Generic.hs
1021 lines 35 kB history raw
1{-# language AllowAmbiguousTypes #-}
2{-# language DataKinds #-}
3{-# language DisambiguateRecordFields #-}
4{-# language DefaultSignatures #-}
5{-# language FlexibleContexts #-}
6{-# language FlexibleInstances #-}
7{-# language GADTs #-}
8{-# language MultiParamTypeClasses #-}
9{-# language ScopedTypeVariables #-}
10{-# language StandaloneKindSignatures #-}
11{-# language TypeApplications #-}
12{-# language TypeFamilies #-}
13{-# language TypeOperators #-}
14{-# language UndecidableInstances #-}
15{-# language ViewPatterns #-}
17{-# options_ghc -fno-warn-orphans #-}
19module Rel8.Schema.Generic
20 ( Rel8able
21 )
22where
24-- base
25import Data.Bifunctor ( bimap )
26import Data.Kind ( Constraint, Type )
27import Data.List.NonEmpty ( NonEmpty )
28import GHC.Generics
29 ( Generic, Rep, from, to
30 , (:*:)( (:*:) ), K1( K1 ), M1( M1 )
31 , D, C, S
32 , Meta( MetaSel )
33 )
34import GHC.TypeLits ( Symbol )
35import Prelude
37-- rel8
38import Rel8.Kind.Necessity
39 ( SNecessity( SRequired, SOptional )
40 , KnownNecessity, necessitySing
41 )
42import Rel8.Schema.Context
43 ( Aggregation( Aggregation )
44 , DB( DB )
45 , Insertion( RequiredInsert, OptionalInsert )
46 , Result( Result )
47 , IsSpecialContext
48 )
49import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
50import Rel8.Schema.Context.Nullify ( Nullifiable )
51import Rel8.Schema.Context.Result
52 ( fromHEitherTable, toHEitherTable
53 , fromHListTable, toHListTable
54 , fromHMaybeTable, toHMaybeTable
55 , fromHNonEmptyTable, toHNonEmptyTable
56 , fromHTheseTable, toHTheseTable
57 )
58import Rel8.Schema.Field ( Field )
59import Rel8.Schema.HTable ( HTable )
60import Rel8.Schema.HTable.Context ( H, HKTable )
61import Rel8.Schema.HTable.Either ( HEitherTable )
62import Rel8.Schema.HTable.Identity ( HIdentity(..) )
63import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
64import Rel8.Schema.HTable.List ( HListTable )
65import Rel8.Schema.HTable.Maybe ( HMaybeTable )
66import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
67import Rel8.Schema.HTable.Pair ( HPair(..) )
68import Rel8.Schema.HTable.Quartet ( HQuartet(..) )
69import Rel8.Schema.HTable.Quintet ( HQuintet(..) )
70import Rel8.Schema.HTable.These ( HTheseTable )
71import Rel8.Schema.HTable.Trio ( HTrio(..) )
72import Rel8.Schema.HTable.Vectorize ( hrelabel )
73import Rel8.Schema.Spec ( Spec( Spec ), KTable )
74import qualified Rel8.Schema.Spec as Kind ( Context )
75import Rel8.Schema.Structure
76 ( IsStructure, Shape(..), Shape1, Shape2
77 , Structure
78 )
79import Rel8.Table
80 ( Table, Columns, Context, fromColumns, toColumns
81 )
82import Rel8.Table.Either ( EitherTable )
83import Rel8.Table.Lifted
84 ( fromColumns1, toColumns1
85 , fromColumns2, toColumns2
86 )
87import Rel8.Table.List ( ListTable )
88import Rel8.Table.Maybe ( MaybeTable(..) )
89import Rel8.Table.NonEmpty ( NonEmptyTable )
90import Rel8.Table.These ( TheseTable )
92-- these
93import Data.These ( These )
96instance (Rel8able t, TableHelper (IsSpecialContext context) context) =>
97 Table context (t context)
98 where
99 type Columns (t context) = GRep t
100 type Context (t context) = context
101 fromColumns = gfromColumns
102 toColumns = gtoColumns
105type TableHelper :: Bool -> Kind.Context -> Constraint
106class IsSpecialContext context ~ isSpecialContext =>
107 TableHelper isSpecialContext context
108 where
109 gfromColumns :: Rel8able t => GRep t (H context) -> t context
110 gtoColumns :: Rel8able t => t context -> GRep t (H context)
113instance TableHelper 'True Aggregation where
114 gfromColumns = fromAggregationColumns
115 gtoColumns = toAggregationColumns
118instance TableHelper 'True DB where
119 gfromColumns = fromDBColumns
120 gtoColumns = toDBColumns
123instance TableHelper 'True Insertion where
124 gfromColumns = fromInsertionColumns
125 gtoColumns = toInsertionColumns
128instance TableHelper 'True Result where
129 gfromColumns = fromResultColumns
130 gtoColumns = toResultColumns
133instance (IsSpecialContext context ~ 'False, Labelable context, Nullifiable context) =>
134 TableHelper 'False context
135 where
136 gfromColumns = fromUnspecialColumns
137 gtoColumns = toUnspecialColumns
140type Rel8able :: KTable -> Constraint
141class HTable (GRep t) => Rel8able t where
142 type GRep t :: HKTable
144 fromAggregationColumns :: GRep t (H Aggregation) -> t Aggregation
145 toAggregationColumns :: t Aggregation -> GRep t (H Aggregation)
147 fromDBColumns :: GRep t (H DB) -> t DB
148 toDBColumns :: t DB -> GRep t (H DB)
150 fromInsertionColumns :: GRep t (H Insertion) -> t Insertion
151 toInsertionColumns :: t Insertion -> GRep t (H Insertion)
153 fromResultColumns :: GRep t (H Result) -> t Result
154 toResultColumns :: t Result -> GRep t (H Result)
156 fromUnspecialColumns ::
157 ( IsSpecialContext context ~ 'False
158 , Labelable context, Nullifiable context
159 )
160 => GRep t (H context) -> t context
161 toUnspecialColumns ::
162 ( IsSpecialContext context ~ 'False
163 , Labelable context, Nullifiable context
164 )
165 => t context -> GRep t (H context)
167 type GRep t = GColumns (Rep (t Structure))
169 default fromAggregationColumns ::
170 ( Generic (t Aggregation)
171 , GColumns (Rep (t Structure)) ~ GRep t
172 , GRel8able Aggregation (Rep (t Structure)) (Rep (t Aggregation))
173 ) => GRep t (H Aggregation) -> t Aggregation
174 fromAggregationColumns = to . fromGColumns @_ @(Rep (t Structure))
176 default toAggregationColumns ::
177 ( Generic (t Aggregation)
178 , GColumns (Rep (t Structure)) ~ GRep t
179 , GRel8able Aggregation (Rep (t Structure)) (Rep (t Aggregation))
180 ) => t Aggregation -> GRep t (H Aggregation)
181 toAggregationColumns = toGColumns @_ @(Rep (t Structure)) . from
183 default fromDBColumns ::
184 ( Generic (t DB)
185 , GColumns (Rep (t Structure)) ~ GRep t
186 , GRel8able DB (Rep (t Structure)) (Rep (t DB))
187 ) => GRep t (H DB) -> t DB
188 fromDBColumns = to . fromGColumns @_ @(Rep (t Structure))
190 default toDBColumns ::
191 ( Generic (t DB)
192 , GColumns (Rep (t Structure)) ~ GRep t
193 , GRel8able DB (Rep (t Structure)) (Rep (t DB))
194 ) => t DB -> GRep t (H DB)
195 toDBColumns = toGColumns @_ @(Rep (t Structure)) . from
197 default fromInsertionColumns ::
198 ( Generic (t Insertion)
199 , GColumns (Rep (t Structure)) ~ GRep t
200 , GRel8able Insertion (Rep (t Structure)) (Rep (t Insertion))
201 ) => GRep t (H Insertion) -> t Insertion
202 fromInsertionColumns = to . fromGColumns @_ @(Rep (t Structure))
204 default toInsertionColumns ::
205 ( Generic (t Insertion)
206 , GColumns (Rep (t Structure)) ~ GRep t
207 , GRel8able Insertion (Rep (t Structure)) (Rep (t Insertion))
208 ) => t Insertion -> GRep t (H Insertion)
209 toInsertionColumns = toGColumns @_ @(Rep (t Structure)) . from
211 default fromResultColumns ::
212 ( Generic (t Result)
213 , GColumns (Rep (t Structure)) ~ GRep t
214 , GRel8able Result (Rep (t Structure)) (Rep (t Result))
215 ) => GRep t (H Result) -> t Result
216 fromResultColumns = to . fromGColumns @_ @(Rep (t Structure))
218 default toResultColumns ::
219 ( Generic (t Result)
220 , GColumns (Rep (t Structure)) ~ GRep t
221 , GRel8able Result (Rep (t Structure)) (Rep (t Result))
222 ) => t Result -> GRep t (H Result)
223 toResultColumns = toGColumns @_ @(Rep (t Structure)) . from
225 default fromUnspecialColumns ::
226 ( Generic (t context)
227 , GColumns (Rep (t Structure)) ~ GRep t
228 , GRel8able context (Rep (t Structure)) (Rep (t context))
229 ) => GRep t (H context) -> t context
230 fromUnspecialColumns = to . fromGColumns @_ @(Rep (t Structure))
232 default toUnspecialColumns ::
233 ( Generic (t context)
234 , GColumns (Rep (t Structure)) ~ GRep t
235 , GRel8able context (Rep (t Structure)) (Rep (t context))
236 ) => t context -> GRep t (H context)
237 toUnspecialColumns = toGColumns @_ @(Rep (t Structure)) . from
240type GColumns :: (Type -> Type) -> HKTable
241type family GColumns structure where
242 GColumns (M1 D _ structure) = GColumns structure
243 GColumns (M1 C _ structure) = GColumns structure
244 GColumns (a :*: b) = HPair (GColumns a) (GColumns b)
245 GColumns (M1 S ('MetaSel ('Just label) _ _ _) (K1 _ structure)) =
246 K1Columns label structure
249type GRel8able :: Kind.Context -> (Type -> Type) -> (Type -> Type) -> Constraint
250class GRel8able context structure rep where
251 fromGColumns :: GColumns structure (H context) -> rep x
252 toGColumns :: rep x -> GColumns structure (H context)
255instance GRel8able context structure rep => GRel8able context (M1 D c structure) (M1 D c rep) where
256 fromGColumns = M1 . fromGColumns @context @structure @rep
257 toGColumns (M1 a) = toGColumns @context @structure @rep a
260instance GRel8able context structure rep => GRel8able context (M1 C c structure) (M1 C c rep) where
261 fromGColumns = M1 . fromGColumns @context @structure @rep
262 toGColumns (M1 a) = toGColumns @context @structure @rep a
265instance (GRel8able context structure1 rep1, GRel8able context structure2 rep2) =>
266 GRel8able context (structure1 :*: structure2) (rep1 :*: rep2)
267 where
268 fromGColumns (HPair a b) =
269 fromGColumns @context @structure1 @rep1 a :*:
270 fromGColumns @context @structure2 @rep2 b
271 toGColumns (a :*: b) =
272 HPair
273 (toGColumns @context @structure1 @rep1 a)
274 (toGColumns @context @structure2 @rep2 b)
277instance
278 ( K1Table label isSpecialContext context isStructure structure a
279 , meta ~ 'MetaSel ('Just label) _su _ss _ds
280 , structureK1 ~ K1 i structure
281 , k1 ~ K1 i a
282 ) => GRel8able context (M1 S meta structureK1) (M1 S meta k1)
283 where
284 fromGColumns = M1 . K1 . fromK1Columns @label @_ @_ @_ @structure
285 toGColumns (M1 (K1 a)) = toK1Columns @label @_ @_ @_ @structure a
288type K1Columns :: Symbol -> Type -> HKTable
289type family K1Columns label structure where
290 K1Columns label (Shape1 'Column ('Spec '[] necessity nullability blueprint)) =
291 HIdentity ('Spec '[label] necessity nullability blueprint)
292 K1Columns _label (Shape1 'Column ('Spec (label ': labels) necessity nullability blueprint)) =
293 HIdentity ('Spec (label ': labels) necessity nullability blueprint)
294 K1Columns label (Shape2 'Either a b) =
295 HLabel label (HEitherTable (K1Columns "Left" a) (K1Columns "Right" b))
296 K1Columns label (Shape1 'List a) = HListTable (K1Columns label a)
297 K1Columns label (Shape1 'Maybe a) = HLabel label (HMaybeTable (K1Columns "Just" a))
298 K1Columns label (Shape1 'NonEmpty a) = HNonEmptyTable (K1Columns label a)
299 K1Columns label (Shape2 'These a b) =
300 HLabel label (HTheseTable (K1Columns "Here" a) (K1Columns "There" b))
301 K1Columns label (a, b) =
302 HLabel label
303 (HPair
304 (K1Columns "fst" a)
305 (K1Columns "snd" b))
306 K1Columns label (a, b, c) =
307 HLabel label
308 (HTrio
309 (K1Columns "fst" a)
310 (K1Columns "snd" b)
311 (K1Columns "trd" c))
312 K1Columns label (a, b, c, d) =
313 HLabel label
314 (HQuartet
315 (K1Columns "fst" a)
316 (K1Columns "snd" b)
317 (K1Columns "trd" c)
318 (K1Columns "frt" d))
319 K1Columns label (a, b, c, d, e) =
320 HLabel label
321 (HQuintet
322 (K1Columns "fst" a)
323 (K1Columns "snd" b)
324 (K1Columns "trd" c)
325 (K1Columns "frt" d)
326 (K1Columns "fft" e))
327 K1Columns label a = HLabel label (Columns a)
330type K1Table :: Symbol -> Bool -> Kind.Context -> Bool -> Type -> Type -> Constraint
331class
332 ( isSpecialContext ~ IsSpecialContext context
333 , isStructure ~ IsStructure structure
334 ) => K1Table label isSpecialContext context isStructure structure a
335 where
336 fromK1Columns :: K1Columns label structure (H context) -> a
337 toK1Columns :: a -> K1Columns label structure (H context)
340instance
341 ( x ~ Field Aggregation '[] necessity db a
342 ) => K1Table label 'True Aggregation 'True (Shape1 'Column ('Spec '[] necessity db a)) x
343 where
344 fromK1Columns (HIdentity (Aggregation a)) = a
345 toK1Columns = HIdentity . Aggregation
346 {-# INLINABLE fromK1Columns #-}
347 {-# INLINABLE toK1Columns #-}
350instance
351 ( x ~ Field Aggregation (label ': labels) necessity db a
352 ) => K1Table _label 'True Aggregation 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
353 where
354 fromK1Columns (HIdentity (Aggregation a)) = a
355 toK1Columns = HIdentity . Aggregation
356 {-# INLINABLE fromK1Columns #-}
357 {-# INLINABLE toK1Columns #-}
360instance
361 ( x ~ Field DB '[] necessity db a
362 ) => K1Table label 'True DB 'True (Shape1 'Column ('Spec '[] necessity db a)) x
363 where
364 fromK1Columns (HIdentity (DB a)) = a
365 toK1Columns = HIdentity . DB
366 {-# INLINABLE fromK1Columns #-}
367 {-# INLINABLE toK1Columns #-}
370instance
371 ( x ~ Field DB (label ': labels) necessity db a
372 ) => K1Table _label 'True DB 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
373 where
374 fromK1Columns (HIdentity (DB a)) = a
375 toK1Columns = HIdentity . DB
376 {-# INLINABLE fromK1Columns #-}
377 {-# INLINABLE toK1Columns #-}
380instance
381 ( x ~ Field Insertion '[] necessity db a
382 , KnownNecessity necessity
383 ) => K1Table label 'True Insertion 'True (Shape1 'Column ('Spec '[] necessity db a)) x
384 where
385 fromK1Columns (HIdentity insert) = case insert of
386 RequiredInsert a -> a
387 OptionalInsert ma -> ma
388 toK1Columns a = HIdentity $ case necessitySing @necessity of
389 SRequired -> RequiredInsert a
390 SOptional -> OptionalInsert a
391 {-# INLINABLE fromK1Columns #-}
392 {-# INLINABLE toK1Columns #-}
395instance
396 ( x ~ Field Insertion (label ': labels) necessity db a
397 , KnownNecessity necessity
398 ) => K1Table _label 'True Insertion 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
399 where
400 fromK1Columns (HIdentity insert) = case insert of
401 RequiredInsert a -> a
402 OptionalInsert ma -> ma
403 toK1Columns a = HIdentity $ case necessitySing @necessity of
404 SRequired -> RequiredInsert a
405 SOptional -> OptionalInsert a
406 {-# INLINABLE fromK1Columns #-}
407 {-# INLINABLE toK1Columns #-}
410instance
411 ( x ~ Field Result '[] necessity db a
412 ) => K1Table label 'True Result 'True (Shape1 'Column ('Spec '[] necessity db a)) x
413 where
414 fromK1Columns (HIdentity (Result a)) = a
415 toK1Columns = HIdentity . Result
416 {-# INLINABLE fromK1Columns #-}
417 {-# INLINABLE toK1Columns #-}
420instance
421 ( x ~ Field Result (label ': labels) necessity db a
422 ) => K1Table _label 'True Result 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
423 where
424 fromK1Columns (HIdentity (Result a)) = a
425 toK1Columns = HIdentity . Result
426 {-# INLINABLE fromK1Columns #-}
427 {-# INLINABLE toK1Columns #-}
430instance
431 ( IsSpecialContext context ~ 'False
432 , x ~ context ('Spec (label ': labels) necessity db a)
433 ) => K1Table _label 'False context 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
434 where
435 fromK1Columns = unHIdentity
436 toK1Columns = HIdentity
437 {-# INLINABLE fromK1Columns #-}
438 {-# INLINABLE toK1Columns #-}
441instance
442 ( IsSpecialContext context ~ 'False
443 , x ~ context ('Spec '[] necessity db a)
444 , Labelable context
445 ) => K1Table label 'False context 'True (Shape1 'Column ('Spec '[] necessity db a)) x
446 where
447 fromK1Columns = unlabeler . unHIdentity
448 toK1Columns = HIdentity . labeler
449 {-# INLINABLE fromK1Columns #-}
450 {-# INLINABLE toK1Columns #-}
453instance
454 ( HTable (K1Columns "Left" structure1)
455 , HTable (K1Columns "Right" structure2)
456 , K1Table "Left" 'True Aggregation (IsStructure structure1) structure1 a
457 , K1Table "Right" 'True Aggregation (IsStructure structure2) structure2 b
458 , e ~ EitherTable a b
459 ) => K1Table label 'True Aggregation 'True (Shape2 'Either structure1 structure2) e
460 where
461 fromK1Columns =
462 fromColumns2
463 (fromK1Columns @"Left" @_ @_ @_ @structure1)
464 (fromK1Columns @"Right" @_ @_ @_ @structure2) .
465 hunlabel unlabeler
466 toK1Columns =
467 hlabel labeler .
468 toColumns2
469 (toK1Columns @"Left" @_ @_ @_ @structure1)
470 (toK1Columns @"Right" @_ @_ @_ @structure2)
471 {-# INLINABLE fromK1Columns #-}
472 {-# INLINABLE toK1Columns #-}
475instance
476 ( HTable (K1Columns "Left" structure1)
477 , HTable (K1Columns "Right" structure2)
478 , K1Table "Left" 'True DB (IsStructure structure1) structure1 a
479 , K1Table "Right" 'True DB (IsStructure structure2) structure2 b
480 , e ~ EitherTable a b
481 ) => K1Table label 'True DB 'True (Shape2 'Either structure1 structure2) e
482 where
483 fromK1Columns =
484 fromColumns2
485 (fromK1Columns @"Left" @_ @_ @_ @structure1)
486 (fromK1Columns @"Right" @_ @_ @_ @structure2) .
487 hunlabel unlabeler
488 toK1Columns =
489 hlabel labeler .
490 toColumns2
491 (toK1Columns @"Left" @_ @_ @_ @structure1)
492 (toK1Columns @"Right" @_ @_ @_ @structure2)
493 {-# INLINABLE fromK1Columns #-}
494 {-# INLINABLE toK1Columns #-}
497instance
498 ( HTable (K1Columns "Left" structure1)
499 , HTable (K1Columns "Right" structure2)
500 , K1Table "Left" 'True Insertion (IsStructure structure1) structure1 a
501 , K1Table "Right" 'True Insertion (IsStructure structure2) structure2 b
502 , e ~ EitherTable a b
503 ) => K1Table label 'True Insertion 'True (Shape2 'Either structure1 structure2) e
504 where
505 fromK1Columns =
506 fromColumns2
507 (fromK1Columns @"Left" @_ @_ @_ @structure1)
508 (fromK1Columns @"Right" @_ @_ @_ @structure2) .
509 hunlabel unlabeler
510 toK1Columns =
511 hlabel labeler .
512 toColumns2
513 (toK1Columns @"Left" @_ @_ @_ @structure1)
514 (toK1Columns @"Right" @_ @_ @_ @structure2)
515 {-# INLINABLE fromK1Columns #-}
516 {-# INLINABLE toK1Columns #-}
519instance
520 ( HTable (K1Columns "Left" structure1)
521 , HTable (K1Columns "Right" structure2)
522 , K1Table "Left" 'True Result (IsStructure structure1) structure1 a
523 , K1Table "Right" 'True Result (IsStructure structure2) structure2 b
524 , e ~ Either a b
525 ) => K1Table label 'True Result 'True (Shape2 'Either structure1 structure2) e
526 where
527 fromK1Columns
528 = bimap
529 (fromK1Columns @"Left" @_ @_ @_ @structure1)
530 (fromK1Columns @"Right" @_ @_ @_ @structure2)
531 . fromHEitherTable
532 . hunlabel unlabeler
533 toK1Columns
534 = hlabel labeler
535 . toHEitherTable
536 . bimap
537 (toK1Columns @"Left" @_ @_ @_ @structure1)
538 (toK1Columns @"Right" @_ @_ @_ @structure2)
539 {-# INLINABLE fromK1Columns #-}
540 {-# INLINABLE toK1Columns #-}
543instance
544 ( HTable (K1Columns "Left" structure1)
545 , HTable (K1Columns "Right" structure2)
546 , K1Table "Left" 'False context (IsStructure structure1) structure1 a
547 , K1Table "Right" 'False context (IsStructure structure2) structure2 b
548 , IsSpecialContext context ~ 'False
549 , Labelable context
550 , Nullifiable context
551 , e ~ EitherTable a b
552 ) => K1Table label 'False context 'True (Shape2 'Either structure1 structure2) e
553 where
554 fromK1Columns =
555 fromColumns2
556 (fromK1Columns @"Left" @_ @_ @_ @structure1)
557 (fromK1Columns @"Right" @_ @_ @_ @structure2) .
558 hunlabel unlabeler
559 toK1Columns =
560 hlabel labeler .
561 toColumns2
562 (toK1Columns @"Left" @_ @_ @_ @structure1)
563 (toK1Columns @"Right" @_ @_ @_ @structure2)
564 {-# INLINABLE fromK1Columns #-}
565 {-# INLINABLE toK1Columns #-}
568instance
569 ( K1Table label 'True Aggregation (IsStructure structure) structure a
570 , Table Aggregation a
571 , K1Columns label structure ~ HLabel label (Columns a)
572 , as ~ ListTable a
573 ) => K1Table label 'True Aggregation 'True (Shape1 'List structure) as
574 where
575 fromK1Columns = fromColumns . hrelabel (hunlabel unlabeler)
576 toK1Columns = hrelabel (hlabel labeler) . toColumns
577 {-# INLINABLE fromK1Columns #-}
578 {-# INLINABLE toK1Columns #-}
581instance
582 ( K1Table label 'True DB (IsStructure structure) structure a
583 , Table DB a
584 , K1Columns label structure ~ HLabel label (Columns a)
585 , as ~ ListTable a
586 ) => K1Table label 'True DB 'True (Shape1 'List structure) as
587 where
588 fromK1Columns = fromColumns . hrelabel (hunlabel unlabeler)
589 toK1Columns = hrelabel (hlabel labeler) . toColumns
590 {-# INLINABLE fromK1Columns #-}
591 {-# INLINABLE toK1Columns #-}
594instance
595 ( K1Table label 'True Insertion (IsStructure structure) structure a
596 , Table Insertion a
597 , K1Columns label structure ~ HLabel label (Columns a)
598 , as ~ ListTable a
599 ) => K1Table label 'True Insertion 'True (Shape1 'List structure) as
600 where
601 fromK1Columns = fromColumns . hrelabel (hunlabel unlabeler)
602 toK1Columns = hrelabel (hlabel labeler) . toColumns
603 {-# INLINABLE fromK1Columns #-}
604 {-# INLINABLE toK1Columns #-}
607instance
608 ( K1Table label 'True Result (IsStructure structure) structure a
609 , HTable (K1Columns label structure)
610 , as ~ [a]
611 ) => K1Table label 'True Result 'True (Shape1 'List structure) as
612 where
613 fromK1Columns = fmap (fromK1Columns @label @'True @Result @_ @structure) . fromHListTable
614 toK1Columns = toHListTable . fmap (toK1Columns @label @'True @Result @_ @structure)
615 {-# INLINABLE fromK1Columns #-}
616 {-# INLINABLE toK1Columns #-}
619instance
620 ( K1Table label 'False context (IsStructure structure) structure a
621 , IsSpecialContext context ~ 'False
622 , Table context a
623 , K1Columns label structure ~ HLabel label (Columns a)
624 , Labelable context
625 , as ~ ListTable a
626 ) => K1Table label 'False context 'True (Shape1 'List structure) as
627 where
628 fromK1Columns = fromColumns . hrelabel (hunlabel unlabeler)
629 toK1Columns = hrelabel (hlabel labeler) . toColumns
630 {-# INLINABLE fromK1Columns #-}
631 {-# INLINABLE toK1Columns #-}
634instance
635 ( HTable (K1Columns "Just" structure)
636 , K1Table "Just" 'True Aggregation (IsStructure structure) structure a
637 , ma ~ MaybeTable a
638 ) => K1Table label 'True Aggregation 'True (Shape1 'Maybe structure) ma
639 where
640 fromK1Columns =
641 fromColumns1 (fromK1Columns @"Just" @_ @_ @_ @structure) .
642 hunlabel unlabeler
643 toK1Columns =
644 hlabel labeler .
645 toColumns1 (toK1Columns @"Just" @_ @_ @_ @structure)
646 {-# INLINABLE fromK1Columns #-}
647 {-# INLINABLE toK1Columns #-}
650instance
651 ( HTable (K1Columns "Just" structure)
652 , K1Table "Just" 'True DB (IsStructure structure) structure a
653 , ma ~ MaybeTable a
654 ) => K1Table label 'True DB 'True (Shape1 'Maybe structure) ma
655 where
656 fromK1Columns =
657 fromColumns1 (fromK1Columns @"Just" @_ @_ @_ @structure) .
658 hunlabel unlabeler
659 toK1Columns =
660 hlabel labeler .
661 toColumns1 (toK1Columns @"Just" @_ @_ @_ @structure)
662 {-# INLINABLE fromK1Columns #-}
663 {-# INLINABLE toK1Columns #-}
666instance
667 ( HTable (K1Columns "Just" structure)
668 , K1Table "Just" 'True Insertion (IsStructure structure) structure a
669 , ma ~ MaybeTable a
670 ) => K1Table label 'True Insertion 'True (Shape1 'Maybe structure) ma
671 where
672 fromK1Columns =
673 fromColumns1 (fromK1Columns @"Just" @_ @_ @_ @structure) .
674 hunlabel unlabeler
675 toK1Columns =
676 hlabel labeler .
677 toColumns1 (toK1Columns @"Just" @_ @_ @_ @structure)
678 {-# INLINABLE fromK1Columns #-}
679 {-# INLINABLE toK1Columns #-}
682instance
683 ( HTable (K1Columns "Just" structure)
684 , K1Table "Just" 'True Result (IsStructure structure) structure a
685 , ma ~ Maybe a
686 ) => K1Table label 'True Result 'True (Shape1 'Maybe structure) ma
687 where
688 fromK1Columns
689 = fmap (fromK1Columns @"Just" @_ @_ @_ @structure)
690 . fromHMaybeTable
691 . hunlabel unlabeler
692 toK1Columns
693 = hlabel labeler
694 . toHMaybeTable
695 . fmap (toK1Columns @"Just" @_ @_ @_ @structure)
696 {-# INLINABLE fromK1Columns #-}
697 {-# INLINABLE toK1Columns #-}
700instance
701 ( HTable (K1Columns "Just" structure)
702 , K1Table "Just" 'False context (IsStructure structure) structure a
703 , IsSpecialContext context ~ 'False
704 , Labelable context
705 , Nullifiable context
706 , ma ~ MaybeTable a
707 ) => K1Table label 'False context 'True (Shape1 'Maybe structure) ma
708 where
709 fromK1Columns =
710 fromColumns1 (fromK1Columns @"Just" @_ @_ @_ @structure) .
711 hunlabel unlabeler
712 toK1Columns =
713 hlabel labeler .
714 toColumns1 (toK1Columns @"Just" @_ @_ @_ @structure)
715 {-# INLINABLE fromK1Columns #-}
716 {-# INLINABLE toK1Columns #-}
719instance
720 ( K1Table label 'True Aggregation (IsStructure structure) structure a
721 , Table Aggregation a
722 , K1Columns label structure ~ HLabel label (Columns a)
723 , as ~ NonEmptyTable a
724 ) => K1Table label 'True Aggregation 'True (Shape1 'NonEmpty structure) as
725 where
726 fromK1Columns = fromColumns . hrelabel (hunlabel unlabeler)
727 toK1Columns = hrelabel (hlabel labeler) . toColumns
728 {-# INLINABLE fromK1Columns #-}
729 {-# INLINABLE toK1Columns #-}
732instance
733 ( K1Table label 'True DB (IsStructure structure) structure a
734 , Table DB a
735 , K1Columns label structure ~ HLabel label (Columns a)
736 , as ~ NonEmptyTable a
737 ) => K1Table label 'True DB 'True (Shape1 'NonEmpty structure) as
738 where
739 fromK1Columns = fromColumns . hrelabel (hunlabel unlabeler)
740 toK1Columns = hrelabel (hlabel labeler) . toColumns
741 {-# INLINABLE fromK1Columns #-}
742 {-# INLINABLE toK1Columns #-}
745instance
746 ( K1Table label 'True Insertion (IsStructure structure) structure a
747 , Table Insertion a
748 , K1Columns label structure ~ HLabel label (Columns a)
749 , as ~ NonEmptyTable a
750 ) => K1Table label 'True Insertion 'True (Shape1 'NonEmpty structure) as
751 where
752 fromK1Columns = fromColumns . hrelabel (hunlabel unlabeler)
753 toK1Columns = hrelabel (hlabel labeler) . toColumns
754 {-# INLINABLE fromK1Columns #-}
755 {-# INLINABLE toK1Columns #-}
758instance
759 ( K1Table label 'True Result (IsStructure structure) structure a
760 , HTable (K1Columns label structure)
761 , as ~ NonEmpty a
762 ) => K1Table label 'True Result 'True (Shape1 'NonEmpty structure) as
763 where
764 fromK1Columns = fmap (fromK1Columns @label @'True @Result @_ @structure) . fromHNonEmptyTable
765 toK1Columns = toHNonEmptyTable . fmap (toK1Columns @label @'True @Result @_ @structure)
766 {-# INLINABLE fromK1Columns #-}
767 {-# INLINABLE toK1Columns #-}
770instance
771 ( K1Table label 'False context (IsStructure structure) structure a
772 , IsSpecialContext context ~ 'False
773 , Table context a
774 , K1Columns label structure ~ HLabel label (Columns a)
775 , Labelable context
776 , as ~ NonEmptyTable a
777 ) => K1Table label 'False context 'True (Shape1 'NonEmpty structure) as
778 where
779 fromK1Columns = fromColumns . hrelabel (hunlabel unlabeler)
780 toK1Columns = hrelabel (hlabel labeler) . toColumns
781 {-# INLINABLE fromK1Columns #-}
782 {-# INLINABLE toK1Columns #-}
785instance
786 ( HTable (K1Columns "Here" structure1)
787 , HTable (K1Columns "There" structure2)
788 , K1Table "Here" 'True Aggregation (IsStructure structure1) structure1 a
789 , K1Table "There" 'True Aggregation (IsStructure structure2) structure2 b
790 , e ~ TheseTable a b
791 ) => K1Table label 'True Aggregation 'True (Shape2 'These structure1 structure2) e
792 where
793 fromK1Columns =
794 fromColumns2
795 (fromK1Columns @"Here" @_ @_ @_ @structure1)
796 (fromK1Columns @"There" @_ @_ @_ @structure2) .
797 hunlabel unlabeler
798 toK1Columns =
799 hlabel labeler .
800 toColumns2
801 (toK1Columns @"Here" @_ @_ @_ @structure1)
802 (toK1Columns @"There" @_ @_ @_ @structure2)
803 {-# INLINABLE fromK1Columns #-}
804 {-# INLINABLE toK1Columns #-}
807instance
808 ( HTable (K1Columns "Here" structure1)
809 , HTable (K1Columns "There" structure2)
810 , K1Table "Here" 'True DB (IsStructure structure1) structure1 a
811 , K1Table "There" 'True DB (IsStructure structure2) structure2 b
812 , e ~ TheseTable a b
813 ) => K1Table label 'True DB 'True (Shape2 'These structure1 structure2) e
814 where
815 fromK1Columns =
816 fromColumns2
817 (fromK1Columns @"Here" @_ @_ @_ @structure1)
818 (fromK1Columns @"There" @_ @_ @_ @structure2) .
819 hunlabel unlabeler
820 toK1Columns =
821 hlabel labeler .
822 toColumns2
823 (toK1Columns @"Here" @_ @_ @_ @structure1)
824 (toK1Columns @"There" @_ @_ @_ @structure2)
825 {-# INLINABLE fromK1Columns #-}
826 {-# INLINABLE toK1Columns #-}
829instance
830 ( HTable (K1Columns "Here" structure1)
831 , HTable (K1Columns "There" structure2)
832 , K1Table "Here" 'True Insertion (IsStructure structure1) structure1 a
833 , K1Table "There" 'True Insertion (IsStructure structure2) structure2 b
834 , e ~ TheseTable a b
835 ) => K1Table label 'True Insertion 'True (Shape2 'These structure1 structure2) e
836 where
837 fromK1Columns =
838 fromColumns2
839 (fromK1Columns @"Here" @_ @_ @_ @structure1)
840 (fromK1Columns @"There" @_ @_ @_ @structure2) .
841 hunlabel unlabeler
842 toK1Columns =
843 hlabel labeler .
844 toColumns2
845 (toK1Columns @"Here" @_ @_ @_ @structure1)
846 (toK1Columns @"There" @_ @_ @_ @structure2)
847 {-# INLINABLE fromK1Columns #-}
848 {-# INLINABLE toK1Columns #-}
851instance
852 ( HTable (K1Columns "Here" structure1)
853 , HTable (K1Columns "There" structure2)
854 , K1Table "Here" 'True Result (IsStructure structure1) structure1 a
855 , K1Table "There" 'True Result (IsStructure structure2) structure2 b
856 , e ~ These a b
857 ) => K1Table label 'True Result 'True (Shape2 'These structure1 structure2) e
858 where
859 fromK1Columns
860 = bimap
861 (fromK1Columns @"Here" @_ @_ @_ @structure1)
862 (fromK1Columns @"There" @_ @_ @_ @structure2)
863 . fromHTheseTable
864 . hunlabel unlabeler
865 toK1Columns
866 = hlabel labeler
867 . toHTheseTable
868 . bimap
869 (toK1Columns @"Here" @_ @_ @_ @structure1)
870 (toK1Columns @"There" @_ @_ @_ @structure2)
871 {-# INLINABLE fromK1Columns #-}
872 {-# INLINABLE toK1Columns #-}
875instance
876 ( HTable (K1Columns "Here" structure1)
877 , HTable (K1Columns "There" structure2)
878 , K1Table "Here" 'False context (IsStructure structure1) structure1 a
879 , K1Table "There" 'False context (IsStructure structure2) structure2 b
880 , IsSpecialContext context ~ 'False
881 , Labelable context
882 , Nullifiable context
883 , e ~ TheseTable a b
884 ) => K1Table label 'False context 'True (Shape2 'These structure1 structure2) e
885 where
886 fromK1Columns =
887 fromColumns2
888 (fromK1Columns @"Here" @_ @_ @_ @structure1)
889 (fromK1Columns @"There" @_ @_ @_ @structure2) .
890 hunlabel unlabeler
891 toK1Columns =
892 hlabel labeler .
893 toColumns2
894 (toK1Columns @"Here" @_ @_ @_ @structure1)
895 (toK1Columns @"There" @_ @_ @_ @structure2)
896 {-# INLINABLE fromK1Columns #-}
897 {-# INLINABLE toK1Columns #-}
901instance
902 ( K1Table "fst" isSpecialContext context (IsStructure structure1) structure1 a1
903 , K1Table "snd" isSpecialContext context (IsStructure structure2) structure2 a2
904 , HTable (K1Columns "fst" structure1)
905 , HTable (K1Columns "snd" structure2)
906 , Labelable context
907 , a ~ (a1, a2)
908 ) => K1Table label isSpecialContext context 'True (structure1, structure2) a
909 where
910 fromK1Columns (hunlabel unlabeler -> (HPair a b)) =
911 ( fromK1Columns @"fst" @_ @_ @_ @structure1 a
912 , fromK1Columns @"snd" @_ @_ @_ @structure2 b
913 )
914 toK1Columns (a, b) = hlabel labeler $ HPair
915 { hfst = toK1Columns @"fst" @_ @_ @_ @structure1 a
916 , hsnd = toK1Columns @"snd" @_ @_ @_ @structure2 b
917 }
918 {-# INLINABLE fromK1Columns #-}
919 {-# INLINABLE toK1Columns #-}
922instance
923 ( K1Table "fst" isSpecialContext context (IsStructure structure1) structure1 a1
924 , K1Table "snd" isSpecialContext context (IsStructure structure2) structure2 a2
925 , K1Table "trd" isSpecialContext context (IsStructure structure3) structure3 a3
926 , HTable (K1Columns "fst" structure1)
927 , HTable (K1Columns "snd" structure2)
928 , HTable (K1Columns "trd" structure3)
929 , Labelable context
930 , a ~ (a1, a2, a3)
931 ) => K1Table label isSpecialContext context 'True (structure1, structure2, structure3) a
932 where
933 fromK1Columns (hunlabel unlabeler -> (HTrio a b c)) =
934 ( fromK1Columns @"fst" @_ @_ @_ @structure1 a
935 , fromK1Columns @"snd" @_ @_ @_ @structure2 b
936 , fromK1Columns @"trd" @_ @_ @_ @structure3 c
937 )
938 toK1Columns (a, b, c) = hlabel labeler $ HTrio
939 { hfst = toK1Columns @"fst" @_ @_ @_ @structure1 a
940 , hsnd = toK1Columns @"snd" @_ @_ @_ @structure2 b
941 , htrd = toK1Columns @"trd" @_ @_ @_ @structure3 c
942 }
943 {-# INLINABLE fromK1Columns #-}
944 {-# INLINABLE toK1Columns #-}
947instance
948 ( K1Table "fst" isSpecialContext context (IsStructure structure1) structure1 a1
949 , K1Table "snd" isSpecialContext context (IsStructure structure2) structure2 a2
950 , K1Table "trd" isSpecialContext context (IsStructure structure3) structure3 a3
951 , K1Table "frt" isSpecialContext context (IsStructure structure3) structure4 a4
952 , HTable (K1Columns "fst" structure1)
953 , HTable (K1Columns "snd" structure2)
954 , HTable (K1Columns "trd" structure3)
955 , HTable (K1Columns "frt" structure4)
956 , Labelable context
957 , a ~ (a1, a2, a3, a4)
958 ) => K1Table label isSpecialContext context 'True (structure1, structure2, structure3, structure4) a
959 where
960 fromK1Columns (hunlabel unlabeler -> (HQuartet a b c d)) =
961 ( fromK1Columns @"fst" @_ @_ @_ @structure1 a
962 , fromK1Columns @"snd" @_ @_ @_ @structure2 b
963 , fromK1Columns @"trd" @_ @_ @_ @structure3 c
964 , fromK1Columns @"frt" @_ @_ @_ @structure4 d
965 )
966 toK1Columns (a, b, c, d) = hlabel labeler $ HQuartet
967 { hfst = toK1Columns @"fst" @_ @_ @_ @structure1 a
968 , hsnd = toK1Columns @"snd" @_ @_ @_ @structure2 b
969 , htrd = toK1Columns @"trd" @_ @_ @_ @structure3 c
970 , hfrt = toK1Columns @"frt" @_ @_ @_ @structure4 d
971 }
972 {-# INLINABLE fromK1Columns #-}
973 {-# INLINABLE toK1Columns #-}
976instance
977 ( K1Table "fst" isSpecialContext context (IsStructure structure1) structure1 a1
978 , K1Table "snd" isSpecialContext context (IsStructure structure2) structure2 a2
979 , K1Table "trd" isSpecialContext context (IsStructure structure3) structure3 a3
980 , K1Table "frt" isSpecialContext context (IsStructure structure3) structure4 a4
981 , K1Table "fft" isSpecialContext context (IsStructure structure3) structure5 a5
982 , HTable (K1Columns "fst" structure1)
983 , HTable (K1Columns "snd" structure2)
984 , HTable (K1Columns "trd" structure3)
985 , HTable (K1Columns "frt" structure4)
986 , HTable (K1Columns "fft" structure5)
987 , Labelable context
988 , a ~ (a1, a2, a3, a4, a5)
989 ) => K1Table label isSpecialContext context 'True (structure1, structure2, structure3, structure4, structure5) a
990 where
991 fromK1Columns (hunlabel unlabeler -> (HQuintet a b c d e)) =
992 ( fromK1Columns @"fst" @_ @_ @_ @structure1 a
993 , fromK1Columns @"snd" @_ @_ @_ @structure2 b
994 , fromK1Columns @"trd" @_ @_ @_ @structure3 c
995 , fromK1Columns @"frt" @_ @_ @_ @structure4 d
996 , fromK1Columns @"fft" @_ @_ @_ @structure5 e
997 )
998 toK1Columns (a, b, c, d, e) = hlabel labeler $ HQuintet
999 { hfst = toK1Columns @"fst" @_ @_ @_ @structure1 a
1000 , hsnd = toK1Columns @"snd" @_ @_ @_ @structure2 b
1001 , htrd = toK1Columns @"trd" @_ @_ @_ @structure3 c
1002 , hfrt = toK1Columns @"frt" @_ @_ @_ @structure4 d
1003 , hfft = toK1Columns @"fft" @_ @_ @_ @structure5 e
1005 {-# INLINABLE fromK1Columns #-}
1006 {-# INLINABLE toK1Columns #-}
1009instance
1010 ( IsSpecialContext context ~ isSpecialContext
1011 , IsStructure structure ~ 'False
1012 , K1Columns label structure ~ HLabel label (Columns structure)
1013 , Columns structure ~ Columns a
1014 , Labelable context
1015 , Table context a
1016 ) => K1Table label isSpecialContext context 'False structure a
1017 where
1018 fromK1Columns = fromColumns . hunlabel unlabeler
1019 toK1Columns = hlabel labeler . toColumns
1020 {-# INLINABLE fromK1Columns #-}
1021 {-# INLINABLE toK1Columns #-}