git.iko.soy/rel8
on master help sign in
Use FCF to decouple GTable from Table
commit1276bebbb0fea9e07559d3a5a3bfa6318ba92e54 authorShane O'Brien <shane.obrien@circuithub.com> dateMon 26 Apr 2021, 22:24 (6 years ago) parent3e8f632
7 files changed+217−163
compare with master
unifiedsplit
rel8.cabal+1 src/Rel8/Generic/Table.hs+127 src/Rel8/Schema/Generic.hs+28−15 src/Rel8/Table.hs+30−71 src/Rel8/Table/Eq.hs+12−35 src/Rel8/Table/Ord.hs+12−36 src/Rel8/Table/Serialize.hs+7−6
rel8.cabal+1
@@ -67,6 +67,7 @@ library
6767 Rel8.Kind.Necessity
6868
6969 Rel8.Generic.Record
70+ Rel8.Generic.Table
7071
7172 Rel8.Order
7273
src/Rel8/Generic/Table.hsnew file+127
@@ -0,0 +1,127 @@
1+{-# language AllowAmbiguousTypes #-}
2+{-# language DataKinds #-}
3+{-# language FlexibleInstances #-}
4+{-# language MultiParamTypeClasses #-}
5+{-# language PolyKinds #-}
6+{-# language RankNTypes #-}
7+{-# language ScopedTypeVariables #-}
8+{-# language StandaloneKindSignatures #-}
9+{-# language TypeApplications #-}
10+{-# language TypeFamilies #-}
11+{-# language TypeOperators #-}
12+{-# language UndecidableInstances #-}
13+
14+module Rel8.Generic.Table
15+ ( GTable, GColumns, GContext, fromGColumns, toGColumns, gtable
16+ )
17+where
18+
19+-- base
20+import Data.Kind ( Constraint, Type )
21+import Data.Proxy ( Proxy( Proxy ) )
22+import GHC.Generics
23+ ( (:*:)( (:*:) ), K1( K1 ), M1( M1 )
24+ , C, D, S
25+ , Meta( MetaSel )
26+ )
27+import GHC.TypeLits ( KnownSymbol )
28+import Prelude hiding ( null )
29+
30+-- rel8
31+import Rel8.FCF ( Eval, Exp )
32+import Rel8.Schema.Context.Label ( HLabelable, hlabeler, hunlabeler )
33+import Rel8.Schema.HTable ( HTable )
34+import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
35+import Rel8.Schema.HTable.Product ( HProduct(..) )
36+import qualified Rel8.Schema.Kind as K
37+
38+
39+type GColumns :: (Type -> Exp K.HTable) -> (Type -> Type) -> K.HTable
40+type family GColumns _Columns rep where
41+ GColumns _Columns (M1 D _ rep) = GColumns _Columns rep
42+ GColumns _Columns (M1 C _ rep) = GColumns _Columns rep
43+ GColumns _Columns (rep1 :*: rep2) =
44+ HProduct (GColumns _Columns rep1) (GColumns _Columns rep2)
45+ GColumns _Columns (M1 S ('MetaSel ('Just label) _ _ _) (K1 _ a)) =
46+ HLabel label (Eval (_Columns a))
47+
48+
49+type GContext :: (Type -> Exp a) -> (Type -> Type) -> a
50+type family GContext _Context rep where
51+ GContext _Context (M1 _ _ rep) = GContext _Context rep
52+ GContext _Context (rep1 :*: _rep2) = GContext _Context rep1
53+ GContext _Context (K1 _ a) = Eval (_Context a)
54+
55+
56+type GTable
57+ :: (Type -> Exp Constraint)
58+ -> (Type -> Exp K.HTable)
59+ -> K.HContext -> (Type -> Type) -> Constraint
60+class GTable _Table _Columns context rep
61+ where
62+ fromGColumns :: ()
63+ => (forall a. Eval (_Table a) => Eval (_Columns a) context -> a)
64+ -> GColumns _Columns rep context
65+ -> rep x
66+
67+ toGColumns :: ()
68+ => (forall a. Eval (_Table a) => a -> Eval (_Columns a) context)
69+ -> rep x
70+ -> GColumns _Columns rep context
71+
72+ gtable :: ()
73+ => (forall a. Eval (_Table a) => Proxy a -> Eval (_Columns a) context)
74+ -> GColumns _Columns rep context
75+
76+
77+instance GTable _Table _Columns context rep =>
78+ GTable _Table _Columns context (M1 D c rep)
79+ where
80+ fromGColumns fromColumns =
81+ M1 . fromGColumns @_Table @_Columns @context @rep fromColumns
82+ toGColumns toColumns (M1 a) =
83+ toGColumns @_Table @_Columns @context @rep toColumns a
84+ gtable = gtable @_Table @_Columns @context @rep
85+
86+
87+instance GTable _Table _Columns context rep =>
88+ GTable _Table _Columns context (M1 C c rep)
89+ where
90+ fromGColumns fromColumns =
91+ M1 . fromGColumns @_Table @_Columns @context @rep fromColumns
92+ toGColumns toColumns (M1 a) =
93+ toGColumns @_Table @_Columns @context @rep toColumns a
94+ gtable = gtable @_Table @_Columns @context @rep
95+
96+
97+instance
98+ ( GTable _Table _Columns context rep1
99+ , GTable _Table _Columns context rep2
100+ )
101+ => GTable _Table _Columns context (rep1 :*: rep2)
102+ where
103+ fromGColumns fromColumns (HProduct a b) =
104+ fromGColumns @_Table @_Columns @context @rep1 fromColumns a :*:
105+ fromGColumns @_Table @_Columns @context @rep2 fromColumns b
106+ toGColumns toColumns (a :*: b) = HProduct
107+ (toGColumns @_Table @_Columns @context @rep1 toColumns a)
108+ (toGColumns @_Table @_Columns @context @rep2 toColumns b)
109+ gtable table = HProduct
110+ (gtable @_Table @_Columns @context @rep1 table)
111+ (gtable @_Table @_Columns @context @rep2 table)
112+
113+
114+instance
115+ ( HTable (Eval (_Columns a))
116+ , Eval (_Table a)
117+ , HLabelable context
118+ , KnownSymbol label
119+ , GColumns _Columns (M1 S meta k1) ~ HLabel label (Eval (_Columns a))
120+ , meta ~ 'MetaSel ('Just label) _su _ss _ds
121+ , k1 ~ K1 i a
122+ )
123+ => GTable _Table _Columns context (M1 S meta k1)
124+ where
125+ fromGColumns fromColumns = M1 . K1 . fromColumns . hunlabel hunlabeler
126+ toGColumns toColumns (M1 (K1 a)) = hlabel hlabeler (toColumns a)
127+ gtable table = hlabel hlabeler (table (Proxy @a))
src/Rel8/Schema/Generic.hs+28−15
@@ -3,7 +3,9 @@
33{-# language FlexibleContexts #-}
44{-# language FlexibleInstances #-}
55{-# language MultiParamTypeClasses #-}
6+{-# language ScopedTypeVariables #-}
67{-# language StandaloneKindSignatures #-}
8+{-# language TypeApplications #-}
79{-# language TypeFamilies #-}
810{-# language UndecidableInstances #-}
911
@@ -23,6 +25,9 @@ import Unsafe.Coerce ( unsafeCoerce )
2325
2426-- rel8
2527import Rel8.Generic.Record ( Record(..) )
28+import Rel8.Generic.Table
29+ ( GTable, GColumns, fromGColumns, toGColumns
30+ )
2631import Rel8.Schema.Context ( Col )
2732import Rel8.Schema.Context.Label ( Labelable )
2833import Rel8.Schema.Field ( Reify, Reifiable, hreify, hunreify )
@@ -31,7 +36,7 @@ import qualified Rel8.Schema.Kind as K
3136import Rel8.Schema.Name ( Name )
3237import Rel8.Table
3338 ( Table, Columns, Context, fromColumns, toColumns
34− , GTable, GColumns, fromGColumns, toGColumns
39+ , TTable, TColumns
3540 )
3641
3742
@@ -96,29 +101,37 @@ type KRel8able = K.Table
96101-- @
97102type Rel8able :: KRel8able -> Constraint
98103class HTable (GRep t) => Rel8able t where
104+ type GRep t :: K.HTable
105+
99106 gfromColumns :: (Labelable context, Reifiable context)
100107 => GRep t (Col (Reify context)) -> t (Reify context)
101108
102109 gtoColumns :: (Labelable context, Reifiable context)
103110 => t (Reify context) -> GRep t (Col (Reify context))
104111
105− default gfromColumns ::
106− ( Generic (Record (t (Reify context)))
107− , GColumns (Rep (Record (t (Reify context)))) ~ GRep t
108− , GTable (Reify context) (Rep (Record (t (Reify context))))
109− ) => GRep t (Col (Reify context)) -> t (Reify context)
110− gfromColumns = unrecord . to . fromGColumns
112+ type GRep t = GColumns TColumns (Rep (Record (t (Reify Name))))
111113
112− default gtoColumns ::
114+ default gfromColumns :: forall context.
113115 ( Generic (Record (t (Reify context)))
114− , GColumns (Rep (Record (t (Reify context)))) ~ GRep t
115− , GTable (Reify context) (Rep (Record (t (Reify context))))
116− ) => t (Reify context) -> GRep t (Col (Reify context))
117− gtoColumns = toGColumns . from . Record
118−
116+ , GColumns TColumns (Rep (Record (t (Reify context)))) ~ GRep t
117+ , GTable (TTable (Reify context)) TColumns (Col (Reify context)) (Rep (Record (t (Reify context))))
118+ )
119+ => GRep t (Col (Reify context)) -> t (Reify context)
120+ gfromColumns =
121+ unrecord .
122+ to .
123+ fromGColumns @(TTable (Reify context)) @TColumns fromColumns
119124
120−type GRep :: K.Table -> K.HTable
121−type GRep t = GColumns (Rep (Record (t (Reify Name))))
125+ default gtoColumns :: forall context.
126+ ( Generic (Record (t (Reify context)))
127+ , GColumns TColumns (Rep (Record (t (Reify context)))) ~ GRep t
128+ , GTable (TTable (Reify context)) TColumns (Col (Reify context)) (Rep (Record (t (Reify context))))
129+ )
130+ => t (Reify context) -> GRep t (Col (Reify context))
131+ gtoColumns =
132+ toGColumns @(TTable (Reify context)) @TColumns toColumns .
133+ from .
134+ Record
122135
123136
124137reify ::
src/Rel8/Table.hs+30−71
@@ -14,10 +14,9 @@
1414{-# language UndecidableInstances #-}
1515
1616module Rel8.Table
17− ( Table (Columns, Context)
18− , toColumns, fromColumns
17+ ( Table (Columns, Context, toColumns, fromColumns)
1918 , Congruent
20− , GTable, GColumns, GContext, fromGColumns, toGColumns
19+ , TTable, TColumns, TContext
2120 )
2221where
2322
@@ -26,28 +25,25 @@ import Data.Functor ( ($>) )
2625import Data.Functor.Identity ( Identity( Identity ) )
2726import Data.Kind ( Constraint, Type )
2827import Data.List.NonEmpty ( NonEmpty )
29−import GHC.Generics
30− ( Generic, Rep, from, to
31− , (:*:)( (:*:) ), K1( K1 ), M1( M1 )
32− , C, D, S
33− , Meta( MetaSel )
34− )
35−import GHC.TypeLits ( KnownSymbol )
28+import GHC.Generics ( Generic, Rep, from, to )
3629import Prelude hiding ( null )
3730
3831-- rel8
32+import Rel8.FCF ( Eval, Exp )
33+import Rel8.Generic.Table
34+ ( GTable, GColumns, GContext, fromGColumns, toGColumns
35+ )
3936import Rel8.Generic.Record ( Record(..) )
4037import Rel8.Schema.Context ( Col(..) )
4138import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
4239import Rel8.Schema.HTable ( HTable )
4340import Rel8.Schema.HTable.Either ( HEitherTable(..) )
4441import Rel8.Schema.HTable.Identity ( HIdentity(..) )
45−import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
42+import Rel8.Schema.HTable.Label ( hlabel, hunlabel )
4643import Rel8.Schema.HTable.List ( HListTable )
4744import Rel8.Schema.HTable.Maybe ( HMaybeTable(..) )
4845import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
4946import Rel8.Schema.HTable.Nullify ( hnulls, hnullify, hunnullify )
50−import Rel8.Schema.HTable.Product ( HProduct(..) )
5147import Rel8.Schema.HTable.These ( HTheseTable(..) )
5248import Rel8.Schema.HTable.Type ( HType( HType ) )
5349import Rel8.Schema.HTable.Vectorize ( hvectorize, hunvectorize )
@@ -85,79 +81,42 @@ class (HTable (Columns a), context ~ Context a) => Table context a | a -> contex
8581 toColumns :: a -> Columns a (Col (Context a))
8682 fromColumns :: Columns a (Col (Context a)) -> a
8783
88− type Columns a = GColumns (Rep (Record a))
89− type Context a = GContext (Rep (Record a))
84+ type Columns a = GColumns TColumns (Rep (Record a))
85+ type Context a = GContext TContext (Rep (Record a))
9086
9187 default toColumns ::
92− ( Generic (Record a), GTable (GContext (Rep (Record a))) (Rep (Record a))
93− , Columns a ~ GColumns (Rep (Record a))
94− , Context a ~ GContext (Rep (Record a))
88+ ( Generic (Record a)
89+ , GTable (TTable context) TColumns (Col (Context a)) (Rep (Record a))
90+ , Columns a ~ GColumns TColumns (Rep (Record a))
9591 )
9692 => a -> Columns a (Col (Context a))
97− toColumns = toGColumns . from . Record
93+ toColumns =
94+ toGColumns @(TTable context) @TColumns toColumns .
95+ from .
96+ Record
9897
9998 default fromColumns ::
100− ( Generic (Record a), GTable (GContext (Rep (Record a))) (Rep (Record a))
101− , Columns a ~ GColumns (Rep (Record a))
102− , Context a ~ GContext (Rep (Record a))
99+ ( Generic (Record a)
100+ , GTable (TTable context) TColumns (Col (Context a)) (Rep (Record a))
101+ , Columns a ~ GColumns TColumns (Rep (Record a))
103102 )
104103 => Columns a (Col (Context a)) -> a
105− fromColumns = unrecord . to . fromGColumns
106−
107−
108−type GColumns :: (Type -> Type) -> K.HTable
109−type family GColumns rep where
110− GColumns (M1 D _ rep) = GColumns rep
111− GColumns (M1 C _ rep) = GColumns rep
112− GColumns (rep1 :*: rep2) = HProduct (GColumns rep1) (GColumns rep2)
113− GColumns (M1 S ('MetaSel ('Just label) _ _ _) (K1 _ a)) =
114− HLabel label (Columns a)
115−
116−
117−type GContext :: (Type -> Type) -> K.Context
118−type family GContext rep where
119− GContext (M1 _ _ rep) = GContext rep
120− GContext (rep1 :*: _rep2) = GContext rep1
121− GContext (K1 _ a) = Context a
122−
104+ fromColumns =
105+ unrecord .
106+ to .
107+ fromGColumns @(TTable context) @TColumns fromColumns
123108
124−type GTable :: K.Context -> (Type -> Type) -> Constraint
125−class context ~ GContext rep => GTable context rep | rep -> context where
126− fromGColumns :: GColumns rep (Col context) -> rep x
127− toGColumns :: rep x -> GColumns rep (Col context)
128109
110+data TTable :: K.Context -> Type -> Exp Constraint
111+type instance Eval (TTable context a) = Table context a
129112
130−instance GTable context rep => GTable context (M1 D c rep) where
131− fromGColumns = M1 . fromGColumns @context @rep
132− toGColumns (M1 a) = toGColumns @context @rep a
133113
114+data TColumns :: Type -> Exp K.HTable
115+type instance Eval (TColumns a) = Columns a
134116
135−instance GTable context rep => GTable context (M1 C c rep) where
136− fromGColumns = M1 . fromGColumns @context @rep
137− toGColumns (M1 a) = toGColumns @context @rep a
138117
139−
140−instance (GTable context rep1, GTable context rep2) =>
141− GTable context (rep1 :*: rep2)
142− where
143− fromGColumns (HProduct a b) =
144− fromGColumns @context @rep1 a :*: fromGColumns @context @rep2 b
145− toGColumns (a :*: b) =
146− HProduct (toGColumns @context @rep1 a) (toGColumns @context @rep2 b)
147−
148−
149−instance
150− ( Table context a
151− , Labelable context
152− , KnownSymbol label
153− , GColumns (M1 S meta k1) ~ HLabel label (Columns a)
154− , meta ~ 'MetaSel ('Just label) _su _ss _ds
155− , k1 ~ K1 i a
156− )
157− => GTable context (M1 S meta k1)
158− where
159− fromGColumns = M1 . K1 . fromColumns . hunlabel unlabeler
160− toGColumns (M1 (K1 a)) = hlabel labeler (toColumns a)
118+data TContext :: Type -> Exp K.Context
119+type instance Eval (TContext a) = Context a
161120
162121
163122-- | Any 'HTable' is also a 'Table'.
src/Rel8/Table/Eq.hs+12−35
@@ -24,28 +24,27 @@ import Data.Foldable ( foldl' )
2424import Data.Functor.Const ( Const( Const ), getConst )
2525import Data.Kind ( Constraint, Type )
2626import Data.List.NonEmpty ( NonEmpty( (:|) ) )
27−import GHC.Generics ( Rep, (:*:), K1, M1, Meta( MetaSel ), D, C, S )
28−import GHC.TypeLits ( KnownSymbol )
27+import Data.Proxy ( Proxy )
28+import GHC.Generics ( Rep )
2929import Prelude
3030
3131-- rel8
3232import Rel8.Expr ( Expr, Col(..) )
3333import Rel8.Expr.Bool ( (||.), (&&.) )
3434import Rel8.Expr.Eq ( (==.), (/=.) )
35+import Rel8.FCF ( Eval, Exp )
3536import Rel8.Generic.Record ( Record )
36−import Rel8.Schema.Context.Label ( hlabeler )
37+import Rel8.Generic.Table ( GTable, GColumns, gtable )
3738import Rel8.Schema.Dict ( Dict( Dict ) )
3839import Rel8.Schema.HTable
3940 ( HTable, HConstrainTable
4041 , htabulateA, hfield, hdicts
4142 )
42−import Rel8.Schema.HTable.Label ( HLabel, hlabel )
43−import Rel8.Schema.HTable.Product ( HProduct(..) )
4443import Rel8.Schema.HTable.Type ( HType(..) )
4544import Rel8.Schema.Kind ( Context )
4645import Rel8.Schema.Null ( Sql )
4746import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
48−import Rel8.Table ( Table, Columns, toColumns, GColumns )
47+import Rel8.Table ( Table, Columns, toColumns, TColumns )
4948import Rel8.Type.Eq ( DBEq )
5049
5150
@@ -57,39 +56,17 @@ class Table Expr a => EqTable a where
5756 eqTable :: Columns a (Dict (ConstrainDBType DBEq))
5857
5958 default eqTable ::
60− ( GColumns (Rep (Record a)) ~ Columns a
61− , GEqTable (Rep (Record a))
59+ ( GTable TEqTable TColumns (Dict (ConstrainDBType DBEq)) (Rep (Record a))
60+ , Columns a ~ GColumns TColumns (Rep (Record a))
6261 )
6362 => Columns a (Dict (ConstrainDBType DBEq))
64− eqTable = geqTable @(Rep (Record a))
63+ eqTable = gtable @TEqTable @TColumns @_ @(Rep (Record a)) table
64+ where
65+ table (_ :: Proxy x) = eqTable @x
6566
6667
67−type GEqTable :: (Type -> Type) -> Constraint
68−class GEqTable rep where
69− geqTable :: GColumns rep (Dict (ConstrainDBType DBEq))
70−
71−
72−instance GEqTable rep => GEqTable (M1 D c rep) where
73− geqTable = geqTable @rep
74−
75−
76−instance GEqTable rep => GEqTable (M1 C c rep) where
77− geqTable = geqTable @rep
78−
79−
80−instance (GEqTable rep1, GEqTable rep2) => GEqTable (rep1 :*: rep2) where
81− geqTable = HProduct (geqTable @rep1) (geqTable @rep2)
82−
83−
84−instance
85− ( EqTable a
86− , KnownSymbol label
87− , GColumns (M1 S meta k1) ~ HLabel label (Columns a)
88− , meta ~ 'MetaSel ('Just label) _su _ss _ds
89− , k1 ~ K1 i a
90− ) => GEqTable (M1 S meta k1)
91− where
92− geqTable = hlabel hlabeler (eqTable @a)
68+data TEqTable :: Type -> Exp Constraint
69+type instance Eval (TEqTable a) = EqTable a
9370
9471
9572instance
src/Rel8/Table/Ord.hs+12−36
@@ -21,8 +21,8 @@ where
2121-- base
2222import Data.Functor.Const ( Const( Const ), getConst )
2323import Data.Kind ( Constraint, Type )
24−import GHC.Generics ( Rep, (:*:), K1, M1, Meta( MetaSel ), D, C, S )
25−import GHC.TypeLits ( KnownSymbol )
24+import Data.Proxy ( Proxy )
25+import GHC.Generics ( Rep )
2626import Prelude hiding ( seq )
2727
2828-- rel8
@@ -30,20 +30,19 @@ import Rel8.Expr ( Expr, Col(..) )
3030import Rel8.Expr.Bool ( (||.), (&&.), false, true )
3131import Rel8.Expr.Eq ( (==.) )
3232import Rel8.Expr.Ord ( (<.), (>.) )
33+import Rel8.FCF ( Eval, Exp )
3334import Rel8.Generic.Record ( Record )
34−import Rel8.Schema.Context.Label ( hlabeler )
35+import Rel8.Generic.Table ( GTable, GColumns, gtable )
3536import Rel8.Schema.Dict ( Dict( Dict ) )
3637import Rel8.Schema.HTable
3738 ( HTable, HConstrainTable
3839 , htabulateA, hfield, hdicts
3940 )
40−import Rel8.Schema.HTable.Label ( HLabel, hlabel )
41−import Rel8.Schema.HTable.Product ( HProduct(..) )
4241import Rel8.Schema.HTable.Type ( HType(..) )
4342import Rel8.Schema.Kind ( Context )
4443import Rel8.Schema.Null (Sql)
4544import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
46−import Rel8.Table ( Table, Columns, toColumns, GColumns )
45+import Rel8.Table ( Table, Columns, toColumns, TColumns )
4746import Rel8.Table.Bool ( bool )
4847import Rel8.Table.Eq ( EqTable )
4948import Rel8.Type.Eq ( DBEq )
@@ -58,40 +57,17 @@ class EqTable a => OrdTable a where
5857 ordTable :: Columns a (Dict (ConstrainDBType DBOrd))
5958
6059 default ordTable ::
61− ( GColumns (Rep (Record a)) ~ Columns a
62− , GOrdTable (Rep (Record a))
60+ ( GTable TOrdTable TColumns (Dict (ConstrainDBType DBOrd)) (Rep (Record a))
61+ , Columns a ~ GColumns TColumns (Rep (Record a))
6362 )
6463 => Columns a (Dict (ConstrainDBType DBOrd))
65− ordTable = gordTable @(Rep (Record a))
64+ ordTable = gtable @TOrdTable @TColumns @_ @(Rep (Record a)) table
65+ where
66+ table (_ :: Proxy x) = ordTable @x
6667
6768
68−type GOrdTable :: (Type -> Type) -> Constraint
69−class GOrdTable rep where
70− gordTable :: GColumns rep (Dict (ConstrainDBType DBOrd))
71−
72−
73−instance GOrdTable rep => GOrdTable (M1 D c rep) where
74− gordTable = gordTable @rep
75−
76−
77−instance GOrdTable rep => GOrdTable (M1 C c rep) where
78− gordTable = gordTable @rep
79−
80−
81−instance (GOrdTable rep1, GOrdTable rep2) => GOrdTable (rep1 :*: rep2) where
82− gordTable = HProduct (gordTable @rep1) (gordTable @rep2)
83−
84−
85−instance
86− ( OrdTable a
87− , KnownSymbol label
88− , GColumns (M1 S meta k1) ~ HLabel label (Columns a)
89− , meta ~ 'MetaSel ('Just label) _su _ss _ds
90− , k1 ~ K1 i a
91− )
92− => GOrdTable (M1 S meta k1)
93− where
94− gordTable = hlabel hlabeler (ordTable @a)
69+data TOrdTable :: Type -> Exp Constraint
70+type instance Eval (TOrdTable a) = OrdTable a
9571
9672
9773instance
src/Rel8/Table/Serialize.hs+7−6
@@ -39,6 +39,7 @@ import qualified Hasql.Decoders as Hasql
3939import Rel8.Expr ( Expr, Col(..) )
4040import Rel8.Expr.Serialize ( slitExpr, sparseValue )
4141import Rel8.Generic.Record ( Record(..) )
42+import Rel8.Generic.Table ( GColumns )
4243import Rel8.Schema.Context ( Col(..) )
4344import Rel8.Schema.Context.Label ( labeler, unlabeler )
4445import Rel8.Schema.HTable ( HTable, htabulate, htabulateA, hfield, hspecs )
@@ -48,7 +49,7 @@ import Rel8.Schema.HTable.Type ( HType(..) )
4849import Rel8.Schema.Null ( NotNull, Sql )
4950import Rel8.Schema.Result ( Result )
5051import Rel8.Schema.Spec ( SSpec(..), KnownSpec )
51−import Rel8.Table ( Table, Columns, fromColumns, toColumns, GColumns )
52+import Rel8.Table ( Table, Columns, fromColumns, toColumns, TColumns )
5253import Rel8.Table.Either ( EitherTable )
5354import Rel8.Table.List ( ListTable )
5455import Rel8.Table.Maybe ( MaybeTable )
@@ -72,7 +73,7 @@ class Table Expr exprs => ToExprs exprs a where
7273 default fromResult ::
7374 ( Generic (Record a)
7475 , GToExprs (Rep (Record exprs)) (Rep (Record a))
75− , Columns exprs ~ GColumns (Rep (Record exprs))
76+ , Columns exprs ~ GColumns TColumns (Rep (Record exprs))
7677 )
7778 => Columns exprs (Col Result) -> a
7879 fromResult = unrecord . to . gfromResult @(Rep (Record exprs))
@@ -80,7 +81,7 @@ class Table Expr exprs => ToExprs exprs a where
8081 default toResult ::
8182 ( Generic (Record a)
8283 , GToExprs (Rep (Record exprs)) (Rep (Record a))
83− , Columns exprs ~ GColumns (Rep (Record exprs))
84+ , Columns exprs ~ GColumns TColumns (Rep (Record exprs))
8485 )
8586 => a -> Columns exprs (Col Result)
8687 toResult = gtoResult @(Rep (Record exprs)) . from . Record
@@ -88,8 +89,8 @@ class Table Expr exprs => ToExprs exprs a where
8889
8990type GToExprs :: (Type -> Type) -> (Type -> Type) -> Constraint
9091class GToExprs exprs rep where
91− gfromResult :: GColumns exprs (Col Result) -> rep x
92− gtoResult :: rep x -> GColumns exprs (Col Result)
92+ gfromResult :: GColumns TColumns exprs (Col Result) -> rep x
93+ gtoResult :: rep x -> GColumns TColumns exprs (Col Result)
9394
9495
9596instance GToExprs exprs rep => GToExprs (M1 D c exprs) (M1 D c rep) where
@@ -112,7 +113,7 @@ instance (GToExprs exprs1 rep1, GToExprs exprs2 rep2) =>
112113instance
113114 ( ToExprs exprs a
114115 , KnownSymbol label
115− , GColumns (M1 S meta k1) ~ HLabel label (Columns exprs)
116+ , GColumns TColumns (M1 S meta k1) ~ HLabel label (Columns exprs)
116117 , meta ~ 'MetaSel ('Just label) _su _ss _ds
117118 , k1 ~ K1 i exprs
118119 , k1' ~ K1 i a