@@ -3,12 +3,14 @@
33{-# language DataKinds #-}
44{-# language DefaultSignatures #-}
55{-# language FlexibleContexts #-}
6+{-# language FlexibleInstances #-}
67{-# language LambdaCase #-}
8+{-# language MultiParamTypeClasses #-}
79{-# language ScopedTypeVariables #-}
810{-# language StandaloneKindSignatures #-}
911{-# language TypeApplications #-}
10−{-# language TypeFamilies #-}
1112{-# language TypeFamilyDependencies #-}
13+{-# language TypeOperators #-}
1214{-# language UndecidableInstances #-}
1315
1416module Rel8.Generic.Rel8able
@@ -17,31 +19,36 @@ module Rel8.Generic.Rel8able
1719 , GRep
1820 , GColumns, gfromColumns, gtoColumns
1921 , GFromExprs, gfromResult, gtoResult
22+ , TSerialize, serialize, deserialize
2023 )
2124where
2225
2326-- base
2427import Data.Kind ( Constraint, Type )
28+import Data.Type.Equality ( type (==) )
2529import GHC.Generics ( Generic, Rep, from, to )
2630import Prelude
2731
2832-- rel8
2933import Rel8.Aggregate ( Aggregate )
3034import Rel8.Expr ( Expr )
31−import Rel8.Generic.Map ( GMap )
35+import Rel8.FCF ( Exp, Eval )
3236import Rel8.Generic.Record ( Record(..) )
3337import Rel8.Generic.Table ( GAlgebra )
3438import qualified Rel8.Generic.Table.Record as G
3539import qualified Rel8.Kind.Algebra as K ( Algebra(..) )
36−import Rel8.Schema.Context.Virtual ( Abstract(..) )
40+import Rel8.Kind.Context ( SContext(..) )
3741import Rel8.Schema.HTable ( HTable )
3842import qualified Rel8.Schema.Kind as K
3943import Rel8.Schema.Name ( Name )
4044import Rel8.Schema.Result ( Result )
4145import Rel8.Table
42− ( fromColumns, toColumns, fromResult, toResult
43− , TTable, TColumns, TFromExprs
46+ ( Table, Columns, Context, fromColumns, toColumns
47+ , FromExprs, fromResult, toResult
48+ , Transpose
49+ , TTable, TColumns
4450 )
51+import Rel8.Table.Transpose ( Transposes )
4552
4653
4754-- | The kind of 'Rel8able' types
@@ -49,6 +56,40 @@ type KRel8able :: Type
4956type KRel8able = K.Rel8able
5057
5158
59+type Serialize :: Bool -> Type -> Type -> Constraint
60+class transposition ~ (a == Transpose Result expr) =>
61+ Serialize transposition expr a
62+ where
63+ serialize :: a -> Columns expr Result
64+ deserialize :: Columns expr Result -> a
65+
66+
67+instance
68+ ( (a == Transpose Result expr) ~ 'True
69+ , Transposes Expr Result expr a
70+ )
71+ => Serialize 'True expr a
72+ where
73+ serialize = toColumns
74+ deserialize = fromColumns
75+
76+
77+instance
78+ ( (a == Transpose Result expr) ~ 'False
79+ , Table (Context expr) expr
80+ , FromExprs expr ~ a
81+ )
82+ => Serialize 'False expr a
83+ where
84+ serialize = toResult @_ @expr
85+ deserialize = fromResult @_ @expr
86+
87+
88+data TSerialize :: Type -> Type -> Exp Constraint
89+type instance Eval (TSerialize expr a) =
90+ Serialize (a == Transpose Result expr) expr a
91+
92+
5293-- | This type class allows you to define custom 'Table's using higher-kinded
5394-- data types. Higher-kinded data types are data types of the pattern:
5495--
@@ -96,8 +137,8 @@ class HTable (GColumns t) => Rel8able t where
96137 type GColumns t :: K.HTable
97138 type GFromExprs t :: Type
98139
99− gfromColumns :: Abstract context -> GColumns t context -> t context
100− gtoColumns :: Abstract context -> t context -> GColumns t context
140+ gfromColumns :: SContext context -> GColumns t context -> t context
141+ gtoColumns :: SContext context -> t context -> GColumns t context
101142
102143 gfromResult :: GColumns t Result -> GFromExprs t
103144 gtoResult :: GFromExprs t -> GColumns t Result
@@ -106,62 +147,38 @@ class HTable (GColumns t) => Rel8able t where
106147 type GFromExprs t = t Result
107148
108149 default gfromColumns :: forall context.
109− ( VRel8able t Aggregate
110− , VRel8able t Expr
111− , VRel8able t Name
150+ ( SRel8able t Aggregate
151+ , SRel8able t Expr
152+ , SRel8able t Name
153+ , SSerialize t
112154 )
113− => Abstract context -> GColumns t context -> t context
155+ => SContext context -> GColumns t context -> t context
114156 gfromColumns = \case
115− VAggregate -> vfromColumns
116− VExpr -> vfromColumns
117− VName -> vfromColumns
157+ SAggregate -> sfromColumns
158+ SExpr -> sfromColumns
159+ SName -> sfromColumns
160+ SResult -> sfromResult
118161
119162 default gtoColumns :: forall context.
120− ( VRel8able t Aggregate
121− , VRel8able t Expr
122− , VRel8able t Name
163+ ( SRel8able t Aggregate
164+ , SRel8able t Expr
165+ , SRel8able t Name
166+ , SSerialize t
123167 )
124− => Abstract context -> t context -> GColumns t context
168+ => SContext context -> t context -> GColumns t context
125169 gtoColumns = \case
126− VAggregate -> vtoColumns
127− VExpr -> vtoColumns
128− VName -> vtoColumns
129−
130− default gfromResult ::
131− ( Generic (Record (t Result))
132− , G.GTable (TTable Expr) TColumns TFromExprs (GRep t Expr)
133− , G.GColumns TColumns (GRep t Expr) ~ GColumns t
134− , Rep (Record (t Result)) ~ GMap TFromExprs (GRep t Expr)
135− , GFromExprs t ~ t Result
136− )
170+ SAggregate -> stoColumns
171+ SExpr -> stoColumns
172+ SName -> stoColumns
173+ SResult -> stoResult
174+
175+ default gfromResult :: (SSerialize t, GFromExprs t ~ t Result)
137176 => GColumns t Result -> GFromExprs t
138− gfromResult =
139− unrecord .
140− to .
141− G.gfromResult
142− @(TTable Expr)
143− @TColumns
144− @TFromExprs
145− @(GRep t Expr)
146− (\(_ :: proxy x) -> fromResult @Expr @x)
147−
148− default gtoResult ::
149− ( Generic (Record (t Result))
150− , G.GTable (TTable Expr) TColumns TFromExprs (GRep t Expr)
151− , G.GColumns TColumns (GRep t Expr) ~ GColumns t
152− , Rep (Record (t Result)) ~ GMap TFromExprs (GRep t Expr)
153− , GFromExprs t ~ t Result
154− )
177+ gfromResult = sfromResult
178+
179+ default gtoResult :: (SSerialize t, GFromExprs t ~ t Result)
155180 => GFromExprs t -> GColumns t Result
156− gtoResult =
157− G.gtoResult
158− @(TTable Expr)
159− @TColumns
160− @TFromExprs
161− @(GRep t Expr)
162− (\(_ :: proxy x) -> toResult @Expr @x) .
163− from .
164− Record
181+ gtoResult = stoResult
165182
166183
167184type Algebra :: K.Rel8able -> K.Algebra
@@ -172,25 +189,59 @@ type GRep :: K.Rel8able -> K.Context -> Type -> Type
172189type GRep t context = Rep (Record (t context))
173190
174191
175−type VRel8able :: K.Rel8able -> K.Context -> Constraint
176−type VRel8able t context =
192+type SRel8able :: K.Rel8able -> K.Context -> Constraint
193+type SRel8able t context =
177194 ( Generic (Record (t context))
178− , G.GTable (TTable context) TColumns TFromExprs (GRep t context)
195+ , G.GTable (TTable context) TColumns (GRep t context)
179196 , G.GColumns TColumns (GRep t context) ~ GColumns t
180197 )
181198
182199
183−vfromColumns :: forall t context. VRel8able t context
200+type SSerialize :: K.Rel8able -> Constraint
201+type SSerialize t =
202+ ( Generic (Record (t Result))
203+ , G.GSerialize TSerialize TColumns (GRep t Expr) (GRep t Result)
204+ , G.GColumns TColumns (GRep t Expr) ~ GColumns t
205+ )
206+
207+
208+sfromColumns :: forall t context. SRel8able t context
184209 => GColumns t context -> t context
185−vfromColumns =
210+sfromColumns =
186211 unrecord .
187212 to .
188− G.gfromColumns @(TTable context) @TColumns @TFromExprs fromColumns
213+ G.gfromColumns @(TTable context) @TColumns fromColumns
189214
190215
191−vtoColumns :: forall t context. VRel8able t context
216+stoColumns :: forall t context. SRel8able t context
192217 => t context -> GColumns t context
193−vtoColumns =
194− G.gtoColumns @(TTable context) @TColumns @TFromExprs toColumns .
218+stoColumns =
219+ G.gtoColumns @(TTable context) @TColumns toColumns .
220+ from .
221+ Record
222+
223+
224+sfromResult :: forall t. SSerialize t
225+ => GColumns t Result -> t Result
226+sfromResult =
227+ unrecord .
228+ to .
229+ G.gfromResult
230+ @TSerialize
231+ @TColumns
232+ @(GRep t Expr)
233+ @(GRep t Result)
234+ (\(_ :: proxy x) -> deserialize @_ @x)
235+
236+
237+stoResult :: forall t. SSerialize t
238+ => t Result -> GColumns t Result
239+stoResult =
240+ G.gtoResult
241+ @TSerialize
242+ @TColumns
243+ @(GRep t Expr)
244+ @(GRep t Result)
245+ (\(_ :: proxy x) -> serialize @_ @x) .
195246 from .
196247 Record