@@ -0,0 +1,1049 @@
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, KnownSymbol )
39+import Rel8.Aggregate ( Aggregate, Col(..) )
40+import Rel8.Expr ( Expr, Col(..) )
41+import Rel8.Kind.Necessity
42+ ( SNecessity( SRequired, SOptional )
43+ , KnownNecessity, necessitySing
45+import Rel8.Schema.Context ( Col(..) )
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 Rel8.Schema.Insert ( Insert, Col(..) )
72+import qualified Rel8.Schema.Kind as K
73+import Rel8.Schema.Name ( Name( Name ), Col(..) )
74+import Rel8.Schema.Spec ( Spec( Spec ), KTable )
75+import Rel8.Schema.Structure
76+ ( IsStructure, Shape(..), Shape1, Shape2
80+ ( Table, Columns, Context, fromColumns, toColumns
82+import Rel8.Table.Either ( EitherTable )
83+import Rel8.Table.Lifted
84+ ( fromColumns1, toColumns1
85+ , fromColumns2, toColumns2
87+import Rel8.Table.List ( ListTable )
88+import Rel8.Table.Maybe ( MaybeTable(..) )
89+import Rel8.Table.NonEmpty ( NonEmptyTable )
90+import Rel8.Table.These ( TheseTable )
93+import Data.These ( These )
96+instance (Rel8able t, TableHelper context) => Table context (t context) where
97+ type Columns (t context) = GRep t
98+ type Context (t context) = context
99+ fromColumns = gfromColumns
100+ toColumns = gtoColumns
103+type TableHelper :: K.Context -> Constraint
104+class TableHelper context where
105+ gfromColumns :: Rel8able t => GRep t (Col context) -> t context
106+ gtoColumns :: Rel8able t => t context -> GRep t (Col context)
109+instance TableHelper Aggregate where
110+ gfromColumns = fromAggregateColumns
111+ gtoColumns = toAggregateColumns
114+instance TableHelper Expr where
115+ gfromColumns = fromExprColumns
116+ gtoColumns = toExprColumns
119+instance TableHelper Insert where
120+ gfromColumns = fromInsertColumns
121+ gtoColumns = toInsertColumns
124+instance TableHelper Identity where
125+ gfromColumns = fromIdentityColumns
126+ gtoColumns = toIdentityColumns
129+instance TableHelper Name where
130+ gfromColumns = fromNameColumns
131+ gtoColumns = toNameColumns
134+-- | This type class allows you to define custom 'Table's using higher-kinded
135+-- data types. Higher-kinded data types are data types of the pattern:
139+-- MyType { field1 :: Column f T1 OR HK1 f
140+-- , field2 :: Column f T2 OR HK2 f
142+-- , fieldN :: Column f Tn OR HKn f
146+-- where @Tn@ is any Haskell type, and @HKn@ is any higher-kinded type.
148+-- That is, higher-kinded data are records where all fields in the record are
149+-- all either of the type @Column f T@ (for any @T@), or are themselves
150+-- higher-kinded data:
156+-- Nested { nested1 :: MyType f
157+-- , nested2 :: MyType f
161+-- The @Rel8able@ type class is used to give us a special mapping operation
162+-- that lets us change the type parameter @f@.
164+-- [Supplying @Rel8able@ instances]
166+-- This type class should be derived generically for all table types in your
167+-- project. To do this, enable the @DeriveAnyType@ and @DeriveGeneric@ language
171+-- \{\-\# LANGUAGE DeriveAnyClass, DeriveGeneric #-\}
173+-- data MyType f = MyType { fieldA :: Column f T }
174+-- deriving ( GHC.Generics.Generic, Rel8able )
176+type Rel8able :: KTable -> Constraint
177+class HTable (GRep t) => Rel8able t where
178+ type GRep t :: K.HTable
180+ fromAggregateColumns :: GRep t (Col Aggregate) -> t Aggregate
181+ toAggregateColumns :: t Aggregate -> GRep t (Col Aggregate)
183+ fromExprColumns :: GRep t (Col Expr) -> t Expr
184+ toExprColumns :: t Expr -> GRep t (Col Expr)
186+ fromInsertColumns :: GRep t (Col Insert) -> t Insert
187+ toInsertColumns :: t Insert -> GRep t (Col Insert)
189+ fromIdentityColumns :: GRep t (Col Identity) -> t Identity
190+ toIdentityColumns :: t Identity -> GRep t (Col Identity)
192+ fromNameColumns :: GRep t (Col Name) -> t Name
193+ toNameColumns :: t Name -> GRep t (Col Name)
195+ type GRep t = GColumns (Rep (t Structure))
197+ default fromAggregateColumns ::
198+ ( Generic (t Aggregate)
199+ , GColumns (Rep (t Structure)) ~ GRep t
200+ , GRel8able Aggregate (Rep (t Structure)) (Rep (t Aggregate))
201+ ) => GRep t (Col Aggregate) -> t Aggregate
202+ fromAggregateColumns = to . fromGColumns @_ @(Rep (t Structure))
204+ default toAggregateColumns ::
205+ ( Generic (t Aggregate)
206+ , GColumns (Rep (t Structure)) ~ GRep t
207+ , GRel8able Aggregate (Rep (t Structure)) (Rep (t Aggregate))
208+ ) => t Aggregate -> GRep t (Col Aggregate)
209+ toAggregateColumns = toGColumns @_ @(Rep (t Structure)) . from
211+ default fromExprColumns ::
213+ , GColumns (Rep (t Structure)) ~ GRep t
214+ , GRel8able Expr (Rep (t Structure)) (Rep (t Expr))
215+ ) => GRep t (Col Expr) -> t Expr
216+ fromExprColumns = to . fromGColumns @_ @(Rep (t Structure))
218+ default toExprColumns ::
220+ , GColumns (Rep (t Structure)) ~ GRep t
221+ , GRel8able Expr (Rep (t Structure)) (Rep (t Expr))
222+ ) => t Expr -> GRep t (Col Expr)
223+ toExprColumns = toGColumns @_ @(Rep (t Structure)) . from
225+ default fromInsertColumns ::
226+ ( Generic (t Insert)
227+ , GColumns (Rep (t Structure)) ~ GRep t
228+ , GRel8able Insert (Rep (t Structure)) (Rep (t Insert))
229+ ) => GRep t (Col Insert) -> t Insert
230+ fromInsertColumns = to . fromGColumns @_ @(Rep (t Structure))
232+ default toInsertColumns ::
233+ ( Generic (t Insert)
234+ , GColumns (Rep (t Structure)) ~ GRep t
235+ , GRel8able Insert (Rep (t Structure)) (Rep (t Insert))
236+ ) => t Insert -> GRep t (Col Insert)
237+ toInsertColumns = toGColumns @_ @(Rep (t Structure)) . from
239+ default fromIdentityColumns ::
240+ ( Generic (t Identity)
241+ , GColumns (Rep (t Structure)) ~ GRep t
242+ , GRel8able Identity (Rep (t Structure)) (Rep (t Identity))
243+ ) => GRep t (Col Identity) -> t Identity
244+ fromIdentityColumns = to . fromGColumns @_ @(Rep (t Structure))
246+ default toIdentityColumns ::
247+ ( Generic (t Identity)
248+ , GColumns (Rep (t Structure)) ~ GRep t
249+ , GRel8able Identity (Rep (t Structure)) (Rep (t Identity))
250+ ) => t Identity -> GRep t (Col Identity)
251+ toIdentityColumns = toGColumns @_ @(Rep (t Structure)) . from
253+ default fromNameColumns ::
255+ , GColumns (Rep (t Structure)) ~ GRep t
256+ , GRel8able Name (Rep (t Structure)) (Rep (t Name))
257+ ) => GRep t (Col Name) -> t Name
258+ fromNameColumns = to . fromGColumns @_ @(Rep (t Structure))
260+ default toNameColumns ::
262+ , GColumns (Rep (t Structure)) ~ GRep t
263+ , GRel8able Name (Rep (t Structure)) (Rep (t Name))
264+ ) => t Name -> GRep t (Col Name)
265+ toNameColumns = toGColumns @_ @(Rep (t Structure)) . from
268+type GColumns :: (Type -> Type) -> K.HTable
269+type family GColumns structure where
270+ GColumns (M1 D _ structure) = GColumns structure
271+ GColumns (M1 C _ structure) = GColumns structure
272+ GColumns (a :*: b) = HPair (GColumns a) (GColumns b)
273+ GColumns (M1 S ('MetaSel ('Just label) _ _ _) (K1 _ structure)) =
274+ K1Columns label structure
277+type GRel8able :: K.Context -> (Type -> Type) -> (Type -> Type) -> Constraint
278+class GRel8able context structure rep where
279+ fromGColumns :: GColumns structure (Col context) -> rep x
280+ toGColumns :: rep x -> GColumns structure (Col context)
283+instance GRel8able context structure rep => GRel8able context (M1 D c structure) (M1 D c rep) where
284+ fromGColumns = M1 . fromGColumns @context @structure @rep
285+ toGColumns (M1 a) = toGColumns @context @structure @rep a
288+instance GRel8able context structure rep => GRel8able context (M1 C c structure) (M1 C c rep) where
289+ fromGColumns = M1 . fromGColumns @context @structure @rep
290+ toGColumns (M1 a) = toGColumns @context @structure @rep a
293+instance (GRel8able context structure1 rep1, GRel8able context structure2 rep2) =>
294+ GRel8able context (structure1 :*: structure2) (rep1 :*: rep2)
296+ fromGColumns (HPair a b) =
297+ fromGColumns @context @structure1 @rep1 a :*:
298+ fromGColumns @context @structure2 @rep2 b
299+ toGColumns (a :*: b) =
301+ (toGColumns @context @structure1 @rep1 a)
302+ (toGColumns @context @structure2 @rep2 b)
306+ ( K1Table label context isStructure structure a
307+ , meta ~ 'MetaSel ('Just label) _su _ss _ds
308+ , structureK1 ~ K1 i structure
310+ ) => GRel8able context (M1 S meta structureK1) (M1 S meta k1)
312+ fromGColumns = M1 . K1 . fromK1Columns @label @_ @_ @structure
313+ toGColumns (M1 (K1 a)) = toK1Columns @label @_ @_ @structure a
316+type K1Columns :: Symbol -> Type -> K.HTable
317+type family K1Columns label structure where
318+ K1Columns label (Shape1 'Column ('Spec '[] necessity a)) =
319+ HIdentity ('Spec '[label] necessity a)
320+ K1Columns _label (Shape1 'Column ('Spec (label ': labels) necessity a)) =
321+ HIdentity ('Spec (label ': labels) necessity a)
322+ K1Columns label (Shape2 'Either a b) =
323+ HLabel label (HEitherTable (K1Columns "Left" a) (K1Columns "Right" b))
324+ K1Columns label (Shape1 'List a) = HListTable (K1Columns label a)
325+ K1Columns label (Shape1 'Maybe a) = HLabel label (HMaybeTable (K1Columns "Just" a))
326+ K1Columns label (Shape1 'NonEmpty a) = HNonEmptyTable (K1Columns label a)
327+ K1Columns label (Shape2 'These a b) =
328+ HLabel label (HTheseTable (K1Columns "Here" a) (K1Columns "There" b))
329+ K1Columns label (a, b) =
333+ (K1Columns "snd" b))
334+ K1Columns label (a, b, c) =
339+ (K1Columns "trd" c))
340+ K1Columns label (a, b, c, d) =
346+ (K1Columns "frt" d))
347+ K1Columns label (a, b, c, d, e) =
354+ (K1Columns "fft" e))
355+ K1Columns label a = HLabel label (Columns a)
358+type K1Table :: Symbol -> K.Context -> Bool -> Type -> Type -> Constraint
359+class isStructure ~ IsStructure structure =>
360+ K1Table label context isStructure structure a
362+ fromK1Columns :: K1Columns label structure (Col context) -> a
363+ toK1Columns :: a -> K1Columns label structure (Col context)
367+ ( x ~ Field Aggregate '[] necessity a
368+ ) => K1Table label Aggregate 'True (Shape1 'Column ('Spec '[] necessity a)) x
370+ fromK1Columns (HIdentity (Aggregation a)) = a
371+ toK1Columns = HIdentity . Aggregation
372+ {-# INLINABLE fromK1Columns #-}
373+ {-# INLINABLE toK1Columns #-}
377+ ( x ~ Field Aggregate (label ': labels) necessity a
378+ ) => K1Table _label Aggregate 'True (Shape1 'Column ('Spec (label ': labels) necessity a)) x
380+ fromK1Columns (HIdentity (Aggregation a)) = a
381+ toK1Columns = HIdentity . Aggregation
382+ {-# INLINABLE fromK1Columns #-}
383+ {-# INLINABLE toK1Columns #-}
387+ ( x ~ Field Expr '[] necessity a
388+ ) => K1Table label Expr 'True (Shape1 'Column ('Spec '[] necessity a)) x
390+ fromK1Columns (HIdentity (DB a)) = a
391+ toK1Columns = HIdentity . DB
392+ {-# INLINABLE fromK1Columns #-}
393+ {-# INLINABLE toK1Columns #-}
397+ ( x ~ Field Expr (label ': labels) necessity a
398+ ) => K1Table _label Expr 'True (Shape1 'Column ('Spec (label ': labels) necessity a)) x
400+ fromK1Columns (HIdentity (DB a)) = a
401+ toK1Columns = HIdentity . DB
402+ {-# INLINABLE fromK1Columns #-}
403+ {-# INLINABLE toK1Columns #-}
407+ ( x ~ Field Insert '[] necessity a
408+ , KnownNecessity necessity
409+ ) => K1Table label Insert 'True (Shape1 'Column ('Spec '[] necessity a)) x
411+ fromK1Columns (HIdentity insert) = case insert of
412+ RequiredInsert a -> a
413+ OptionalInsert ma -> ma
414+ toK1Columns a = HIdentity $ case necessitySing @necessity of
415+ SRequired -> RequiredInsert a
416+ SOptional -> OptionalInsert a
417+ {-# INLINABLE fromK1Columns #-}
418+ {-# INLINABLE toK1Columns #-}
422+ ( x ~ Field Insert (label ': labels) necessity a
423+ , KnownNecessity necessity
424+ ) => K1Table _label Insert 'True (Shape1 'Column ('Spec (label ': labels) necessity a)) x
426+ fromK1Columns (HIdentity insert) = case insert of
427+ RequiredInsert a -> a
428+ OptionalInsert ma -> ma
429+ toK1Columns a = HIdentity $ case necessitySing @necessity of
430+ SRequired -> RequiredInsert a
431+ SOptional -> OptionalInsert a
432+ {-# INLINABLE fromK1Columns #-}
433+ {-# INLINABLE toK1Columns #-}
437+ ( x ~ Field Identity '[] necessity a
438+ ) => K1Table label Identity 'True (Shape1 'Column ('Spec '[] necessity a)) x
440+ fromK1Columns (HIdentity (Result a)) = a
441+ toK1Columns = HIdentity . Result
442+ {-# INLINABLE fromK1Columns #-}
443+ {-# INLINABLE toK1Columns #-}
447+ ( x ~ Field Identity (label ': labels) necessity a
448+ ) => K1Table _label Identity 'True (Shape1 'Column ('Spec (label ': labels) necessity a)) x
450+ fromK1Columns (HIdentity (Result a)) = a
451+ toK1Columns = HIdentity . Result
452+ {-# INLINABLE fromK1Columns #-}
453+ {-# INLINABLE toK1Columns #-}
457+ ( x ~ Field Name '[] necessity a
458+ ) => K1Table _label Name 'True (Shape1 'Column ('Spec (label ': labels) necessity a)) x
460+ fromK1Columns (HIdentity (NameCol a)) = Name a
461+ toK1Columns (Name a) = HIdentity (NameCol a)
462+ {-# INLINABLE fromK1Columns #-}
463+ {-# INLINABLE toK1Columns #-}
467+ ( x ~ Field Name (label ': labels) necessity a
468+ ) => K1Table label Name 'True (Shape1 'Column ('Spec '[] necessity a)) x
470+ fromK1Columns = Name . (\(NameCol a) -> a) . unlabeler . unHIdentity
471+ toK1Columns = HIdentity . labeler . NameCol . (\(Name a) -> a)
472+ {-# INLINABLE fromK1Columns #-}
473+ {-# INLINABLE toK1Columns #-}
477+ ( HTable (K1Columns "Left" structure1)
478+ , HTable (K1Columns "Right" structure2)
479+ , K1Table "Left" Aggregate (IsStructure structure1) structure1 a
480+ , K1Table "Right" Aggregate (IsStructure structure2) structure2 b
481+ , e ~ EitherTable a b
483+ ) => K1Table label Aggregate 'True (Shape2 'Either structure1 structure2) e
487+ (fromK1Columns @"Left" @_ @_ @structure1)
488+ (fromK1Columns @"Right" @_ @_ @structure2) .
493+ (toK1Columns @"Left" @_ @_ @structure1)
494+ (toK1Columns @"Right" @_ @_ @structure2)
495+ {-# INLINABLE fromK1Columns #-}
496+ {-# INLINABLE toK1Columns #-}
500+ ( HTable (K1Columns "Left" structure1)
501+ , HTable (K1Columns "Right" structure2)
502+ , K1Table "Left" Expr (IsStructure structure1) structure1 a
503+ , K1Table "Right" Expr (IsStructure structure2) structure2 b
504+ , e ~ EitherTable a b
506+ ) => K1Table label Expr 'True (Shape2 'Either structure1 structure2) e
510+ (fromK1Columns @"Left" @_ @_ @structure1)
511+ (fromK1Columns @"Right" @_ @_ @structure2) .
516+ (toK1Columns @"Left" @_ @_ @structure1)
517+ (toK1Columns @"Right" @_ @_ @structure2)
518+ {-# INLINABLE fromK1Columns #-}
519+ {-# INLINABLE toK1Columns #-}
523+ ( HTable (K1Columns "Left" structure1)
524+ , HTable (K1Columns "Right" structure2)
525+ , K1Table "Left" Insert (IsStructure structure1) structure1 a
526+ , K1Table "Right" Insert (IsStructure structure2) structure2 b
527+ , e ~ EitherTable a b
529+ ) => K1Table label Insert 'True (Shape2 'Either structure1 structure2) e
533+ (fromK1Columns @"Left" @_ @_ @structure1)
534+ (fromK1Columns @"Right" @_ @_ @structure2) .
539+ (toK1Columns @"Left" @_ @_ @structure1)
540+ (toK1Columns @"Right" @_ @_ @structure2)
541+ {-# INLINABLE fromK1Columns #-}
542+ {-# INLINABLE toK1Columns #-}
546+ ( HTable (K1Columns "Left" structure1)
547+ , HTable (K1Columns "Right" structure2)
548+ , K1Table "Left" Identity (IsStructure structure1) structure1 a
549+ , K1Table "Right" Identity (IsStructure structure2) structure2 b
552+ ) => K1Table label Identity 'True (Shape2 'Either structure1 structure2) e
556+ (fromK1Columns @"Left" @_ @_ @structure1)
557+ (fromK1Columns @"Right" @_ @_ @structure2)
559+ . hunlabel unlabeler
564+ (toK1Columns @"Left" @_ @_ @structure1)
565+ (toK1Columns @"Right" @_ @_ @structure2)
566+ {-# INLINABLE fromK1Columns #-}
567+ {-# INLINABLE toK1Columns #-}
571+ ( HTable (K1Columns "Left" structure1)
572+ , HTable (K1Columns "Right" structure2)
573+ , K1Table "Left" Name (IsStructure structure1) structure1 a
574+ , K1Table "Right" Name (IsStructure structure2) structure2 b
575+ , e ~ EitherTable a b
577+ ) => K1Table label Name 'True (Shape2 'Either structure1 structure2) e
581+ (fromK1Columns @"Left" @_ @_ @structure1)
582+ (fromK1Columns @"Right" @_ @_ @structure2) .
587+ (toK1Columns @"Left" @_ @_ @structure1)
588+ (toK1Columns @"Right" @_ @_ @structure2)
589+ {-# INLINABLE fromK1Columns #-}
590+ {-# INLINABLE toK1Columns #-}
595+ , K1Columns label structure ~ HLabel label (Columns a)
598+ ) => K1Table label Aggregate 'True (Shape1 'List structure) as
600+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
601+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
602+ {-# INLINABLE fromK1Columns #-}
603+ {-# INLINABLE toK1Columns #-}
608+ , K1Columns label structure ~ HLabel label (Columns a)
611+ ) => K1Table label Expr 'True (Shape1 'List structure) as
613+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
614+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
615+ {-# INLINABLE fromK1Columns #-}
616+ {-# INLINABLE toK1Columns #-}
621+ , K1Columns label structure ~ HLabel label (Columns a)
624+ ) => K1Table label Insert 'True (Shape1 'List structure) as
626+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
627+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
628+ {-# INLINABLE fromK1Columns #-}
629+ {-# INLINABLE toK1Columns #-}
633+ ( K1Table label Identity (IsStructure structure) structure a
634+ , HTable (K1Columns label structure)
636+ ) => K1Table label Identity 'True (Shape1 'List structure) as
638+ fromK1Columns = fmap (fromK1Columns @label @_ @_ @structure) . fromHListTable
639+ toK1Columns = toHListTable . fmap (toK1Columns @label @_ @_ @structure)
640+ {-# INLINABLE fromK1Columns #-}
641+ {-# INLINABLE toK1Columns #-}
646+ , K1Columns label structure ~ HLabel label (Columns a)
649+ ) => K1Table label Name 'True (Shape1 'List structure) as
651+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
652+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
653+ {-# INLINABLE fromK1Columns #-}
654+ {-# INLINABLE toK1Columns #-}
658+ ( HTable (K1Columns "Just" structure)
659+ , K1Table "Just" Aggregate (IsStructure structure) structure a
662+ ) => K1Table label Aggregate 'True (Shape1 'Maybe structure) ma
665+ fromColumns1 (fromK1Columns @"Just" @_ @_ @structure) .
669+ toColumns1 (toK1Columns @"Just" @_ @_ @structure)
670+ {-# INLINABLE fromK1Columns #-}
671+ {-# INLINABLE toK1Columns #-}
675+ ( HTable (K1Columns "Just" structure)
676+ , K1Table "Just" Expr (IsStructure structure) structure a
679+ ) => K1Table label Expr 'True (Shape1 'Maybe structure) ma
682+ fromColumns1 (fromK1Columns @"Just" @_ @_ @structure) .
686+ toColumns1 (toK1Columns @"Just" @_ @_ @structure)
687+ {-# INLINABLE fromK1Columns #-}
688+ {-# INLINABLE toK1Columns #-}
692+ ( HTable (K1Columns "Just" structure)
693+ , K1Table "Just" Insert (IsStructure structure) structure a
696+ ) => K1Table label Insert 'True (Shape1 'Maybe structure) ma
699+ fromColumns1 (fromK1Columns @"Just" @_ @_ @structure) .
703+ toColumns1 (toK1Columns @"Just" @_ @_ @structure)
704+ {-# INLINABLE fromK1Columns #-}
705+ {-# INLINABLE toK1Columns #-}
709+ ( HTable (K1Columns "Just" structure)
710+ , K1Table "Just" Identity (IsStructure structure) structure a
713+ ) => K1Table label Identity 'True (Shape1 'Maybe structure) ma
716+ = fmap (fromK1Columns @"Just" @_ @_ @structure)
718+ . hunlabel unlabeler
722+ . fmap (toK1Columns @"Just" @_ @_ @structure)
723+ {-# INLINABLE fromK1Columns #-}
724+ {-# INLINABLE toK1Columns #-}
728+ ( HTable (K1Columns "Just" structure)
729+ , K1Table "Just" Name (IsStructure structure) structure a
732+ ) => K1Table label Name 'True (Shape1 'Maybe structure) ma
735+ fromColumns1 (fromK1Columns @"Just" @_ @_ @structure) .
739+ toColumns1 (toK1Columns @"Just" @_ @_ @structure)
740+ {-# INLINABLE fromK1Columns #-}
741+ {-# INLINABLE toK1Columns #-}
746+ , K1Columns label structure ~ HLabel label (Columns a)
747+ , as ~ NonEmptyTable a
749+ ) => K1Table label Aggregate 'True (Shape1 'NonEmpty structure) as
751+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
752+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
753+ {-# INLINABLE fromK1Columns #-}
754+ {-# INLINABLE toK1Columns #-}
759+ , K1Columns label structure ~ HLabel label (Columns a)
760+ , as ~ NonEmptyTable a
762+ ) => K1Table label Expr 'True (Shape1 'NonEmpty structure) as
764+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
765+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
766+ {-# INLINABLE fromK1Columns #-}
767+ {-# INLINABLE toK1Columns #-}
772+ , K1Columns label structure ~ HLabel label (Columns a)
773+ , as ~ NonEmptyTable a
775+ ) => K1Table label Insert 'True (Shape1 'NonEmpty structure) as
777+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
778+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
779+ {-# INLINABLE fromK1Columns #-}
780+ {-# INLINABLE toK1Columns #-}
784+ ( K1Table label Identity (IsStructure structure) structure a
785+ , HTable (K1Columns label structure)
787+ ) => K1Table label Identity 'True (Shape1 'NonEmpty structure) as
789+ fromK1Columns = fmap (fromK1Columns @label @_ @_ @structure) . fromHNonEmptyTable
790+ toK1Columns = toHNonEmptyTable . fmap (toK1Columns @label @_ @_ @structure)
791+ {-# INLINABLE fromK1Columns #-}
792+ {-# INLINABLE toK1Columns #-}
797+ , K1Columns label structure ~ HLabel label (Columns a)
798+ , as ~ NonEmptyTable a
800+ ) => K1Table label Name 'True (Shape1 'NonEmpty structure) as
802+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
803+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
804+ {-# INLINABLE fromK1Columns #-}
805+ {-# INLINABLE toK1Columns #-}
809+ ( HTable (K1Columns "Here" structure1)
810+ , HTable (K1Columns "There" structure2)
811+ , K1Table "Here" Aggregate (IsStructure structure1) structure1 a
812+ , K1Table "There" Aggregate (IsStructure structure2) structure2 b
813+ , e ~ TheseTable a b
815+ ) => K1Table label Aggregate 'True (Shape2 'These structure1 structure2) e
819+ (fromK1Columns @"Here" @_ @_ @structure1)
820+ (fromK1Columns @"There" @_ @_ @structure2) .
825+ (toK1Columns @"Here" @_ @_ @structure1)
826+ (toK1Columns @"There" @_ @_ @structure2)
827+ {-# INLINABLE fromK1Columns #-}
828+ {-# INLINABLE toK1Columns #-}
832+ ( HTable (K1Columns "Here" structure1)
833+ , HTable (K1Columns "There" structure2)
834+ , K1Table "Here" Expr (IsStructure structure1) structure1 a
835+ , K1Table "There" Expr (IsStructure structure2) structure2 b
836+ , e ~ TheseTable a b
838+ ) => K1Table label Expr '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" Insert (IsStructure structure1) structure1 a
858+ , K1Table "There" Insert (IsStructure structure2) structure2 b
859+ , e ~ TheseTable a b
861+ ) => K1Table label Insert 'True (Shape2 'These structure1 structure2) e
865+ (fromK1Columns @"Here" @_ @_ @structure1)
866+ (fromK1Columns @"There" @_ @_ @structure2) .
871+ (toK1Columns @"Here" @_ @_ @structure1)
872+ (toK1Columns @"There" @_ @_ @structure2)
873+ {-# INLINABLE fromK1Columns #-}
874+ {-# INLINABLE toK1Columns #-}
878+ ( HTable (K1Columns "Here" structure1)
879+ , HTable (K1Columns "There" structure2)
880+ , K1Table "Here" Identity (IsStructure structure1) structure1 a
881+ , K1Table "There" Identity (IsStructure structure2) structure2 b
884+ ) => K1Table label Identity 'True (Shape2 'These structure1 structure2) e
888+ (fromK1Columns @"Here" @_ @_ @structure1)
889+ (fromK1Columns @"There" @_ @_ @structure2)
891+ . hunlabel unlabeler
896+ (toK1Columns @"Here" @_ @_ @structure1)
897+ (toK1Columns @"There" @_ @_ @structure2)
898+ {-# INLINABLE fromK1Columns #-}
899+ {-# INLINABLE toK1Columns #-}
903+ ( HTable (K1Columns "Here" structure1)
904+ , HTable (K1Columns "There" structure2)
905+ , K1Table "Here" Name (IsStructure structure1) structure1 a
906+ , K1Table "There" Name (IsStructure structure2) structure2 b
907+ , e ~ TheseTable a b
909+ ) => K1Table label Name 'True (Shape2 'These structure1 structure2) e
913+ (fromK1Columns @"Here" @_ @_ @structure1)
914+ (fromK1Columns @"There" @_ @_ @structure2) .
919+ (toK1Columns @"Here" @_ @_ @structure1)
920+ (toK1Columns @"There" @_ @_ @structure2)
921+ {-# INLINABLE fromK1Columns #-}
922+ {-# INLINABLE toK1Columns #-}
926+ ( K1Table "fst" context (IsStructure structure1) structure1 a1
927+ , K1Table "snd" context (IsStructure structure2) structure2 a2
928+ , HTable (K1Columns "fst" structure1)
929+ , HTable (K1Columns "snd" structure2)
933+ ) => K1Table label context 'True (structure1, structure2) a
935+ fromK1Columns (hunlabel unlabeler -> (HPair a b)) =
936+ ( fromK1Columns @"fst" @_ @_ @structure1 a
937+ , fromK1Columns @"snd" @_ @_ @structure2 b
939+ toK1Columns (a, b) = hlabel labeler $ HPair
940+ { hfst = toK1Columns @"fst" @_ @_ @structure1 a
941+ , hsnd = toK1Columns @"snd" @_ @_ @structure2 b
943+ {-# INLINABLE fromK1Columns #-}
944+ {-# INLINABLE toK1Columns #-}
948+ ( K1Table "fst" context (IsStructure structure1) structure1 a1
949+ , K1Table "snd" context (IsStructure structure2) structure2 a2
950+ , K1Table "trd" context (IsStructure structure3) structure3 a3
951+ , HTable (K1Columns "fst" structure1)
952+ , HTable (K1Columns "snd" structure2)
953+ , HTable (K1Columns "trd" structure3)
957+ ) => K1Table label context 'True (structure1, structure2, structure3) a
959+ fromK1Columns (hunlabel unlabeler -> (HTrio a b c)) =
960+ ( fromK1Columns @"fst" @_ @_ @structure1 a
961+ , fromK1Columns @"snd" @_ @_ @structure2 b
962+ , fromK1Columns @"trd" @_ @_ @structure3 c
964+ toK1Columns (a, b, c) = hlabel labeler $ HTrio
965+ { hfst = toK1Columns @"fst" @_ @_ @structure1 a
966+ , hsnd = toK1Columns @"snd" @_ @_ @structure2 b
967+ , htrd = toK1Columns @"trd" @_ @_ @structure3 c
969+ {-# INLINABLE fromK1Columns #-}
970+ {-# INLINABLE toK1Columns #-}
974+ ( K1Table "fst" context (IsStructure structure1) structure1 a1
975+ , K1Table "snd" context (IsStructure structure2) structure2 a2
976+ , K1Table "trd" context (IsStructure structure3) structure3 a3
977+ , K1Table "frt" context (IsStructure structure3) structure4 a4
978+ , HTable (K1Columns "fst" structure1)
979+ , HTable (K1Columns "snd" structure2)
980+ , HTable (K1Columns "trd" structure3)
981+ , HTable (K1Columns "frt" structure4)
983+ , a ~ (a1, a2, a3, a4)
985+ ) => K1Table label context 'True (structure1, structure2, structure3, structure4) a
987+ fromK1Columns (hunlabel unlabeler -> (HQuartet a b c d)) =
988+ ( fromK1Columns @"fst" @_ @_ @structure1 a
989+ , fromK1Columns @"snd" @_ @_ @structure2 b
990+ , fromK1Columns @"trd" @_ @_ @structure3 c
991+ , fromK1Columns @"frt" @_ @_ @structure4 d
993+ toK1Columns (a, b, c, d) = hlabel labeler $ HQuartet
994+ { hfst = toK1Columns @"fst" @_ @_ @structure1 a
995+ , hsnd = toK1Columns @"snd" @_ @_ @structure2 b
996+ , htrd = toK1Columns @"trd" @_ @_ @structure3 c
997+ , hfrt = toK1Columns @"frt" @_ @_ @structure4 d
999+ {-# INLINABLE fromK1Columns #-}
1000+ {-# INLINABLE toK1Columns #-}
1004+ ( K1Table "fst" context (IsStructure structure1) structure1 a1
1005+ , K1Table "snd" context (IsStructure structure2) structure2 a2
1006+ , K1Table "trd" context (IsStructure structure3) structure3 a3
1007+ , K1Table "frt" context (IsStructure structure3) structure4 a4
1008+ , K1Table "fft" context (IsStructure structure3) structure5 a5
1009+ , HTable (K1Columns "fst" structure1)
1010+ , HTable (K1Columns "snd" structure2)
1011+ , HTable (K1Columns "trd" structure3)
1012+ , HTable (K1Columns "frt" structure4)
1013+ , HTable (K1Columns "fft" structure5)
1014+ , Labelable context
1015+ , a ~ (a1, a2, a3, a4, a5)
1016+ , KnownSymbol label
1017+ ) => K1Table label context 'True (structure1, structure2, structure3, structure4, structure5) a
1019+ fromK1Columns (hunlabel unlabeler -> (HQuintet a b c d e)) =
1020+ ( fromK1Columns @"fst" @_ @_ @structure1 a
1021+ , fromK1Columns @"snd" @_ @_ @structure2 b
1022+ , fromK1Columns @"trd" @_ @_ @structure3 c
1023+ , fromK1Columns @"frt" @_ @_ @structure4 d
1024+ , fromK1Columns @"fft" @_ @_ @structure5 e
1026+ toK1Columns (a, b, c, d, e) = hlabel labeler $ HQuintet
1027+ { hfst = toK1Columns @"fst" @_ @_ @structure1 a
1028+ , hsnd = toK1Columns @"snd" @_ @_ @structure2 b
1029+ , htrd = toK1Columns @"trd" @_ @_ @structure3 c
1030+ , hfrt = toK1Columns @"frt" @_ @_ @structure4 d
1031+ , hfft = toK1Columns @"fft" @_ @_ @structure5 e
1033+ {-# INLINABLE fromK1Columns #-}
1034+ {-# INLINABLE toK1Columns #-}
1038+ ( IsStructure structure ~ 'False
1039+ , K1Columns label structure ~ HLabel label (Columns structure)
1040+ , Columns structure ~ Columns a
1041+ , Labelable context
1043+ , KnownSymbol label
1044+ ) => K1Table label context 'False structure a
1046+ fromK1Columns = fromColumns . hunlabel unlabeler
1047+ toK1Columns = hlabel labeler . toColumns
1048+ {-# INLINABLE fromK1Columns #-}
1049+ {-# INLINABLE toK1Columns #-}