git.iko.soy/rel8
on 119c825 help sign in
rel8/src/Rel8/Generic/Rel8able.hs
247 lines 6.5 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 ScopedTypeVariables #-}
10{-# language StandaloneKindSignatures #-}
11{-# language TypeApplications #-}
12{-# language TypeFamilyDependencies #-}
13{-# language TypeOperators #-}
14{-# language UndecidableInstances #-}
16module Rel8.Generic.Rel8able
17 ( KRel8able, Rel8able
18 , Algebra
19 , GRep
20 , GColumns, gfromColumns, gtoColumns
21 , GFromExprs, gfromResult, gtoResult
22 , TSerialize, serialize, deserialize
23 )
24where
26-- base
27import Data.Kind ( Constraint, Type )
28import Data.Type.Equality ( type (==) )
29import GHC.Generics ( Generic, Rep, from, to )
30import Prelude
32-- rel8
33import Rel8.Aggregate ( Aggregate )
34import Rel8.Expr ( Expr )
35import Rel8.FCF ( Exp, Eval )
36import Rel8.Generic.Record ( Record(..) )
37import Rel8.Generic.Table ( GAlgebra )
38import qualified Rel8.Generic.Table.Record as G
39import qualified Rel8.Kind.Algebra as K ( Algebra(..) )
40import Rel8.Kind.Context ( SContext(..) )
41import Rel8.Schema.HTable ( HTable )
42import qualified Rel8.Schema.Kind as K
43import Rel8.Schema.Name ( Name )
44import Rel8.Schema.Result ( Result )
45import Rel8.Table
46 ( Table, Columns, Context, fromColumns, toColumns
47 , FromExprs, fromResult, toResult
48 , Transpose
49 , TTable, TColumns
50 )
51import Rel8.Table.Transpose ( Transposes )
54-- | The kind of 'Rel8able' types
55type KRel8able :: Type
56type KRel8able = K.Rel8able
59type Serialize :: Bool -> Type -> Type -> Constraint
60class transposition ~ (a == Transpose Result expr) =>
61 Serialize transposition expr a
62 where
63 serialize :: a -> Columns expr Result
64 deserialize :: Columns expr Result -> a
67instance
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
77instance
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
88data TSerialize :: Type -> Type -> Exp Constraint
89type instance Eval (TSerialize expr a) =
90 Serialize (a == Transpose Result expr) expr a
93-- | This type class allows you to define custom 'Table's using higher-kinded
94-- data types. Higher-kinded data types are data types of the pattern:
95--
96-- @
97-- data MyType f =
98-- MyType { field1 :: Column f T1 OR HK1 f
99-- , field2 :: Column f T2 OR HK2 f
100-- , ...
101-- , fieldN :: Column f Tn OR HKn f
102-- }
103-- @
104--
105-- where @Tn@ is any Haskell type, and @HKn@ is any higher-kinded type.
106--
107-- That is, higher-kinded data are records where all fields in the record are
108-- all either of the type @Column f T@ (for any @T@), or are themselves
109-- higher-kinded data:
110--
111-- [Nested]
112--
113-- @
114-- data Nested f =
115-- Nested { nested1 :: MyType f
116-- , nested2 :: MyType f
117-- }
118-- @
119--
120-- The @Rel8able@ type class is used to give us a special mapping operation
121-- that lets us change the type parameter @f@.
122--
123-- [Supplying @Rel8able@ instances]
124--
125-- This type class should be derived generically for all table types in your
126-- project. To do this, enable the @DeriveAnyType@ and @DeriveGeneric@ language
127-- extensions:
128--
129-- @
130-- \{\-\# LANGUAGE DeriveAnyClass, DeriveGeneric #-\}
131--
132-- data MyType f = MyType { fieldA :: Column f T }
133-- deriving ( GHC.Generics.Generic, Rel8able )
134-- @
135type Rel8able :: K.Rel8able -> Constraint
136class HTable (GColumns t) => Rel8able t where
137 type GColumns t :: K.HTable
138 type GFromExprs t :: Type
140 gfromColumns :: SContext context -> GColumns t context -> t context
141 gtoColumns :: SContext context -> t context -> GColumns t context
143 gfromResult :: GColumns t Result -> GFromExprs t
144 gtoResult :: GFromExprs t -> GColumns t Result
146 type GColumns t = G.GColumns TColumns (GRep t Expr)
147 type GFromExprs t = t Result
149 default gfromColumns :: forall context.
150 ( SRel8able t Aggregate
151 , SRel8able t Expr
152 , SRel8able t Name
153 , SSerialize t
154 )
155 => SContext context -> GColumns t context -> t context
156 gfromColumns = \case
157 SAggregate -> sfromColumns
158 SExpr -> sfromColumns
159 SName -> sfromColumns
160 SResult -> sfromResult
162 default gtoColumns :: forall context.
163 ( SRel8able t Aggregate
164 , SRel8able t Expr
165 , SRel8able t Name
166 , SSerialize t
167 )
168 => SContext context -> t context -> GColumns t context
169 gtoColumns = \case
170 SAggregate -> stoColumns
171 SExpr -> stoColumns
172 SName -> stoColumns
173 SResult -> stoResult
175 default gfromResult :: (SSerialize t, GFromExprs t ~ t Result)
176 => GColumns t Result -> GFromExprs t
177 gfromResult = sfromResult
179 default gtoResult :: (SSerialize t, GFromExprs t ~ t Result)
180 => GFromExprs t -> GColumns t Result
181 gtoResult = stoResult
184type Algebra :: K.Rel8able -> K.Algebra
185type Algebra t = GAlgebra (GRep t Expr)
188type GRep :: K.Rel8able -> K.Context -> Type -> Type
189type GRep t context = Rep (Record (t context))
192type SRel8able :: K.Rel8able -> K.Context -> Constraint
193type SRel8able t context =
194 ( Generic (Record (t context))
195 , G.GTable (TTable context) TColumns (GRep t context)
196 , G.GColumns TColumns (GRep t context) ~ GColumns t
197 )
200type SSerialize :: K.Rel8able -> Constraint
201type 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 )
208sfromColumns :: forall t context. SRel8able t context
209 => GColumns t context -> t context
210sfromColumns =
211 unrecord .
212 to .
213 G.gfromColumns @(TTable context) @TColumns fromColumns
216stoColumns :: forall t context. SRel8able t context
217 => t context -> GColumns t context
218stoColumns =
219 G.gtoColumns @(TTable context) @TColumns toColumns .
220 from .
221 Record
224sfromResult :: forall t. SSerialize t
225 => GColumns t Result -> t Result
226sfromResult =
227 unrecord .
228 to .
229 G.gfromResult
230 @TSerialize
231 @TColumns
232 @(GRep t Expr)
233 @(GRep t Result)
234 (\(_ :: proxy x) -> deserialize @_ @x)
237stoResult :: forall t. SSerialize t
238 => t Result -> GColumns t Result
239stoResult =
240 G.gtoResult
241 @TSerialize
242 @TColumns
243 @(GRep t Expr)
244 @(GRep t Result)
245 (\(_ :: proxy x) -> serialize @_ @x) .
246 from .
247 Record