git.iko.soy/rel8
on master help sign in
Use FCF to decouple GTable from Table
1276bebShane O'Brien
rel8.cabal+1
compare with master
unifiedsplit
@@ -67,6 +67,7 @@ library
67 Rel8.Kind.Necessity
67 Rel8.Kind.Necessity
68
68
69 Rel8.Generic.Record
69 Rel8.Generic.Record
70+ Rel8.Generic.Table
70
71
71 Rel8.Order
72 Rel8.Order
72
73
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 @@
3{-# language FlexibleContexts #-}
3{-# language FlexibleContexts #-}
4{-# language FlexibleInstances #-}
4{-# language FlexibleInstances #-}
5{-# language MultiParamTypeClasses #-}
5{-# language MultiParamTypeClasses #-}
6+{-# language ScopedTypeVariables #-}
6{-# language StandaloneKindSignatures #-}
7{-# language StandaloneKindSignatures #-}
8+{-# language TypeApplications #-}
7{-# language TypeFamilies #-}
9{-# language TypeFamilies #-}
8{-# language UndecidableInstances #-}
10{-# language UndecidableInstances #-}
9
11
@@ -23,6 +25,9 @@ import Unsafe.Coerce ( unsafeCoerce )
23
25
24-- rel8
26-- rel8
25import Rel8.Generic.Record ( Record(..) )
27import Rel8.Generic.Record ( Record(..) )
28+import Rel8.Generic.Table
29+ ( GTable, GColumns, fromGColumns, toGColumns
30+ )
26import Rel8.Schema.Context ( Col )
31import Rel8.Schema.Context ( Col )
27import Rel8.Schema.Context.Label ( Labelable )
32import Rel8.Schema.Context.Label ( Labelable )
28import Rel8.Schema.Field ( Reify, Reifiable, hreify, hunreify )
33import Rel8.Schema.Field ( Reify, Reifiable, hreify, hunreify )
@@ -31,7 +36,7 @@ import qualified Rel8.Schema.Kind as K
31import Rel8.Schema.Name ( Name )
36import Rel8.Schema.Name ( Name )
32import Rel8.Table
37import Rel8.Table
33 ( Table, Columns, Context, fromColumns, toColumns
38 ( Table, Columns, Context, fromColumns, toColumns
34− , GTable, GColumns, fromGColumns, toGColumns
39+ , TTable, TColumns
35 )
40 )
36
41
37
42
@@ -96,29 +101,37 @@ type KRel8able = K.Table
96-- @
101-- @
97type Rel8able :: KRel8able -> Constraint
102type Rel8able :: KRel8able -> Constraint
98class HTable (GRep t) => Rel8able t where
103class HTable (GRep t) => Rel8able t where
104+ type GRep t :: K.HTable
105+
99 gfromColumns :: (Labelable context, Reifiable context)
106 gfromColumns :: (Labelable context, Reifiable context)
100 => GRep t (Col (Reify context)) -> t (Reify context)
107 => GRep t (Col (Reify context)) -> t (Reify context)
101
108
102 gtoColumns :: (Labelable context, Reifiable context)
109 gtoColumns :: (Labelable context, Reifiable context)
103 => t (Reify context) -> GRep t (Col (Reify context))
110 => t (Reify context) -> GRep t (Col (Reify context))
104
111
105− default gfromColumns ::
112+ type GRep t = GColumns TColumns (Rep (Record (t (Reify Name))))
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
111
113
112− default gtoColumns ::
114+ default gfromColumns :: forall context.
113 ( Generic (Record (t (Reify context)))
115 ( Generic (Record (t (Reify context)))
114− , GColumns (Rep (Record (t (Reify context)))) ~ GRep t
116+ , GColumns TColumns (Rep (Record (t (Reify context)))) ~ GRep t
115− , GTable (Reify context) (Rep (Record (t (Reify context))))
117+ , GTable (TTable (Reify context)) TColumns (Col (Reify context)) (Rep (Record (t (Reify context))))
118+ )
116− ) => t (Reify context) -> GRep t (Col (Reify context))
119+ => GRep t (Col (Reify context)) -> t (Reify context)
117− gtoColumns = toGColumns . from . Record
120+ gfromColumns =
118−
121+ unrecord .
122+ to .
123+ fromGColumns @(TTable (Reify context)) @TColumns fromColumns
119
124
120−type GRep :: K.Table -> K.HTable
125+ default gtoColumns :: forall context.
121−type GRep t = GColumns (Rep (Record (t (Reify Name))))
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
122
135
123
136
124reify ::
137reify ::
src/Rel8/Table.hs+30−71
@@ -14,10 +14,9 @@
14{-# language UndecidableInstances #-}
14{-# language UndecidableInstances #-}
15
15
16module Rel8.Table
16module Rel8.Table
17− ( Table (Columns, Context)
18− , toColumns, fromColumns
17+ ( Table (Columns, Context, toColumns, fromColumns)
19 , Congruent
18 , Congruent
20− , GTable, GColumns, GContext, fromGColumns, toGColumns
19+ , TTable, TColumns, TContext
21 )
20 )
22where
21where
23
22
@@ -26,28 +25,25 @@ import Data.Functor ( ($>) )
26import Data.Functor.Identity ( Identity( Identity ) )
25import Data.Functor.Identity ( Identity( Identity ) )
27import Data.Kind ( Constraint, Type )
26import Data.Kind ( Constraint, Type )
28import Data.List.NonEmpty ( NonEmpty )
27import Data.List.NonEmpty ( NonEmpty )
29−import GHC.Generics
28+import GHC.Generics ( Generic, Rep, from, to )
30− ( Generic, Rep, from, to
31− , (:*:)( (:*:) ), K1( K1 ), M1( M1 )
32− , C, D, S
33− , Meta( MetaSel )
34− )
35−import GHC.TypeLits ( KnownSymbol )
36import Prelude hiding ( null )
29import Prelude hiding ( null )
37
30
38-- rel8
31-- rel8
32+import Rel8.FCF ( Eval, Exp )
33+import Rel8.Generic.Table
34+ ( GTable, GColumns, GContext, fromGColumns, toGColumns
35+ )
39import Rel8.Generic.Record ( Record(..) )
36import Rel8.Generic.Record ( Record(..) )
40import Rel8.Schema.Context ( Col(..) )
37import Rel8.Schema.Context ( Col(..) )
41import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
38import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
42import Rel8.Schema.HTable ( HTable )
39import Rel8.Schema.HTable ( HTable )
43import Rel8.Schema.HTable.Either ( HEitherTable(..) )
40import Rel8.Schema.HTable.Either ( HEitherTable(..) )
44import Rel8.Schema.HTable.Identity ( HIdentity(..) )
41import Rel8.Schema.HTable.Identity ( HIdentity(..) )
45−import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
42+import Rel8.Schema.HTable.Label ( hlabel, hunlabel )
46import Rel8.Schema.HTable.List ( HListTable )
43import Rel8.Schema.HTable.List ( HListTable )
47import Rel8.Schema.HTable.Maybe ( HMaybeTable(..) )
44import Rel8.Schema.HTable.Maybe ( HMaybeTable(..) )
48import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
45import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
49import Rel8.Schema.HTable.Nullify ( hnulls, hnullify, hunnullify )
46import Rel8.Schema.HTable.Nullify ( hnulls, hnullify, hunnullify )
50−import Rel8.Schema.HTable.Product ( HProduct(..) )
51import Rel8.Schema.HTable.These ( HTheseTable(..) )
47import Rel8.Schema.HTable.These ( HTheseTable(..) )
52import Rel8.Schema.HTable.Type ( HType( HType ) )
48import Rel8.Schema.HTable.Type ( HType( HType ) )
53import Rel8.Schema.HTable.Vectorize ( hvectorize, hunvectorize )
49import Rel8.Schema.HTable.Vectorize ( hvectorize, hunvectorize )
@@ -85,79 +81,42 @@ class (HTable (Columns a), context ~ Context a) => Table context a | a -> contex
85 toColumns :: a -> Columns a (Col (Context a))
81 toColumns :: a -> Columns a (Col (Context a))
86 fromColumns :: Columns a (Col (Context a)) -> a
82 fromColumns :: Columns a (Col (Context a)) -> a
87
83
88− type Columns a = GColumns (Rep (Record a))
84+ type Columns a = GColumns TColumns (Rep (Record a))
89− type Context a = GContext (Rep (Record a))
85+ type Context a = GContext TContext (Rep (Record a))
90
86
91 default toColumns ::
87 default toColumns ::
92− ( Generic (Record a), GTable (GContext (Rep (Record a))) (Rep (Record a))
88+ ( Generic (Record a)
89+ , GTable (TTable context) TColumns (Col (Context a)) (Rep (Record a))
93− , Columns a ~ GColumns (Rep (Record a))
90+ , Columns a ~ GColumns TColumns (Rep (Record a))
94− , Context a ~ GContext (Rep (Record a))
95 )
91 )
96 => a -> Columns a (Col (Context a))
92 => a -> Columns a (Col (Context a))
97− toColumns = toGColumns . from . Record
93+ toColumns =
94+ toGColumns @(TTable context) @TColumns toColumns .
95+ from .
96+ Record
98
97
99 default fromColumns ::
98 default fromColumns ::
100− ( Generic (Record a), GTable (GContext (Rep (Record a))) (Rep (Record a))
99+ ( Generic (Record a)
100+ , GTable (TTable context) TColumns (Col (Context a)) (Rep (Record a))
101− , Columns a ~ GColumns (Rep (Record a))
101+ , Columns a ~ GColumns TColumns (Rep (Record a))
102− , Context a ~ GContext (Rep (Record a))
103 )
102 )
104 => Columns a (Col (Context a)) -> a
103 => Columns a (Col (Context a)) -> a
105− fromColumns = unrecord . to . fromGColumns
104+ fromColumns =
106−
105+ unrecord .
107−
106+ to .
108−type GColumns :: (Type -> Type) -> K.HTable
107+ fromGColumns @(TTable context) @TColumns fromColumns
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−
123
108
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)
128
109
110+data TTable :: K.Context -> Type -> Exp Constraint
111+type instance Eval (TTable context a) = Table context a
129
112
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
133
113
114+data TColumns :: Type -> Exp K.HTable
115+type instance Eval (TColumns a) = Columns a
134
116
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
138
117
139−
118+data TContext :: Type -> Exp K.Context
140−instance (GTable context rep1, GTable context rep2) =>
119+type instance Eval (TContext a) = Context a
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)
161
120
162
121
163-- | Any 'HTable' is also a 'Table'.
122-- | Any 'HTable' is also a 'Table'.
src/Rel8/Table/Eq.hs+12−35
@@ -24,28 +24,27 @@ import Data.Foldable ( foldl' )
24import Data.Functor.Const ( Const( Const ), getConst )
24import Data.Functor.Const ( Const( Const ), getConst )
25import Data.Kind ( Constraint, Type )
25import Data.Kind ( Constraint, Type )
26import Data.List.NonEmpty ( NonEmpty( (:|) ) )
26import Data.List.NonEmpty ( NonEmpty( (:|) ) )
27+import Data.Proxy ( Proxy )
27−import GHC.Generics ( Rep, (:*:), K1, M1, Meta( MetaSel ), D, C, S )
28+import GHC.Generics ( Rep )
28−import GHC.TypeLits ( KnownSymbol )
29import Prelude
29import Prelude
30
30
31-- rel8
31-- rel8
32import Rel8.Expr ( Expr, Col(..) )
32import Rel8.Expr ( Expr, Col(..) )
33import Rel8.Expr.Bool ( (||.), (&&.) )
33import Rel8.Expr.Bool ( (||.), (&&.) )
34import Rel8.Expr.Eq ( (==.), (/=.) )
34import Rel8.Expr.Eq ( (==.), (/=.) )
35+import Rel8.FCF ( Eval, Exp )
35import Rel8.Generic.Record ( Record )
36import Rel8.Generic.Record ( Record )
36−import Rel8.Schema.Context.Label ( hlabeler )
37+import Rel8.Generic.Table ( GTable, GColumns, gtable )
37import Rel8.Schema.Dict ( Dict( Dict ) )
38import Rel8.Schema.Dict ( Dict( Dict ) )
38import Rel8.Schema.HTable
39import Rel8.Schema.HTable
39 ( HTable, HConstrainTable
40 ( HTable, HConstrainTable
40 , htabulateA, hfield, hdicts
41 , htabulateA, hfield, hdicts
41 )
42 )
42−import Rel8.Schema.HTable.Label ( HLabel, hlabel )
43−import Rel8.Schema.HTable.Product ( HProduct(..) )
44import Rel8.Schema.HTable.Type ( HType(..) )
43import Rel8.Schema.HTable.Type ( HType(..) )
45import Rel8.Schema.Kind ( Context )
44import Rel8.Schema.Kind ( Context )
46import Rel8.Schema.Null ( Sql )
45import Rel8.Schema.Null ( Sql )
47import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
46import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
48−import Rel8.Table ( Table, Columns, toColumns, GColumns )
47+import Rel8.Table ( Table, Columns, toColumns, TColumns )
49import Rel8.Type.Eq ( DBEq )
48import Rel8.Type.Eq ( DBEq )
50
49
51
50
@@ -57,39 +56,17 @@ class Table Expr a => EqTable a where
57 eqTable :: Columns a (Dict (ConstrainDBType DBEq))
56 eqTable :: Columns a (Dict (ConstrainDBType DBEq))
58
57
59 default eqTable ::
58 default eqTable ::
60− ( GColumns (Rep (Record a)) ~ Columns a
59+ ( GTable TEqTable TColumns (Dict (ConstrainDBType DBEq)) (Rep (Record a))
61− , GEqTable (Rep (Record a))
60+ , Columns a ~ GColumns TColumns (Rep (Record a))
62 )
61 )
63 => Columns a (Dict (ConstrainDBType DBEq))
62 => 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
65
66
66
67
67−type GEqTable :: (Type -> Type) -> Constraint
68+data TEqTable :: Type -> Exp Constraint
68−class GEqTable rep where
69+type instance Eval (TEqTable a) = EqTable a
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)
93
70
94
71
95instance
72instance
src/Rel8/Table/Ord.hs+12−36
@@ -21,8 +21,8 @@ where
21-- base
21-- base
22import Data.Functor.Const ( Const( Const ), getConst )
22import Data.Functor.Const ( Const( Const ), getConst )
23import Data.Kind ( Constraint, Type )
23import Data.Kind ( Constraint, Type )
24+import Data.Proxy ( Proxy )
24−import GHC.Generics ( Rep, (:*:), K1, M1, Meta( MetaSel ), D, C, S )
25+import GHC.Generics ( Rep )
25−import GHC.TypeLits ( KnownSymbol )
26import Prelude hiding ( seq )
26import Prelude hiding ( seq )
27
27
28-- rel8
28-- rel8
@@ -30,20 +30,19 @@ import Rel8.Expr ( Expr, Col(..) )
30import Rel8.Expr.Bool ( (||.), (&&.), false, true )
30import Rel8.Expr.Bool ( (||.), (&&.), false, true )
31import Rel8.Expr.Eq ( (==.) )
31import Rel8.Expr.Eq ( (==.) )
32import Rel8.Expr.Ord ( (<.), (>.) )
32import Rel8.Expr.Ord ( (<.), (>.) )
33+import Rel8.FCF ( Eval, Exp )
33import Rel8.Generic.Record ( Record )
34import Rel8.Generic.Record ( Record )
34−import Rel8.Schema.Context.Label ( hlabeler )
35+import Rel8.Generic.Table ( GTable, GColumns, gtable )
35import Rel8.Schema.Dict ( Dict( Dict ) )
36import Rel8.Schema.Dict ( Dict( Dict ) )
36import Rel8.Schema.HTable
37import Rel8.Schema.HTable
37 ( HTable, HConstrainTable
38 ( HTable, HConstrainTable
38 , htabulateA, hfield, hdicts
39 , htabulateA, hfield, hdicts
39 )
40 )
40−import Rel8.Schema.HTable.Label ( HLabel, hlabel )
41−import Rel8.Schema.HTable.Product ( HProduct(..) )
42import Rel8.Schema.HTable.Type ( HType(..) )
41import Rel8.Schema.HTable.Type ( HType(..) )
43import Rel8.Schema.Kind ( Context )
42import Rel8.Schema.Kind ( Context )
44import Rel8.Schema.Null (Sql)
43import Rel8.Schema.Null (Sql)
45import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
44import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
46−import Rel8.Table ( Table, Columns, toColumns, GColumns )
45+import Rel8.Table ( Table, Columns, toColumns, TColumns )
47import Rel8.Table.Bool ( bool )
46import Rel8.Table.Bool ( bool )
48import Rel8.Table.Eq ( EqTable )
47import Rel8.Table.Eq ( EqTable )
49import Rel8.Type.Eq ( DBEq )
48import Rel8.Type.Eq ( DBEq )
@@ -58,40 +57,17 @@ class EqTable a => OrdTable a where
58 ordTable :: Columns a (Dict (ConstrainDBType DBOrd))
57 ordTable :: Columns a (Dict (ConstrainDBType DBOrd))
59
58
60 default ordTable ::
59 default ordTable ::
61− ( GColumns (Rep (Record a)) ~ Columns a
60+ ( GTable TOrdTable TColumns (Dict (ConstrainDBType DBOrd)) (Rep (Record a))
62− , GOrdTable (Rep (Record a))
61+ , Columns a ~ GColumns TColumns (Rep (Record a))
63 )
62 )
64 => Columns a (Dict (ConstrainDBType DBOrd))
63 => 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
66
67
67
68
68−type GOrdTable :: (Type -> Type) -> Constraint
69+data TOrdTable :: Type -> Exp 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
70+type instance Eval (TOrdTable a) = 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)
95
71
96
72
97instance
73instance
src/Rel8/Table/Serialize.hs+7−6
@@ -39,6 +39,7 @@ import qualified Hasql.Decoders as Hasql
39import Rel8.Expr ( Expr, Col(..) )
39import Rel8.Expr ( Expr, Col(..) )
40import Rel8.Expr.Serialize ( slitExpr, sparseValue )
40import Rel8.Expr.Serialize ( slitExpr, sparseValue )
41import Rel8.Generic.Record ( Record(..) )
41import Rel8.Generic.Record ( Record(..) )
42+import Rel8.Generic.Table ( GColumns )
42import Rel8.Schema.Context ( Col(..) )
43import Rel8.Schema.Context ( Col(..) )
43import Rel8.Schema.Context.Label ( labeler, unlabeler )
44import Rel8.Schema.Context.Label ( labeler, unlabeler )
44import Rel8.Schema.HTable ( HTable, htabulate, htabulateA, hfield, hspecs )
45import Rel8.Schema.HTable ( HTable, htabulate, htabulateA, hfield, hspecs )
@@ -48,7 +49,7 @@ import Rel8.Schema.HTable.Type ( HType(..) )
48import Rel8.Schema.Null ( NotNull, Sql )
49import Rel8.Schema.Null ( NotNull, Sql )
49import Rel8.Schema.Result ( Result )
50import Rel8.Schema.Result ( Result )
50import Rel8.Schema.Spec ( SSpec(..), KnownSpec )
51import Rel8.Schema.Spec ( SSpec(..), KnownSpec )
51−import Rel8.Table ( Table, Columns, fromColumns, toColumns, GColumns )
52+import Rel8.Table ( Table, Columns, fromColumns, toColumns, TColumns )
52import Rel8.Table.Either ( EitherTable )
53import Rel8.Table.Either ( EitherTable )
53import Rel8.Table.List ( ListTable )
54import Rel8.Table.List ( ListTable )
54import Rel8.Table.Maybe ( MaybeTable )
55import Rel8.Table.Maybe ( MaybeTable )
@@ -72,7 +73,7 @@ class Table Expr exprs => ToExprs exprs a where
72 default fromResult ::
73 default fromResult ::
73 ( Generic (Record a)
74 ( Generic (Record a)
74 , GToExprs (Rep (Record exprs)) (Rep (Record a))
75 , GToExprs (Rep (Record exprs)) (Rep (Record a))
75− , Columns exprs ~ GColumns (Rep (Record exprs))
76+ , Columns exprs ~ GColumns TColumns (Rep (Record exprs))
76 )
77 )
77 => Columns exprs (Col Result) -> a
78 => Columns exprs (Col Result) -> a
78 fromResult = unrecord . to . gfromResult @(Rep (Record exprs))
79 fromResult = unrecord . to . gfromResult @(Rep (Record exprs))
@@ -80,7 +81,7 @@ class Table Expr exprs => ToExprs exprs a where
80 default toResult ::
81 default toResult ::
81 ( Generic (Record a)
82 ( Generic (Record a)
82 , GToExprs (Rep (Record exprs)) (Rep (Record a))
83 , GToExprs (Rep (Record exprs)) (Rep (Record a))
83− , Columns exprs ~ GColumns (Rep (Record exprs))
84+ , Columns exprs ~ GColumns TColumns (Rep (Record exprs))
84 )
85 )
85 => a -> Columns exprs (Col Result)
86 => a -> Columns exprs (Col Result)
86 toResult = gtoResult @(Rep (Record exprs)) . from . Record
87 toResult = gtoResult @(Rep (Record exprs)) . from . Record
@@ -88,8 +89,8 @@ class Table Expr exprs => ToExprs exprs a where
88
89
89type GToExprs :: (Type -> Type) -> (Type -> Type) -> Constraint
90type GToExprs :: (Type -> Type) -> (Type -> Type) -> Constraint
90class GToExprs exprs rep where
91class GToExprs exprs rep where
91− gfromResult :: GColumns exprs (Col Result) -> rep x
92+ gfromResult :: GColumns TColumns exprs (Col Result) -> rep x
92− gtoResult :: rep x -> GColumns exprs (Col Result)
93+ gtoResult :: rep x -> GColumns TColumns exprs (Col Result)
93
94
94
95
95instance GToExprs exprs rep => GToExprs (M1 D c exprs) (M1 D c rep) where
96instance GToExprs exprs rep => GToExprs (M1 D c exprs) (M1 D c rep) where
@@ -112,7 +113,7 @@ instance (GToExprs exprs1 rep1, GToExprs exprs2 rep2) =>
112instance
113instance
113 ( ToExprs exprs a
114 ( ToExprs exprs a
114 , KnownSymbol label
115 , KnownSymbol label
115− , GColumns (M1 S meta k1) ~ HLabel label (Columns exprs)
116+ , GColumns TColumns (M1 S meta k1) ~ HLabel label (Columns exprs)
116 , meta ~ 'MetaSel ('Just label) _su _ss _ds
117 , meta ~ 'MetaSel ('Just label) _su _ss _ds
117 , k1 ~ K1 i exprs
118 , k1 ~ K1 i exprs
118 , k1' ~ K1 i a
119 , k1' ~ K1 i a