git.iko.soy/rel8
on master help sign in
Introduce ADT meta-Rel8able for sum types
4bc16d3Shane O'Brien
rel8.cabal+3
compare with master
unifiedsplit
@@ -50,6 +50,7 @@ library
50 Rel8.Aggregate
50 Rel8.Aggregate
51
51
52 Rel8.Column
52 Rel8.Column
53+ Rel8.Column.ADT
53 Rel8.Column.Either
54 Rel8.Column.Either
54 Rel8.Column.Field
55 Rel8.Column.Field
55 Rel8.Column.Lift
56 Rel8.Column.Lift
@@ -143,6 +144,7 @@ library
143 Rel8.Statement.View
144 Rel8.Statement.View
144
145
145 Rel8.Table
146 Rel8.Table
147+ Rel8.Table.ADT
146 Rel8.Table.Aggregate
148 Rel8.Table.Aggregate
147 Rel8.Table.Alternative
149 Rel8.Table.Alternative
148 Rel8.Table.Bool
150 Rel8.Table.Bool
@@ -158,6 +160,7 @@ library
158 Rel8.Table.Ord
160 Rel8.Table.Ord
159 Rel8.Table.Order
161 Rel8.Table.Order
160 Rel8.Table.Recontextualize
162 Rel8.Table.Recontextualize
163+ Rel8.Table.Rel8able
161 Rel8.Table.Serialize
164 Rel8.Table.Serialize
162 Rel8.Table.Tag
165 Rel8.Table.Tag
163 Rel8.Table.These
166 Rel8.Table.These
src/Rel8.hs+7
@@ -33,6 +33,7 @@ module Rel8
33 , Rel8able, KRel8able
33 , Rel8able, KRel8able
34 , Column, Field, Necessity( Required, Optional )
34 , Column, Field, Necessity( Required, Optional )
35 , Default
35 , Default
36+ , HADT
36 , HEither
37 , HEither
37 , HMaybe
38 , HMaybe
38 , HList
39 , HList
@@ -81,6 +82,9 @@ module Rel8
81 , bindTheseTable
82 , bindTheseTable
82 , bitraverseTheseTable
83 , bitraverseTheseTable
83
84
85+ -- ** @ADT@
86+ , ADT
87+
84 -- ** @ListTable@
88 -- ** @ListTable@
85 , ListTable
89 , ListTable
86 , many
90 , many
@@ -251,6 +255,7 @@ import Prelude ()
251-- rel8
255-- rel8
252import Rel8.Aggregate
256import Rel8.Aggregate
253import Rel8.Column
257import Rel8.Column
258+import Rel8.Column.ADT
254import Rel8.Column.Either
259import Rel8.Column.Either
255import Rel8.Column.Field
260import Rel8.Column.Field
256import Rel8.Column.Lift
261import Rel8.Column.Lift
@@ -300,6 +305,7 @@ import Rel8.Statement.Select
300import Rel8.Statement.Update
305import Rel8.Statement.Update
301import Rel8.Statement.View
306import Rel8.Statement.View
302import Rel8.Table
307import Rel8.Table
308+import Rel8.Table.ADT
303import Rel8.Table.Aggregate
309import Rel8.Table.Aggregate
304import Rel8.Table.Alternative
310import Rel8.Table.Alternative
305import Rel8.Table.Bool
311import Rel8.Table.Bool
@@ -313,6 +319,7 @@ import Rel8.Table.Name
313import Rel8.Table.NonEmpty
319import Rel8.Table.NonEmpty
314import Rel8.Table.Ord
320import Rel8.Table.Ord
315import Rel8.Table.Order
321import Rel8.Table.Order
322+import Rel8.Table.Rel8able ()
316import Rel8.Table.Serialize
323import Rel8.Table.Serialize
317import Rel8.Table.These
324import Rel8.Table.These
318import Rel8.Type
325import Rel8.Type
src/Rel8/Column/ADT.hsnew file+94
@@ -0,0 +1,94 @@
1+{-# language DataKinds #-}
2+{-# language LambdaCase #-}
3+{-# language MultiParamTypeClasses #-}
4+{-# language StandaloneKindSignatures #-}
5+{-# language TypeFamilies #-}
6+{-# language UndecidableInstances #-}
7+
8+module Rel8.Column.ADT
9+ ( HADT, AHADT(..)
10+ )
11+where
12+
13+-- base
14+import Data.Kind ( Type )
15+import Prelude
16+
17+-- rel8
18+import Rel8.Generic.Rel8able
19+ ( Rel8able
20+ , GColumnsADT, gfromColumnsADT, gtoColumnsADT
21+ , greify, gunreify
22+ )
23+import Rel8.Kind.Context ( SContext(..), Reifiable, contextSing )
24+import Rel8.Schema.Context ( Col )
25+import qualified Rel8.Schema.Kind as K
26+import Rel8.Schema.Reify ( Reify, hreify, hunreify )
27+import Rel8.Schema.Result ( Result )
28+import Rel8.Table
29+ ( Table, Columns, Context, fromColumns, toColumns
30+ , Unreify, reify, unreify
31+ )
32+import Rel8.Table.ADT ( ADT( ADT ) )
33+import Rel8.Table.Recontextualize ( Recontextualize )
34+
35+
36+type HADT :: K.Context -> K.Rel8able -> Type
37+type family HADT context t where
38+ HADT (Reify context) t = AHADT context t
39+ HADT Result t = t Result
40+ HADT context t = ADT t context
41+
42+
43+type AHADT :: K.Context -> K.Rel8able -> Type
44+newtype AHADT context t = AHADT (HADT context t)
45+
46+
47+instance (Rel8able t, Reifiable context) =>
48+ Table (Reify context) (AHADT context t)
49+ where
50+ type Context (AHADT context t) = Reify context
51+ type Columns (AHADT context t) = GColumnsADT t
52+ type Unreify (AHADT context t) = HADT context t
53+
54+ fromColumns = sfromColumnsADT contextSing
55+ toColumns = stoColumnsADT contextSing
56+ reify _ = AHADT
57+ unreify _ (AHADT a) = a
58+
59+
60+instance
61+ ( Reifiable context, Reifiable context'
62+ , Rel8able t, t ~ t'
63+ )
64+ => Recontextualize
65+ (Reify context)
66+ (Reify context')
67+ (AHADT context t)
68+ (AHADT context' t')
69+
70+
71+sfromColumnsADT :: Rel8able t
72+ => SContext context
73+ -> GColumnsADT t (Col (Reify context))
74+ -> AHADT context t
75+sfromColumnsADT = \case
76+ SAggregate -> AHADT . ADT . hunreify
77+ SExpr -> AHADT . ADT . hunreify
78+ SInsert -> AHADT . ADT . hunreify
79+ SName -> AHADT . ADT . hunreify
80+ SResult -> AHADT . gunreify . gfromColumnsADT
81+ SReify context -> AHADT . sfromColumnsADT context . hunreify
82+
83+
84+stoColumnsADT :: Rel8able t
85+ => SContext context
86+ -> AHADT context t
87+ -> GColumnsADT t (Col (Reify context))
88+stoColumnsADT = \case
89+ SAggregate -> hreify . (\(AHADT (ADT a)) -> a)
90+ SExpr -> hreify . (\(AHADT (ADT a)) -> a)
91+ SInsert -> hreify . (\(AHADT (ADT a)) -> a)
92+ SName -> hreify . (\(AHADT (ADT a)) -> a)
93+ SResult -> gtoColumnsADT . greify . (\(AHADT a) -> a)
94+ SReify context -> hreify . stoColumnsADT context . (\(AHADT a) -> a)
src/Rel8/Generic/Rel8able.hs+86−58
@@ -11,12 +11,13 @@
11{-# language TypeFamilies #-}
11{-# language TypeFamilies #-}
12{-# language UndecidableInstances #-}
12{-# language UndecidableInstances #-}
13
13
14−{-# options_ghc -fno-warn-orphans #-}
15−
16module Rel8.Generic.Rel8able
14module Rel8.Generic.Rel8able
17 ( KRel8able, Rel8able
15 ( KRel8able, Rel8able
18− , GColumns, GContext, gfromColumns, gtoColumns, greify, gunreify
19 , Algebra
16 , Algebra
17+ , GRep
18+ , GColumns, GContext, gfromColumns, gtoColumns
19+ , GColumnsADT, gfromColumnsADT, gtoColumnsADT
20+ , greify, gunreify
20 )
21 )
21where
22where
22
23
@@ -28,11 +29,7 @@ import GHC.Generics ( Generic, Rep, from, to )
28import Prelude
29import Prelude
29
30
30-- rel8
31-- rel8
31−import Rel8.Kind.Context
32+import Rel8.Kind.Context ( Reifiable )
32− ( SContext( SReify )
33− , Reifiable, contextSing
34− , sLabelable, sReifiable
35− )
36import Rel8.FCF ( Eval, Exp )
33import Rel8.FCF ( Eval, Exp )
37import Rel8.Generic.Map ( GMap, GMappable, gmap, gunmap )
34import Rel8.Generic.Map ( GMap, GMappable, gmap, gunmap )
38import Rel8.Generic.Record ( Record(..) )
35import Rel8.Generic.Record ( Record(..) )
@@ -40,6 +37,7 @@ import Rel8.Generic.Table
40 ( GGTable, GGColumns, GGContext, ggfromColumns, ggtoColumns
37 ( GGTable, GGColumns, GGContext, ggfromColumns, ggtoColumns
41 , GAlgebra
38 , GAlgebra
42 )
39 )
40+import qualified Rel8.Generic.Table.ADT as G
43import Rel8.Kind.Algebra
41import Rel8.Kind.Algebra
44 ( SAlgebra( SProduct, SSum )
42 ( SAlgebra( SProduct, SSum )
45 , KnownAlgebra, algebraSing
43 , KnownAlgebra, algebraSing
@@ -47,48 +45,17 @@ import Rel8.Kind.Algebra
47import qualified Rel8.Kind.Algebra as K ( Algebra(..) )
45import qualified Rel8.Kind.Algebra as K ( Algebra(..) )
48import Rel8.Schema.Context ( Col )
46import Rel8.Schema.Context ( Col )
49import Rel8.Schema.Context.Label ( Labelable )
47import Rel8.Schema.Context.Label ( Labelable )
50−import Rel8.Schema.Dict ( Dict( Dict ) )
51import Rel8.Schema.HTable ( HTable )
48import Rel8.Schema.HTable ( HTable )
52import qualified Rel8.Schema.Kind as K
49import qualified Rel8.Schema.Kind as K
53import Rel8.Schema.Name ( Name )
50import Rel8.Schema.Name ( Name )
54−import Rel8.Schema.Reify
51+import Rel8.Schema.Reify ( Col( Reify ), Reify, UnwrapReify )
55− ( Col( Reify ), Reify, hreify, hunreify
56− , UnwrapReify
57− )
58import Rel8.Schema.Result ( Result )
52import Rel8.Schema.Result ( Result )
59import Rel8.Table
53import Rel8.Table
60− ( Table, Columns, Context, fromColumns, toColumns
54+ ( fromColumns, toColumns, reify, unreify
61− , Unreify, reify, unreify
62 , TTable, TColumns, TContext, TUnreify
55 , TTable, TColumns, TContext, TUnreify
63 )
56 )
64
57
65
58
66−instance
67− ( Rel8able t
68− , GContext t context ~ context
69− , Labelable context
70− , Reifiable context
71− )
72− => Table context (t context)
73− where
74− type Columns (t context) = GColumns t
75− type Context (t context) = context
76− type Unreify (t context) = t (UnwrapReify context)
77−
78− fromColumns = gunreify . gfromColumns . hreify
79− toColumns = hunreify . gtoColumns . greify
80−
81− reify Refl = case contextSing @context of
82− SReify context -> case sLabelable context of
83− Dict -> case sReifiable context of
84− Dict -> greify
85−
86− unreify Refl = case contextSing @context of
87− SReify context -> case sLabelable context of
88− Dict -> case sReifiable context of
89− Dict -> gunreify
90−
91−
92type KRel8able :: Type
59type KRel8able :: Type
93type KRel8able = K.Rel8able
60type KRel8able = K.Rel8able
94
61
@@ -136,9 +103,19 @@ type KRel8able = K.Rel8able
136-- deriving ( GHC.Generics.Generic, Rel8able )
103-- deriving ( GHC.Generics.Generic, Rel8able )
137-- @
104-- @
138type Rel8able :: K.Rel8able -> Constraint
105type Rel8able :: K.Rel8able -> Constraint
106+class
139−class HTable (GColumns t) => Rel8able t where
107+ ( HTable (GColumns t)
108+ , HTable (GColumnsADT t)
109+ , GContext t Result ~ Result
110+ )
111+ => Rel8able t
112+ where
140 type Algebra t :: K.Algebra
113 type Algebra t :: K.Algebra
114+
115+ type GRep t (context :: K.Context) :: Type -> Type
116+
141 type GColumns t :: K.HTable
117 type GColumns t :: K.HTable
118+
142 type GContext t (context :: K.Context) :: K.Context
119 type GContext t (context :: K.Context) :: K.Context
143
120
144 gfromColumns :: (Labelable context, Reifiable context, GContext t context ~ context)
121 gfromColumns :: (Labelable context, Reifiable context, GContext t context ~ context)
@@ -147,21 +124,31 @@ class HTable (GColumns t) => Rel8able t where
147 gtoColumns :: (Labelable context, Reifiable context, GContext t context ~ context)
124 gtoColumns :: (Labelable context, Reifiable context, GContext t context ~ context)
148 => t (Reify context) -> GColumns t (Col (Reify context))
125 => t (Reify context) -> GColumns t (Col (Reify context))
149
126
127+ gfromColumnsADT :: GColumnsADT t (Col (Reify Result)) -> t (Reify Result)
128+
129+ gtoColumnsADT :: t (Reify Result) -> GColumnsADT t (Col (Reify Result))
130+
150 greify :: (Labelable context, Reifiable context)
131 greify :: (Labelable context, Reifiable context)
151 => t context -> t (Reify context)
132 => t context -> t (Reify context)
152
133
153 gunreify :: (Labelable context, Reifiable context)
134 gunreify :: (Labelable context, Reifiable context)
154 => t (Reify context) -> t context
135 => t (Reify context) -> t context
155
136
156− type Algebra t = GAlgebra (Rep (Record (t (Reify Name))))
137+ type Algebra t = GAlgebra (GRep t (Reify Name))
138+
139+ type GRep t context = Rep (Record (t context))
140+
157− type GColumns t = Eval (GGColumns (Algebra t) TColumns (Rep (Record (t (Reify Name)))))
141+ type GColumns t = Eval (GGColumns (Algebra t) TColumns (GRep t (Reify Name)))
142+
143+ type GContext t context =
158− type GContext t context = Eval (GGContext (Algebra t) TUnreifyContext (Rep (Record (t (Reify context)))))
144+ Eval (GGContext (Algebra t) TUnreifyContext (GRep t (Reify context)))
159
145
160 default gfromColumns :: forall context.
146 default gfromColumns :: forall context.
161 ( Generic (Record (t (Reify context)))
147 ( Generic (Record (t (Reify context)))
148+ , GRep t (Reify context) ~ Rep (Record (t (Reify context)))
162 , KnownAlgebra (Algebra t)
149 , KnownAlgebra (Algebra t)
163− , Eval (GGTable (Algebra t) (TTable (Reify context)) TColumns (Col (Reify context)) (Rep (Record (t (Reify context)))))
150+ , Eval (GGTable (Algebra t) (TTable (Reify context)) TColumns (Col (Reify context)) (GRep t (Reify context)))
164− , Eval (GGColumns (Algebra t) TColumns (Rep (Record (t (Reify context))))) ~ GColumns t
151+ , Eval (GGColumns (Algebra t) TColumns (GRep t (Reify context))) ~ GColumns t
165 , Constraints t context
152 , Constraints t context
166 )
153 )
167 => GColumns t (Col (Reify context)) -> t (Reify context)
154 => GColumns t (Col (Reify context)) -> t (Reify context)
@@ -179,9 +166,10 @@ class HTable (GColumns t) => Rel8able t where
179
166
180 default gtoColumns :: forall context.
167 default gtoColumns :: forall context.
181 ( Generic (Record (t (Reify context)))
168 ( Generic (Record (t (Reify context)))
169+ , GRep t (Reify context) ~ Rep (Record (t (Reify context)))
182 , KnownAlgebra (Algebra t)
170 , KnownAlgebra (Algebra t)
183− , Eval (GGTable (Algebra t) (TTable (Reify context)) TColumns (Col (Reify context)) (Rep (Record (t (Reify context)))))
171+ , Eval (GGTable (Algebra t) (TTable (Reify context)) TColumns (Col (Reify context)) (GRep t (Reify context)))
184− , Eval (GGColumns (Algebra t) TColumns (Rep (Record (t (Reify context))))) ~ GColumns t
172+ , Eval (GGColumns (Algebra t) TColumns (GRep t (Reify context))) ~ GColumns t
185 , Constraints t context
173 , Constraints t context
186 )
174 )
187 => t (Reify context) -> GColumns t (Col (Reify context))
175 => t (Reify context) -> GColumns t (Col (Reify context))
@@ -197,11 +185,47 @@ class HTable (GColumns t) => Rel8able t where
197 from .
185 from .
198 Record
186 Record
199
187
188+ default gfromColumnsADT ::
189+ ( Generic (Record (t (Reify Result)))
190+ , GRep t (Reify Result) ~ Rep (Record (t (Reify Result)))
191+ , G.GTableADT (TTable (Reify Result)) TColumns (Col (Reify Result)) (GRep t (Reify Result))
192+ , G.GColumnsADT TColumns (GRep t (Reify Result)) ~ GColumnsADT t
193+ )
194+ => GColumnsADT t (Col (Reify Result)) -> t (Reify Result)
195+ gfromColumnsADT =
196+ unrecord .
197+ to .
198+ G.gfromColumnsADT
199+ @(TTable (Reify Result))
200+ @TColumns
201+ (\(Reify a) -> a)
202+ Reify
203+ fromColumns
204+
205+ default gtoColumnsADT ::
206+ ( Generic (Record (t (Reify Result)))
207+ , GRep t (Reify Result) ~ Rep (Record (t (Reify Result)))
208+ , G.GTableADT (TTable (Reify Result)) TColumns (Col (Reify Result)) (GRep t (Reify Result))
209+ , G.GColumnsADT TColumns (GRep t (Reify Result)) ~ GColumnsADT t
210+ )
211+ => t (Reify Result) -> GColumnsADT t (Col (Reify Result))
212+ gtoColumnsADT =
213+ G.gtoColumnsADT
214+ @(TTable (Reify Result))
215+ @TColumns
216+ (\(Reify a) -> a)
217+ Reify
218+ toColumns .
219+ from .
220+ Record
221+
200 default greify :: forall context.
222 default greify :: forall context.
201 ( Generic (Record (t context))
223 ( Generic (Record (t context))
224+ , GRep t context ~ Rep (Record (t context))
202 , Generic (Record (t (Reify context)))
225 , Generic (Record (t (Reify context)))
226+ , GRep t (Reify context) ~ Rep (Record (t (Reify context)))
203− , GMappable (TTable (Reify context)) (Rep (Record (t (Reify context))))
227+ , GMappable (TTable (Reify context)) (GRep t (Reify context))
204− , Rep (Record (t context)) ~ GMap TUnreify (Rep (Record (t (Reify context))))
228+ , GRep t context ~ GMap TUnreify (GRep t (Reify context))
205 )
229 )
206 => t context -> t (Reify context)
230 => t context -> t (Reify context)
207 greify =
231 greify =
@@ -213,9 +237,11 @@ class HTable (GColumns t) => Rel8able t where
213
237
214 default gunreify :: forall context.
238 default gunreify :: forall context.
215 ( Generic (Record (t context))
239 ( Generic (Record (t context))
240+ , GRep t context ~ Rep (Record (t context))
216 , Generic (Record (t (Reify context)))
241 , Generic (Record (t (Reify context)))
242+ , GRep t (Reify context) ~ Rep (Record (t (Reify context)))
217− , GMappable (TTable (Reify context)) (Rep (Record (t (Reify context))))
243+ , GMappable (TTable (Reify context)) (GRep t (Reify context))
218− , Rep (Record (t context)) ~ GMap TUnreify (Rep (Record (t (Reify context))))
244+ , GRep t context ~ GMap TUnreify (GRep t (Reify context))
219 )
245 )
220 => t (Reify context) -> t context
246 => t (Reify context) -> t context
221 gunreify =
247 gunreify =
@@ -226,6 +252,9 @@ class HTable (GColumns t) => Rel8able t where
226 Record
252 Record
227
253
228
254
255+type GColumnsADT t = G.GColumnsADT TColumns (GRep t (Reify Name))
256+
257+
229data TUnreifyContext :: Type -> Exp K.Context
258data TUnreifyContext :: Type -> Exp K.Context
230type instance Eval (TUnreifyContext a) = UnwrapReify (Eval (TContext a))
259type instance Eval (TUnreifyContext a) = UnwrapReify (Eval (TContext a))
231
260
@@ -237,9 +266,8 @@ type Constraints t context = Constraints' (Algebra t) t context
237type Constraints' :: K.Algebra -> K.Rel8able -> K.Context -> Constraint
266type Constraints' :: K.Algebra -> K.Rel8able -> K.Context -> Constraint
238type family Constraints' algebra t context where
267type family Constraints' algebra t context where
239 Constraints' 'K.Product t context =
268 Constraints' 'K.Product t context =
240− ( Eval (GGContext 'K.Product TContext (Rep (Record (t (Reify context))))) ~
269+ Eval (GGContext 'K.Product TContext (GRep t (Reify context))) ~
241− Reify context
270+ Reify context
242− )
243 Constraints' 'K.Sum _ context = context ~ Result
271 Constraints' 'K.Sum _ context = context ~ Result
244
272
245
273
@@ -248,7 +276,7 @@ fromContext :: forall t context spec.
248 , Constraints t context
276 , Constraints t context
249 )
277 )
250 => Col (Reify context) spec
278 => Col (Reify context) spec
251− -> Col (Eval (GGContext (Algebra t) TContext (Rep (Record (t (Reify context)))))) spec
279+ -> Col (Eval (GGContext (Algebra t) TContext (GRep t (Reify context)))) spec
252fromContext = case algebraSing @(Algebra t) of
280fromContext = case algebraSing @(Algebra t) of
253 SProduct -> id
281 SProduct -> id
254 SSum -> \(Reify a) -> a
282 SSum -> \(Reify a) -> a
@@ -258,7 +286,7 @@ toContext :: forall t context spec.
258 ( KnownAlgebra (Algebra t)
286 ( KnownAlgebra (Algebra t)
259 , Constraints t context
287 , Constraints t context
260 )
288 )
261− => Col (Eval (GGContext (Algebra t) TContext (Rep (Record (t (Reify context)))))) spec
289+ => Col (Eval (GGContext (Algebra t) TContext (GRep t (Reify context)))) spec
262 -> Col (Reify context) spec
290 -> Col (Reify context) spec
263toContext = case algebraSing @(Algebra t) of
291toContext = case algebraSing @(Algebra t) of
264 SProduct -> id
292 SProduct -> id
src/Rel8/Generic/Rel8able/Test.hs+8
@@ -124,3 +124,11 @@ data TableSum f
124 | TableSumC (Column f Text)
124 | TableSumC (Column f Text)
125 deriving stock Generic
125 deriving stock Generic
126 deriving anyclass Rel8able
126 deriving anyclass Rel8able
127+
128+
129+data TableProduct f = TableProduct
130+ { sum :: HADT f TableSum
131+ , list :: TableList f
132+ }
133+ deriving stock Generic
134+ deriving anyclass Rel8able
src/Rel8/Table/ADT.hsnew file+46
@@ -0,0 +1,46 @@
1+{-# language DataKinds #-}
2+{-# language StandaloneKindSignatures #-}
3+{-# language TypeFamilies #-}
4+{-# language UndecidableInstances #-}
5+
6+module Rel8.Table.ADT
7+ ( ADT( ADT )
8+ )
9+where
10+
11+-- base
12+import Prelude ()
13+
14+-- rel8
15+import Rel8.Generic.Rel8able
16+ ( Rel8able, Algebra
17+ , GRep, GColumns, GContext, gfromColumns, gtoColumns
18+ , GColumnsADT, gfromColumnsADT, gtoColumnsADT
19+ , greify, gunreify
20+ )
21+import qualified Rel8.Kind.Algebra as K
22+import Rel8.Schema.Context ( Col )
23+import qualified Rel8.Schema.Kind as K
24+import Rel8.Schema.Reify ( hreify, hunreify )
25+
26+
27+type ADT :: K.Rel8able -> K.Rel8able
28+newtype ADT t context = ADT (GColumnsADT t (Col context))
29+
30+
31+instance Rel8able t => Rel8able (ADT t) where
32+ type Algebra (ADT t) = 'K.Product
33+
34+ type GRep (ADT t) context = GRep t context
35+
36+ type GColumns (ADT t) = GColumnsADT t
37+ type GContext (ADT t) context = context
38+
39+ gfromColumns = ADT
40+ gtoColumns (ADT a) = a
41+
42+ gfromColumnsADT = ADT
43+ gtoColumnsADT (ADT a) = a
44+
45+ greify (ADT a) = ADT (hreify a)
46+ gunreify (ADT a) = ADT (hunreify a)
src/Rel8/Table/Eq.hs−11
@@ -44,7 +44,6 @@ import Rel8.Schema.HTable
44 , htabulateA, hfield, hdicts
44 , htabulateA, hfield, hdicts
45 )
45 )
46import Rel8.Schema.HTable.Type ( HType(..) )
46import Rel8.Schema.HTable.Type ( HType(..) )
47−import Rel8.Schema.Kind ( Context )
48import Rel8.Schema.Null ( Sql )
47import Rel8.Schema.Null ( Sql )
49import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType, nullifier )
48import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType, nullifier )
50import Rel8.Table ( Table, Columns, toColumns, TColumns )
49import Rel8.Table ( Table, Columns, toColumns, TColumns )
@@ -80,16 +79,6 @@ data TEqTable :: Type -> Exp Constraint
80type instance Eval (TEqTable a) = EqTable a
79type instance Eval (TEqTable a) = EqTable a
81
80
82
81
83−instance
84− ( Table Expr (t (Expr :: Context))
85− , f ~ Expr
86− , HConstrainTable (Columns (t Expr)) (ConstrainDBType DBEq)
87− )
88− => EqTable (t f)
89− where
90− eqTable = hdicts @(Columns (t f)) @(ConstrainDBType DBEq)
91−
92−
93instance
82instance
94 ( HTable t
83 ( HTable t
95 , f ~ Col Expr
84 , f ~ Col Expr
src/Rel8/Table/NonEmpty.hs−1
@@ -3,7 +3,6 @@
3{-# language FlexibleInstances #-}
3{-# language FlexibleInstances #-}
4{-# language MultiParamTypeClasses #-}
4{-# language MultiParamTypeClasses #-}
5{-# language NamedFieldPuns #-}
5{-# language NamedFieldPuns #-}
6−{-# language QuantifiedConstraints #-}
7{-# language ScopedTypeVariables #-}
6{-# language ScopedTypeVariables #-}
8{-# language StandaloneKindSignatures #-}
7{-# language StandaloneKindSignatures #-}
9{-# language TypeApplications #-}
8{-# language TypeApplications #-}
src/Rel8/Table/Ord.hs+1−13
@@ -42,10 +42,9 @@ import Rel8.Schema.HTable
42 , htabulateA, hfield, hdicts
42 , htabulateA, hfield, hdicts
43 )
43 )
44import Rel8.Schema.HTable.Type ( HType(..) )
44import Rel8.Schema.HTable.Type ( HType(..) )
45−import Rel8.Schema.Kind ( Context )
46import Rel8.Schema.Null (Sql)
45import Rel8.Schema.Null (Sql)
47import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType, nullifier )
46import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType, nullifier )
48−import Rel8.Table ( Table, Columns, toColumns, TColumns )
47+import Rel8.Table ( Columns, toColumns, TColumns )
49import Rel8.Table.Bool ( bool )
48import Rel8.Table.Bool ( bool )
50import Rel8.Table.Eq ( EqTable )
49import Rel8.Table.Eq ( EqTable )
51import Rel8.Type.Eq ( DBEq )
50import Rel8.Type.Eq ( DBEq )
@@ -81,17 +80,6 @@ data TOrdTable :: Type -> Exp Constraint
81type instance Eval (TOrdTable a) = OrdTable a
80type instance Eval (TOrdTable a) = OrdTable a
82
81
83
82
84−instance
85− ( Table Expr (t (Expr :: Context))
86− , f ~ Expr
87− , HConstrainTable (Columns (t Expr)) (ConstrainDBType DBEq)
88− , HConstrainTable (Columns (t Expr)) (ConstrainDBType DBOrd)
89− )
90− => OrdTable (t f)
91− where
92− ordTable = hdicts @(Columns (t f)) @(ConstrainDBType DBOrd)
93−
94−
95instance
83instance
96 ( HTable t
84 ( HTable t
97 , f ~ Col Expr
85 , f ~ Col Expr
src/Rel8/Table/Recontextualize.hs+8−11
@@ -48,19 +48,13 @@ instance Sql DBType a => Recontextualize Result Result (Identity a) (Identity a)
48instance HTable t => Recontextualize from to (t (Col from)) (t (Col to))
48instance HTable t => Recontextualize from to (t (Col from)) (t (Col to))
49
49
50
50
51−instance
52− ( Table from (t from)
53− , Table to (t to)
54− , Congruent (t from) (t to)
55− ) => Recontextualize from to (t from) (t to)
56−
57−
58instance
51instance
59 ( Recontextualize from to a1 b1
52 ( Recontextualize from to a1 b1
60 , Recontextualize from to a2 b2
53 , Recontextualize from to a2 b2
61 , Labelable from
54 , Labelable from
62 , Labelable to
55 , Labelable to
56+ )
63− ) => Recontextualize from to (a1, a2) (b1, b2)
57+ => Recontextualize from to (a1, a2) (b1, b2)
64
58
65
59
66instance
60instance
@@ -68,7 +62,8 @@ instance
68 , Recontextualize from to a2 b2
62 , Recontextualize from to a2 b2
69 , Recontextualize from to a3 b3
63 , Recontextualize from to a3 b3
70 , Labelable from, Labelable to
64 , Labelable from, Labelable to
65+ )
71− ) => Recontextualize from to (a1, a2, a3) (b1, b2, b3)
66+ => Recontextualize from to (a1, a2, a3) (b1, b2, b3)
72
67
73
68
74instance
69instance
@@ -77,7 +72,8 @@ instance
77 , Recontextualize from to a3 b3
72 , Recontextualize from to a3 b3
78 , Recontextualize from to a4 b4
73 , Recontextualize from to a4 b4
79 , Labelable from, Labelable to
74 , Labelable from, Labelable to
75+ )
80− ) => Recontextualize from to (a1, a2, a3, a4) (b1, b2, b3, b4)
76+ => Recontextualize from to (a1, a2, a3, a4) (b1, b2, b3, b4)
81
77
82
78
83instance
79instance
@@ -87,4 +83,5 @@ instance
87 , Recontextualize from to a4 b4
83 , Recontextualize from to a4 b4
88 , Recontextualize from to a5 b5
84 , Recontextualize from to a5 b5
89 , Labelable from, Labelable to
85 , Labelable from, Labelable to
86+ )
90− ) => Recontextualize from to (a1, a2, a3, a4, a5) (b1, b2, b3, b4, b5)
87+ => Recontextualize from to (a1, a2, a3, a4, a5) (b1, b2, b3, b4, b5)
src/Rel8/Table/Rel8able.hsnew file+167
@@ -0,0 +1,167 @@
1+{-# language DataKinds #-}
2+{-# language FlexibleInstances #-}
3+{-# language FunctionalDependencies #-}
4+{-# language ScopedTypeVariables #-}
5+{-# language StandaloneKindSignatures #-}
6+{-# language TypeApplications #-}
7+{-# language TypeFamilies #-}
8+{-# language UndecidableInstances #-}
9+
10+{-# options_ghc -fno-warn-orphans #-}
11+
12+module Rel8.Table.Rel8able
13+ (
14+ )
15+where
16+
17+-- base
18+import Data.Kind ( Constraint )
19+import Data.Type.Equality ( (:~:)( Refl ) )
20+import Prelude
21+
22+-- rel8
23+import Rel8.Expr ( Expr )
24+import qualified Rel8.Kind.Algebra as K
25+import Rel8.Kind.Context
26+ ( SContext( SReify )
27+ , Reifiable, contextSing
28+ , sLabelable, sReifiable
29+ )
30+import Rel8.Generic.Rel8able
31+ ( Rel8able, Algebra
32+ , GColumns, GContext, gfromColumns, gtoColumns
33+ , gfromColumnsADT, gtoColumnsADT
34+ , greify, gunreify
35+ )
36+import Rel8.Schema.Context ( Col )
37+import Rel8.Schema.Context.Label ( Labelable )
38+import Rel8.Schema.Dict ( Dict( Dict ) )
39+import qualified Rel8.Schema.Kind as K
40+import Rel8.Schema.HTable ( HConstrainTable, hdicts )
41+import Rel8.Schema.Reify ( hreify, hunreify, UnwrapReify )
42+import Rel8.Schema.Result ( Result )
43+import Rel8.Table
44+ ( Table, Columns, Context, Congruent, fromColumns, toColumns
45+ , Unreify, reify, unreify
46+ )
47+import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
48+import Rel8.Table.ADT ( ADT )
49+import Rel8.Table.Eq ( EqTable, eqTable )
50+import Rel8.Table.Ord ( OrdTable, ordTable )
51+import Rel8.Table.Recontextualize ( Recontextualize )
52+import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
53+import Rel8.Type.Eq ( DBEq )
54+import Rel8.Type.Ord ( DBOrd )
55+
56+
57+instance
58+ ( Rel8able t
59+ , GContext t context ~ context
60+ , Labelable context
61+ , Reifiable context
62+ )
63+ => Table context (t context)
64+ where
65+ type Columns (t context) = GColumns t
66+ type Context (t context) = context
67+ type Unreify (t context) = t (UnwrapReify context)
68+
69+ fromColumns = gunreify . gfromColumns . hreify
70+ toColumns = hunreify . gtoColumns . greify
71+
72+ reify Refl = case contextSing @context of
73+ SReify context -> case sLabelable context of
74+ Dict -> case sReifiable context of
75+ Dict -> greify
76+
77+ unreify Refl = case contextSing @context of
78+ SReify context -> case sLabelable context of
79+ Dict -> case sReifiable context of
80+ Dict -> gunreify
81+
82+
83+instance
84+ ( Rel8able t
85+ , Labelable from, Reifiable from, GContext t from ~ from
86+ , Labelable to, Reifiable to, GContext t to ~ to
87+ , Congruent (t from) (t to)
88+ )
89+ => Recontextualize from to (t from) (t to)
90+
91+
92+instance
93+ ( context ~ Expr
94+ , Rel8able t
95+ , GContext t context ~ context
96+ , HConstrainTable (Columns (t context)) (ConstrainDBType DBEq)
97+ )
98+ => EqTable (t context)
99+ where
100+ eqTable = hdicts @(Columns (t context)) @(ConstrainDBType DBEq)
101+
102+
103+instance
104+ ( context ~ Expr
105+ , Rel8able t
106+ , GContext t context ~ context
107+ , HConstrainTable (Columns (t context)) (ConstrainDBType DBEq)
108+ , HConstrainTable (Columns (t context)) (ConstrainDBType DBOrd)
109+ )
110+ => OrdTable (t context)
111+ where
112+ ordTable = hdicts @(Columns (t context)) @(ConstrainDBType DBOrd)
113+
114+
115+type instance FromExprs (t Expr) = FromExprs' t Result
116+
117+
118+instance
119+ ( x ~ t' Expr
120+ , result ~ Result
121+ , ToExprs' (Algebra t) t' t
122+ )
123+ => ToExprs x (t result)
124+ where
125+ fromResult = fromResult' @(Algebra t) @t'
126+ toResult = toResult' @(Algebra t) @t'
127+
128+
129+type FromExprs' :: K.Rel8able -> K.Rel8able
130+type family FromExprs' t where
131+ FromExprs' (ADT t) = t
132+ FromExprs' t = t
133+
134+
135+type ToExprs' :: K.Algebra -> K.Rel8able -> K.Rel8able -> Constraint
136+class
137+ ( algebra ~ Algebra t
138+ , Rel8able t'
139+ , GContext t' Expr ~ Expr
140+ )
141+ => ToExprs' algebra t' t | algebra t -> t'
142+ where
143+ fromResult' :: GColumns t' (Col Result) -> t Result
144+ toResult' :: t Result -> GColumns t' (Col Result)
145+
146+
147+instance
148+ ( Algebra t ~ 'K.Product
149+ , Rel8able t
150+ , GContext t Expr ~ Expr
151+ , t ~ t'
152+ )
153+ => ToExprs' 'K.Product t' t
154+ where
155+ fromResult' = fromColumns
156+ toResult' = toColumns
157+
158+
159+instance
160+ ( Algebra t ~ 'K.Sum
161+ , Rel8able t
162+ , t' ~ ADT t
163+ )
164+ => ToExprs' 'K.Sum t' t
165+ where
166+ fromResult' = gunreify . gfromColumnsADT . hreify
167+ toResult' = hunreify . gtoColumnsADT . greify
src/Rel8/Table/Serialize.hs+2−11
@@ -15,8 +15,8 @@
15
15
16module Rel8.Table.Serialize
16module Rel8.Table.Serialize
17 ( Serializable, lit, parse
17 ( Serializable, lit, parse
18− , ToExprs(..)
18+ , ToExprs(..), FromExprs
19− , FromExprs
19+ , TToExprs
20 )
20 )
21where
21where
22
22
@@ -50,7 +50,6 @@ import Rel8.Table.Either ( EitherTable )
50import Rel8.Table.List ( ListTable )
50import Rel8.Table.List ( ListTable )
51import Rel8.Table.Maybe ( MaybeTable )
51import Rel8.Table.Maybe ( MaybeTable )
52import Rel8.Table.NonEmpty ( NonEmptyTable )
52import Rel8.Table.NonEmpty ( NonEmptyTable )
53−import Rel8.Table.Recontextualize ( Recontextualize )
54import Rel8.Table.These ( TheseTable )
53import Rel8.Table.These ( TheseTable )
55import Rel8.Type ( DBType )
54import Rel8.Type ( DBType )
56
55
@@ -231,13 +230,6 @@ instance (HTable t, result ~ Col Result, x ~ t (Col Expr)) =>
231 toResult = id
230 toResult = id
232
231
233
232
234−instance (Recontextualize Result Expr (t Result) (t Expr), result ~ Result, x ~ t Expr) =>
235− ToExprs x (t result)
236− where
237− fromResult = fromColumns
238− toResult = toColumns
239−
240−
241instance (KnownSpec spec, x ~ Col Expr spec) =>
233instance (KnownSpec spec, x ~ Col Expr spec) =>
242 ToExprs x (Col Result spec)
234 ToExprs x (Col Result spec)
243 where
235 where
@@ -268,7 +260,6 @@ type instance FromExprs (a, b, c, d, e, f, g) =
268 ( FromExprs a, FromExprs b, FromExprs c, FromExprs d, FromExprs e
260 ( FromExprs a, FromExprs b, FromExprs c, FromExprs d, FromExprs e
269 , FromExprs f, FromExprs g
261 , FromExprs f, FromExprs g
270 )
262 )
271−type instance FromExprs (t Expr) = t Result
272type instance FromExprs (t (Col Expr)) = t (Col Result)
263type instance FromExprs (t (Col Expr)) = t (Col Result)
273
264
274
265