@@ -0,0 +1,1062 @@
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.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
79+ ( Table, Columns, Context, fromColumns, toColumns
81+import Rel8.Table.Either ( EitherTable )
82+import Rel8.Table.Lifted
83+ ( fromColumns1, toColumns1
84+ , fromColumns2, toColumns2
86+import Rel8.Table.List ( ListTable )
87+import Rel8.Table.Maybe ( MaybeTable(..) )
88+import Rel8.Table.NonEmpty ( NonEmptyTable )
89+import Rel8.Table.These ( TheseTable )
92+import Data.These ( These )
95+instance (Rel8able t, TableHelper (IsSpecialContext context) context) =>
96+ Table context (t context)
98+ type Columns (t context) = GRep t
99+ type Context (t context) = context
100+ fromColumns = gfromColumns
101+ toColumns = gtoColumns
104+type TableHelper :: Bool -> K.Context -> Constraint
105+class IsSpecialContext context ~ isSpecialContext =>
106+ TableHelper isSpecialContext context
108+ gfromColumns :: Rel8able t => GRep t (Col context) -> t context
109+ gtoColumns :: Rel8able t => t context -> GRep t (Col context)
112+instance TableHelper 'True Aggregate where
113+ gfromColumns = fromAggregateColumns
114+ gtoColumns = toAggregateColumns
117+instance TableHelper 'True Expr where
118+ gfromColumns = fromExprColumns
119+ gtoColumns = toExprColumns
122+instance TableHelper 'True Insertion where
123+ gfromColumns = fromInsertionColumns
124+ gtoColumns = toInsertionColumns
127+instance TableHelper 'True Identity where
128+ gfromColumns = fromIdentityColumns
129+ gtoColumns = toIdentityColumns
132+instance (IsSpecialContext context ~ 'False, Labelable context, Nullifiable context) =>
133+ TableHelper 'False context
135+ gfromColumns = fromUnspecialColumns
136+ gtoColumns = toUnspecialColumns
139+-- | This type class allows you to define custom 'Table's using higher-kinded
140+-- data types. Higher-kinded data types are data types of the pattern:
144+-- MyType { field1 :: Column f T1 OR HK1 f
145+-- , field2 :: Column f T2 OR HK2 f
147+-- , fieldN :: Column f Tn OR HKn f
151+-- where @Tn@ is any Haskell type, and @HKn@ is any higher-kinded type.
153+-- That is, higher-kinded data are records where all fields in the record are
154+-- all either of the type @Column f T@ (for any @T@), or are themselves
155+-- higher-kinded data:
161+-- Nested { nested1 :: MyType f
162+-- , nested2 :: MyType f
166+-- The @Rel8able@ type class is used to give us a special mapping operation
167+-- that lets us change the type parameter @f@.
169+-- [Supplying @Rel8able@ instances]
171+-- This type class should be derived generically for all table types in your
172+-- project. To do this, enable the @DeriveAnyType@ and @DeriveGeneric@ language
176+-- \{\-\# LANGUAGE DeriveAnyClass, DeriveGeneric #-\}
178+-- data MyType f = MyType { fieldA :: Column f T }
179+-- deriving ( GHC.Generics.Generic, Rel8able )
181+type Rel8able :: KTable -> Constraint
182+class HTable (GRep t) => Rel8able t where
183+ type GRep t :: K.HTable
185+ fromAggregateColumns :: GRep t (Col Aggregate) -> t Aggregate
186+ toAggregateColumns :: t Aggregate -> GRep t (Col Aggregate)
188+ fromExprColumns :: GRep t (Col Expr) -> t Expr
189+ toExprColumns :: t Expr -> GRep t (Col Expr)
191+ fromInsertionColumns :: GRep t (Col Insertion) -> t Insertion
192+ toInsertionColumns :: t Insertion -> GRep t (Col Insertion)
194+ fromIdentityColumns :: GRep t (Col Identity) -> t Identity
195+ toIdentityColumns :: t Identity -> GRep t (Col Identity)
197+ fromUnspecialColumns ::
198+ ( IsSpecialContext context ~ 'False
199+ , Labelable context, Nullifiable context
201+ => GRep t (Col context) -> t context
202+ toUnspecialColumns ::
203+ ( IsSpecialContext context ~ 'False
204+ , Labelable context, Nullifiable context
206+ => t context -> GRep t (Col context)
208+ type GRep t = GColumns (Rep (t Structure))
210+ default fromAggregateColumns ::
211+ ( Generic (t Aggregate)
212+ , GColumns (Rep (t Structure)) ~ GRep t
213+ , GRel8able Aggregate (Rep (t Structure)) (Rep (t Aggregate))
214+ ) => GRep t (Col Aggregate) -> t Aggregate
215+ fromAggregateColumns = to . fromGColumns @_ @(Rep (t Structure))
217+ default toAggregateColumns ::
218+ ( Generic (t Aggregate)
219+ , GColumns (Rep (t Structure)) ~ GRep t
220+ , GRel8able Aggregate (Rep (t Structure)) (Rep (t Aggregate))
221+ ) => t Aggregate -> GRep t (Col Aggregate)
222+ toAggregateColumns = toGColumns @_ @(Rep (t Structure)) . from
224+ default fromExprColumns ::
226+ , GColumns (Rep (t Structure)) ~ GRep t
227+ , GRel8able Expr (Rep (t Structure)) (Rep (t Expr))
228+ ) => GRep t (Col Expr) -> t Expr
229+ fromExprColumns = to . fromGColumns @_ @(Rep (t Structure))
231+ default toExprColumns ::
233+ , GColumns (Rep (t Structure)) ~ GRep t
234+ , GRel8able Expr (Rep (t Structure)) (Rep (t Expr))
235+ ) => t Expr -> GRep t (Col Expr)
236+ toExprColumns = toGColumns @_ @(Rep (t Structure)) . from
238+ default fromInsertionColumns ::
239+ ( Generic (t Insertion)
240+ , GColumns (Rep (t Structure)) ~ GRep t
241+ , GRel8able Insertion (Rep (t Structure)) (Rep (t Insertion))
242+ ) => GRep t (Col Insertion) -> t Insertion
243+ fromInsertionColumns = to . fromGColumns @_ @(Rep (t Structure))
245+ default toInsertionColumns ::
246+ ( Generic (t Insertion)
247+ , GColumns (Rep (t Structure)) ~ GRep t
248+ , GRel8able Insertion (Rep (t Structure)) (Rep (t Insertion))
249+ ) => t Insertion -> GRep t (Col Insertion)
250+ toInsertionColumns = toGColumns @_ @(Rep (t Structure)) . from
252+ default fromIdentityColumns ::
253+ ( Generic (t Identity)
254+ , GColumns (Rep (t Structure)) ~ GRep t
255+ , GRel8able Identity (Rep (t Structure)) (Rep (t Identity))
256+ ) => GRep t (Col Identity) -> t Identity
257+ fromIdentityColumns = to . fromGColumns @_ @(Rep (t Structure))
259+ default toIdentityColumns ::
260+ ( Generic (t Identity)
261+ , GColumns (Rep (t Structure)) ~ GRep t
262+ , GRel8able Identity (Rep (t Structure)) (Rep (t Identity))
263+ ) => t Identity -> GRep t (Col Identity)
264+ toIdentityColumns = toGColumns @_ @(Rep (t Structure)) . from
266+ default fromUnspecialColumns ::
267+ ( Generic (t context)
268+ , GColumns (Rep (t Structure)) ~ GRep t
269+ , GRel8able context (Rep (t Structure)) (Rep (t context))
270+ ) => GRep t (Col context) -> t context
271+ fromUnspecialColumns = to . fromGColumns @_ @(Rep (t Structure))
273+ default toUnspecialColumns ::
274+ ( Generic (t context)
275+ , GColumns (Rep (t Structure)) ~ GRep t
276+ , GRel8able context (Rep (t Structure)) (Rep (t context))
277+ ) => t context -> GRep t (Col context)
278+ toUnspecialColumns = toGColumns @_ @(Rep (t Structure)) . from
281+type GColumns :: (Type -> Type) -> K.HTable
282+type family GColumns structure where
283+ GColumns (M1 D _ structure) = GColumns structure
284+ GColumns (M1 C _ structure) = GColumns structure
285+ GColumns (a :*: b) = HPair (GColumns a) (GColumns b)
286+ GColumns (M1 S ('MetaSel ('Just label) _ _ _) (K1 _ structure)) =
287+ K1Columns label structure
290+type GRel8able :: K.Context -> (Type -> Type) -> (Type -> Type) -> Constraint
291+class GRel8able context structure rep where
292+ fromGColumns :: GColumns structure (Col context) -> rep x
293+ toGColumns :: rep x -> GColumns structure (Col context)
296+instance GRel8able context structure rep => GRel8able context (M1 D c structure) (M1 D c rep) where
297+ fromGColumns = M1 . fromGColumns @context @structure @rep
298+ toGColumns (M1 a) = toGColumns @context @structure @rep a
301+instance GRel8able context structure rep => GRel8able context (M1 C c structure) (M1 C c rep) where
302+ fromGColumns = M1 . fromGColumns @context @structure @rep
303+ toGColumns (M1 a) = toGColumns @context @structure @rep a
306+instance (GRel8able context structure1 rep1, GRel8able context structure2 rep2) =>
307+ GRel8able context (structure1 :*: structure2) (rep1 :*: rep2)
309+ fromGColumns (HPair a b) =
310+ fromGColumns @context @structure1 @rep1 a :*:
311+ fromGColumns @context @structure2 @rep2 b
312+ toGColumns (a :*: b) =
314+ (toGColumns @context @structure1 @rep1 a)
315+ (toGColumns @context @structure2 @rep2 b)
319+ ( K1Table label isSpecialContext context isStructure structure a
320+ , meta ~ 'MetaSel ('Just label) _su _ss _ds
321+ , structureK1 ~ K1 i structure
323+ ) => GRel8able context (M1 S meta structureK1) (M1 S meta k1)
325+ fromGColumns = M1 . K1 . fromK1Columns @label @_ @_ @_ @structure
326+ toGColumns (M1 (K1 a)) = toK1Columns @label @_ @_ @_ @structure a
329+type K1Columns :: Symbol -> Type -> K.HTable
330+type family K1Columns label structure where
331+ K1Columns label (Shape1 'Column ('Spec '[] necessity nullability blueprint)) =
332+ HIdentity ('Spec '[label] necessity nullability blueprint)
333+ K1Columns _label (Shape1 'Column ('Spec (label ': labels) necessity nullability blueprint)) =
334+ HIdentity ('Spec (label ': labels) necessity nullability blueprint)
335+ K1Columns label (Shape2 'Either a b) =
336+ HLabel label (HEitherTable (K1Columns "Left" a) (K1Columns "Right" b))
337+ K1Columns label (Shape1 'List a) = HListTable (K1Columns label a)
338+ K1Columns label (Shape1 'Maybe a) = HLabel label (HMaybeTable (K1Columns "Just" a))
339+ K1Columns label (Shape1 'NonEmpty a) = HNonEmptyTable (K1Columns label a)
340+ K1Columns label (Shape2 'These a b) =
341+ HLabel label (HTheseTable (K1Columns "Here" a) (K1Columns "There" b))
342+ K1Columns label (a, b) =
346+ (K1Columns "snd" b))
347+ K1Columns label (a, b, c) =
352+ (K1Columns "trd" c))
353+ K1Columns label (a, b, c, d) =
359+ (K1Columns "frt" d))
360+ K1Columns label (a, b, c, d, e) =
367+ (K1Columns "fft" e))
368+ K1Columns label a = HLabel label (Columns a)
371+type K1Table :: Symbol -> Bool -> K.Context -> Bool -> Type -> Type -> Constraint
373+ ( isSpecialContext ~ IsSpecialContext context
374+ , isStructure ~ IsStructure structure
375+ ) => K1Table label isSpecialContext context isStructure structure a
377+ fromK1Columns :: K1Columns label structure (Col context) -> a
378+ toK1Columns :: a -> K1Columns label structure (Col context)
382+ ( x ~ Field Aggregate '[] necessity db a
383+ ) => K1Table label 'True Aggregate 'True (Shape1 'Column ('Spec '[] necessity db a)) x
385+ fromK1Columns (HIdentity (Aggregation a)) = a
386+ toK1Columns = HIdentity . Aggregation
387+ {-# INLINABLE fromK1Columns #-}
388+ {-# INLINABLE toK1Columns #-}
392+ ( x ~ Field Aggregate (label ': labels) necessity db a
393+ ) => K1Table _label 'True Aggregate 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
395+ fromK1Columns (HIdentity (Aggregation a)) = a
396+ toK1Columns = HIdentity . Aggregation
397+ {-# INLINABLE fromK1Columns #-}
398+ {-# INLINABLE toK1Columns #-}
402+ ( x ~ Field Expr '[] necessity db a
403+ ) => K1Table label 'True Expr 'True (Shape1 'Column ('Spec '[] necessity db a)) x
405+ fromK1Columns (HIdentity (DB a)) = a
406+ toK1Columns = HIdentity . DB
407+ {-# INLINABLE fromK1Columns #-}
408+ {-# INLINABLE toK1Columns #-}
412+ ( x ~ Field Expr (label ': labels) necessity db a
413+ ) => K1Table _label 'True Expr 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
415+ fromK1Columns (HIdentity (DB a)) = a
416+ toK1Columns = HIdentity . DB
417+ {-# INLINABLE fromK1Columns #-}
418+ {-# INLINABLE toK1Columns #-}
422+ ( x ~ Field Insertion '[] necessity db a
423+ , KnownNecessity necessity
424+ ) => K1Table label 'True Insertion 'True (Shape1 'Column ('Spec '[] necessity db 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 Insertion (label ': labels) necessity db a
438+ , KnownNecessity necessity
439+ ) => K1Table _label 'True Insertion 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
441+ fromK1Columns (HIdentity insert) = case insert of
442+ RequiredInsert a -> a
443+ OptionalInsert ma -> ma
444+ toK1Columns a = HIdentity $ case necessitySing @necessity of
445+ SRequired -> RequiredInsert a
446+ SOptional -> OptionalInsert a
447+ {-# INLINABLE fromK1Columns #-}
448+ {-# INLINABLE toK1Columns #-}
452+ ( x ~ Field Identity '[] necessity db a
453+ ) => K1Table label 'True Identity 'True (Shape1 'Column ('Spec '[] necessity db a)) x
455+ fromK1Columns (HIdentity (Result a)) = a
456+ toK1Columns = HIdentity . Result
457+ {-# INLINABLE fromK1Columns #-}
458+ {-# INLINABLE toK1Columns #-}
462+ ( x ~ Field Identity (label ': labels) necessity db a
463+ ) => K1Table _label 'True Identity 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
465+ fromK1Columns (HIdentity (Result a)) = a
466+ toK1Columns = HIdentity . Result
467+ {-# INLINABLE fromK1Columns #-}
468+ {-# INLINABLE toK1Columns #-}
472+ ( IsSpecialContext context ~ 'False
474+ ) => K1Table _label 'False context 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
476+ fromK1Columns (HIdentity (Col a)) = a
477+ toK1Columns = HIdentity . Col
478+ {-# INLINABLE fromK1Columns #-}
479+ {-# INLINABLE toK1Columns #-}
483+ ( IsSpecialContext context ~ 'False
486+ ) => K1Table label 'False context 'True (Shape1 'Column ('Spec '[] necessity db a)) x
488+ fromK1Columns = (\(Col a) -> a) . unlabeler . unHIdentity
489+ toK1Columns = HIdentity . labeler . Col
490+ {-# INLINABLE fromK1Columns #-}
491+ {-# INLINABLE toK1Columns #-}
495+ ( HTable (K1Columns "Left" structure1)
496+ , HTable (K1Columns "Right" structure2)
497+ , K1Table "Left" 'True Aggregate (IsStructure structure1) structure1 a
498+ , K1Table "Right" 'True Aggregate (IsStructure structure2) structure2 b
499+ , e ~ EitherTable a b
500+ ) => K1Table label 'True Aggregate 'True (Shape2 'Either structure1 structure2) e
504+ (fromK1Columns @"Left" @_ @_ @_ @structure1)
505+ (fromK1Columns @"Right" @_ @_ @_ @structure2) .
510+ (toK1Columns @"Left" @_ @_ @_ @structure1)
511+ (toK1Columns @"Right" @_ @_ @_ @structure2)
512+ {-# INLINABLE fromK1Columns #-}
513+ {-# INLINABLE toK1Columns #-}
517+ ( HTable (K1Columns "Left" structure1)
518+ , HTable (K1Columns "Right" structure2)
519+ , K1Table "Left" 'True Expr (IsStructure structure1) structure1 a
520+ , K1Table "Right" 'True Expr (IsStructure structure2) structure2 b
521+ , e ~ EitherTable a b
522+ ) => K1Table label 'True Expr 'True (Shape2 'Either structure1 structure2) e
526+ (fromK1Columns @"Left" @_ @_ @_ @structure1)
527+ (fromK1Columns @"Right" @_ @_ @_ @structure2) .
532+ (toK1Columns @"Left" @_ @_ @_ @structure1)
533+ (toK1Columns @"Right" @_ @_ @_ @structure2)
534+ {-# INLINABLE fromK1Columns #-}
535+ {-# INLINABLE toK1Columns #-}
539+ ( HTable (K1Columns "Left" structure1)
540+ , HTable (K1Columns "Right" structure2)
541+ , K1Table "Left" 'True Insertion (IsStructure structure1) structure1 a
542+ , K1Table "Right" 'True Insertion (IsStructure structure2) structure2 b
543+ , e ~ EitherTable a b
544+ ) => K1Table label 'True Insertion 'True (Shape2 'Either structure1 structure2) e
548+ (fromK1Columns @"Left" @_ @_ @_ @structure1)
549+ (fromK1Columns @"Right" @_ @_ @_ @structure2) .
554+ (toK1Columns @"Left" @_ @_ @_ @structure1)
555+ (toK1Columns @"Right" @_ @_ @_ @structure2)
556+ {-# INLINABLE fromK1Columns #-}
557+ {-# INLINABLE toK1Columns #-}
561+ ( HTable (K1Columns "Left" structure1)
562+ , HTable (K1Columns "Right" structure2)
563+ , K1Table "Left" 'True Identity (IsStructure structure1) structure1 a
564+ , K1Table "Right" 'True Identity (IsStructure structure2) structure2 b
566+ ) => K1Table label 'True Identity 'True (Shape2 'Either structure1 structure2) e
570+ (fromK1Columns @"Left" @_ @_ @_ @structure1)
571+ (fromK1Columns @"Right" @_ @_ @_ @structure2)
573+ . hunlabel unlabeler
578+ (toK1Columns @"Left" @_ @_ @_ @structure1)
579+ (toK1Columns @"Right" @_ @_ @_ @structure2)
580+ {-# INLINABLE fromK1Columns #-}
581+ {-# INLINABLE toK1Columns #-}
585+ ( HTable (K1Columns "Left" structure1)
586+ , HTable (K1Columns "Right" structure2)
587+ , K1Table "Left" 'False context (IsStructure structure1) structure1 a
588+ , K1Table "Right" 'False context (IsStructure structure2) structure2 b
589+ , IsSpecialContext context ~ 'False
591+ , Nullifiable context
592+ , e ~ EitherTable a b
593+ ) => K1Table label 'False context 'True (Shape2 'Either structure1 structure2) e
597+ (fromK1Columns @"Left" @_ @_ @_ @structure1)
598+ (fromK1Columns @"Right" @_ @_ @_ @structure2) .
603+ (toK1Columns @"Left" @_ @_ @_ @structure1)
604+ (toK1Columns @"Right" @_ @_ @_ @structure2)
605+ {-# INLINABLE fromK1Columns #-}
606+ {-# INLINABLE toK1Columns #-}
610+ ( K1Table label 'True Aggregate (IsStructure structure) structure a
612+ , K1Columns label structure ~ HLabel label (Columns a)
614+ ) => K1Table label 'True Aggregate '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 'True Expr (IsStructure structure) structure a
625+ , K1Columns label structure ~ HLabel label (Columns a)
627+ ) => K1Table label 'True Expr 'True (Shape1 'List structure) as
629+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
630+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
631+ {-# INLINABLE fromK1Columns #-}
632+ {-# INLINABLE toK1Columns #-}
636+ ( K1Table label 'True Insertion (IsStructure structure) structure a
638+ , K1Columns label structure ~ HLabel label (Columns a)
640+ ) => K1Table label 'True Insertion 'True (Shape1 'List structure) as
642+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
643+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
644+ {-# INLINABLE fromK1Columns #-}
645+ {-# INLINABLE toK1Columns #-}
649+ ( K1Table label 'True Identity (IsStructure structure) structure a
650+ , HTable (K1Columns label structure)
652+ ) => K1Table label 'True Identity 'True (Shape1 'List structure) as
654+ fromK1Columns = fmap (fromK1Columns @label @'True @Identity @_ @structure) . fromHListTable
655+ toK1Columns = toHListTable . fmap (toK1Columns @label @'True @Identity @_ @structure)
656+ {-# INLINABLE fromK1Columns #-}
657+ {-# INLINABLE toK1Columns #-}
661+ ( K1Table label 'False context (IsStructure structure) structure a
662+ , IsSpecialContext context ~ 'False
664+ , K1Columns label structure ~ HLabel label (Columns a)
667+ ) => K1Table label 'False context 'True (Shape1 'List structure) as
669+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
670+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
671+ {-# INLINABLE fromK1Columns #-}
672+ {-# INLINABLE toK1Columns #-}
676+ ( HTable (K1Columns "Just" structure)
677+ , K1Table "Just" 'True Aggregate (IsStructure structure) structure a
679+ ) => K1Table label 'True Aggregate '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" 'True Expr (IsStructure structure) structure a
695+ ) => K1Table label 'True Expr 'True (Shape1 'Maybe structure) ma
698+ fromColumns1 (fromK1Columns @"Just" @_ @_ @_ @structure) .
702+ toColumns1 (toK1Columns @"Just" @_ @_ @_ @structure)
703+ {-# INLINABLE fromK1Columns #-}
704+ {-# INLINABLE toK1Columns #-}
708+ ( HTable (K1Columns "Just" structure)
709+ , K1Table "Just" 'True Insertion (IsStructure structure) structure a
711+ ) => K1Table label 'True Insertion 'True (Shape1 'Maybe structure) ma
714+ fromColumns1 (fromK1Columns @"Just" @_ @_ @_ @structure) .
718+ toColumns1 (toK1Columns @"Just" @_ @_ @_ @structure)
719+ {-# INLINABLE fromK1Columns #-}
720+ {-# INLINABLE toK1Columns #-}
724+ ( HTable (K1Columns "Just" structure)
725+ , K1Table "Just" 'True Identity (IsStructure structure) structure a
727+ ) => K1Table label 'True Identity 'True (Shape1 'Maybe structure) ma
730+ = fmap (fromK1Columns @"Just" @_ @_ @_ @structure)
732+ . hunlabel unlabeler
736+ . fmap (toK1Columns @"Just" @_ @_ @_ @structure)
737+ {-# INLINABLE fromK1Columns #-}
738+ {-# INLINABLE toK1Columns #-}
742+ ( HTable (K1Columns "Just" structure)
743+ , K1Table "Just" 'False context (IsStructure structure) structure a
744+ , IsSpecialContext context ~ 'False
746+ , Nullifiable context
748+ ) => K1Table label 'False context 'True (Shape1 'Maybe structure) ma
751+ fromColumns1 (fromK1Columns @"Just" @_ @_ @_ @structure) .
755+ toColumns1 (toK1Columns @"Just" @_ @_ @_ @structure)
756+ {-# INLINABLE fromK1Columns #-}
757+ {-# INLINABLE toK1Columns #-}
761+ ( K1Table label 'True Aggregate (IsStructure structure) structure a
763+ , K1Columns label structure ~ HLabel label (Columns a)
764+ , as ~ NonEmptyTable a
765+ ) => K1Table label 'True Aggregate 'True (Shape1 'NonEmpty structure) as
767+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
768+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
769+ {-# INLINABLE fromK1Columns #-}
770+ {-# INLINABLE toK1Columns #-}
774+ ( K1Table label 'True Expr (IsStructure structure) structure a
776+ , K1Columns label structure ~ HLabel label (Columns a)
777+ , as ~ NonEmptyTable a
778+ ) => K1Table label 'True Expr 'True (Shape1 'NonEmpty structure) as
780+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
781+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
782+ {-# INLINABLE fromK1Columns #-}
783+ {-# INLINABLE toK1Columns #-}
787+ ( K1Table label 'True Insertion (IsStructure structure) structure a
789+ , K1Columns label structure ~ HLabel label (Columns a)
790+ , as ~ NonEmptyTable a
791+ ) => K1Table label 'True Insertion 'True (Shape1 'NonEmpty structure) as
793+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
794+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
795+ {-# INLINABLE fromK1Columns #-}
796+ {-# INLINABLE toK1Columns #-}
800+ ( K1Table label 'True Identity (IsStructure structure) structure a
801+ , HTable (K1Columns label structure)
803+ ) => K1Table label 'True Identity 'True (Shape1 'NonEmpty structure) as
805+ fromK1Columns = fmap (fromK1Columns @label @'True @Identity @_ @structure) . fromHNonEmptyTable
806+ toK1Columns = toHNonEmptyTable . fmap (toK1Columns @label @'True @Identity @_ @structure)
807+ {-# INLINABLE fromK1Columns #-}
808+ {-# INLINABLE toK1Columns #-}
812+ ( K1Table label 'False context (IsStructure structure) structure a
813+ , IsSpecialContext context ~ 'False
815+ , K1Columns label structure ~ HLabel label (Columns a)
817+ , as ~ NonEmptyTable a
818+ ) => K1Table label 'False context 'True (Shape1 'NonEmpty structure) as
820+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
821+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns
822+ {-# INLINABLE fromK1Columns #-}
823+ {-# INLINABLE toK1Columns #-}
827+ ( HTable (K1Columns "Here" structure1)
828+ , HTable (K1Columns "There" structure2)
829+ , K1Table "Here" 'True Aggregate (IsStructure structure1) structure1 a
830+ , K1Table "There" 'True Aggregate (IsStructure structure2) structure2 b
831+ , e ~ TheseTable a b
832+ ) => K1Table label 'True Aggregate 'True (Shape2 'These structure1 structure2) e
836+ (fromK1Columns @"Here" @_ @_ @_ @structure1)
837+ (fromK1Columns @"There" @_ @_ @_ @structure2) .
842+ (toK1Columns @"Here" @_ @_ @_ @structure1)
843+ (toK1Columns @"There" @_ @_ @_ @structure2)
844+ {-# INLINABLE fromK1Columns #-}
845+ {-# INLINABLE toK1Columns #-}
849+ ( HTable (K1Columns "Here" structure1)
850+ , HTable (K1Columns "There" structure2)
851+ , K1Table "Here" 'True Expr (IsStructure structure1) structure1 a
852+ , K1Table "There" 'True Expr (IsStructure structure2) structure2 b
853+ , e ~ TheseTable a b
854+ ) => K1Table label 'True Expr 'True (Shape2 'These structure1 structure2) e
858+ (fromK1Columns @"Here" @_ @_ @_ @structure1)
859+ (fromK1Columns @"There" @_ @_ @_ @structure2) .
864+ (toK1Columns @"Here" @_ @_ @_ @structure1)
865+ (toK1Columns @"There" @_ @_ @_ @structure2)
866+ {-# INLINABLE fromK1Columns #-}
867+ {-# INLINABLE toK1Columns #-}
871+ ( HTable (K1Columns "Here" structure1)
872+ , HTable (K1Columns "There" structure2)
873+ , K1Table "Here" 'True Insertion (IsStructure structure1) structure1 a
874+ , K1Table "There" 'True Insertion (IsStructure structure2) structure2 b
875+ , e ~ TheseTable a b
876+ ) => K1Table label 'True Insertion 'True (Shape2 'These structure1 structure2) e
880+ (fromK1Columns @"Here" @_ @_ @_ @structure1)
881+ (fromK1Columns @"There" @_ @_ @_ @structure2) .
886+ (toK1Columns @"Here" @_ @_ @_ @structure1)
887+ (toK1Columns @"There" @_ @_ @_ @structure2)
888+ {-# INLINABLE fromK1Columns #-}
889+ {-# INLINABLE toK1Columns #-}
893+ ( HTable (K1Columns "Here" structure1)
894+ , HTable (K1Columns "There" structure2)
895+ , K1Table "Here" 'True Identity (IsStructure structure1) structure1 a
896+ , K1Table "There" 'True Identity (IsStructure structure2) structure2 b
898+ ) => K1Table label 'True Identity 'True (Shape2 'These structure1 structure2) e
902+ (fromK1Columns @"Here" @_ @_ @_ @structure1)
903+ (fromK1Columns @"There" @_ @_ @_ @structure2)
905+ . hunlabel unlabeler
910+ (toK1Columns @"Here" @_ @_ @_ @structure1)
911+ (toK1Columns @"There" @_ @_ @_ @structure2)
912+ {-# INLINABLE fromK1Columns #-}
913+ {-# INLINABLE toK1Columns #-}
917+ ( HTable (K1Columns "Here" structure1)
918+ , HTable (K1Columns "There" structure2)
919+ , K1Table "Here" 'False context (IsStructure structure1) structure1 a
920+ , K1Table "There" 'False context (IsStructure structure2) structure2 b
921+ , IsSpecialContext context ~ 'False
923+ , Nullifiable context
924+ , e ~ TheseTable a b
925+ ) => K1Table label 'False context 'True (Shape2 'These structure1 structure2) e
929+ (fromK1Columns @"Here" @_ @_ @_ @structure1)
930+ (fromK1Columns @"There" @_ @_ @_ @structure2) .
935+ (toK1Columns @"Here" @_ @_ @_ @structure1)
936+ (toK1Columns @"There" @_ @_ @_ @structure2)
937+ {-# INLINABLE fromK1Columns #-}
938+ {-# INLINABLE toK1Columns #-}
943+ ( K1Table "fst" isSpecialContext context (IsStructure structure1) structure1 a1
944+ , K1Table "snd" isSpecialContext context (IsStructure structure2) structure2 a2
945+ , HTable (K1Columns "fst" structure1)
946+ , HTable (K1Columns "snd" structure2)
949+ ) => K1Table label isSpecialContext context 'True (structure1, structure2) a
951+ fromK1Columns (hunlabel unlabeler -> (HPair a b)) =
952+ ( fromK1Columns @"fst" @_ @_ @_ @structure1 a
953+ , fromK1Columns @"snd" @_ @_ @_ @structure2 b
955+ toK1Columns (a, b) = hlabel labeler $ HPair
956+ { hfst = toK1Columns @"fst" @_ @_ @_ @structure1 a
957+ , hsnd = toK1Columns @"snd" @_ @_ @_ @structure2 b
959+ {-# INLINABLE fromK1Columns #-}
960+ {-# INLINABLE toK1Columns #-}
964+ ( K1Table "fst" isSpecialContext context (IsStructure structure1) structure1 a1
965+ , K1Table "snd" isSpecialContext context (IsStructure structure2) structure2 a2
966+ , K1Table "trd" isSpecialContext context (IsStructure structure3) structure3 a3
967+ , HTable (K1Columns "fst" structure1)
968+ , HTable (K1Columns "snd" structure2)
969+ , HTable (K1Columns "trd" structure3)
972+ ) => K1Table label isSpecialContext context 'True (structure1, structure2, structure3) a
974+ fromK1Columns (hunlabel unlabeler -> (HTrio a b c)) =
975+ ( fromK1Columns @"fst" @_ @_ @_ @structure1 a
976+ , fromK1Columns @"snd" @_ @_ @_ @structure2 b
977+ , fromK1Columns @"trd" @_ @_ @_ @structure3 c
979+ toK1Columns (a, b, c) = hlabel labeler $ HTrio
980+ { hfst = toK1Columns @"fst" @_ @_ @_ @structure1 a
981+ , hsnd = toK1Columns @"snd" @_ @_ @_ @structure2 b
982+ , htrd = toK1Columns @"trd" @_ @_ @_ @structure3 c
984+ {-# INLINABLE fromK1Columns #-}
985+ {-# INLINABLE toK1Columns #-}
989+ ( K1Table "fst" isSpecialContext context (IsStructure structure1) structure1 a1
990+ , K1Table "snd" isSpecialContext context (IsStructure structure2) structure2 a2
991+ , K1Table "trd" isSpecialContext context (IsStructure structure3) structure3 a3
992+ , K1Table "frt" isSpecialContext context (IsStructure structure3) structure4 a4
993+ , HTable (K1Columns "fst" structure1)
994+ , HTable (K1Columns "snd" structure2)
995+ , HTable (K1Columns "trd" structure3)
996+ , HTable (K1Columns "frt" structure4)
998+ , a ~ (a1, a2, a3, a4)
999+ ) => K1Table label isSpecialContext context 'True (structure1, structure2, structure3, structure4) a
1001+ fromK1Columns (hunlabel unlabeler -> (HQuartet a b c d)) =
1002+ ( fromK1Columns @"fst" @_ @_ @_ @structure1 a
1003+ , fromK1Columns @"snd" @_ @_ @_ @structure2 b
1004+ , fromK1Columns @"trd" @_ @_ @_ @structure3 c
1005+ , fromK1Columns @"frt" @_ @_ @_ @structure4 d
1007+ toK1Columns (a, b, c, d) = hlabel labeler $ HQuartet
1008+ { hfst = toK1Columns @"fst" @_ @_ @_ @structure1 a
1009+ , hsnd = toK1Columns @"snd" @_ @_ @_ @structure2 b
1010+ , htrd = toK1Columns @"trd" @_ @_ @_ @structure3 c
1011+ , hfrt = toK1Columns @"frt" @_ @_ @_ @structure4 d
1013+ {-# INLINABLE fromK1Columns #-}
1014+ {-# INLINABLE toK1Columns #-}
1018+ ( K1Table "fst" isSpecialContext context (IsStructure structure1) structure1 a1
1019+ , K1Table "snd" isSpecialContext context (IsStructure structure2) structure2 a2
1020+ , K1Table "trd" isSpecialContext context (IsStructure structure3) structure3 a3
1021+ , K1Table "frt" isSpecialContext context (IsStructure structure3) structure4 a4
1022+ , K1Table "fft" isSpecialContext context (IsStructure structure3) structure5 a5
1023+ , HTable (K1Columns "fst" structure1)
1024+ , HTable (K1Columns "snd" structure2)
1025+ , HTable (K1Columns "trd" structure3)
1026+ , HTable (K1Columns "frt" structure4)
1027+ , HTable (K1Columns "fft" structure5)
1028+ , Labelable context
1029+ , a ~ (a1, a2, a3, a4, a5)
1030+ ) => K1Table label isSpecialContext context 'True (structure1, structure2, structure3, structure4, structure5) a
1032+ fromK1Columns (hunlabel unlabeler -> (HQuintet a b c d e)) =
1033+ ( fromK1Columns @"fst" @_ @_ @_ @structure1 a
1034+ , fromK1Columns @"snd" @_ @_ @_ @structure2 b
1035+ , fromK1Columns @"trd" @_ @_ @_ @structure3 c
1036+ , fromK1Columns @"frt" @_ @_ @_ @structure4 d
1037+ , fromK1Columns @"fft" @_ @_ @_ @structure5 e
1039+ toK1Columns (a, b, c, d, e) = hlabel labeler $ HQuintet
1040+ { hfst = toK1Columns @"fst" @_ @_ @_ @structure1 a
1041+ , hsnd = toK1Columns @"snd" @_ @_ @_ @structure2 b
1042+ , htrd = toK1Columns @"trd" @_ @_ @_ @structure3 c
1043+ , hfrt = toK1Columns @"frt" @_ @_ @_ @structure4 d
1044+ , hfft = toK1Columns @"fft" @_ @_ @_ @structure5 e
1046+ {-# INLINABLE fromK1Columns #-}
1047+ {-# INLINABLE toK1Columns #-}
1051+ ( IsSpecialContext context ~ isSpecialContext
1052+ , IsStructure structure ~ 'False
1053+ , K1Columns label structure ~ HLabel label (Columns structure)
1054+ , Columns structure ~ Columns a
1055+ , Labelable context
1057+ ) => K1Table label isSpecialContext context 'False structure a
1059+ fromK1Columns = fromColumns . hunlabel unlabeler
1060+ toK1Columns = hlabel labeler . toColumns
1061+ {-# INLINABLE fromK1Columns #-}
1062+ {-# INLINABLE toK1Columns #-}