@@ -1,1020 +0,0 @@
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 #-}
16−
17−{-# options_ghc -fno-warn-orphans #-}
18−
19−module Rel8.Schema.Generic
20− ( Rel8able
21− )
22−where
23−
24−-- base
25−import Data.Bifunctor ( bimap )
26−import Data.Functor.Identity ( Identity )
27−import Data.Kind ( Constraint, Type )
28−import Data.List.NonEmpty ( NonEmpty )
29−import GHC.Generics
30− ( Generic, Rep, from, to
31− , (:*:)( (:*:) ), K1( K1 ), M1( M1 )
32− , D, C, S
33− , Meta( MetaSel )
34− )
35−import GHC.TypeLits ( Symbol )
36−import Prelude
37−
38−-- rel8
39−import Rel8.Aggregate ( Aggregate )
40−import Rel8.Expr ( Expr )
41−import Rel8.Kind.Necessity
42− ( SNecessity( SRequired, SOptional )
43− , KnownNecessity, necessitySing
44− )
45−import Rel8.Schema.Context
46−import Rel8.Schema.Context.Identity
47− ( fromHEitherTable, toHEitherTable
48− , fromHListTable, toHListTable
49− , fromHMaybeTable, toHMaybeTable
50− , fromHNonEmptyTable, toHNonEmptyTable
51− , fromHTheseTable, toHTheseTable
52− )
53−import Rel8.Schema.Context.Label
54− ( Labelable, labeler, unlabeler
55− , hlabeler, hunlabeler
56− )
57−import Rel8.Schema.Context.Nullify ( Nullifiable )
58−import Rel8.Schema.Field ( Field )
59−import Rel8.Schema.HTable ( HTable )
60−import Rel8.Schema.HTable.Either ( HEitherTable )
61−import Rel8.Schema.HTable.Identity ( HIdentity(..) )
62−import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
63−import Rel8.Schema.HTable.List ( HListTable )
64−import Rel8.Schema.HTable.Maybe ( HMaybeTable )
65−import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
66−import Rel8.Schema.HTable.Pair ( HPair(..) )
67−import Rel8.Schema.HTable.Quartet ( HQuartet(..) )
68−import Rel8.Schema.HTable.Quintet ( HQuintet(..) )
69−import Rel8.Schema.HTable.These ( HTheseTable )
70−import Rel8.Schema.HTable.Trio ( HTrio(..) )
71−import Rel8.Schema.HTable.Vectorize ( hrelabel )
72−import qualified Rel8.Schema.Kind as K
73−import Rel8.Schema.Spec ( Spec( Spec ), KTable )
74−import Rel8.Schema.Structure
75− ( IsStructure, Shape(..), Shape1, Shape2
76− , Structure
77− )
78−import Rel8.Table
79− ( Table, Columns, Context, fromColumns, toColumns
80− )
81−import Rel8.Table.Either ( EitherTable )
82−import Rel8.Table.Lifted
83− ( fromColumns1, toColumns1
84− , fromColumns2, toColumns2
85− )
86−import Rel8.Table.List ( ListTable )
87−import Rel8.Table.Maybe ( MaybeTable(..) )
88−import Rel8.Table.NonEmpty ( NonEmptyTable )
89−import Rel8.Table.These ( TheseTable )
90−
91−-- these
92−import Data.These ( These )
93−
94−
95−instance (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
102−
103−
104−type TableHelper :: Bool -> K.Context -> Constraint
105−class 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)
110−
111−
112−instance TableHelper 'True Aggregate where
113− gfromColumns = fromAggregateColumns
114− gtoColumns = toAggregateColumns
115−
116−
117−instance TableHelper 'True Expr where
118− gfromColumns = fromExprColumns
119− gtoColumns = toExprColumns
120−
121−
122−instance TableHelper 'True Insertion where
123− gfromColumns = fromInsertionColumns
124− gtoColumns = toInsertionColumns
125−
126−
127−instance TableHelper 'True Identity where
128− gfromColumns = fromIdentityColumns
129− gtoColumns = toIdentityColumns
130−
131−
132−instance (IsSpecialContext context ~ 'False, Labelable context, Nullifiable context) =>
133− TableHelper 'False context
134− where
135− gfromColumns = fromUnspecialColumns
136− gtoColumns = toUnspecialColumns
137−
138−
139−type Rel8able :: KTable -> Constraint
140−class HTable (GRep t) => Rel8able t where
141− type GRep t :: K.HTable
142−
143− fromAggregateColumns :: GRep t (Col Aggregate) -> t Aggregate
144− toAggregateColumns :: t Aggregate -> GRep t (Col Aggregate)
145−
146− fromExprColumns :: GRep t (Col Expr) -> t Expr
147− toExprColumns :: t Expr -> GRep t (Col Expr)
148−
149− fromInsertionColumns :: GRep t (Col Insertion) -> t Insertion
150− toInsertionColumns :: t Insertion -> GRep t (Col Insertion)
151−
152− fromIdentityColumns :: GRep t (Col Identity) -> t Identity
153− toIdentityColumns :: t Identity -> GRep t (Col Identity)
154−
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)
165−
166− type GRep t = GColumns (Rep (t Structure))
167−
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))
174−
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
181−
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))
188−
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
195−
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))
202−
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
209−
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))
216−
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
223−
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))
230−
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
237−
238−
239−type GColumns :: (Type -> Type) -> K.HTable
240−type 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
246−
247−
248−type GRel8able :: K.Context -> (Type -> Type) -> (Type -> Type) -> Constraint
249−class GRel8able context structure rep where
250− fromGColumns :: GColumns structure (Col context) -> rep x
251− toGColumns :: rep x -> GColumns structure (Col context)
252−
253−
254−instance 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
257−
258−
259−instance 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
262−
263−
264−instance (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)
274−
275−
276−instance
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
285−
286−
287−type K1Columns :: Symbol -> Type -> K.HTable
288−type 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)
327−
328−
329−type K1Table :: Symbol -> Bool -> K.Context -> Bool -> Type -> Type -> Constraint
330−class
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)
337−
338−
339−instance
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 #-}
347−
348−
349−instance
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 #-}
357−
358−
359−instance
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 #-}
367−
368−
369−instance
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 #-}
377−
378−
379−instance
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 #-}
392−
393−
394−instance
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 #-}
407−
408−
409−instance
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 #-}
417−
418−
419−instance
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 #-}
427−
428−
429−instance
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 #-}
438−
439−
440−instance
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 #-}
450−
451−
452−instance
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 #-}
472−
473−
474−instance
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 #-}
494−
495−
496−instance
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 #-}
516−
517−
518−instance
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 #-}
540−
541−
542−instance
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 #-}
565−
566−
567−instance
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 #-}
578−
579−
580−instance
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 #-}
591−
592−
593−instance
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 #-}
604−
605−
606−instance
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 #-}
616−
617−
618−instance
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 #-}
631−
632−
633−instance
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 hunlabeler
642− toK1Columns =
643− hlabel hlabeler .
644− toColumns1 (toK1Columns @"Just" @_ @_ @_ @structure)
645− {-# INLINABLE fromK1Columns #-}
646− {-# INLINABLE toK1Columns #-}
647−
648−
649−instance
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 hunlabeler
658− toK1Columns =
659− hlabel hlabeler .
660− toColumns1 (toK1Columns @"Just" @_ @_ @_ @structure)
661− {-# INLINABLE fromK1Columns #-}
662− {-# INLINABLE toK1Columns #-}
663−
664−
665−instance
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 hunlabeler
674− toK1Columns =
675− hlabel hlabeler .
676− toColumns1 (toK1Columns @"Just" @_ @_ @_ @structure)
677− {-# INLINABLE fromK1Columns #-}
678− {-# INLINABLE toK1Columns #-}
679−
680−
681−instance
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 #-}
697−
698−
699−instance
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 #-}
716−
717−
718−instance
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 #-}
729−
730−
731−instance
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 #-}
742−
743−
744−instance
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 #-}
755−
756−
757−instance
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 #-}
767−
768−
769−instance
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 #-}
782−
783−
784−instance
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 #-}
804−
805−
806−instance
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 #-}
826−
827−
828−instance
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 #-}
848−
849−
850−instance
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 #-}
872−
873−
874−instance
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 #-}
897−
898−
899−
900−instance
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 #-}
919−
920−
921−instance
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 #-}
944−
945−
946−instance
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 #-}
973−
974−
975−instance
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
1003− }
1004− {-# INLINABLE fromK1Columns #-}
1005− {-# INLINABLE toK1Columns #-}
1006−
1007−
1008−instance
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 #-}