@@ -1,1049 +0,0 @@
1−{-# language AllowAmbiguousTypes #-}
2−{-# language DataKinds #-}
3−{-# language DisambiguateRecordFields #-}
4−{-# language DefaultSignatures #-}
5−{-# language FlexibleContexts #-}
6−{-# language FlexibleInstances #-}
7−{-# language GADTs #-}
8−{-# language MultiParamTypeClasses #-}
9−{-# language ScopedTypeVariables #-}
10−{-# language StandaloneKindSignatures #-}
11−{-# language TypeApplications #-}
12−{-# language TypeFamilies #-}
13−{-# language TypeOperators #-}
14−{-# language UndecidableInstances #-}
15−{-# language ViewPatterns #-}
16−
17−{-# options_ghc -fno-warn-orphans #-}
18−
19−module Rel8.Schema.Generic
20− ( Rel8able
21− )
22−where
23−
24−-- base
25−import Data.Bifunctor ( bimap )
26−import Data.Functor.Identity ( Identity )
27−import Data.Kind ( Constraint, Type )
28−import Data.List.NonEmpty ( NonEmpty )
29−import GHC.Generics
30− ( Generic, Rep, from, to
31− , (:*:)( (:*:) ), K1( K1 ), M1( M1 )
32− , D, C, S
33− , Meta( MetaSel )
34− )
35−import GHC.TypeLits ( Symbol, KnownSymbol )
36−import Prelude
37−
38−-- rel8
39−import Rel8.Aggregate ( Aggregate, Col(..) )
40−import Rel8.Expr ( Expr, Col(..) )
41−import Rel8.Kind.Necessity
42− ( SNecessity( SRequired, SOptional )
43− , KnownNecessity, necessitySing
44− )
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
52− )
53−import Rel8.Schema.Context.Label
54− ( Labelable, labeler, unlabeler
55− , hlabeler, hunlabeler
56− )
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
77− , Structure
78− )
79−import Rel8.Table
80− ( Table, Columns, Context, fromColumns, toColumns
81− )
82−import Rel8.Table.Either ( EitherTable )
83−import Rel8.Table.Lifted
84− ( fromColumns1, toColumns1
85− , fromColumns2, toColumns2
86− )
87−import Rel8.Table.List ( ListTable )
88−import Rel8.Table.Maybe ( MaybeTable(..) )
89−import Rel8.Table.NonEmpty ( NonEmptyTable )
90−import Rel8.Table.These ( TheseTable )
91−
92−-- these
93−import Data.These ( These )
94−
95−
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
101−
102−
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)
107−
108−
109−instance TableHelper Aggregate where
110− gfromColumns = fromAggregateColumns
111− gtoColumns = toAggregateColumns
112−
113−
114−instance TableHelper Expr where
115− gfromColumns = fromExprColumns
116− gtoColumns = toExprColumns
117−
118−
119−instance TableHelper Insert where
120− gfromColumns = fromInsertColumns
121− gtoColumns = toInsertColumns
122−
123−
124−instance TableHelper Identity where
125− gfromColumns = fromIdentityColumns
126− gtoColumns = toIdentityColumns
127−
128−
129−instance TableHelper Name where
130− gfromColumns = fromNameColumns
131− gtoColumns = toNameColumns
132−
133−
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:
136−--
137−-- @
138−-- data MyType f =
139−-- MyType { field1 :: Column f T1 OR HK1 f
140−-- , field2 :: Column f T2 OR HK2 f
141−-- , ...
142−-- , fieldN :: Column f Tn OR HKn f
143−-- }
144−-- @
145−--
146−-- where @Tn@ is any Haskell type, and @HKn@ is any higher-kinded type.
147−--
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:
151−--
152−-- [Nested]
153−--
154−-- @
155−-- data Nested f =
156−-- Nested { nested1 :: MyType f
157−-- , nested2 :: MyType f
158−-- }
159−-- @
160−--
161−-- The @Rel8able@ type class is used to give us a special mapping operation
162−-- that lets us change the type parameter @f@.
163−--
164−-- [Supplying @Rel8able@ instances]
165−--
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
168−-- extensions:
169−--
170−-- @
171−-- \{\-\# LANGUAGE DeriveAnyClass, DeriveGeneric #-\}
172−--
173−-- data MyType f = MyType { fieldA :: Column f T }
174−-- deriving ( GHC.Generics.Generic, Rel8able )
175−-- @
176−type Rel8able :: KTable -> Constraint
177−class HTable (GRep t) => Rel8able t where
178− type GRep t :: K.HTable
179−
180− fromAggregateColumns :: GRep t (Col Aggregate) -> t Aggregate
181− toAggregateColumns :: t Aggregate -> GRep t (Col Aggregate)
182−
183− fromExprColumns :: GRep t (Col Expr) -> t Expr
184− toExprColumns :: t Expr -> GRep t (Col Expr)
185−
186− fromInsertColumns :: GRep t (Col Insert) -> t Insert
187− toInsertColumns :: t Insert -> GRep t (Col Insert)
188−
189− fromIdentityColumns :: GRep t (Col Identity) -> t Identity
190− toIdentityColumns :: t Identity -> GRep t (Col Identity)
191−
192− fromNameColumns :: GRep t (Col Name) -> t Name
193− toNameColumns :: t Name -> GRep t (Col Name)
194−
195− type GRep t = GColumns (Rep (t Structure))
196−
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))
203−
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
210−
211− default fromExprColumns ::
212− ( Generic (t Expr)
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))
217−
218− default toExprColumns ::
219− ( Generic (t Expr)
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
224−
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))
231−
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
238−
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))
245−
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
252−
253− default fromNameColumns ::
254− ( Generic (t Name)
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))
259−
260− default toNameColumns ::
261− ( Generic (t Name)
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
266−
267−
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
275−
276−
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)
281−
282−
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
286−
287−
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
291−
292−
293−instance (GRel8able context structure1 rep1, GRel8able context structure2 rep2) =>
294− GRel8able context (structure1 :*: structure2) (rep1 :*: rep2)
295− where
296− fromGColumns (HPair a b) =
297− fromGColumns @context @structure1 @rep1 a :*:
298− fromGColumns @context @structure2 @rep2 b
299− toGColumns (a :*: b) =
300− HPair
301− (toGColumns @context @structure1 @rep1 a)
302− (toGColumns @context @structure2 @rep2 b)
303−
304−
305−instance
306− ( K1Table label context isStructure structure a
307− , meta ~ 'MetaSel ('Just label) _su _ss _ds
308− , structureK1 ~ K1 i structure
309− , k1 ~ K1 i a
310− ) => GRel8able context (M1 S meta structureK1) (M1 S meta k1)
311− where
312− fromGColumns = M1 . K1 . fromK1Columns @label @_ @_ @structure
313− toGColumns (M1 (K1 a)) = toK1Columns @label @_ @_ @structure a
314−
315−
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) =
330− HLabel label
331− (HPair
332− (K1Columns "fst" a)
333− (K1Columns "snd" b))
334− K1Columns label (a, b, c) =
335− HLabel label
336− (HTrio
337− (K1Columns "fst" a)
338− (K1Columns "snd" b)
339− (K1Columns "trd" c))
340− K1Columns label (a, b, c, d) =
341− HLabel label
342− (HQuartet
343− (K1Columns "fst" a)
344− (K1Columns "snd" b)
345− (K1Columns "trd" c)
346− (K1Columns "frt" d))
347− K1Columns label (a, b, c, d, e) =
348− HLabel label
349− (HQuintet
350− (K1Columns "fst" a)
351− (K1Columns "snd" b)
352− (K1Columns "trd" c)
353− (K1Columns "frt" d)
354− (K1Columns "fft" e))
355− K1Columns label a = HLabel label (Columns a)
356−
357−
358−type K1Table :: Symbol -> K.Context -> Bool -> Type -> Type -> Constraint
359−class isStructure ~ IsStructure structure =>
360− K1Table label context isStructure structure a
361− where
362− fromK1Columns :: K1Columns label structure (Col context) -> a
363− toK1Columns :: a -> K1Columns label structure (Col context)
364−
365−
366−instance
367− ( x ~ Field Aggregate '[] necessity a
368− ) => K1Table label Aggregate 'True (Shape1 'Column ('Spec '[] necessity a)) x
369− where
370− fromK1Columns (HIdentity (Aggregation a)) = a
371− toK1Columns = HIdentity . Aggregation
372− {-# INLINABLE fromK1Columns #-}
373− {-# INLINABLE toK1Columns #-}
374−
375−
376−instance
377− ( x ~ Field Aggregate (label ': labels) necessity a
378− ) => K1Table _label Aggregate 'True (Shape1 'Column ('Spec (label ': labels) necessity a)) x
379− where
380− fromK1Columns (HIdentity (Aggregation a)) = a
381− toK1Columns = HIdentity . Aggregation
382− {-# INLINABLE fromK1Columns #-}
383− {-# INLINABLE toK1Columns #-}
384−
385−
386−instance
387− ( x ~ Field Expr '[] necessity a
388− ) => K1Table label Expr 'True (Shape1 'Column ('Spec '[] necessity a)) x
389− where
390− fromK1Columns (HIdentity (DB a)) = a
391− toK1Columns = HIdentity . DB
392− {-# INLINABLE fromK1Columns #-}
393− {-# INLINABLE toK1Columns #-}
394−
395−
396−instance
397− ( x ~ Field Expr (label ': labels) necessity a
398− ) => K1Table _label Expr 'True (Shape1 'Column ('Spec (label ': labels) necessity a)) x
399− where
400− fromK1Columns (HIdentity (DB a)) = a
401− toK1Columns = HIdentity . DB
402− {-# INLINABLE fromK1Columns #-}
403− {-# INLINABLE toK1Columns #-}
404−
405−
406−instance
407− ( x ~ Field Insert '[] necessity a
408− , KnownNecessity necessity
409− ) => K1Table label Insert 'True (Shape1 'Column ('Spec '[] necessity a)) x
410− where
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 #-}
419−
420−
421−instance
422− ( x ~ Field Insert (label ': labels) necessity a
423− , KnownNecessity necessity
424− ) => K1Table _label Insert 'True (Shape1 'Column ('Spec (label ': labels) necessity a)) x
425− where
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 #-}
434−
435−
436−instance
437− ( x ~ Field Identity '[] necessity a
438− ) => K1Table label Identity 'True (Shape1 'Column ('Spec '[] necessity a)) x
439− where
440− fromK1Columns (HIdentity (Result a)) = a
441− toK1Columns = HIdentity . Result
442− {-# INLINABLE fromK1Columns #-}
443− {-# INLINABLE toK1Columns #-}
444−
445−
446−instance
447− ( x ~ Field Identity (label ': labels) necessity a
448− ) => K1Table _label Identity 'True (Shape1 'Column ('Spec (label ': labels) necessity a)) x
449− where
450− fromK1Columns (HIdentity (Result a)) = a
451− toK1Columns = HIdentity . Result
452− {-# INLINABLE fromK1Columns #-}
453− {-# INLINABLE toK1Columns #-}
454−
455−
456−instance
457− ( x ~ Field Name '[] necessity a
458− ) => K1Table _label Name 'True (Shape1 'Column ('Spec (label ': labels) necessity a)) x
459− where
460− fromK1Columns (HIdentity (NameCol a)) = Name a
461− toK1Columns (Name a) = HIdentity (NameCol a)
462− {-# INLINABLE fromK1Columns #-}
463− {-# INLINABLE toK1Columns #-}
464−
465−
466−instance
467− ( x ~ Field Name (label ': labels) necessity a
468− ) => K1Table label Name 'True (Shape1 'Column ('Spec '[] necessity a)) x
469− where
470− fromK1Columns = Name . (\(NameCol a) -> a) . unlabeler . unHIdentity
471− toK1Columns = HIdentity . labeler . NameCol . (\(Name a) -> a)
472− {-# INLINABLE fromK1Columns #-}
473− {-# INLINABLE toK1Columns #-}
474−
475−
476−instance
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
482− , KnownSymbol label
483− ) => K1Table label Aggregate 'True (Shape2 'Either structure1 structure2) e
484− where
485− fromK1Columns =
486− fromColumns2
487− (fromK1Columns @"Left" @_ @_ @structure1)
488− (fromK1Columns @"Right" @_ @_ @structure2) .
489− hunlabel unlabeler
490− toK1Columns =
491− hlabel labeler .
492− toColumns2
493− (toK1Columns @"Left" @_ @_ @structure1)
494− (toK1Columns @"Right" @_ @_ @structure2)
495− {-# INLINABLE fromK1Columns #-}
496− {-# INLINABLE toK1Columns #-}
497−
498−
499−instance
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
505− , KnownSymbol label
506− ) => K1Table label Expr 'True (Shape2 'Either structure1 structure2) e
507− where
508− fromK1Columns =
509− fromColumns2
510− (fromK1Columns @"Left" @_ @_ @structure1)
511− (fromK1Columns @"Right" @_ @_ @structure2) .
512− hunlabel unlabeler
513− toK1Columns =
514− hlabel labeler .
515− toColumns2
516− (toK1Columns @"Left" @_ @_ @structure1)
517− (toK1Columns @"Right" @_ @_ @structure2)
518− {-# INLINABLE fromK1Columns #-}
519− {-# INLINABLE toK1Columns #-}
520−
521−
522−instance
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
528− , KnownSymbol label
529− ) => K1Table label Insert 'True (Shape2 'Either structure1 structure2) e
530− where
531− fromK1Columns =
532− fromColumns2
533− (fromK1Columns @"Left" @_ @_ @structure1)
534− (fromK1Columns @"Right" @_ @_ @structure2) .
535− hunlabel unlabeler
536− toK1Columns =
537− hlabel labeler .
538− toColumns2
539− (toK1Columns @"Left" @_ @_ @structure1)
540− (toK1Columns @"Right" @_ @_ @structure2)
541− {-# INLINABLE fromK1Columns #-}
542− {-# INLINABLE toK1Columns #-}
543−
544−
545−instance
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
550− , e ~ Either a b
551− , KnownSymbol label
552− ) => K1Table label Identity 'True (Shape2 'Either structure1 structure2) e
553− where
554− fromK1Columns
555− = bimap
556− (fromK1Columns @"Left" @_ @_ @structure1)
557− (fromK1Columns @"Right" @_ @_ @structure2)
558− . fromHEitherTable
559− . hunlabel unlabeler
560− toK1Columns
561− = hlabel labeler
562− . toHEitherTable
563− . bimap
564− (toK1Columns @"Left" @_ @_ @structure1)
565− (toK1Columns @"Right" @_ @_ @structure2)
566− {-# INLINABLE fromK1Columns #-}
567− {-# INLINABLE toK1Columns #-}
568−
569−
570−instance
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
576− , KnownSymbol label
577− ) => K1Table label Name 'True (Shape2 'Either structure1 structure2) e
578− where
579− fromK1Columns =
580− fromColumns2
581− (fromK1Columns @"Left" @_ @_ @structure1)
582− (fromK1Columns @"Right" @_ @_ @structure2) .
583− hunlabel unlabeler
584− toK1Columns =
585− hlabel labeler .
586− toColumns2
587− (toK1Columns @"Left" @_ @_ @structure1)
588− (toK1Columns @"Right" @_ @_ @structure2)
589− {-# INLINABLE fromK1Columns #-}
590− {-# INLINABLE toK1Columns #-}
591−
592−
593−instance
594− ( Table Aggregate a
595− , K1Columns label structure ~ HLabel label (Columns a)
596− , as ~ ListTable a
597− , KnownSymbol label
598− ) => K1Table label Aggregate 'True (Shape1 'List structure) as
599− where
600− fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
601− toK1Columns = hrelabel (hlabel hlabeler) . toColumns
602− {-# INLINABLE fromK1Columns #-}
603− {-# INLINABLE toK1Columns #-}
604−
605−
606−instance
607− ( Table Expr a
608− , K1Columns label structure ~ HLabel label (Columns a)
609− , as ~ ListTable a
610− , KnownSymbol label
611− ) => K1Table label Expr 'True (Shape1 'List structure) as
612− where
613− fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
614− toK1Columns = hrelabel (hlabel hlabeler) . toColumns
615− {-# INLINABLE fromK1Columns #-}
616− {-# INLINABLE toK1Columns #-}
617−
618−
619−instance
620− ( Table Insert a
621− , K1Columns label structure ~ HLabel label (Columns a)
622− , as ~ ListTable a
623− , KnownSymbol label
624− ) => K1Table label Insert 'True (Shape1 'List structure) as
625− where
626− fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
627− toK1Columns = hrelabel (hlabel hlabeler) . toColumns
628− {-# INLINABLE fromK1Columns #-}
629− {-# INLINABLE toK1Columns #-}
630−
631−
632−instance
633− ( K1Table label Identity (IsStructure structure) structure a
634− , HTable (K1Columns label structure)
635− , as ~ [a]
636− ) => K1Table label Identity 'True (Shape1 'List structure) as
637− where
638− fromK1Columns = fmap (fromK1Columns @label @_ @_ @structure) . fromHListTable
639− toK1Columns = toHListTable . fmap (toK1Columns @label @_ @_ @structure)
640− {-# INLINABLE fromK1Columns #-}
641− {-# INLINABLE toK1Columns #-}
642−
643−
644−instance
645− ( Table Name a
646− , K1Columns label structure ~ HLabel label (Columns a)
647− , as ~ ListTable a
648− , KnownSymbol label
649− ) => K1Table label Name 'True (Shape1 'List structure) as
650− where
651− fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
652− toK1Columns = hrelabel (hlabel hlabeler) . toColumns
653− {-# INLINABLE fromK1Columns #-}
654− {-# INLINABLE toK1Columns #-}
655−
656−
657−instance
658− ( HTable (K1Columns "Just" structure)
659− , K1Table "Just" Aggregate (IsStructure structure) structure a
660− , ma ~ MaybeTable a
661− , KnownSymbol label
662− ) => K1Table label Aggregate 'True (Shape1 'Maybe structure) ma
663− where
664− fromK1Columns =
665− fromColumns1 (fromK1Columns @"Just" @_ @_ @structure) .
666− hunlabel unlabeler
667− toK1Columns =
668− hlabel labeler .
669− toColumns1 (toK1Columns @"Just" @_ @_ @structure)
670− {-# INLINABLE fromK1Columns #-}
671− {-# INLINABLE toK1Columns #-}
672−
673−
674−instance
675− ( HTable (K1Columns "Just" structure)
676− , K1Table "Just" Expr (IsStructure structure) structure a
677− , ma ~ MaybeTable a
678− , KnownSymbol label
679− ) => K1Table label Expr 'True (Shape1 'Maybe structure) ma
680− where
681− fromK1Columns =
682− fromColumns1 (fromK1Columns @"Just" @_ @_ @structure) .
683− hunlabel unlabeler
684− toK1Columns =
685− hlabel labeler .
686− toColumns1 (toK1Columns @"Just" @_ @_ @structure)
687− {-# INLINABLE fromK1Columns #-}
688− {-# INLINABLE toK1Columns #-}
689−
690−
691−instance
692− ( HTable (K1Columns "Just" structure)
693− , K1Table "Just" Insert (IsStructure structure) structure a
694− , ma ~ MaybeTable a
695− , KnownSymbol label
696− ) => K1Table label Insert 'True (Shape1 'Maybe structure) ma
697− where
698− fromK1Columns =
699− fromColumns1 (fromK1Columns @"Just" @_ @_ @structure) .
700− hunlabel unlabeler
701− toK1Columns =
702− hlabel labeler .
703− toColumns1 (toK1Columns @"Just" @_ @_ @structure)
704− {-# INLINABLE fromK1Columns #-}
705− {-# INLINABLE toK1Columns #-}
706−
707−
708−instance
709− ( HTable (K1Columns "Just" structure)
710− , K1Table "Just" Identity (IsStructure structure) structure a
711− , ma ~ Maybe a
712− , KnownSymbol label
713− ) => K1Table label Identity 'True (Shape1 'Maybe structure) ma
714− where
715− fromK1Columns
716− = fmap (fromK1Columns @"Just" @_ @_ @structure)
717− . fromHMaybeTable
718− . hunlabel unlabeler
719− toK1Columns
720− = hlabel labeler
721− . toHMaybeTable
722− . fmap (toK1Columns @"Just" @_ @_ @structure)
723− {-# INLINABLE fromK1Columns #-}
724− {-# INLINABLE toK1Columns #-}
725−
726−
727−instance
728− ( HTable (K1Columns "Just" structure)
729− , K1Table "Just" Name (IsStructure structure) structure a
730− , ma ~ MaybeTable a
731− , KnownSymbol label
732− ) => K1Table label Name 'True (Shape1 'Maybe structure) ma
733− where
734− fromK1Columns =
735− fromColumns1 (fromK1Columns @"Just" @_ @_ @structure) .
736− hunlabel unlabeler
737− toK1Columns =
738− hlabel labeler .
739− toColumns1 (toK1Columns @"Just" @_ @_ @structure)
740− {-# INLINABLE fromK1Columns #-}
741− {-# INLINABLE toK1Columns #-}
742−
743−
744−instance
745− ( Table Aggregate a
746− , K1Columns label structure ~ HLabel label (Columns a)
747− , as ~ NonEmptyTable a
748− , KnownSymbol label
749− ) => K1Table label Aggregate 'True (Shape1 'NonEmpty structure) as
750− where
751− fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
752− toK1Columns = hrelabel (hlabel hlabeler) . toColumns
753− {-# INLINABLE fromK1Columns #-}
754− {-# INLINABLE toK1Columns #-}
755−
756−
757−instance
758− ( Table Expr a
759− , K1Columns label structure ~ HLabel label (Columns a)
760− , as ~ NonEmptyTable a
761− , KnownSymbol label
762− ) => K1Table label Expr 'True (Shape1 'NonEmpty structure) as
763− where
764− fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
765− toK1Columns = hrelabel (hlabel hlabeler) . toColumns
766− {-# INLINABLE fromK1Columns #-}
767− {-# INLINABLE toK1Columns #-}
768−
769−
770−instance
771− ( Table Insert a
772− , K1Columns label structure ~ HLabel label (Columns a)
773− , as ~ NonEmptyTable a
774− , KnownSymbol label
775− ) => K1Table label Insert 'True (Shape1 'NonEmpty structure) as
776− where
777− fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
778− toK1Columns = hrelabel (hlabel hlabeler) . toColumns
779− {-# INLINABLE fromK1Columns #-}
780− {-# INLINABLE toK1Columns #-}
781−
782−
783−instance
784− ( K1Table label Identity (IsStructure structure) structure a
785− , HTable (K1Columns label structure)
786− , as ~ NonEmpty a
787− ) => K1Table label Identity 'True (Shape1 'NonEmpty structure) as
788− where
789− fromK1Columns = fmap (fromK1Columns @label @_ @_ @structure) . fromHNonEmptyTable
790− toK1Columns = toHNonEmptyTable . fmap (toK1Columns @label @_ @_ @structure)
791− {-# INLINABLE fromK1Columns #-}
792− {-# INLINABLE toK1Columns #-}
793−
794−
795−instance
796− ( Table Name a
797− , K1Columns label structure ~ HLabel label (Columns a)
798− , as ~ NonEmptyTable a
799− , KnownSymbol label
800− ) => K1Table label Name 'True (Shape1 'NonEmpty structure) as
801− where
802− fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
803− toK1Columns = hrelabel (hlabel hlabeler) . toColumns
804− {-# INLINABLE fromK1Columns #-}
805− {-# INLINABLE toK1Columns #-}
806−
807−
808−instance
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
814− , KnownSymbol label
815− ) => K1Table label Aggregate 'True (Shape2 'These structure1 structure2) e
816− where
817− fromK1Columns =
818− fromColumns2
819− (fromK1Columns @"Here" @_ @_ @structure1)
820− (fromK1Columns @"There" @_ @_ @structure2) .
821− hunlabel unlabeler
822− toK1Columns =
823− hlabel labeler .
824− toColumns2
825− (toK1Columns @"Here" @_ @_ @structure1)
826− (toK1Columns @"There" @_ @_ @structure2)
827− {-# INLINABLE fromK1Columns #-}
828− {-# INLINABLE toK1Columns #-}
829−
830−
831−instance
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
837− , KnownSymbol label
838− ) => K1Table label Expr 'True (Shape2 'These structure1 structure2) e
839− where
840− fromK1Columns =
841− fromColumns2
842− (fromK1Columns @"Here" @_ @_ @structure1)
843− (fromK1Columns @"There" @_ @_ @structure2) .
844− hunlabel unlabeler
845− toK1Columns =
846− hlabel labeler .
847− toColumns2
848− (toK1Columns @"Here" @_ @_ @structure1)
849− (toK1Columns @"There" @_ @_ @structure2)
850− {-# INLINABLE fromK1Columns #-}
851− {-# INLINABLE toK1Columns #-}
852−
853−
854−instance
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
860− , KnownSymbol label
861− ) => K1Table label Insert 'True (Shape2 'These structure1 structure2) e
862− where
863− fromK1Columns =
864− fromColumns2
865− (fromK1Columns @"Here" @_ @_ @structure1)
866− (fromK1Columns @"There" @_ @_ @structure2) .
867− hunlabel unlabeler
868− toK1Columns =
869− hlabel labeler .
870− toColumns2
871− (toK1Columns @"Here" @_ @_ @structure1)
872− (toK1Columns @"There" @_ @_ @structure2)
873− {-# INLINABLE fromK1Columns #-}
874− {-# INLINABLE toK1Columns #-}
875−
876−
877−instance
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
882− , e ~ These a b
883− , KnownSymbol label
884− ) => K1Table label Identity 'True (Shape2 'These structure1 structure2) e
885− where
886− fromK1Columns
887− = bimap
888− (fromK1Columns @"Here" @_ @_ @structure1)
889− (fromK1Columns @"There" @_ @_ @structure2)
890− . fromHTheseTable
891− . hunlabel unlabeler
892− toK1Columns
893− = hlabel labeler
894− . toHTheseTable
895− . bimap
896− (toK1Columns @"Here" @_ @_ @structure1)
897− (toK1Columns @"There" @_ @_ @structure2)
898− {-# INLINABLE fromK1Columns #-}
899− {-# INLINABLE toK1Columns #-}
900−
901−
902−instance
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
908− , KnownSymbol label
909− ) => K1Table label Name 'True (Shape2 'These structure1 structure2) e
910− where
911− fromK1Columns =
912− fromColumns2
913− (fromK1Columns @"Here" @_ @_ @structure1)
914− (fromK1Columns @"There" @_ @_ @structure2) .
915− hunlabel unlabeler
916− toK1Columns =
917− hlabel labeler .
918− toColumns2
919− (toK1Columns @"Here" @_ @_ @structure1)
920− (toK1Columns @"There" @_ @_ @structure2)
921− {-# INLINABLE fromK1Columns #-}
922− {-# INLINABLE toK1Columns #-}
923−
924−
925−instance
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)
930− , Labelable context
931− , a ~ (a1, a2)
932− , KnownSymbol label
933− ) => K1Table label context 'True (structure1, structure2) a
934− where
935− fromK1Columns (hunlabel unlabeler -> (HPair a b)) =
936− ( fromK1Columns @"fst" @_ @_ @structure1 a
937− , fromK1Columns @"snd" @_ @_ @structure2 b
938− )
939− toK1Columns (a, b) = hlabel labeler $ HPair
940− { hfst = toK1Columns @"fst" @_ @_ @structure1 a
941− , hsnd = toK1Columns @"snd" @_ @_ @structure2 b
942− }
943− {-# INLINABLE fromK1Columns #-}
944− {-# INLINABLE toK1Columns #-}
945−
946−
947−instance
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)
954− , Labelable context
955− , a ~ (a1, a2, a3)
956− , KnownSymbol label
957− ) => K1Table label context 'True (structure1, structure2, structure3) a
958− where
959− fromK1Columns (hunlabel unlabeler -> (HTrio a b c)) =
960− ( fromK1Columns @"fst" @_ @_ @structure1 a
961− , fromK1Columns @"snd" @_ @_ @structure2 b
962− , fromK1Columns @"trd" @_ @_ @structure3 c
963− )
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
968− }
969− {-# INLINABLE fromK1Columns #-}
970− {-# INLINABLE toK1Columns #-}
971−
972−
973−instance
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)
982− , Labelable context
983− , a ~ (a1, a2, a3, a4)
984− , KnownSymbol label
985− ) => K1Table label context 'True (structure1, structure2, structure3, structure4) a
986− where
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
992− )
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
998− }
999− {-# INLINABLE fromK1Columns #-}
1000− {-# INLINABLE toK1Columns #-}
1001−
1002−
1003−instance
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
1018− where
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
1025− )
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
1032− }
1033− {-# INLINABLE fromK1Columns #-}
1034− {-# INLINABLE toK1Columns #-}
1035−
1036−
1037−instance
1038− ( IsStructure structure ~ 'False
1039− , K1Columns label structure ~ HLabel label (Columns structure)
1040− , Columns structure ~ Columns a
1041− , Labelable context
1042− , Table context a
1043− , KnownSymbol label
1044− ) => K1Table label context 'False structure a
1045− where
1046− fromK1Columns = fromColumns . hunlabel unlabeler
1047− toK1Columns = hlabel labeler . toColumns
1048− {-# INLINABLE fromK1Columns #-}
1049− {-# INLINABLE toK1Columns #-}