@@ -0,0 +1,1019 @@
1+{-# language AllowAmbiguousTypes #-}
2+{-# language DataKinds #-}
3+{-# language DisambiguateRecordFields #-}
4+{-# language DefaultSignatures #-}
5+{-# language FlexibleContexts #-}
6+{-# language FlexibleInstances #-}
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 #-}
19+module Rel8.Schema.Generic
25+import Data.Bifunctor ( bimap )
26+import Data.Functor.Identity ( Identity )
27+import Data.Kind ( Constraint, Type )
28+import Data.List.NonEmpty ( NonEmpty )
30+ ( Generic, Rep, from, to
31+ , (:*:)( (:*:) ), K1( K1 ), M1( M1 )
35+import GHC.TypeLits ( Symbol )
39+import Rel8.Aggregate ( Aggregate )
40+import Rel8.Expr ( Expr )
41+import Rel8.Kind.Necessity
42+ ( SNecessity( SRequired, SOptional )
43+ , KnownNecessity, necessitySing
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
53+import Rel8.Schema.Context.Label
54+ ( Labelable, labeler, unlabeler
55+ , hlabeler, hunlabeler
57+import Rel8.Schema.Field ( Field )
58+import Rel8.Schema.HTable ( HTable )
59+import Rel8.Schema.HTable.Either ( HEitherTable )
60+import Rel8.Schema.HTable.Identity ( HIdentity(..) )
61+import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
62+import Rel8.Schema.HTable.List ( HListTable )
63+import Rel8.Schema.HTable.Maybe ( HMaybeTable )
64+import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
65+import Rel8.Schema.HTable.Pair ( HPair(..) )
66+import Rel8.Schema.HTable.Quartet ( HQuartet(..) )
67+import Rel8.Schema.HTable.Quintet ( HQuintet(..) )
68+import Rel8.Schema.HTable.These ( HTheseTable )
69+import Rel8.Schema.HTable.Trio ( HTrio(..) )
70+import Rel8.Schema.HTable.Vectorize ( hrelabel )
71+import qualified Rel8.Schema.Kind as K
72+import Rel8.Schema.Spec ( Spec( Spec ), KTable )
73+import Rel8.Schema.Structure
74+ ( IsStructure, Shape(..), Shape1, Shape2
78+ ( Table, Columns, Context, fromColumns, toColumns
80+import Rel8.Table.Either ( EitherTable )
81+import Rel8.Table.Lifted
82+ ( fromColumns1, toColumns1
83+ , fromColumns2, toColumns2
85+import Rel8.Table.List ( ListTable )
86+import Rel8.Table.Maybe ( MaybeTable(..) )
87+import Rel8.Table.NonEmpty ( NonEmptyTable )
88+import Rel8.Table.These ( TheseTable )
91+import Data.These ( These )
94+instance (Rel8able t, TableHelper context) => Table context (t context) where
95+ type Columns (t context) = GRep t
96+ type Context (t context) = context
97+ fromColumns = gfromColumns
98+ toColumns = gtoColumns
101+type TableHelper :: K.Context -> Constraint
102+class TableHelper context where
103+ gfromColumns :: Rel8able t => GRep t (Col context) -> t context
104+ gtoColumns :: Rel8able t => t context -> GRep t (Col context)
107+instance TableHelper Aggregate where
108+ gfromColumns = fromAggregateColumns
109+ gtoColumns = toAggregateColumns
112+instance TableHelper Expr where
113+ gfromColumns = fromExprColumns
114+ gtoColumns = toExprColumns
117+instance TableHelper Insertion where
118+ gfromColumns = fromInsertionColumns
119+ gtoColumns = toInsertionColumns
122+instance TableHelper Identity where
123+ gfromColumns = fromIdentityColumns
124+ gtoColumns = toIdentityColumns
127+instance TableHelper Name where
128+ gfromColumns = fromNameColumns
129+ gtoColumns = toNameColumns
132+-- | This type class allows you to define custom 'Table's using higher-kinded
133+-- data types. Higher-kinded data types are data types of the pattern:
137+-- MyType { field1 :: Column f T1 OR HK1 f
138+-- , field2 :: Column f T2 OR HK2 f
140+-- , fieldN :: Column f Tn OR HKn f
144+-- where @Tn@ is any Haskell type, and @HKn@ is any higher-kinded type.
146+-- That is, higher-kinded data are records where all fields in the record are
147+-- all either of the type @Column f T@ (for any @T@), or are themselves
148+-- higher-kinded data:
154+-- Nested { nested1 :: MyType f
155+-- , nested2 :: MyType f
159+-- The @Rel8able@ type class is used to give us a special mapping operation
160+-- that lets us change the type parameter @f@.
162+-- [Supplying @Rel8able@ instances]
164+-- This type class should be derived generically for all table types in your
165+-- project. To do this, enable the @DeriveAnyType@ and @DeriveGeneric@ language
169+-- \{\-\# LANGUAGE DeriveAnyClass, DeriveGeneric #-\}
171+-- data MyType f = MyType { fieldA :: Column f T }
172+-- deriving ( GHC.Generics.Generic, Rel8able )
174+type Rel8able :: KTable -> Constraint
175+class HTable (GRep t) => Rel8able t where
176+ type GRep t :: K.HTable
178+ fromAggregateColumns :: GRep t (Col Aggregate) -> t Aggregate
179+ toAggregateColumns :: t Aggregate -> GRep t (Col Aggregate)
181+ fromExprColumns :: GRep t (Col Expr) -> t Expr
182+ toExprColumns :: t Expr -> GRep t (Col Expr)
184+ fromInsertionColumns :: GRep t (Col Insertion) -> t Insertion
185+ toInsertionColumns :: t Insertion -> GRep t (Col Insertion)
187+ fromIdentityColumns :: GRep t (Col Identity) -> t Identity
188+ toIdentityColumns :: t Identity -> GRep t (Col Identity)
190+ fromNameColumns :: GRep t (Col Name) -> t Name
191+ toNameColumns :: t Name -> GRep t (Col Name)
193+ type GRep t = GColumns (Rep (t Structure))
195+ default fromAggregateColumns ::
196+ ( Generic (t Aggregate)
197+ , GColumns (Rep (t Structure)) ~ GRep t
198+ , GRel8able Aggregate (Rep (t Structure)) (Rep (t Aggregate))
199+ ) => GRep t (Col Aggregate) -> t Aggregate
200+ fromAggregateColumns = to . fromGColumns @_ @(Rep (t Structure))
202+ default toAggregateColumns ::
203+ ( Generic (t Aggregate)
204+ , GColumns (Rep (t Structure)) ~ GRep t
205+ , GRel8able Aggregate (Rep (t Structure)) (Rep (t Aggregate))
206+ ) => t Aggregate -> GRep t (Col Aggregate)
207+ toAggregateColumns = toGColumns @_ @(Rep (t Structure)) . from
209+ default fromExprColumns ::
211+ , GColumns (Rep (t Structure)) ~ GRep t
212+ , GRel8able Expr (Rep (t Structure)) (Rep (t Expr))
213+ ) => GRep t (Col Expr) -> t Expr
214+ fromExprColumns = to . fromGColumns @_ @(Rep (t Structure))
216+ default toExprColumns ::
218+ , GColumns (Rep (t Structure)) ~ GRep t
219+ , GRel8able Expr (Rep (t Structure)) (Rep (t Expr))
220+ ) => t Expr -> GRep t (Col Expr)
221+ toExprColumns = toGColumns @_ @(Rep (t Structure)) . from
223+ default fromInsertionColumns ::
224+ ( Generic (t Insertion)
225+ , GColumns (Rep (t Structure)) ~ GRep t
226+ , GRel8able Insertion (Rep (t Structure)) (Rep (t Insertion))
227+ ) => GRep t (Col Insertion) -> t Insertion
228+ fromInsertionColumns = to . fromGColumns @_ @(Rep (t Structure))
230+ default toInsertionColumns ::
231+ ( Generic (t Insertion)
232+ , GColumns (Rep (t Structure)) ~ GRep t
233+ , GRel8able Insertion (Rep (t Structure)) (Rep (t Insertion))
234+ ) => t Insertion -> GRep t (Col Insertion)
235+ toInsertionColumns = toGColumns @_ @(Rep (t Structure)) . from
237+ default fromIdentityColumns ::
238+ ( Generic (t Identity)
239+ , GColumns (Rep (t Structure)) ~ GRep t
240+ , GRel8able Identity (Rep (t Structure)) (Rep (t Identity))
241+ ) => GRep t (Col Identity) -> t Identity
242+ fromIdentityColumns = to . fromGColumns @_ @(Rep (t Structure))
244+ default toIdentityColumns ::
245+ ( Generic (t Identity)
246+ , GColumns (Rep (t Structure)) ~ GRep t
247+ , GRel8able Identity (Rep (t Structure)) (Rep (t Identity))
248+ ) => t Identity -> GRep t (Col Identity)
249+ toIdentityColumns = toGColumns @_ @(Rep (t Structure)) . from
251+ default fromNameColumns ::
253+ , GColumns (Rep (t Structure)) ~ GRep t
254+ , GRel8able Name (Rep (t Structure)) (Rep (t Name))
255+ ) => GRep t (Col Name) -> t Name
256+ fromNameColumns = to . fromGColumns @_ @(Rep (t Structure))
258+ default toNameColumns ::
260+ , GColumns (Rep (t Structure)) ~ GRep t
261+ , GRel8able Name (Rep (t Structure)) (Rep (t Name))
262+ ) => t Name -> GRep t (Col Name)
263+ toNameColumns = toGColumns @_ @(Rep (t Structure)) . from
266+type GColumns :: (Type -> Type) -> K.HTable
267+type family GColumns structure where
268+ GColumns (M1 D _ structure) = GColumns structure
269+ GColumns (M1 C _ structure) = GColumns structure
270+ GColumns (a :*: b) = HPair (GColumns a) (GColumns b)
271+ GColumns (M1 S ('MetaSel ('Just label) _ _ _) (K1 _ structure)) =
272+ K1Columns label structure
275+type GRel8able :: K.Context -> (Type -> Type) -> (Type -> Type) -> Constraint
276+class GRel8able context structure rep where
277+ fromGColumns :: GColumns structure (Col context) -> rep x
278+ toGColumns :: rep x -> GColumns structure (Col context)
281+instance GRel8able context structure rep => GRel8able context (M1 D c structure) (M1 D c rep) where
282+ fromGColumns = M1 . fromGColumns @context @structure @rep
283+ toGColumns (M1 a) = toGColumns @context @structure @rep a
286+instance GRel8able context structure rep => GRel8able context (M1 C c structure) (M1 C c rep) where
287+ fromGColumns = M1 . fromGColumns @context @structure @rep
288+ toGColumns (M1 a) = toGColumns @context @structure @rep a
291+instance (GRel8able context structure1 rep1, GRel8able context structure2 rep2) =>
292+ GRel8able context (structure1 :*: structure2) (rep1 :*: rep2)
294+ fromGColumns (HPair a b) =
295+ fromGColumns @context @structure1 @rep1 a :*:
296+ fromGColumns @context @structure2 @rep2 b
297+ toGColumns (a :*: b) =
299+ (toGColumns @context @structure1 @rep1 a)
300+ (toGColumns @context @structure2 @rep2 b)
304+ ( K1Table label context isStructure structure a
305+ , meta ~ 'MetaSel ('Just label) _su _ss _ds
306+ , structureK1 ~ K1 i structure
308+ ) => GRel8able context (M1 S meta structureK1) (M1 S meta k1)
310+ fromGColumns = M1 . K1 . fromK1Columns @label @_ @_ @structure
311+ toGColumns (M1 (K1 a)) = toK1Columns @label @_ @_ @structure a
314+type K1Columns :: Symbol -> Type -> K.HTable
315+type family K1Columns label structure where
316+ K1Columns label (Shape1 'Column ('Spec '[] necessity nullability blueprint)) =
317+ HIdentity ('Spec '[label] necessity nullability blueprint)
318+ K1Columns _label (Shape1 'Column ('Spec (label ': labels) necessity nullability blueprint)) =
319+ HIdentity ('Spec (label ': labels) necessity nullability blueprint)
320+ K1Columns label (Shape2 'Either a b) =
321+ HLabel label (HEitherTable (K1Columns "Left" a) (K1Columns "Right" b))
322+ K1Columns label (Shape1 'List a) = HListTable (K1Columns label a)
323+ K1Columns label (Shape1 'Maybe a) = HLabel label (HMaybeTable (K1Columns "Just" a))
324+ K1Columns label (Shape1 'NonEmpty a) = HNonEmptyTable (K1Columns label a)
325+ K1Columns label (Shape2 'These a b) =
326+ HLabel label (HTheseTable (K1Columns "Here" a) (K1Columns "There" b))
327+ K1Columns label (a, b) =
331+ (K1Columns "snd" b))
332+ K1Columns label (a, b, c) =
337+ (K1Columns "trd" c))
338+ K1Columns label (a, b, c, d) =
344+ (K1Columns "frt" d))
345+ K1Columns label (a, b, c, d, e) =
352+ (K1Columns "fft" e))
353+ K1Columns label a = HLabel label (Columns a)
356+type K1Table :: Symbol -> K.Context -> Bool -> Type -> Type -> Constraint
357+class isStructure ~ IsStructure structure =>
358+ K1Table label context isStructure structure a
360+ fromK1Columns :: K1Columns label structure (Col context) -> a
361+ toK1Columns :: a -> K1Columns label structure (Col context)
365+ ( x ~ Field Aggregate '[] necessity db a
366+ ) => K1Table label Aggregate 'True (Shape1 'Column ('Spec '[] necessity db a)) x
368+ fromK1Columns (HIdentity (Aggregation a)) = a
369+ toK1Columns = HIdentity . Aggregation
370+ {-# INLINABLE fromK1Columns #-}
371+ {-# INLINABLE toK1Columns #-}
375+ ( x ~ Field Aggregate (label ': labels) necessity db a
376+ ) => K1Table _label Aggregate 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
378+ fromK1Columns (HIdentity (Aggregation a)) = a
379+ toK1Columns = HIdentity . Aggregation
380+ {-# INLINABLE fromK1Columns #-}
381+ {-# INLINABLE toK1Columns #-}
385+ ( x ~ Field Expr '[] necessity db a
386+ ) => K1Table label Expr 'True (Shape1 'Column ('Spec '[] necessity db a)) x
388+ fromK1Columns (HIdentity (DB a)) = a
389+ toK1Columns = HIdentity . DB
390+ {-# INLINABLE fromK1Columns #-}
391+ {-# INLINABLE toK1Columns #-}
395+ ( x ~ Field Expr (label ': labels) necessity db a
396+ ) => K1Table _label Expr 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
398+ fromK1Columns (HIdentity (DB a)) = a
399+ toK1Columns = HIdentity . DB
400+ {-# INLINABLE fromK1Columns #-}
401+ {-# INLINABLE toK1Columns #-}
405+ ( x ~ Field Insertion '[] necessity db a
406+ , KnownNecessity necessity
407+ ) => K1Table label Insertion 'True (Shape1 'Column ('Spec '[] necessity db a)) x
409+ fromK1Columns (HIdentity insert) = case insert of
410+ RequiredInsert a -> a
411+ OptionalInsert ma -> ma
412+ toK1Columns a = HIdentity $ case necessitySing @necessity of
413+ SRequired -> RequiredInsert a
414+ SOptional -> OptionalInsert a
415+ {-# INLINABLE fromK1Columns #-}
416+ {-# INLINABLE toK1Columns #-}
420+ ( x ~ Field Insertion (label ': labels) necessity db a
421+ , KnownNecessity necessity
422+ ) => K1Table _label Insertion 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
424+ fromK1Columns (HIdentity insert) = case insert of
425+ RequiredInsert a -> a
426+ OptionalInsert ma -> ma
427+ toK1Columns a = HIdentity $ case necessitySing @necessity of
428+ SRequired -> RequiredInsert a
429+ SOptional -> OptionalInsert a
430+ {-# INLINABLE fromK1Columns #-}
431+ {-# INLINABLE toK1Columns #-}
435+ ( x ~ Field Identity '[] necessity db a
436+ ) => K1Table label Identity 'True (Shape1 'Column ('Spec '[] necessity db a)) x
438+ fromK1Columns (HIdentity (Result a)) = a
439+ toK1Columns = HIdentity . Result
440+ {-# INLINABLE fromK1Columns #-}
441+ {-# INLINABLE toK1Columns #-}
445+ ( x ~ Field Identity (label ': labels) necessity db a
446+ ) => K1Table _label Identity 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
448+ fromK1Columns (HIdentity (Result a)) = a
449+ toK1Columns = HIdentity . Result
450+ {-# INLINABLE fromK1Columns #-}
451+ {-# INLINABLE toK1Columns #-}
455+ ( x ~ Field Name '[] necessity db a
456+ ) => K1Table _label Name 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
458+ fromK1Columns (HIdentity (NameCol a)) = Name a
459+ toK1Columns (Name a) = HIdentity (NameCol a)
460+ {-# INLINABLE fromK1Columns #-}
461+ {-# INLINABLE toK1Columns #-}
465+ ( x ~ Field Name (label ': labels) necessity db a
466+ ) => K1Table label Name 'True (Shape1 'Column ('Spec '[] necessity db a)) x
468+ fromK1Columns = Name . (\(NameCol a) -> a) . unlabeler . unHIdentity
469+ toK1Columns = HIdentity . labeler . NameCol . (\(Name a) -> a)
470+ {-# INLINABLE fromK1Columns #-}
471+ {-# INLINABLE toK1Columns #-}
475+ ( HTable (K1Columns "Left" structure1)
476+ , HTable (K1Columns "Right" structure2)
477+ , K1Table "Left" Aggregate (IsStructure structure1) structure1 a
478+ , K1Table "Right" Aggregate (IsStructure structure2) structure2 b
479+ , e ~ EitherTable a b
480+ ) => K1Table label Aggregate 'True (Shape2 'Either structure1 structure2) e
484+ (fromK1Columns @"Left" @_ @_ @structure1)
485+ (fromK1Columns @"Right" @_ @_ @structure2) .
490+ (toK1Columns @"Left" @_ @_ @structure1)
491+ (toK1Columns @"Right" @_ @_ @structure2)
492+ {-# INLINABLE fromK1Columns #-}
493+ {-# INLINABLE toK1Columns #-}
497+ ( HTable (K1Columns "Left" structure1)
498+ , HTable (K1Columns "Right" structure2)
499+ , K1Table "Left" Expr (IsStructure structure1) structure1 a
500+ , K1Table "Right" Expr (IsStructure structure2) structure2 b
501+ , e ~ EitherTable a b
502+ ) => K1Table label Expr 'True (Shape2 'Either structure1 structure2) e
506+ (fromK1Columns @"Left" @_ @_ @structure1)
507+ (fromK1Columns @"Right" @_ @_ @structure2) .
512+ (toK1Columns @"Left" @_ @_ @structure1)
513+ (toK1Columns @"Right" @_ @_ @structure2)
514+ {-# INLINABLE fromK1Columns #-}
515+ {-# INLINABLE toK1Columns #-}
519+ ( HTable (K1Columns "Left" structure1)
520+ , HTable (K1Columns "Right" structure2)
521+ , K1Table "Left" Insertion (IsStructure structure1) structure1 a
522+ , K1Table "Right" Insertion (IsStructure structure2) structure2 b
523+ , e ~ EitherTable a b
524+ ) => K1Table label Insertion 'True (Shape2 'Either structure1 structure2) e
528+ (fromK1Columns @"Left" @_ @_ @structure1)
529+ (fromK1Columns @"Right" @_ @_ @structure2) .
534+ (toK1Columns @"Left" @_ @_ @structure1)
535+ (toK1Columns @"Right" @_ @_ @structure2)
536+ {-# INLINABLE fromK1Columns #-}
537+ {-# INLINABLE toK1Columns #-}
541+ ( HTable (K1Columns "Left" structure1)
542+ , HTable (K1Columns "Right" structure2)
543+ , K1Table "Left" Identity (IsStructure structure1) structure1 a
544+ , K1Table "Right" Identity (IsStructure structure2) structure2 b
546+ ) => K1Table label Identity 'True (Shape2 'Either structure1 structure2) e
550+ (fromK1Columns @"Left" @_ @_ @structure1)
551+ (fromK1Columns @"Right" @_ @_ @structure2)
553+ . hunlabel unlabeler
558+ (toK1Columns @"Left" @_ @_ @structure1)
559+ (toK1Columns @"Right" @_ @_ @structure2)
560+ {-# INLINABLE fromK1Columns #-}
561+ {-# INLINABLE toK1Columns #-}
565+ ( HTable (K1Columns "Left" structure1)
566+ , HTable (K1Columns "Right" structure2)
567+ , K1Table "Left" Name (IsStructure structure1) structure1 a
568+ , K1Table "Right" Name (IsStructure structure2) structure2 b
569+ , e ~ EitherTable a b
570+ ) => K1Table label Name 'True (Shape2 'Either structure1 structure2) e
574+ (fromK1Columns @"Left" @_ @_ @structure1)
575+ (fromK1Columns @"Right" @_ @_ @structure2) .
580+ (toK1Columns @"Left" @_ @_ @structure1)
581+ (toK1Columns @"Right" @_ @_ @structure2)
582+ {-# INLINABLE fromK1Columns #-}
583+ {-# INLINABLE toK1Columns #-}
588+ , K1Columns label structure ~ HLabel label (Columns a)
590+ ) => K1Table label Aggregate 'True (Shape1 'List structure) as
592+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
593+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
594+ {-# INLINABLE fromK1Columns #-}
595+ {-# INLINABLE toK1Columns #-}
600+ , K1Columns label structure ~ HLabel label (Columns a)
602+ ) => K1Table label Expr 'True (Shape1 'List structure) as
604+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
605+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
606+ {-# INLINABLE fromK1Columns #-}
607+ {-# INLINABLE toK1Columns #-}
612+ , K1Columns label structure ~ HLabel label (Columns a)
614+ ) => K1Table label Insertion 'True (Shape1 'List structure) as
616+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
617+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
618+ {-# INLINABLE fromK1Columns #-}
619+ {-# INLINABLE toK1Columns #-}
623+ ( K1Table label Identity (IsStructure structure) structure a
624+ , HTable (K1Columns label structure)
626+ ) => K1Table label Identity 'True (Shape1 'List structure) as
628+ fromK1Columns = fmap (fromK1Columns @label @_ @_ @structure) . fromHListTable
629+ toK1Columns = toHListTable . fmap (toK1Columns @label @_ @_ @structure)
630+ {-# INLINABLE fromK1Columns #-}
631+ {-# INLINABLE toK1Columns #-}
636+ , K1Columns label structure ~ HLabel label (Columns a)
638+ ) => K1Table label Name 'True (Shape1 'List structure) as
640+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
641+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
642+ {-# INLINABLE fromK1Columns #-}
643+ {-# INLINABLE toK1Columns #-}
647+ ( HTable (K1Columns "Just" structure)
648+ , K1Table "Just" Aggregate (IsStructure structure) structure a
650+ ) => K1Table label Aggregate 'True (Shape1 'Maybe structure) ma
653+ fromColumns1 (fromK1Columns @"Just" @_ @_ @structure) .
657+ toColumns1 (toK1Columns @"Just" @_ @_ @structure)
658+ {-# INLINABLE fromK1Columns #-}
659+ {-# INLINABLE toK1Columns #-}
663+ ( HTable (K1Columns "Just" structure)
664+ , K1Table "Just" Expr (IsStructure structure) structure a
666+ ) => K1Table label Expr 'True (Shape1 'Maybe structure) ma
669+ fromColumns1 (fromK1Columns @"Just" @_ @_ @structure) .
673+ toColumns1 (toK1Columns @"Just" @_ @_ @structure)
674+ {-# INLINABLE fromK1Columns #-}
675+ {-# INLINABLE toK1Columns #-}
679+ ( HTable (K1Columns "Just" structure)
680+ , K1Table "Just" Insertion (IsStructure structure) structure a
682+ ) => K1Table label Insertion 'True (Shape1 'Maybe structure) ma
685+ fromColumns1 (fromK1Columns @"Just" @_ @_ @structure) .
689+ toColumns1 (toK1Columns @"Just" @_ @_ @structure)
690+ {-# INLINABLE fromK1Columns #-}
691+ {-# INLINABLE toK1Columns #-}
695+ ( HTable (K1Columns "Just" structure)
696+ , K1Table "Just" Identity (IsStructure structure) structure a
698+ ) => K1Table label Identity 'True (Shape1 'Maybe structure) ma
701+ = fmap (fromK1Columns @"Just" @_ @_ @structure)
703+ . hunlabel unlabeler
707+ . fmap (toK1Columns @"Just" @_ @_ @structure)
708+ {-# INLINABLE fromK1Columns #-}
709+ {-# INLINABLE toK1Columns #-}
713+ ( HTable (K1Columns "Just" structure)
714+ , K1Table "Just" Name (IsStructure structure) structure a
716+ ) => K1Table label Name 'True (Shape1 'Maybe structure) ma
719+ fromColumns1 (fromK1Columns @"Just" @_ @_ @structure) .
723+ toColumns1 (toK1Columns @"Just" @_ @_ @structure)
724+ {-# INLINABLE fromK1Columns #-}
725+ {-# INLINABLE toK1Columns #-}
730+ , K1Columns label structure ~ HLabel label (Columns a)
731+ , as ~ NonEmptyTable a
732+ ) => K1Table label Aggregate 'True (Shape1 'NonEmpty structure) as
734+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
735+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
736+ {-# INLINABLE fromK1Columns #-}
737+ {-# INLINABLE toK1Columns #-}
742+ , K1Columns label structure ~ HLabel label (Columns a)
743+ , as ~ NonEmptyTable a
744+ ) => K1Table label Expr 'True (Shape1 'NonEmpty structure) as
746+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
747+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
748+ {-# INLINABLE fromK1Columns #-}
749+ {-# INLINABLE toK1Columns #-}
754+ , K1Columns label structure ~ HLabel label (Columns a)
755+ , as ~ NonEmptyTable a
756+ ) => K1Table label Insertion 'True (Shape1 'NonEmpty structure) as
758+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
759+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
760+ {-# INLINABLE fromK1Columns #-}
761+ {-# INLINABLE toK1Columns #-}
765+ ( K1Table label Identity (IsStructure structure) structure a
766+ , HTable (K1Columns label structure)
768+ ) => K1Table label Identity 'True (Shape1 'NonEmpty structure) as
770+ fromK1Columns = fmap (fromK1Columns @label @_ @_ @structure) . fromHNonEmptyTable
771+ toK1Columns = toHNonEmptyTable . fmap (toK1Columns @label @_ @_ @structure)
772+ {-# INLINABLE fromK1Columns #-}
773+ {-# INLINABLE toK1Columns #-}
778+ , K1Columns label structure ~ HLabel label (Columns a)
779+ , as ~ NonEmptyTable a
780+ ) => K1Table label Name 'True (Shape1 'NonEmpty structure) as
782+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
783+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
784+ {-# INLINABLE fromK1Columns #-}
785+ {-# INLINABLE toK1Columns #-}
789+ ( HTable (K1Columns "Here" structure1)
790+ , HTable (K1Columns "There" structure2)
791+ , K1Table "Here" Aggregate (IsStructure structure1) structure1 a
792+ , K1Table "There" Aggregate (IsStructure structure2) structure2 b
793+ , e ~ TheseTable a b
794+ ) => K1Table label Aggregate 'True (Shape2 'These structure1 structure2) e
798+ (fromK1Columns @"Here" @_ @_ @structure1)
799+ (fromK1Columns @"There" @_ @_ @structure2) .
804+ (toK1Columns @"Here" @_ @_ @structure1)
805+ (toK1Columns @"There" @_ @_ @structure2)
806+ {-# INLINABLE fromK1Columns #-}
807+ {-# INLINABLE toK1Columns #-}
811+ ( HTable (K1Columns "Here" structure1)
812+ , HTable (K1Columns "There" structure2)
813+ , K1Table "Here" Expr (IsStructure structure1) structure1 a
814+ , K1Table "There" Expr (IsStructure structure2) structure2 b
815+ , e ~ TheseTable a b
816+ ) => K1Table label Expr 'True (Shape2 'These structure1 structure2) e
820+ (fromK1Columns @"Here" @_ @_ @structure1)
821+ (fromK1Columns @"There" @_ @_ @structure2) .
826+ (toK1Columns @"Here" @_ @_ @structure1)
827+ (toK1Columns @"There" @_ @_ @structure2)
828+ {-# INLINABLE fromK1Columns #-}
829+ {-# INLINABLE toK1Columns #-}
833+ ( HTable (K1Columns "Here" structure1)
834+ , HTable (K1Columns "There" structure2)
835+ , K1Table "Here" Insertion (IsStructure structure1) structure1 a
836+ , K1Table "There" Insertion (IsStructure structure2) structure2 b
837+ , e ~ TheseTable a b
838+ ) => K1Table label Insertion 'True (Shape2 'These structure1 structure2) e
842+ (fromK1Columns @"Here" @_ @_ @structure1)
843+ (fromK1Columns @"There" @_ @_ @structure2) .
848+ (toK1Columns @"Here" @_ @_ @structure1)
849+ (toK1Columns @"There" @_ @_ @structure2)
850+ {-# INLINABLE fromK1Columns #-}
851+ {-# INLINABLE toK1Columns #-}
855+ ( HTable (K1Columns "Here" structure1)
856+ , HTable (K1Columns "There" structure2)
857+ , K1Table "Here" Identity (IsStructure structure1) structure1 a
858+ , K1Table "There" Identity (IsStructure structure2) structure2 b
860+ ) => K1Table label Identity 'True (Shape2 'These structure1 structure2) e
864+ (fromK1Columns @"Here" @_ @_ @structure1)
865+ (fromK1Columns @"There" @_ @_ @structure2)
867+ . hunlabel unlabeler
872+ (toK1Columns @"Here" @_ @_ @structure1)
873+ (toK1Columns @"There" @_ @_ @structure2)
874+ {-# INLINABLE fromK1Columns #-}
875+ {-# INLINABLE toK1Columns #-}
879+ ( HTable (K1Columns "Here" structure1)
880+ , HTable (K1Columns "There" structure2)
881+ , K1Table "Here" Name (IsStructure structure1) structure1 a
882+ , K1Table "There" Name (IsStructure structure2) structure2 b
883+ , e ~ TheseTable a b
884+ ) => K1Table label Name 'True (Shape2 'These structure1 structure2) e
888+ (fromK1Columns @"Here" @_ @_ @structure1)
889+ (fromK1Columns @"There" @_ @_ @structure2) .
894+ (toK1Columns @"Here" @_ @_ @structure1)
895+ (toK1Columns @"There" @_ @_ @structure2)
896+ {-# INLINABLE fromK1Columns #-}
897+ {-# INLINABLE toK1Columns #-}
901+ ( K1Table "fst" context (IsStructure structure1) structure1 a1
902+ , K1Table "snd" context (IsStructure structure2) structure2 a2
903+ , HTable (K1Columns "fst" structure1)
904+ , HTable (K1Columns "snd" structure2)
907+ ) => K1Table label context 'True (structure1, structure2) a
909+ fromK1Columns (hunlabel unlabeler -> (HPair a b)) =
910+ ( fromK1Columns @"fst" @_ @_ @structure1 a
911+ , fromK1Columns @"snd" @_ @_ @structure2 b
913+ toK1Columns (a, b) = hlabel labeler $ HPair
914+ { hfst = toK1Columns @"fst" @_ @_ @structure1 a
915+ , hsnd = toK1Columns @"snd" @_ @_ @structure2 b
917+ {-# INLINABLE fromK1Columns #-}
918+ {-# INLINABLE toK1Columns #-}
922+ ( K1Table "fst" context (IsStructure structure1) structure1 a1
923+ , K1Table "snd" context (IsStructure structure2) structure2 a2
924+ , K1Table "trd" context (IsStructure structure3) structure3 a3
925+ , HTable (K1Columns "fst" structure1)
926+ , HTable (K1Columns "snd" structure2)
927+ , HTable (K1Columns "trd" structure3)
930+ ) => K1Table label context 'True (structure1, structure2, structure3) a
932+ fromK1Columns (hunlabel unlabeler -> (HTrio a b c)) =
933+ ( fromK1Columns @"fst" @_ @_ @structure1 a
934+ , fromK1Columns @"snd" @_ @_ @structure2 b
935+ , fromK1Columns @"trd" @_ @_ @structure3 c
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
942+ {-# INLINABLE fromK1Columns #-}
943+ {-# INLINABLE toK1Columns #-}
947+ ( K1Table "fst" context (IsStructure structure1) structure1 a1
948+ , K1Table "snd" context (IsStructure structure2) structure2 a2
949+ , K1Table "trd" context (IsStructure structure3) structure3 a3
950+ , K1Table "frt" 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)
956+ , a ~ (a1, a2, a3, a4)
957+ ) => K1Table label context 'True (structure1, structure2, structure3, structure4) a
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
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
971+ {-# INLINABLE fromK1Columns #-}
972+ {-# INLINABLE toK1Columns #-}
976+ ( K1Table "fst" context (IsStructure structure1) structure1 a1
977+ , K1Table "snd" context (IsStructure structure2) structure2 a2
978+ , K1Table "trd" context (IsStructure structure3) structure3 a3
979+ , K1Table "frt" context (IsStructure structure3) structure4 a4
980+ , K1Table "fft" 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)
987+ , a ~ (a1, a2, a3, a4, a5)
988+ ) => K1Table label context 'True (structure1, structure2, structure3, structure4, structure5) a
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
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 #-}
1009+ ( IsStructure structure ~ 'False
1010+ , K1Columns label structure ~ HLabel label (Columns structure)
1011+ , Columns structure ~ Columns a
1012+ , Labelable context
1014+ ) => K1Table label context 'False structure a
1016+ fromK1Columns = fromColumns . hunlabel unlabeler
1017+ toK1Columns = hlabel labeler . toColumns
1018+ {-# INLINABLE fromK1Columns #-}
1019+ {-# INLINABLE toK1Columns #-}