git.iko.soy/rel8
on master help sign in
Add reify and unreify to Table class
1c73ec6Shane O'Brien
rel8.cabal+3
compare with master
unifiedsplit
@@ -63,6 +63,7 @@ library
63
63
64 Rel8.FCF
64 Rel8.FCF
65
65
66+ Rel8.Kind.Context
66 Rel8.Kind.Labels
67 Rel8.Kind.Labels
67 Rel8.Kind.Necessity
68 Rel8.Kind.Necessity
68
69
@@ -115,6 +116,7 @@ library
115 Rel8.Schema.Kind
116 Rel8.Schema.Kind
116 Rel8.Schema.Name
117 Rel8.Schema.Name
117 Rel8.Schema.Null
118 Rel8.Schema.Null
119+ Rel8.Schema.Reify
118 Rel8.Schema.Result
120 Rel8.Schema.Result
119 Rel8.Schema.Spec
121 Rel8.Schema.Spec
120 Rel8.Schema.Spec.ConstrainDBType
122 Rel8.Schema.Spec.ConstrainDBType
@@ -148,6 +150,7 @@ library
148 Rel8.Table.Tag
150 Rel8.Table.Tag
149 Rel8.Table.These
151 Rel8.Table.These
150 Rel8.Table.Undefined
152 Rel8.Table.Undefined
153+ Rel8.Table.Unreify
151
154
152 Rel8.Type
155 Rel8.Type
153 Rel8.Type.Array
156 Rel8.Type.Array
src/Rel8/Aggregate.hs+8−1
@@ -37,9 +37,13 @@ import Rel8.Schema.Context.Label ( Labelable(..) )
37import Rel8.Schema.HTable ( hfield, htabulate, htabulateA, hspecs )
37import Rel8.Schema.HTable ( hfield, htabulate, htabulateA, hspecs )
38import Rel8.Schema.Name ( Name )
38import Rel8.Schema.Name ( Name )
39import Rel8.Schema.Null ( Sql )
39import Rel8.Schema.Null ( Sql )
40+import Rel8.Schema.Reify ( notReify )
40import Rel8.Schema.Result ( Result )
41import Rel8.Schema.Result ( Result )
41import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
42import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
43+import Rel8.Table
42−import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
44+ ( Table, Columns, Context, fromColumns, toColumns
45+ , reify, unreify
46+ )
43import Rel8.Table.Recontextualize ( Recontextualize )
47import Rel8.Table.Recontextualize ( Recontextualize )
44import Rel8.Type ( DBType )
48import Rel8.Type ( DBType )
45
49
@@ -82,6 +86,9 @@ instance Table Expr a => Table Aggregate (Aggregate a) where
82 case hfield as field of
86 case hfield as field of
83 Aggregation a -> DB <$> a
87 Aggregation a -> DB <$> a
84
88
89+ reify = notReify
90+ unreify = notReify
91+
85
92
86instance Sql DBType a =>
93instance Sql DBType a =>
87 Recontextualize Aggregate Aggregate (Aggregate (Expr a)) (Aggregate (Expr a))
94 Recontextualize Aggregate Aggregate (Aggregate (Expr a)) (Aggregate (Expr a))
src/Rel8/Expr.hs+6−1
@@ -41,9 +41,12 @@ import Rel8.Schema.Context ( Interpretation, Col )
41import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
41import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
42import Rel8.Schema.HTable.Type ( HType( HType ) )
42import Rel8.Schema.HTable.Type ( HType( HType ) )
43import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )
43import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )
44+import Rel8.Schema.Reify ( notReify )
44import Rel8.Schema.Result ( Result )
45import Rel8.Schema.Result ( Result )
45import Rel8.Schema.Spec ( Spec( Spec ) )
46import Rel8.Schema.Spec ( Spec( Spec ) )
47+import Rel8.Table
46−import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
48+ ( Table, Columns, Context, fromColumns, toColumns, reify, unreify
49+ )
47import Rel8.Table.Recontextualize ( Recontextualize )
50import Rel8.Table.Recontextualize ( Recontextualize )
48import Rel8.Type ( DBType )
51import Rel8.Type ( DBType )
49import Rel8.Type.Monoid ( DBMonoid, memptyExpr )
52import Rel8.Type.Monoid ( DBMonoid, memptyExpr )
@@ -112,6 +115,8 @@ instance Sql DBType a => Table Expr (Expr a) where
112
115
113 toColumns a = HType (DB a)
116 toColumns a = HType (DB a)
114 fromColumns (HType (DB a)) = a
117 fromColumns (HType (DB a)) = a
118+ reify = notReify
119+ unreify = notReify
115
120
116
121
117instance Sql DBType a => Recontextualize Expr Expr (Expr a) (Expr a)
122instance Sql DBType a => Recontextualize Expr Expr (Expr a) (Expr a)
src/Rel8/Generic/Table.hs+38−2
@@ -12,7 +12,8 @@
12{-# language UndecidableInstances #-}
12{-# language UndecidableInstances #-}
13
13
14module Rel8.Generic.Table
14module Rel8.Generic.Table
15+ ( GTable, GColumns, GContext, GUnreify
15− ( GTable, GColumns, GContext, fromGColumns, toGColumns, gtable
16+ , fromGColumns, toGColumns, gtable, greify, gunreify
16 )
17 )
17where
18where
18
19
@@ -53,6 +54,14 @@ type family GContext _Context rep where
53 GContext _Context (K1 _ a) = Eval (_Context a)
54 GContext _Context (K1 _ a) = Eval (_Context a)
54
55
55
56
57+type GUnreify :: (Type -> Exp a) -> (Type -> Type) -> Type -> Type
58+type family GUnreify _Unreify rep where
59+ GUnreify _Unreify (M1 i c rep) = M1 i c (GUnreify _Unreify rep)
60+ GUnreify _Unreify (rep1 :*: rep2) =
61+ GUnreify _Unreify rep1 :*: GUnreify _Unreify rep2
62+ GUnreify _Unreify (K1 i a) = K1 i (Eval (_Unreify a))
63+
64+
56type GTable
65type GTable
57 :: (Type -> Exp Constraint)
66 :: (Type -> Exp Constraint)
58 -> (Type -> Exp K.HTable)
67 -> (Type -> Exp K.HTable)
@@ -73,6 +82,18 @@ class GTable _Table _Columns context rep
73 => (forall a. Eval (_Table a) => Proxy a -> Eval (_Columns a) context)
82 => (forall a. Eval (_Table a) => Proxy a -> Eval (_Columns a) context)
74 -> GColumns _Columns rep context
83 -> GColumns _Columns rep context
75
84
85+ greify :: ()
86+ => Proxy _Unreify
87+ -> (forall a. Eval (_Table a) => Eval (_Unreify a) -> a)
88+ -> GUnreify _Unreify rep x
89+ -> rep x
90+
91+ gunreify :: ()
92+ => Proxy _Unreify
93+ -> (forall a. Eval (_Table a) => a -> Eval (_Unreify a))
94+ -> rep x
95+ -> GUnreify _Unreify rep x
96+
76
97
77instance GTable _Table _Columns context rep =>
98instance GTable _Table _Columns context rep =>
78 GTable _Table _Columns context (M1 D c rep)
99 GTable _Table _Columns context (M1 D c rep)
@@ -82,6 +103,10 @@ instance GTable _Table _Columns context rep =>
82 toGColumns toColumns (M1 a) =
103 toGColumns toColumns (M1 a) =
83 toGColumns @_Table @_Columns @context @rep toColumns a
104 toGColumns @_Table @_Columns @context @rep toColumns a
84 gtable = gtable @_Table @_Columns @context @rep
105 gtable = gtable @_Table @_Columns @context @rep
106+ greify proxy reify (M1 a) =
107+ M1 (greify @_Table @_Columns @context @rep proxy reify a)
108+ gunreify proxy unreify (M1 a) =
109+ M1 (gunreify @_Table @_Columns @context @rep proxy unreify a)
85
110
86
111
87instance GTable _Table _Columns context rep =>
112instance GTable _Table _Columns context rep =>
@@ -92,6 +117,10 @@ instance GTable _Table _Columns context rep =>
92 toGColumns toColumns (M1 a) =
117 toGColumns toColumns (M1 a) =
93 toGColumns @_Table @_Columns @context @rep toColumns a
118 toGColumns @_Table @_Columns @context @rep toColumns a
94 gtable = gtable @_Table @_Columns @context @rep
119 gtable = gtable @_Table @_Columns @context @rep
120+ greify proxy reify (M1 a) =
121+ M1 (greify @_Table @_Columns @context @rep proxy reify a)
122+ gunreify proxy unreify (M1 a) =
123+ M1 (gunreify @_Table @_Columns @context @rep proxy unreify a)
95
124
96
125
97instance
126instance
@@ -109,6 +138,12 @@ instance
109 gtable table = HProduct
138 gtable table = HProduct
110 (gtable @_Table @_Columns @context @rep1 table)
139 (gtable @_Table @_Columns @context @rep1 table)
111 (gtable @_Table @_Columns @context @rep2 table)
140 (gtable @_Table @_Columns @context @rep2 table)
141+ greify proxy reify (a :*: b) =
142+ greify @_Table @_Columns @context @rep1 proxy reify a :*:
143+ greify @_Table @_Columns @context @rep2 proxy reify b
144+ gunreify proxy unreify (a :*: b) =
145+ gunreify @_Table @_Columns @context @rep1 proxy unreify a :*:
146+ gunreify @_Table @_Columns @context @rep2 proxy unreify b
112
147
113
148
114instance
149instance
@@ -116,7 +151,6 @@ instance
116 , Eval (_Table a)
151 , Eval (_Table a)
117 , HLabelable context
152 , HLabelable context
118 , KnownSymbol label
153 , KnownSymbol label
119− , GColumns _Columns (M1 S meta k1) ~ HLabel label (Eval (_Columns a))
120 , meta ~ 'MetaSel ('Just label) _su _ss _ds
154 , meta ~ 'MetaSel ('Just label) _su _ss _ds
121 , k1 ~ K1 i a
155 , k1 ~ K1 i a
122 )
156 )
@@ -125,3 +159,5 @@ instance
125 fromGColumns fromColumns = M1 . K1 . fromColumns . hunlabel hunlabeler
159 fromGColumns fromColumns = M1 . K1 . fromColumns . hunlabel hunlabeler
126 toGColumns toColumns (M1 (K1 a)) = hlabel hlabeler (toColumns a)
160 toGColumns toColumns (M1 (K1 a)) = hlabel hlabeler (toColumns a)
127 gtable table = hlabel hlabeler (table (Proxy @a))
161 gtable table = hlabel hlabeler (table (Proxy @a))
162+ greify _ reify (M1 (K1 a)) = M1 (K1 (reify a))
163+ gunreify _ unreify (M1 (K1 a)) = M1 (K1 (unreify a))
src/Rel8/Kind/Context.hsnew file+89
@@ -0,0 +1,89 @@
1+{-# language DataKinds #-}
2+{-# language GADTs #-}
3+{-# language LambdaCase #-}
4+{-# language StandaloneKindSignatures #-}
5+
6+module Rel8.Kind.Context
7+ ( Reifiable( contextSing )
8+ , SContext(..)
9+ , sReifiable
10+ , sLabelable
11+ )
12+where
13+
14+-- base
15+import Data.Kind ( Constraint, Type )
16+import Prelude ()
17+
18+-- rel8
19+import Rel8.Aggregate ( Aggregate )
20+import Rel8.Expr ( Expr )
21+import Rel8.Schema.Dict ( Dict( Dict ) )
22+import Rel8.Schema.Context ( Interpretation )
23+import Rel8.Schema.Context.Label ( Labelable )
24+import Rel8.Schema.Insert ( Insert )
25+import Rel8.Schema.Kind ( Context )
26+import Rel8.Schema.Name ( Name )
27+import Rel8.Schema.Reify ( Reify )
28+import Rel8.Schema.Result ( Result )
29+
30+
31+type SContext :: Context -> Type
32+data SContext context where
33+ SAggregate :: SContext Aggregate
34+ SExpr :: SContext Expr
35+ SInsert :: SContext Insert
36+ SName :: SContext Name
37+ SResult :: SContext Result
38+ SReify :: SContext context -> SContext (Reify context)
39+
40+
41+type Reifiable :: Context -> Constraint
42+class Interpretation context => Reifiable context where
43+ contextSing :: SContext context
44+
45+
46+instance Reifiable Aggregate where
47+ contextSing = SAggregate
48+
49+
50+instance Reifiable Expr where
51+ contextSing = SExpr
52+
53+
54+instance Reifiable Result where
55+ contextSing = SResult
56+
57+
58+instance Reifiable Insert where
59+ contextSing = SInsert
60+
61+
62+instance Reifiable Name where
63+ contextSing = SName
64+
65+
66+instance Reifiable context => Reifiable (Reify context) where
67+ contextSing = SReify contextSing
68+
69+
70+sReifiable :: SContext context -> Dict Reifiable context
71+sReifiable = \case
72+ SAggregate -> Dict
73+ SExpr -> Dict
74+ SInsert -> Dict
75+ SName -> Dict
76+ SResult -> Dict
77+ SReify context -> case sReifiable context of
78+ Dict -> Dict
79+
80+
81+sLabelable :: SContext context -> Dict Labelable context
82+sLabelable = \case
83+ SAggregate -> Dict
84+ SExpr -> Dict
85+ SInsert -> Dict
86+ SName -> Dict
87+ SResult -> Dict
88+ SReify context -> case sLabelable context of
89+ Dict -> Dict
src/Rel8/Schema/Field.hs+48−74
@@ -10,31 +10,28 @@
10module Rel8.Schema.Field
10module Rel8.Schema.Field
11 ( Field
11 ( Field
12 , HEither, HList, HMaybe, HNonEmpty, HThese
12 , HEither, HList, HMaybe, HNonEmpty, HThese
13− , Reify, hreify, hunreify
14− , Reifiable(..)
15 , AField(..)
13 , AField(..)
16 , AHEither(..), AHList(..), AHMaybe(..), AHNonEmpty(..), AHThese(..)
14 , AHEither(..), AHList(..), AHMaybe(..), AHNonEmpty(..), AHThese(..)
17− , SContext(..)
18 )
15 )
19where
16where
20
17
21-- base
18-- base
19+import Control.Applicative ( liftA2 )
22import Data.Bifunctor ( Bifunctor, bimap )
20import Data.Bifunctor ( Bifunctor, bimap )
23−import Data.Kind ( Constraint, Type )
21+import Data.Kind ( Type )
24import Data.List.NonEmpty ( NonEmpty )
22import Data.List.NonEmpty ( NonEmpty )
25import Prelude
23import Prelude
26
24
27-- rel8
25-- rel8
28import Rel8.Aggregate ( Aggregate, Col(..) )
26import Rel8.Aggregate ( Aggregate, Col(..) )
29import Rel8.Expr ( Expr, Col(..) )
27import Rel8.Expr ( Expr, Col(..) )
28+import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
30import Rel8.Kind.Necessity
29import Rel8.Kind.Necessity
31 ( Necessity( Required, Optional )
30 ( Necessity( Required, Optional )
32 , SNecessity( SRequired, SOptional )
31 , SNecessity( SRequired, SOptional )
33 , KnownNecessity, necessitySing
32 , KnownNecessity, necessitySing
34 )
33 )
35−import Rel8.Schema.Context ( Interpretation, Col(..) )
34+import Rel8.Schema.Context ( Col(..) )
36−import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
37−import Rel8.Schema.HTable ( HTable, hfield, htabulate )
38import Rel8.Schema.HTable.Either ( HEitherTable )
35import Rel8.Schema.HTable.Either ( HEitherTable )
39import Rel8.Schema.HTable.List ( HListTable )
36import Rel8.Schema.HTable.List ( HListTable )
40import Rel8.Schema.HTable.Maybe ( HMaybeTable )
37import Rel8.Schema.HTable.Maybe ( HMaybeTable )
@@ -45,11 +42,12 @@ import Rel8.Schema.Insert ( Insert, Col(..) )
45import qualified Rel8.Schema.Kind as K
42import qualified Rel8.Schema.Kind as K
46import Rel8.Schema.Name ( Name(..), Col(..) )
43import Rel8.Schema.Name ( Name(..), Col(..) )
47import Rel8.Schema.Null ( Sql )
44import Rel8.Schema.Null ( Sql )
45+import Rel8.Schema.Reify ( Reify, Col(..), hreify, hunreify )
48import Rel8.Schema.Result ( Result )
46import Rel8.Schema.Result ( Result )
49import Rel8.Schema.Spec ( Spec( Spec ) )
47import Rel8.Schema.Spec ( Spec( Spec ) )
50import Rel8.Table
48import Rel8.Table
51− ( Table, Columns, Context, fromColumns, toColumns
49+ ( Table, Columns, Congruent, Context, fromColumns, toColumns
52− , Congruent
50+ , Unreify, reify, unreify
53 )
51 )
54import Rel8.Table.Either ( EitherTable )
52import Rel8.Table.Either ( EitherTable )
55import Rel8.Table.List ( ListTable( ListTable ) )
53import Rel8.Table.List ( ListTable( ListTable ) )
@@ -57,6 +55,7 @@ import Rel8.Table.Maybe ( MaybeTable )
57import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )
55import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )
58import Rel8.Table.Recontextualize ( Recontextualize )
56import Rel8.Table.Recontextualize ( Recontextualize )
59import Rel8.Table.These ( TheseTable )
57import Rel8.Table.These ( TheseTable )
58+import Rel8.Table.Unreify ( Unreifiable )
60import Rel8.Type ( DBType )
59import Rel8.Type ( DBType )
61
60
62-- these
61-- these
@@ -133,9 +132,12 @@ instance (Reifiable context, KnownNecessity necessity, Sql DBType a) =>
133 where
132 where
134 type Context (AField context necessity a) = Reify context
133 type Context (AField context necessity a) = Reify context
135 type Columns (AField context necessity a) = HIdentity ('Spec '[""] necessity a)
134 type Columns (AField context necessity a) = HIdentity ('Spec '[""] necessity a)
135+ type Unreify (AField context necessity a) = Field context necessity a
136
136
137 fromColumns (HIdentity (Reify a)) = sfromColumn contextSing a
137 fromColumns (HIdentity (Reify a)) = sfromColumn contextSing a
138 toColumns = HIdentity . Reify . stoColumn contextSing necessitySing
138 toColumns = HIdentity . Reify . stoColumn contextSing necessitySing
139+ reify _ = AField
140+ unreify _ (AField a) = a
139
141
140
142
141instance
143instance
@@ -166,9 +168,12 @@ instance (Reifiable context, Table (Reify context) a, Table (Reify context) b)
166 where
168 where
167 type Context (AHEither context a b) = Reify context
169 type Context (AHEither context a b) = Reify context
168 type Columns (AHEither context a b) = HEitherTable (Columns a) (Columns b)
170 type Columns (AHEither context a b) = HEitherTable (Columns a) (Columns b)
171+ type Unreify (AHEither context a b) = HEither context (Unreify a) (Unreify b)
169
172
170 fromColumns = sfromColumnsEither contextSing
173 fromColumns = sfromColumnsEither contextSing
171 toColumns = stoColumnsEither contextSing
174 toColumns = stoColumnsEither contextSing
175+ reify proof = liftA2 bimap reify reify proof . AHEither
176+ unreify proof = (\(AHEither a) -> a) . liftA2 bimap unreify unreify proof
172
177
173
178
174instance
179instance
@@ -187,18 +192,30 @@ type AHList :: K.Context -> Type -> Type
187newtype AHList context a = AHList (HList context a)
192newtype AHList context a = AHList (HList context a)
188
193
189
194
195+instance
196+ ( Reifiable context
190−instance (Reifiable context, Table (Reify context) a) =>
197+ , Table (Reify context) a
198+ , Unreifiable (Reify context) a
199+ )
191− Table (Reify context) (AHList context a)
200+ => Table (Reify context) (AHList context a)
192 where
201 where
193 type Context (AHList context a) = Reify context
202 type Context (AHList context a) = Reify context
194 type Columns (AHList context a) = HListTable (Columns a)
203 type Columns (AHList context a) = HListTable (Columns a)
204+ type Unreify (AHList context a) = HList context (Unreify a)
195
205
196 fromColumns = sfromColumnsList contextSing
206 fromColumns = sfromColumnsList contextSing
197 toColumns = stoColumnsList contextSing
207 toColumns = stoColumnsList contextSing
208+ reify proof =
209+ smapList contextSing (reify proof) hreify .
210+ AHList
211+ unreify proof =
212+ (\(AHList a) -> a) .
213+ smapList contextSing (unreify proof) hunreify
198
214
199
215
200instance
216instance
201 ( Reifiable context, Reifiable context'
217 ( Reifiable context, Reifiable context'
218+ , Unreifiable (Reify context) a, Unreifiable (Reify context') a'
202 , Recontextualize (Reify context) (Reify context') a a'
219 , Recontextualize (Reify context) (Reify context') a a'
203 ) =>
220 ) =>
204 Recontextualize
221 Recontextualize
@@ -221,9 +238,12 @@ instance (Reifiable context, Table (Reify context) a) =>
221 where
238 where
222 type Context (AHMaybe context a) = Reify context
239 type Context (AHMaybe context a) = Reify context
223 type Columns (AHMaybe context a) = HMaybeTable (Columns a)
240 type Columns (AHMaybe context a) = HMaybeTable (Columns a)
241+ type Unreify (AHMaybe context a) = HMaybe context (Unreify a)
224
242
225 fromColumns = sfromColumnsMaybe contextSing
243 fromColumns = sfromColumnsMaybe contextSing
226 toColumns = stoColumnsMaybe contextSing
244 toColumns = stoColumnsMaybe contextSing
245+ reify proof = fmap fmap reify proof . AHMaybe
246+ unreify proof = (\(AHMaybe a) -> a) . fmap fmap unreify proof
227
247
228
248
229instance
249instance
@@ -241,18 +261,30 @@ type AHNonEmpty :: K.Context -> Type -> Type
241newtype AHNonEmpty context a = AHNonEmpty (HNonEmpty context a)
261newtype AHNonEmpty context a = AHNonEmpty (HNonEmpty context a)
242
262
243
263
264+instance
265+ ( Reifiable context
244−instance (Reifiable context, Table (Reify context) a) =>
266+ , Table (Reify context) a
267+ , Unreifiable (Reify context) a
268+ )
245− Table (Reify context) (AHNonEmpty context a)
269+ => Table (Reify context) (AHNonEmpty context a)
246 where
270 where
247 type Context (AHNonEmpty context a) = Reify context
271 type Context (AHNonEmpty context a) = Reify context
248 type Columns (AHNonEmpty context a) = HNonEmptyTable (Columns a)
272 type Columns (AHNonEmpty context a) = HNonEmptyTable (Columns a)
273+ type Unreify (AHNonEmpty context a) = HNonEmpty context (Unreify a)
249
274
250 fromColumns = sfromColumnsNonEmpty contextSing
275 fromColumns = sfromColumnsNonEmpty contextSing
251 toColumns = stoColumnsNonEmpty contextSing
276 toColumns = stoColumnsNonEmpty contextSing
277+ reify proof =
278+ smapNonEmpty contextSing (reify proof) hreify .
279+ AHNonEmpty
280+ unreify proof =
281+ (\(AHNonEmpty a) -> a) .
282+ smapNonEmpty contextSing (unreify proof) hunreify
252
283
253
284
254instance
285instance
255 ( Reifiable context, Reifiable context'
286 ( Reifiable context, Reifiable context'
287+ , Unreifiable (Reify context) a, Unreifiable (Reify context') a'
256 , Recontextualize (Reify context) (Reify context') a a'
288 , Recontextualize (Reify context) (Reify context') a a'
257 ) =>
289 ) =>
258 Recontextualize
290 Recontextualize
@@ -279,9 +311,12 @@ instance (Reifiable context, Table (Reify context) a, Table (Reify context) b)
279 where
311 where
280 type Context (AHThese context a b) = Reify context
312 type Context (AHThese context a b) = Reify context
281 type Columns (AHThese context a b) = HTheseTable (Columns a) (Columns b)
313 type Columns (AHThese context a b) = HTheseTable (Columns a) (Columns b)
314+ type Unreify (AHThese context a b) = HThese context (Unreify a) (Unreify b)
282
315
283 fromColumns = sfromColumnsThese contextSing
316 fromColumns = sfromColumnsThese contextSing
284 toColumns = stoColumnsThese contextSing
317 toColumns = stoColumnsThese contextSing
318+ reify proof = liftA2 bimap reify reify proof . AHThese
319+ unreify proof = (\(AHThese a) -> a) . liftA2 bimap unreify unreify proof
285
320
286
321
287instance
322instance
@@ -296,58 +331,6 @@ instance
296 (AHThese context' a' b')
331 (AHThese context' a' b')
297
332
298
333
299−type SContext :: K.Context -> Type
300−data SContext context where
301− SAggregate :: SContext Aggregate
302− SExpr :: SContext Expr
303− SInsert :: SContext Insert
304− SName :: SContext Name
305− SResult :: SContext Result
306− SReify :: SContext context -> SContext (Reify context)
307−
308−
309−type Reifiable :: K.Context -> Constraint
310−class Interpretation context => Reifiable context where
311− contextSing :: SContext context
312−
313−
314−instance Reifiable Aggregate where
315− contextSing = SAggregate
316−
317−
318−instance Reifiable Expr where
319− contextSing = SExpr
320−
321−
322−instance Reifiable Result where
323− contextSing = SResult
324−
325−
326−instance Reifiable Insert where
327− contextSing = SInsert
328−
329−
330−instance Reifiable Name where
331− contextSing = SName
332−
333−
334−type Reify :: K.Context -> K.Context
335−data Reify context a
336−
337−
338−instance Interpretation (Reify context) where
339− newtype Col (Reify context) spec = Reify (Col context spec)
340−
341−
342−instance Labelable context => Labelable (Reify context) where
343− labeler (Reify a) = Reify (labeler a)
344− unlabeler (Reify a) = Reify (unlabeler a)
345−
346−
347−instance Reifiable context => Reifiable (Reify context) where
348− contextSing = SReify contextSing
349−
350−
351sfromColumn :: ()
334sfromColumn :: ()
352 => SContext context
335 => SContext context
353 -> Col context ('Spec labels necessity a)
336 -> Col context ('Spec labels necessity a)
@@ -710,12 +693,3 @@ stoColumnsThese = \case
710 stoColumnsThese context .
693 stoColumnsThese context .
711 sbimapThese context (hunreify . toColumns) (hunreify . toColumns) .
694 sbimapThese context (hunreify . toColumns) (hunreify . toColumns) .
712 (\(AHThese a) -> a)
695 (\(AHThese a) -> a)
713−
714−
715−hreify :: HTable t => t (Col context) -> t (Col (Reify context))
716−hreify a = htabulate $ \field -> Reify (hfield a field)
717−
718−
719−hunreify :: HTable t => t (Col (Reify context)) -> t (Col context)
720−hunreify a = htabulate $ \field -> case hfield a field of
721− Reify x -> x
src/Rel8/Schema/Generic.hs+62−24
@@ -19,38 +19,56 @@ where
19
19
20-- base
20-- base
21import Data.Kind ( Constraint, Type )
21import Data.Kind ( Constraint, Type )
22+import Data.Proxy ( Proxy( Proxy ) )
23+import Data.Type.Equality ( (:~:)( Refl ) )
22import GHC.Generics ( Generic, Rep, from, to )
24import GHC.Generics ( Generic, Rep, from, to )
23import Prelude
25import Prelude
24−import Unsafe.Coerce ( unsafeCoerce )
25
26
26-- rel8
27-- rel8
28+import Rel8.Kind.Context
29+ ( SContext( SReify )
30+ , Reifiable, contextSing
31+ , sLabelable, sReifiable
32+ )
27import Rel8.Generic.Record ( Record(..) )
33import Rel8.Generic.Record ( Record(..) )
28import Rel8.Generic.Table
34import Rel8.Generic.Table
29 ( GTable, GColumns, fromGColumns, toGColumns
35 ( GTable, GColumns, fromGColumns, toGColumns
36+ , GUnreify
30 )
37 )
38+import qualified Rel8.Generic.Table as G
31import Rel8.Schema.Context ( Col )
39import Rel8.Schema.Context ( Col )
32import Rel8.Schema.Context.Label ( Labelable )
40import Rel8.Schema.Context.Label ( Labelable )
33−import Rel8.Schema.Field ( Reify, Reifiable, hreify, hunreify )
41+import Rel8.Schema.Dict ( Dict( Dict ) )
34import Rel8.Schema.HTable ( HTable )
42import Rel8.Schema.HTable ( HTable )
35import qualified Rel8.Schema.Kind as K
43import qualified Rel8.Schema.Kind as K
36import Rel8.Schema.Name ( Name )
44import Rel8.Schema.Name ( Name )
45+import Rel8.Schema.Reify ( Reify, UnwrapReify, hreify, hunreify )
37import Rel8.Table
46import Rel8.Table
38 ( Table, Columns, Context, fromColumns, toColumns
47 ( Table, Columns, Context, fromColumns, toColumns
48+ , Unreify, reify, unreify
39− , TTable, TColumns
49+ , TTable, TColumns, TUnreify
40 )
50 )
41
51
42
52
43−instance
44− ( Rel8able t
45− , Labelable context
53+instance (Rel8able t, Labelable context, Reifiable context) =>
46− , Reifiable context
47− ) => Table context (t context)
54+ Table context (t context)
48 where
55 where
49 type Columns (t context) = GRep t
56 type Columns (t context) = GRep t
50 type Context (t context) = context
57 type Context (t context) = context
58+ type Unreify (t context) = t (UnwrapReify context)
59+
60+ fromColumns = gunreify . gfromColumns . hreify
61+ toColumns = hunreify . gtoColumns . greify
62+
63+ reify Refl = case contextSing @context of
64+ SReify context -> case sLabelable context of
65+ Dict -> case sReifiable context of
66+ Dict -> greify
51
67
52− fromColumns = unreify . gfromColumns . hreify
68+ unreify Refl = case contextSing @context of
53− toColumns = hunreify . gtoColumns . reify
69+ SReify context -> case sLabelable context of
70+ Dict -> case sReifiable context of
71+ Dict -> gunreify
54
72
55
73
56type KRel8able :: Type
74type KRel8able :: Type
@@ -109,6 +127,12 @@ class HTable (GRep t) => Rel8able t where
109 gtoColumns :: (Labelable context, Reifiable context)
127 gtoColumns :: (Labelable context, Reifiable context)
110 => t (Reify context) -> GRep t (Col (Reify context))
128 => t (Reify context) -> GRep t (Col (Reify context))
111
129
130+ greify :: (Labelable context, Reifiable context)
131+ => t context -> t (Reify context)
132+
133+ gunreify :: (Labelable context, Reifiable context)
134+ => t (Reify context) -> t context
135+
112 type GRep t = GColumns TColumns (Rep (Record (t (Reify Name))))
136 type GRep t = GColumns TColumns (Rep (Record (t (Reify Name))))
113
137
114 default gfromColumns :: forall context.
138 default gfromColumns :: forall context.
@@ -133,18 +157,32 @@ class HTable (GRep t) => Rel8able t where
133 from .
157 from .
134 Record
158 Record
135
159
160+ default greify :: forall context.
161+ ( Generic (Record (t context))
162+ , Generic (Record (t (Reify context)))
163+ , GTable (TTable (Reify context)) TColumns (Col (Reify context)) (Rep (Record (t (Reify context))))
164+ , Rep (Record (t context)) ~ GUnreify TUnreify (Rep (Record (t (Reify context))))
165+ )
166+ => t context -> t (Reify context)
167+ greify =
168+ unrecord .
169+ to .
170+ G.greify @(TTable (Reify context)) @TColumns @(Col (Reify context)) (Proxy @TUnreify)
171+ (reify Refl) .
172+ from .
173+ Record
136
174
137−reify ::
175+ default gunreify :: forall context.
138− (-- Rel8able t
176+ ( Generic (Record (t context))
139− --, forall necessity a. Coercible (Field context necessity a) (AField context necessity a) => Coercible (t context) (t (Reify context))
177+ , Generic (Record (t (Reify context)))
140− )
178+ , GTable (TTable (Reify context)) TColumns (Col (Reify context)) (Rep (Record (t (Reify context))))
141− => t context -> t (Reify context)
179+ , Rep (Record (t context)) ~ GUnreify TUnreify (Rep (Record (t (Reify context))))
142−reify = unsafeCoerce
180+ )
143−
181+ => t (Reify context) -> t context
144−
182+ gunreify =
145−unreify ::
183+ unrecord .
146− (-- Rel8able t
184+ to .
147− --, forall necessity a. Coercible (AField context necessity a) (Field context necessity a) => Coercible (t (Reify context)) (t context)
185+ G.gunreify @(TTable (Reify context)) @TColumns @(Col (Reify context)) (Proxy @TUnreify)
148− )
186+ (unreify Refl) .
149− => t (Reify context) -> t context
187+ from .
150−unreify = unsafeCoerce
188+ Record
src/Rel8/Schema/Generic/Test.hs+6−3
@@ -8,6 +8,8 @@
8{-# language StandaloneDeriving #-}
8{-# language StandaloneDeriving #-}
9{-# language TypeFamilies #-}
9{-# language TypeFamilies #-}
10
10
11+{-# options_ghc -O0 #-}
12+
11module Rel8.Schema.Generic.Test
13module Rel8.Schema.Generic.Test
12 ( module Rel8.Schema.Generic.Test
14 ( module Rel8.Schema.Generic.Test
13 )
15 )
@@ -77,7 +79,7 @@ data TableList f = TableList
77
79
78data TableNonEmpty f = TableNonEmpty
80data TableNonEmpty f = TableNonEmpty
79 { foo :: Column f Bool
81 { foo :: Column f Bool
80− , bars :: HNonEmpty f (TableList f, Default f Char)
82+ , bars :: HNonEmpty f (TableList f, TableMaybe f)
81 }
83 }
82 deriving stock Generic
84 deriving stock Generic
83 deriving anyclass Rel8able
85 deriving anyclass Rel8able
@@ -86,14 +88,15 @@ data TableNonEmpty f = TableNonEmpty
86data S3Object = S3Object
88data S3Object = S3Object
87 { bucketName :: Text
89 { bucketName :: Text
88 , objectKey :: Text
90 , objectKey :: Text
91+ }
89− } deriving stock Generic
92+ deriving stock Generic
90
93
91
94
92deriving via HKDT S3Object
95deriving via HKDT S3Object
93 instance x ~ HKD S3Object Expr => ToExprs x S3Object
96 instance x ~ HKD S3Object Expr => ToExprs x S3Object
94
97
95
98
96−data HKDTest f = HKDTest
99+newtype HKDTest f = HKDTest
97 { s3Object :: Lift f S3Object
100 { s3Object :: Lift f S3Object
98 }
101 }
99 deriving stock Generic
102 deriving stock Generic
src/Rel8/Schema/HKD.hs+20−5
@@ -37,17 +37,17 @@ import GHC.TypeLits ( KnownSymbol )
37import Prelude
37import Prelude
38
38
39-- higgledy
39-- higgledy
40−import Data.Generic.HKD ( Construct, HKD( HKD, runHKD ), GHKD_, construct, deconstruct )
40+import Data.Generic.HKD ( Construct, HKD(..), GHKD_, construct, deconstruct )
41
41
42-- rel8
42-- rel8
43import Rel8.Aggregate ( Col(..), Aggregate )
43import Rel8.Aggregate ( Col(..), Aggregate )
44import Rel8.Expr ( Expr )
44import Rel8.Expr ( Expr )
45+import Rel8.Kind.Context ( Reifiable(..), SContext(..) )
45import Rel8.Schema.Context.Label
46import Rel8.Schema.Context.Label
46 ( Labelable
47 ( Labelable
47 , HLabelable, hlabeler, hunlabeler
48 , HLabelable, hlabeler, hunlabeler
48 )
49 )
49import Rel8.Schema.Dict ( Dict( Dict ) )
50import Rel8.Schema.Dict ( Dict( Dict ) )
50−import Rel8.Schema.Field ( Reify, Reifiable(..), SContext(..), hunreify, hreify )
51import Rel8.Schema.HTable ( HTable )
51import Rel8.Schema.HTable ( HTable )
52import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
52import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
53import Rel8.Schema.HTable.Product ( HProduct( HProduct ) )
53import Rel8.Schema.HTable.Product ( HProduct( HProduct ) )
@@ -56,8 +56,12 @@ import Rel8.Schema.Insert ( Insert, Col(..) )
56import qualified Rel8.Schema.Kind as K
56import qualified Rel8.Schema.Kind as K
57import Rel8.Schema.Name ( Name(..) )
57import Rel8.Schema.Name ( Name(..) )
58import Rel8.Schema.Null ( Sql )
58import Rel8.Schema.Null ( Sql )
59+import Rel8.Schema.Reify ( Reify, hreify, hunreify, NotReify, notReify )
59import Rel8.Schema.Result ( Result )
60import Rel8.Schema.Result ( Result )
61+import Rel8.Table
60−import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
62+ ( Table, Columns, Context, fromColumns, toColumns
63+ , Unreify, reify, unreify
64+ )
61import Rel8.Table.Recontextualize ( Recontextualize )
65import Rel8.Table.Recontextualize ( Recontextualize )
62import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
66import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )
63import Rel8.Type ( DBType )
67import Rel8.Type ( DBType )
@@ -178,19 +182,27 @@ type family GColumns rep where
178 GColumns (f :*: g) = HProduct (GColumns f) (GColumns g)
182 GColumns (f :*: g) = HProduct (GColumns f) (GColumns g)
179
183
180
184
185+instance
186+ ( GTable (Rep a)
187+ , Column1 context f
181−instance (GTable (Rep a), Column1 context f, Labelable context) =>
188+ , Labelable context
189+ , NotReify context
190+ )
182− Table context (HKD a f)
191+ => Table context (HKD a f)
183 where
192 where
184 type Columns (HKD a f) = GRep a
193 type Columns (HKD a f) = GRep a
185 type Context (HKD a f) = Context1 f
194 type Context (HKD a f) = Context1 f
186
195
187 toColumns = toGColumns toColumn1 . runHKD
196 toColumns = toGColumns toColumn1 . runHKD
188 fromColumns = HKD . fromGColumns fromColumn1
197 fromColumns = HKD . fromGColumns fromColumn1
198+ reify = notReify
199+ unreify = notReify
189
200
190
201
191instance
202instance
192 ( a ~ a'
203 ( a ~ a'
193 , GTable (Rep a)
204 , GTable (Rep a)
205+ , NotReify context, NotReify context'
194 , Recontextualize1 context context' f f'
206 , Recontextualize1 context context' f f'
195 , Column1 context f, Labelable context
207 , Column1 context f, Labelable context
196 , Column1 context' f', Labelable context'
208 , Column1 context' f', Labelable context'
@@ -227,9 +239,12 @@ instance
227 where
239 where
228 type Context (ALift context a) = Reify context
240 type Context (ALift context a) = Reify context
229 type Columns (ALift context a) = GRep a
241 type Columns (ALift context a) = GRep a
242+ type Unreify (ALift context a) = Lift context a
230
243
231 fromColumns = sfromColumnsLift contextSing
244 fromColumns = sfromColumnsLift contextSing
232 toColumns = stoColumnsLift contextSing
245 toColumns = stoColumnsLift contextSing
246+ reify _ = ALift
247+ unreify _ (ALift a) = a
233
248
234
249
235instance
250instance
src/Rel8/Schema/HTable/Nullify.hs+5−5
@@ -1,13 +1,13 @@
1−{-# LANGUAGE DeriveAnyClass #-}
2−{-# LANGUAGE DerivingStrategies #-}
3−{-# LANGUAGE DeriveGeneric #-}
4−{-# LANGUAGE NamedFieldPuns #-}
5−{-# LANGUAGE LambdaCase #-}
6{-# language ConstraintKinds #-}
1{-# language ConstraintKinds #-}
7{-# language DataKinds #-}
2{-# language DataKinds #-}
3+{-# language DeriveAnyClass #-}
4+{-# language DerivingStrategies #-}
5+{-# language DeriveGeneric #-}
8{-# language FlexibleInstances #-}
6{-# language FlexibleInstances #-}
9{-# language GADTs #-}
7{-# language GADTs #-}
8+{-# language LambdaCase #-}
10{-# language MultiParamTypeClasses #-}
9{-# language MultiParamTypeClasses #-}
10+{-# language NamedFieldPuns #-}
11{-# language QuantifiedConstraints #-}
11{-# language QuantifiedConstraints #-}
12{-# language RankNTypes #-}
12{-# language RankNTypes #-}
13{-# language ScopedTypeVariables #-}
13{-# language ScopedTypeVariables #-}
src/Rel8/Schema/Insert.hs+7−1
@@ -39,11 +39,15 @@ import Rel8.Schema.Context.Nullify
39import Rel8.Schema.HTable.Type ( HType( HType ) )
39import Rel8.Schema.HTable.Type ( HType( HType ) )
40import Rel8.Schema.Name ( Name, Selects )
40import Rel8.Schema.Name ( Name, Selects )
41import Rel8.Schema.Null ( Sql )
41import Rel8.Schema.Null ( Sql )
42+import Rel8.Schema.Reify ( notReify )
42import Rel8.Schema.Result ( Result )
43import Rel8.Schema.Result ( Result )
43import Rel8.Schema.Spec ( SSpec(SSpec, nullity), Spec(Spec) )
44import Rel8.Schema.Spec ( SSpec(SSpec, nullity), Spec(Spec) )
44import Rel8.Schema.Table ( TableSchema )
45import Rel8.Schema.Table ( TableSchema )
45import Rel8.Statement.Returning ( Returning )
46import Rel8.Statement.Returning ( Returning )
46−import Rel8.Table ( Table(..) )
47+import Rel8.Table
48+ ( Table, Context, Columns, fromColumns, toColumns
49+ , reify, unreify
50+ )
47import Rel8.Table.Recontextualize ( Recontextualize )
51import Rel8.Table.Recontextualize ( Recontextualize )
48import Rel8.Table.Tag ( Tag(..), fromExpr )
52import Rel8.Table.Tag ( Tag(..), fromExpr )
49import Rel8.Type ( DBType )
53import Rel8.Type ( DBType )
@@ -89,6 +93,8 @@ instance Sql DBType a => Table Insert (Insertion a) where
89
93
90 toColumns (Insertion a) = HType (RequiredInsert a)
94 toColumns (Insertion a) = HType (RequiredInsert a)
91 fromColumns (HType (RequiredInsert a)) = Insertion a
95 fromColumns (HType (RequiredInsert a)) = Insertion a
96+ reify = notReify
97+ unreify = notReify
92
98
93
99
94instance Sql DBType a =>
100instance Sql DBType a =>
src/Rel8/Schema/Name.hs+6−1
@@ -31,8 +31,11 @@ import Rel8.Schema.Context ( Interpretation, Col )
31import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
31import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
32import Rel8.Schema.HTable.Type ( HType( HType ) )
32import Rel8.Schema.HTable.Type ( HType( HType ) )
33import Rel8.Schema.Null ( Sql )
33import Rel8.Schema.Null ( Sql )
34+import Rel8.Schema.Reify ( notReify )
34import Rel8.Schema.Result ( Result )
35import Rel8.Schema.Result ( Result )
36+import Rel8.Table
35−import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
37+ ( Table, Columns, Context, fromColumns, toColumns, reify, unreify
38+ )
36import Rel8.Table.Recontextualize ( Recontextualize )
39import Rel8.Table.Recontextualize ( Recontextualize )
37import Rel8.Type ( DBType )
40import Rel8.Type ( DBType )
38
41
@@ -59,6 +62,8 @@ instance Sql DBType a => Table Name (Name a) where
59
62
60 toColumns (Name a) = HType (NameCol a)
63 toColumns (Name a) = HType (NameCol a)
61 fromColumns (HType (NameCol a)) = Name a
64 fromColumns (HType (NameCol a)) = Name a
65+ reify = notReify
66+ unreify = notReify
62
67
63
68
64instance Sql DBType a => Recontextualize Expr Name (Expr a) (Name a)
69instance Sql DBType a => Recontextualize Expr Name (Expr a) (Name a)
src/Rel8/Schema/Reify.hsnew file+75
@@ -0,0 +1,75 @@
1+{-# language AllowAmbiguousTypes #-}
2+{-# language EmptyCase #-}
3+{-# language DataKinds #-}
4+{-# language FlexibleInstances #-}
5+{-# language ScopedTypeVariables #-}
6+{-# language StandaloneKindSignatures #-}
7+{-# language TypeApplications #-}
8+{-# language TypeFamilies #-}
9+{-# language TypeOperators #-}
10+{-# language UndecidableInstances #-}
11+
12+module Rel8.Schema.Reify
13+ ( Reify, Col( Reify ), hreify, hunreify
14+ , UnwrapReify
15+ , NotReify, notReify
16+ )
17+where
18+
19+-- base
20+import Data.Kind ( Constraint )
21+import Data.Type.Equality ( (:~:)( Refl ) )
22+import Prelude
23+
24+-- rel8
25+import Rel8.Schema.Context ( Interpretation, Col )
26+import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
27+import Rel8.Schema.HTable ( HTable, hfield, htabulate )
28+import Rel8.Schema.Kind ( Context )
29+
30+
31+type Reify :: Context -> Context
32+data Reify context a
33+
34+
35+instance Interpretation (Reify context) where
36+ newtype Col (Reify context) spec = Reify (Col context spec)
37+
38+
39+instance Labelable context => Labelable (Reify context) where
40+ labeler (Reify a) = Reify (labeler a)
41+ unlabeler (Reify a) = Reify (unlabeler a)
42+
43+
44+hreify :: HTable t => t (Col context) -> t (Col (Reify context))
45+hreify a = htabulate $ \field -> Reify (hfield a field)
46+
47+
48+hunreify :: HTable t => t (Col (Reify context)) -> t (Col context)
49+hunreify a = htabulate $ \field -> case hfield a field of
50+ Reify x -> x
51+
52+
53+type UnwrapReify :: Context -> Context
54+type family UnwrapReify context where
55+ UnwrapReify (Reify context) = context
56+
57+
58+type IsReify :: Context -> Bool
59+type family IsReify context where
60+ IsReify (Reify _) = 'True
61+ IsReify _ = 'False
62+
63+
64+type NotReify :: Context -> Constraint
65+class IsReify context ~ 'False => NotReify context
66+instance IsReify context ~ 'False => NotReify context
67+
68+
69+notReify :: forall context ctx a. NotReify context => context :~: Reify ctx -> a
70+notReify refl = case lemma @context of
71+ Refl -> case refl of
72+
73+
74+lemma :: NotReify context => IsReify context :~: 'False
75+lemma = Refl
src/Rel8/Table.hs+99−9
@@ -1,3 +1,4 @@
1+{-# language AllowAmbiguousTypes #-}
1{-# language DataKinds #-}
2{-# language DataKinds #-}
2{-# language DefaultSignatures #-}
3{-# language DefaultSignatures #-}
3{-# language DisambiguateRecordFields #-}
4{-# language DisambiguateRecordFields #-}
@@ -14,9 +15,9 @@
14{-# language UndecidableInstances #-}
15{-# language UndecidableInstances #-}
15
16
16module Rel8.Table
17module Rel8.Table
17− ( Table (Columns, Context, toColumns, fromColumns)
18+ ( Table (Columns, Context, Unreify, toColumns, fromColumns, reify, unreify)
18 , Congruent
19 , Congruent
19− , TTable, TColumns, TContext
20+ , TTable, TColumns, TContext, TUnreify
20 )
21 )
21where
22where
22
23
@@ -25,13 +26,16 @@ import Data.Functor ( ($>) )
25import Data.Functor.Identity ( Identity( Identity ) )
26import Data.Functor.Identity ( Identity( Identity ) )
26import Data.Kind ( Constraint, Type )
27import Data.Kind ( Constraint, Type )
27import Data.List.NonEmpty ( NonEmpty )
28import Data.List.NonEmpty ( NonEmpty )
29+import Data.Proxy ( Proxy( Proxy ) )
30+import Data.Type.Equality ( (:~:)( Refl ) )
28import GHC.Generics ( Generic, Rep, from, to )
31import GHC.Generics ( Generic, Rep, from, to )
29import Prelude hiding ( null )
32import Prelude hiding ( null )
30
33
31-- rel8
34-- rel8
32import Rel8.FCF ( Eval, Exp )
35import Rel8.FCF ( Eval, Exp )
33import Rel8.Generic.Table
36import Rel8.Generic.Table
34− ( GTable, GColumns, GContext, fromGColumns, toGColumns
37+ ( GTable, GColumns, GContext, GUnreify
38+ , fromGColumns, toGColumns, greify, gunreify
35 )
39 )
36import Rel8.Generic.Record ( Record(..) )
40import Rel8.Generic.Record ( Record(..) )
37import Rel8.Schema.Context ( Col(..) )
41import Rel8.Schema.Context ( Col(..) )
@@ -49,6 +53,11 @@ import Rel8.Schema.HTable.Type ( HType( HType ) )
49import Rel8.Schema.HTable.Vectorize ( hvectorize, hunvectorize )
53import Rel8.Schema.HTable.Vectorize ( hvectorize, hunvectorize )
50import qualified Rel8.Schema.Kind as K
54import qualified Rel8.Schema.Kind as K
51import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ), Sql )
55import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ), Sql )
56+import Rel8.Schema.Reify
57+ ( Reify, Col( Reify ), hreify, hunreify
58+ , UnwrapReify
59+ , notReify
60+ )
52import Rel8.Schema.Result ( Result )
61import Rel8.Schema.Result ( Result )
53import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..), KnownSpec )
62import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..), KnownSpec )
54import Rel8.Type ( DBType )
63import Rel8.Type ( DBType )
@@ -78,18 +87,24 @@ class (HTable (Columns a), context ~ Context a) => Table context a | a -> contex
78 -- | The common context that all columns use as an interpretation.
87 -- | The common context that all columns use as an interpretation.
79 type Context a :: K.Context
88 type Context a :: K.Context
80
89
90+ type Unreify a :: Type
91+
81− toColumns :: a -> Columns a (Col (Context a))
92+ toColumns :: a -> Columns a (Col context)
82− fromColumns :: Columns a (Col (Context a)) -> a
93+ fromColumns :: Columns a (Col context) -> a
94+
95+ reify :: context :~: Reify ctx -> Unreify a -> a
96+ unreify :: context :~: Reify ctx -> a -> Unreify a
83
97
84 type Columns a = GColumns TColumns (Rep (Record a))
98 type Columns a = GColumns TColumns (Rep (Record a))
85 type Context a = GContext TContext (Rep (Record a))
99 type Context a = GContext TContext (Rep (Record a))
100+ type Unreify a = DefaultUnreify a
86
101
87 default toColumns ::
102 default toColumns ::
88 ( Generic (Record a)
103 ( Generic (Record a)
89− , GTable (TTable context) TColumns (Col (Context a)) (Rep (Record a))
104+ , GTable (TTable context) TColumns (Col context) (Rep (Record a))
90 , Columns a ~ GColumns TColumns (Rep (Record a))
105 , Columns a ~ GColumns TColumns (Rep (Record a))
91 )
106 )
92− => a -> Columns a (Col (Context a))
107+ => a -> Columns a (Col context)
93 toColumns =
108 toColumns =
94 toGColumns @(TTable context) @TColumns toColumns .
109 toGColumns @(TTable context) @TColumns toColumns .
95 from .
110 from .
@@ -97,15 +112,45 @@ class (HTable (Columns a), context ~ Context a) => Table context a | a -> contex
97
112
98 default fromColumns ::
113 default fromColumns ::
99 ( Generic (Record a)
114 ( Generic (Record a)
100− , GTable (TTable context) TColumns (Col (Context a)) (Rep (Record a))
115+ , GTable (TTable context) TColumns (Col context) (Rep (Record a))
101 , Columns a ~ GColumns TColumns (Rep (Record a))
116 , Columns a ~ GColumns TColumns (Rep (Record a))
102 )
117 )
103− => Columns a (Col (Context a)) -> a
118+ => Columns a (Col context) -> a
104 fromColumns =
119 fromColumns =
105 unrecord .
120 unrecord .
106 to .
121 to .
107 fromGColumns @(TTable context) @TColumns fromColumns
122 fromGColumns @(TTable context) @TColumns fromColumns
108
123
124+ default reify ::
125+ ( Generic (Record a)
126+ , Generic (Record (Unreify a))
127+ , GTable (TTable context) TColumns (Col context) (Rep (Record a))
128+ , Rep (Record (Unreify a)) ~ GUnreify TUnreify (Rep (Record a))
129+ )
130+ => context :~: Reify ctx -> Unreify a -> a
131+ reify Refl =
132+ unrecord .
133+ to .
134+ greify @(TTable context) @TColumns @(Col context) (Proxy @TUnreify)
135+ (reify Refl) .
136+ from .
137+ Record
138+
139+ default unreify ::
140+ ( Generic (Record a)
141+ , Generic (Record (Unreify a))
142+ , GTable (TTable context) TColumns (Col context) (Rep (Record a))
143+ , Rep (Record (Unreify a)) ~ GUnreify TUnreify (Rep (Record a))
144+ )
145+ => context :~: Reify ctx -> a -> Unreify a
146+ unreify Refl =
147+ unrecord .
148+ to .
149+ gunreify @(TTable context) @TColumns @(Col context) (Proxy @TUnreify)
150+ (unreify Refl) .
151+ from .
152+ Record
153+
109
154
110data TTable :: K.Context -> Type -> Exp Constraint
155data TTable :: K.Context -> Type -> Exp Constraint
111type instance Eval (TTable context a) = Table context a
156type instance Eval (TTable context a) = Table context a
@@ -119,23 +164,50 @@ data TContext :: Type -> Exp K.Context
119type instance Eval (TContext a) = Context a
164type instance Eval (TContext a) = Context a
120
165
121
166
167+data TUnreify :: Type -> Exp Type
168+type instance Eval (TUnreify a) = Unreify a
169+
170+
171+type DefaultUnreify :: Type -> Type
172+type family DefaultUnreify a where
173+ DefaultUnreify (t a b c d e f g) =
174+ t (Unreify a) (Unreify b) (Unreify c) (Unreify d) (Unreify e) (Unreify f) (Unreify g)
175+ DefaultUnreify (t a b c d e f) =
176+ t (Unreify a) (Unreify b) (Unreify c) (Unreify d) (Unreify e) (Unreify f)
177+ DefaultUnreify (t a b c d e) =
178+ t (Unreify a) (Unreify b) (Unreify c) (Unreify d) (Unreify e)
179+ DefaultUnreify (t a b c d) =
180+ t (Unreify a) (Unreify b) (Unreify c) (Unreify d)
181+ DefaultUnreify (t a b c) = t (Unreify a) (Unreify b) (Unreify c)
182+ DefaultUnreify (t a b) = t (Unreify a) (Unreify b)
183+ DefaultUnreify (t a) = t (Unreify a)
184+
185+
122-- | Any 'HTable' is also a 'Table'.
186-- | Any 'HTable' is also a 'Table'.
123instance HTable t => Table context (t (Col context)) where
187instance HTable t => Table context (t (Col context)) where
124 type Columns (t (Col context)) = t
188 type Columns (t (Col context)) = t
125 type Context (t (Col context)) = context
189 type Context (t (Col context)) = context
190+ type Unreify (t (Col context)) = t (Col (UnwrapReify context))
126
191
127 toColumns = id
192 toColumns = id
128 fromColumns = id
193 fromColumns = id
129
194
195+ reify Refl = hreify
196+ unreify Refl = hunreify
197+
130
198
131-- | Any context is trivially a table.
199-- | Any context is trivially a table.
132instance KnownSpec spec => Table context (Col context spec) where
200instance KnownSpec spec => Table context (Col context spec) where
133 type Columns (Col context spec) = HIdentity spec
201 type Columns (Col context spec) = HIdentity spec
134 type Context (Col context spec) = context
202 type Context (Col context spec) = context
203+ type Unreify (Col context spec) = Col (UnwrapReify context) spec
135
204
136 toColumns = HIdentity
205 toColumns = HIdentity
137 fromColumns = unHIdentity
206 fromColumns = unHIdentity
138
207
208+ reify Refl = Reify
209+ unreify Refl (Reify a) = a
210+
139
211
140instance Sql DBType a => Table Result (Identity a) where
212instance Sql DBType a => Table Result (Identity a) where
141 type Columns (Identity a) = HType a
213 type Columns (Identity a) = HType a
@@ -144,6 +216,9 @@ instance Sql DBType a => Table Result (Identity a) where
144 toColumns (Identity a) = HType (Result a)
216 toColumns (Identity a) = HType (Result a)
145 fromColumns (HType (Result a)) = Identity a
217 fromColumns (HType (Result a)) = Identity a
146
218
219+ reify = notReify
220+ unreify = notReify
221+
147
222
148instance (Table Result a, Table Result b) => Table Result (Either a b) where
223instance (Table Result a, Table Result b) => Table Result (Either a b) where
149 type Columns (Either a b) = HEitherTable (Columns a) (Columns b)
224 type Columns (Either a b) = HEitherTable (Columns a) (Columns b)
@@ -168,6 +243,9 @@ instance (Table Result a, Table Result b) => Table Result (Either a b) where
168 where
243 where
169 err = error "Either.fromColumns: mismatch between tag and data"
244 err = error "Either.fromColumns: mismatch between tag and data"
170
245
246+ reify = notReify
247+ unreify = notReify
248+
171
249
172instance Table Result a => Table Result [a] where
250instance Table Result a => Table Result [a] where
173 type Columns [a] = HListTable (Columns a)
251 type Columns [a] = HListTable (Columns a)
@@ -176,6 +254,9 @@ instance Table Result a => Table Result [a] where
176 toColumns = hvectorize vectorizer . fmap toColumns
254 toColumns = hvectorize vectorizer . fmap toColumns
177 fromColumns = fmap fromColumns . hunvectorize unvectorizer
255 fromColumns = fmap fromColumns . hunvectorize unvectorizer
178
256
257+ reify = notReify
258+ unreify = notReify
259+
179
260
180instance Table Result a => Table Result (Maybe a) where
261instance Table Result a => Table Result (Maybe a) where
181 type Columns (Maybe a) = HMaybeTable (Columns a)
262 type Columns (Maybe a) = HMaybeTable (Columns a)
@@ -197,6 +278,9 @@ instance Table Result a => Table Result (Maybe a) where
197 Nothing -> error "Maybe.fromColumns: mismatch between tag and data"
278 Nothing -> error "Maybe.fromColumns: mismatch between tag and data"
198 Just just -> fromColumns just
279 Just just -> fromColumns just
199
280
281+ reify = notReify
282+ unreify = notReify
283+
200
284
201instance Table Result a => Table Result (NonEmpty a) where
285instance Table Result a => Table Result (NonEmpty a) where
202 type Columns (NonEmpty a) = HNonEmptyTable (Columns a)
286 type Columns (NonEmpty a) = HNonEmptyTable (Columns a)
@@ -205,6 +289,9 @@ instance Table Result a => Table Result (NonEmpty a) where
205 toColumns = hvectorize vectorizer . fmap toColumns
289 toColumns = hvectorize vectorizer . fmap toColumns
206 fromColumns = fmap fromColumns . hunvectorize unvectorizer
290 fromColumns = fmap fromColumns . hunvectorize unvectorizer
207
291
292+ reify = notReify
293+ unreify = notReify
294+
208
295
209instance (Table Result a, Table Result b) => Table Result (These a b) where
296instance (Table Result a, Table Result b) => Table Result (These a b) where
210 type Columns (These a b) = HTheseTable (Columns a) (Columns b)
297 type Columns (These a b) = HTheseTable (Columns a) (Columns b)
@@ -242,6 +329,9 @@ instance (Table Result a, Table Result b) => Table Result (These a b) where
242 , hjust = hlabel labeler (hunlabel unlabeler hthere)
329 , hjust = hlabel labeler (hunlabel unlabeler hthere)
243 }
330 }
244
331
332+ reify = notReify
333+ unreify = notReify
334+
245
335
246instance (Table context a, Table context b, Labelable context)
336instance (Table context a, Table context b, Labelable context)
247 => Table context (a, b)
337 => Table context (a, b)
src/Rel8/Table/Either.hs+7−1
@@ -20,6 +20,7 @@ module Rel8.Table.Either
20where
20where
21
21
22-- base
22-- base
23+import Control.Applicative ( liftA2 )
23import Data.Bifunctor ( Bifunctor, bimap )
24import Data.Bifunctor ( Bifunctor, bimap )
24import Data.Functor.Identity ( runIdentity )
25import Data.Functor.Identity ( runIdentity )
25import Data.Kind ( Type )
26import Data.Kind ( Type )
@@ -46,7 +47,10 @@ import Rel8.Schema.HTable.Identity ( HIdentity(..) )
46import Rel8.Schema.HTable.Label ( hlabel, hunlabel )
47import Rel8.Schema.HTable.Label ( hlabel, hunlabel )
47import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )
48import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )
48import Rel8.Schema.Name ( Name )
49import Rel8.Schema.Name ( Name )
50+import Rel8.Table
49−import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
51+ ( Table, Columns, Context, fromColumns, toColumns
52+ , reify, unreify
53+ )
50import Rel8.Table.Bool ( bool )
54import Rel8.Table.Bool ( bool )
51import Rel8.Table.Eq ( EqTable, eqTable )
55import Rel8.Table.Eq ( EqTable, eqTable )
52import Rel8.Table.Ord ( OrdTable, ordTable )
56import Rel8.Table.Ord ( OrdTable, ordTable )
@@ -108,6 +112,8 @@ instance
108
112
109 toColumns = toColumns2 toColumns toColumns
113 toColumns = toColumns2 toColumns toColumns
110 fromColumns = fromColumns2 fromColumns fromColumns
114 fromColumns = fromColumns2 fromColumns fromColumns
115+ reify = liftA2 bimap reify reify
116+ unreify = liftA2 bimap unreify unreify
111
117
112
118
113instance
119instance
src/Rel8/Table/List.hs+18−4
@@ -17,6 +17,7 @@ where
17-- base
17-- base
18import Data.Functor.Identity ( Identity( Identity ) )
18import Data.Functor.Identity ( Identity( Identity ) )
19import Data.Kind ( Type )
19import Data.Kind ( Type )
20+import Data.Type.Equality ( (:~:)( Refl ) )
20import Prelude
21import Prelude
21
22
22-- rel8
23-- rel8
@@ -28,7 +29,11 @@ import Rel8.Schema.HTable.Vectorize ( happend, hempty, hvectorize )
28import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
29import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
29import Rel8.Schema.Spec ( SSpec(..) )
30import Rel8.Schema.Spec ( SSpec(..) )
30import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
31import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
32+import Rel8.Schema.Reify ( hreify, hunreify )
33+import Rel8.Table
31−import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )
34+ ( Table, Context, Columns, fromColumns, toColumns
35+ , reify, unreify
36+ )
32import Rel8.Table.Alternative
37import Rel8.Table.Alternative
33 ( AltTable, (<|>:)
38 ( AltTable, (<|>:)
34 , AlternativeTable, emptyTable
39 , AlternativeTable, emptyTable
@@ -36,6 +41,7 @@ import Rel8.Table.Alternative
36import Rel8.Table.Eq ( EqTable, eqTable )
41import Rel8.Table.Eq ( EqTable, eqTable )
37import Rel8.Table.Ord ( OrdTable, ordTable )
42import Rel8.Table.Ord ( OrdTable, ordTable )
38import Rel8.Table.Recontextualize ( Recontextualize )
43import Rel8.Table.Recontextualize ( Recontextualize )
44+import Rel8.Table.Unreify ( Unreifiable )
39
45
40
46
41-- | A @ListTable@ value contains zero or more instances of @a@. You construct
47-- | A @ListTable@ value contains zero or more instances of @a@. You construct
@@ -44,16 +50,24 @@ type ListTable :: Type -> Type
44newtype ListTable a = ListTable (HListTable (Columns a) (Col (Context a)))
50newtype ListTable a = ListTable (HListTable (Columns a) (Col (Context a)))
45
51
46
52
53+instance (Table context a, Unreifiable context a) =>
47−instance Table context a => Table context (ListTable a) where
54+ Table context (ListTable a)
55+ where
48 type Columns (ListTable a) = HListTable (Columns a)
56 type Columns (ListTable a) = HListTable (Columns a)
49 type Context (ListTable a) = Context a
57 type Context (ListTable a) = Context a
50
58
51 fromColumns = ListTable
59 fromColumns = ListTable
52 toColumns (ListTable a) = a
60 toColumns (ListTable a) = a
53
61
62+ reify Refl (ListTable a) = ListTable (hreify a)
63+ unreify Refl (ListTable a) = ListTable (hunreify a)
64+
54
65
66+instance
67+ ( Unreifiable from a, Unreifiable to b
55−instance Recontextualize from to a b =>
68+ , Recontextualize from to a b
69+ )
56− Recontextualize from to (ListTable a) (ListTable b)
70+ => Recontextualize from to (ListTable a) (ListTable b)
57
71
58
72
59instance EqTable a => EqTable (ListTable a) where
73instance EqTable a => EqTable (ListTable a) where
src/Rel8/Table/Maybe.hs+8−2
@@ -48,7 +48,10 @@ import Rel8.Schema.HTable.Maybe ( HMaybeTable(..) )
48import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )
48import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )
49import Rel8.Schema.Name ( Name )
49import Rel8.Schema.Name ( Name )
50import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ), Sql, nullable )
50import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ), Sql, nullable )
51+import Rel8.Table
51−import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
52+ ( Table, Columns, Context, fromColumns, toColumns
53+ , reify, unreify
54+ )
52import Rel8.Table.Alternative
55import Rel8.Table.Alternative
53 ( AltTable, (<|>:)
56 ( AltTable, (<|>:)
54 , AlternativeTable, emptyTable
57 , AlternativeTable, emptyTable
@@ -139,13 +142,16 @@ instance
139
142
140 toColumns = toColumns1 toColumns
143 toColumns = toColumns1 toColumns
141 fromColumns = fromColumns1 fromColumns
144 fromColumns = fromColumns1 fromColumns
145+ reify = fmap fmap reify
146+ unreify = fmap fmap unreify
142
147
143
148
144instance
149instance
145 ( Labelable from, Nullifiable from, ConstrainTag from MaybeTag
150 ( Labelable from, Nullifiable from, ConstrainTag from MaybeTag
146 , Labelable to, Nullifiable to, ConstrainTag to MaybeTag
151 , Labelable to, Nullifiable to, ConstrainTag to MaybeTag
147 , Recontextualize from to a b
152 , Recontextualize from to a b
153+ )
148− ) => Recontextualize from to (MaybeTable a) (MaybeTable b)
154+ => Recontextualize from to (MaybeTable a) (MaybeTable b)
149
155
150
156
151instance EqTable a => EqTable (MaybeTable a) where
157instance EqTable a => EqTable (MaybeTable a) where
src/Rel8/Table/NonEmpty.hs+20−4
@@ -1,7 +1,9 @@
1+{-# language DataKinds #-}
1{-# language FlexibleContexts #-}
2{-# language FlexibleContexts #-}
2{-# language FlexibleInstances #-}
3{-# language FlexibleInstances #-}
3{-# language MultiParamTypeClasses #-}
4{-# language MultiParamTypeClasses #-}
4{-# language NamedFieldPuns #-}
5{-# language NamedFieldPuns #-}
6+{-# language QuantifiedConstraints #-}
5{-# language ScopedTypeVariables #-}
7{-# language ScopedTypeVariables #-}
6{-# language StandaloneKindSignatures #-}
8{-# language StandaloneKindSignatures #-}
7{-# language TypeApplications #-}
9{-# language TypeApplications #-}
@@ -19,6 +21,7 @@ where
19import Data.Functor.Identity ( Identity( Identity ) )
21import Data.Functor.Identity ( Identity( Identity ) )
20import Data.Kind ( Type )
22import Data.Kind ( Type )
21import Data.List.NonEmpty ( NonEmpty )
23import Data.List.NonEmpty ( NonEmpty )
24+import Data.Type.Equality ( (:~:)( Refl ) )
22import Prelude
25import Prelude
23
26
24-- rel8
27-- rel8
@@ -28,13 +31,18 @@ import Rel8.Schema.Dict ( Dict( Dict ) )
28import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
31import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
29import Rel8.Schema.HTable.Vectorize ( happend, hvectorize )
32import Rel8.Schema.HTable.Vectorize ( happend, hvectorize )
30import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
33import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
34+import Rel8.Schema.Reify ( hreify, hunreify )
31import Rel8.Schema.Spec ( SSpec(..) )
35import Rel8.Schema.Spec ( SSpec(..) )
32import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
36import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
37+import Rel8.Table
33−import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )
38+ ( Table, Context, Columns, fromColumns, toColumns
39+ , reify, unreify
40+ )
34import Rel8.Table.Alternative ( AltTable, (<|>:) )
41import Rel8.Table.Alternative ( AltTable, (<|>:) )
35import Rel8.Table.Eq ( EqTable, eqTable )
42import Rel8.Table.Eq ( EqTable, eqTable )
36import Rel8.Table.Ord ( OrdTable, ordTable )
43import Rel8.Table.Ord ( OrdTable, ordTable )
37import Rel8.Table.Recontextualize ( Recontextualize )
44import Rel8.Table.Recontextualize ( Recontextualize )
45+import Rel8.Table.Unreify ( Unreifiable )
38
46
39
47
40-- | A @NonEmptyTable@ value contains one or more instances of @a@. You
48-- | A @NonEmptyTable@ value contains one or more instances of @a@. You
@@ -44,16 +52,24 @@ newtype NonEmptyTable a =
44 NonEmptyTable (HNonEmptyTable (Columns a) (Col (Context a)))
52 NonEmptyTable (HNonEmptyTable (Columns a) (Col (Context a)))
45
53
46
54
55+instance (Table context a, Unreifiable context a) =>
47−instance Table context a => Table context (NonEmptyTable a) where
56+ Table context (NonEmptyTable a)
57+ where
48 type Columns (NonEmptyTable a) = HNonEmptyTable (Columns a)
58 type Columns (NonEmptyTable a) = HNonEmptyTable (Columns a)
49 type Context (NonEmptyTable a) = Context a
59 type Context (NonEmptyTable a) = Context a
50
60
51 fromColumns = NonEmptyTable
61 fromColumns = NonEmptyTable
52 toColumns (NonEmptyTable a) = a
62 toColumns (NonEmptyTable a) = a
53
63
64+ reify Refl (NonEmptyTable a) = NonEmptyTable (hreify a)
65+ unreify Refl (NonEmptyTable a) = NonEmptyTable (hunreify a)
66+
54
67
68+instance
69+ ( Unreifiable from a, Unreifiable to b
55−instance Recontextualize from to a b =>
70+ , Recontextualize from to a b
71+ )
56− Recontextualize from to (NonEmptyTable a) (NonEmptyTable b)
72+ => Recontextualize from to (NonEmptyTable a) (NonEmptyTable b)
57
73
58
74
59instance EqTable a => EqTable (NonEmptyTable a) where
75instance EqTable a => EqTable (NonEmptyTable a) where
src/Rel8/Table/These.hs+8−2
@@ -24,6 +24,7 @@ module Rel8.Table.These
24where
24where
25
25
26-- base
26-- base
27+import Control.Applicative ( liftA2 )
27import Data.Bifunctor ( Bifunctor, bimap )
28import Data.Bifunctor ( Bifunctor, bimap )
28import Data.Functor.Identity ( runIdentity )
29import Data.Functor.Identity ( runIdentity )
29import Data.Kind ( Type )
30import Data.Kind ( Type )
@@ -49,8 +50,11 @@ import Rel8.Schema.HTable.Label ( hlabel, hunlabel )
49import Rel8.Schema.HTable.Identity ( HIdentity(..) )
50import Rel8.Schema.HTable.Identity ( HIdentity(..) )
50import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )
51import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )
51import Rel8.Schema.HTable.These ( HTheseTable(..) )
52import Rel8.Schema.HTable.These ( HTheseTable(..) )
52−import Rel8.Schema.Name ( Name )
53+import Rel8.Schema.Name ( Name )
54+import Rel8.Table
53−import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
55+ ( Table, Columns, Context, fromColumns, toColumns
56+ , reify, unreify
57+ )
54import Rel8.Table.Eq ( EqTable, eqTable )
58import Rel8.Table.Eq ( EqTable, eqTable )
55import Rel8.Table.Maybe
59import Rel8.Table.Maybe
56 ( MaybeTable(..)
60 ( MaybeTable(..)
@@ -128,6 +132,8 @@ instance
128
132
129 toColumns = toColumns2 toColumns toColumns
133 toColumns = toColumns2 toColumns toColumns
130 fromColumns = fromColumns2 fromColumns fromColumns
134 fromColumns = fromColumns2 fromColumns fromColumns
135+ reify = liftA2 bimap reify reify
136+ unreify = liftA2 bimap unreify unreify
131
137
132
138
133instance
139instance
src/Rel8/Table/Unreify.hsnew file+43
@@ -0,0 +1,43 @@
1+{-# language DataKinds #-}
2+{-# language StandaloneKindSignatures #-}
3+{-# language TypeFamilies #-}
4+{-# language UndecidableInstances #-}
5+
6+-- | This module implements some machinery for implementing methods of the
7+-- 'Table' class for a particular special (but important) class of polymorphic
8+-- @Table@ types.
9+--
10+-- This special case is characterised by a @newtype@ wrapper around a bare
11+-- 'HTable' which is constructed by applying a type family to the polymorphic
12+-- type variable.
13+--
14+-- Examples of this class of @Table@ include @ListTable@ and @NonEmptyTable@.
15+--
16+-- The tricky part about implementing @Table@ for these types is 'reify' and
17+-- 'unreify'. There is no guarantee in general that @'Unreify' a@ is itself
18+-- a @Table@, let alone a @Table@ with the same 'Columns' as @a@
19+-- (e.g., @Unreify (AColumn Result Bool) = Bool@, and @Bool@ is not a
20+-- @Table@)
21+
22+module Rel8.Table.Unreify
23+ ( Unreifiable
24+ )
25+where
26+
27+-- base
28+import Data.Kind ( Constraint, Type )
29+import Prelude ()
30+
31+-- rel8
32+import qualified Rel8.Schema.Kind as K
33+import Rel8.Schema.Reify ( Reify )
34+import Rel8.Table ( Table, Columns, Unreify )
35+
36+
37+type Unreifiable :: K.Context -> Type -> Constraint
38+type family Unreifiable context a where
39+ Unreifiable (Reify context) a =
40+ ( Table context (Unreify a)
41+ , Columns a ~ Columns (Unreify a)
42+ )
43+ Unreifiable _ _ = ()