git.iko.soy/rel8
on 032242f help sign in
rel8/src/Rel8/Generic/Rel8able.hs
260 lines 6.9 kB history raw
1{-# language AllowAmbiguousTypes #-}
2{-# language ConstraintKinds #-}
3{-# language DataKinds #-}
4{-# language DefaultSignatures #-}
5{-# language FlexibleContexts #-}
6{-# language FlexibleInstances #-}
7{-# language LambdaCase #-}
8{-# language MultiParamTypeClasses #-}
9{-# language QuantifiedConstraints #-}
10{-# language ScopedTypeVariables #-}
11{-# language StandaloneKindSignatures #-}
12{-# language TypeApplications #-}
13{-# language TypeFamilyDependencies #-}
14{-# language TypeOperators #-}
15{-# language UndecidableInstances #-}
17module Rel8.Generic.Rel8able
18 ( KRel8able, Rel8able
19 , Algebra
20 , GRep
21 , GColumns, gfromColumns, gtoColumns
22 , GFromExprs, gfromResult, gtoResult
23 , TSerialize, serialize, deserialize
24 )
25where
27-- base
28import Data.Kind ( Constraint, Type )
29import Data.Type.Equality ( type (==) )
30import GHC.Generics ( Generic, Rep, from, to )
31import Prelude
33-- rel8
34import Rel8.Aggregate ( Aggregate )
35import Rel8.Expr ( Expr )
36import Rel8.FCF ( Exp, Eval )
37import Rel8.Generic.Record ( Record(..) )
38import Rel8.Generic.Table ( GAlgebra )
39import qualified Rel8.Generic.Table.Record as G
40import qualified Rel8.Kind.Algebra as K ( Algebra(..) )
41import Rel8.Kind.Context ( SContext(..) )
42import Rel8.Schema.Field ( Field )
43import Rel8.Schema.HTable ( HTable )
44import qualified Rel8.Schema.Kind as K
45import Rel8.Schema.Name ( Name )
46import Rel8.Schema.Result ( Result )
47import Rel8.Table
48 ( Table, Columns, Context, fromColumns, toColumns
49 , FromExprs, fromResult, toResult
50 , Transpose
51 , TTable, TColumns
52 )
53import Rel8.Table.Transpose ( Transposes )
56-- | The kind of 'Rel8able' types
57type KRel8able :: Type
58type KRel8able = K.Rel8able
61type Serialize :: Bool -> Type -> Type -> Constraint
62class transposition ~ (a == Transpose Result expr) =>
63 Serialize transposition expr a
64 where
65 serialize :: a -> Columns expr Result
66 deserialize :: Columns expr Result -> a
69instance
70 ( (a == Transpose Result expr) ~ 'True
71 , Transposes Expr Result expr a
72 )
73 => Serialize 'True expr a
74 where
75 serialize = toColumns
76 deserialize = fromColumns
79instance
80 ( (a == Transpose Result expr) ~ 'False
81 , Table (Context expr) expr
82 , FromExprs expr ~ a
83 )
84 => Serialize 'False expr a
85 where
86 serialize = toResult @_ @expr
87 deserialize = fromResult @_ @expr
90data TSerialize :: Type -> Type -> Exp Constraint
91type instance Eval (TSerialize expr a) =
92 Serialize (a == Transpose Result expr) expr a
95-- | This type class allows you to define custom 'Table's using higher-kinded
96-- data types. Higher-kinded data types are data types of the pattern:
97--
98-- @
99-- data MyType f =
100-- MyType { field1 :: Column f T1 OR HK1 f
101-- , field2 :: Column f T2 OR HK2 f
102-- , ...
103-- , fieldN :: Column f Tn OR HKn f
104-- }
105-- @
106--
107-- where @Tn@ is any Haskell type, and @HKn@ is any higher-kinded type.
108--
109-- That is, higher-kinded data are records where all fields in the record are
110-- all either of the type @Column f T@ (for any @T@), or are themselves
111-- higher-kinded data:
112--
113-- [Nested]
114--
115-- @
116-- data Nested f =
117-- Nested { nested1 :: MyType f
118-- , nested2 :: MyType f
119-- }
120-- @
121--
122-- The @Rel8able@ type class is used to give us a special mapping operation
123-- that lets us change the type parameter @f@.
124--
125-- [Supplying @Rel8able@ instances]
126--
127-- This type class should be derived generically for all table types in your
128-- project. To do this, enable the @DeriveAnyType@ and @DeriveGeneric@ language
129-- extensions:
130--
131-- @
132-- \{\-\# LANGUAGE DeriveAnyClass, DeriveGeneric #-\}
133--
134-- data MyType f = MyType { fieldA :: Column f T }
135-- deriving ( GHC.Generics.Generic, Rel8able )
136-- @
137type Rel8able :: K.Rel8able -> Constraint
138class HTable (GColumns t) => Rel8able t where
139 type GColumns t :: K.HTable
140 type GFromExprs t :: Type
142 gfromColumns :: SContext context -> GColumns t context -> t context
143 gtoColumns :: SContext context -> t context -> GColumns t context
145 gfromResult :: GColumns t Result -> GFromExprs t
146 gtoResult :: GFromExprs t -> GColumns t Result
148 type GColumns t = G.GColumns TColumns (GRep t Expr)
149 type GFromExprs t = t Result
151 default gfromColumns :: forall context.
152 ( SRel8able t Aggregate
153 , SRel8able t Expr
154 , forall table. SRel8able t (Field table)
155 , SRel8able t Name
156 , SSerialize t
157 )
158 => SContext context -> GColumns t context -> t context
159 gfromColumns = \case
160 SAggregate -> sfromColumns
161 SExpr -> sfromColumns
162 SField -> sfromColumns
163 SName -> sfromColumns
164 SResult -> sfromResult
166 default gtoColumns :: forall context.
167 ( SRel8able t Aggregate
168 , SRel8able t Expr
169 , forall table. SRel8able t (Field table)
170 , SRel8able t Name
171 , SSerialize t
172 )
173 => SContext context -> t context -> GColumns t context
174 gtoColumns = \case
175 SAggregate -> stoColumns
176 SExpr -> stoColumns
177 SField -> stoColumns
178 SName -> stoColumns
179 SResult -> stoResult
181 default gfromResult :: (SSerialize t, GFromExprs t ~ t Result)
182 => GColumns t Result -> GFromExprs t
183 gfromResult = sfromResult
185 default gtoResult :: (SSerialize t, GFromExprs t ~ t Result)
186 => GFromExprs t -> GColumns t Result
187 gtoResult = stoResult
190type Algebra :: K.Rel8able -> K.Algebra
191type Algebra t = GAlgebra (GRep t Expr)
194type GRep :: K.Rel8able -> K.Context -> Type -> Type
195type GRep t context = Rep (Record (t context))
198type SRel8able :: K.Rel8able -> K.Context -> Constraint
199class
200 ( Generic (Record (t context))
201 , G.GTable (TTable context) TColumns (GRep t context)
202 , G.GColumns TColumns (GRep t context) ~ GColumns t
203 )
204 => SRel8able t context
205instance
206 ( Generic (Record (t context))
207 , G.GTable (TTable context) TColumns (GRep t context)
208 , G.GColumns TColumns (GRep t context) ~ GColumns t
209 )
210 => SRel8able t context
213type SSerialize :: K.Rel8able -> Constraint
214type SSerialize t =
215 ( Generic (Record (t Result))
216 , G.GSerialize TSerialize TColumns (GRep t Expr) (GRep t Result)
217 , G.GColumns TColumns (GRep t Expr) ~ GColumns t
218 )
221sfromColumns :: forall t context. SRel8able t context
222 => GColumns t context -> t context
223sfromColumns =
224 unrecord .
225 to .
226 G.gfromColumns @(TTable context) @TColumns fromColumns
229stoColumns :: forall t context. SRel8able t context
230 => t context -> GColumns t context
231stoColumns =
232 G.gtoColumns @(TTable context) @TColumns toColumns .
233 from .
234 Record
237sfromResult :: forall t. SSerialize t
238 => GColumns t Result -> t Result
239sfromResult =
240 unrecord .
241 to .
242 G.gfromResult
243 @TSerialize
244 @TColumns
245 @(GRep t Expr)
246 @(GRep t Result)
247 (\(_ :: proxy x) -> deserialize @_ @x)
250stoResult :: forall t. SSerialize t
251 => t Result -> GColumns t Result
252stoResult =
253 G.gtoResult
254 @TSerialize
255 @TColumns
256 @(GRep t Expr)
257 @(GRep t Result)
258 (\(_ :: proxy x) -> serialize @_ @x) .
259 from .
260 Record