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