git.iko.soy/rel8
on d07e3b5 help sign in
rel8/src/Rel8/Generic/Rel8able.hs
251 lines 7.7 kB history raw
1{-# language AllowAmbiguousTypes #-}
2{-# language DataKinds #-}
3{-# language DefaultSignatures #-}
4{-# language FlexibleContexts #-}
5{-# language FlexibleInstances #-}
6{-# language MultiParamTypeClasses #-}
7{-# language ScopedTypeVariables #-}
8{-# language StandaloneKindSignatures #-}
9{-# language TypeApplications #-}
10{-# language TypeFamilies #-}
11{-# language UndecidableInstances #-}
13module Rel8.Generic.Rel8able
14 ( KRel8able, Rel8able
15 , Algebra
16 , GRep
17 , GColumns, GContext, gfromColumns, gtoColumns
18 , GColumnsADT, gfromColumnsADT, gtoColumnsADT
19 , greify, gunreify
20 , TUnreifyContext
21 )
22where
24-- base
25import Data.Kind ( Constraint, Type )
26import Data.Proxy ( Proxy( Proxy ) )
27import Data.Type.Equality ( (:~:)( Refl ) )
28import GHC.Generics ( Generic, Rep, from, to )
29import Prelude
31-- rel8
32import Rel8.Kind.Context ( Reifiable )
33import Rel8.FCF ( Eval, Exp )
34import Rel8.Generic.Map ( GMap, GMappable, gmap, gunmap )
35import Rel8.Generic.Record ( Record(..) )
36import Rel8.Generic.Table
37 ( GGTable, GGColumns, GGContext, ggfromColumns, ggtoColumns
38 , GAlgebra
39 )
40import qualified Rel8.Generic.Table.ADT as G
41import Rel8.Kind.Algebra ( KnownAlgebra )
42import qualified Rel8.Kind.Algebra as K ( Algebra(..) )
43import Rel8.Schema.Context ( Col )
44import Rel8.Schema.Context.Label ( Labelable )
45import Rel8.Schema.HTable ( HTable )
46import qualified Rel8.Schema.Kind as K
47import Rel8.Schema.Reify ( Col( Reify ), Reify, UnwrapReify )
48import Rel8.Schema.Result ( Result )
49import Rel8.Table
50 ( fromColumns, toColumns, reify, unreify
51 , TTable, TColumns, TContext, TUnreify
52 )
55type KRel8able :: Type
56type KRel8able = K.Rel8able
59-- | This type class allows you to define custom 'Table's using higher-kinded
60-- data types. Higher-kinded data types are data types of the pattern:
61--
62-- @
63-- data MyType f =
64-- MyType { field1 :: Column f T1 OR HK1 f
65-- , field2 :: Column f T2 OR HK2 f
66-- , ...
67-- , fieldN :: Column f Tn OR HKn f
68-- }
69-- @
70--
71-- where @Tn@ is any Haskell type, and @HKn@ is any higher-kinded type.
72--
73-- That is, higher-kinded data are records where all fields in the record are
74-- all either of the type @Column f T@ (for any @T@), or are themselves
75-- higher-kinded data:
76--
77-- [Nested]
78--
79-- @
80-- data Nested f =
81-- Nested { nested1 :: MyType f
82-- , nested2 :: MyType f
83-- }
84-- @
85--
86-- The @Rel8able@ type class is used to give us a special mapping operation
87-- that lets us change the type parameter @f@.
88--
89-- [Supplying @Rel8able@ instances]
90--
91-- This type class should be derived generically for all table types in your
92-- project. To do this, enable the @DeriveAnyType@ and @DeriveGeneric@ language
93-- extensions:
94--
95-- @
96-- \{\-\# LANGUAGE DeriveAnyClass, DeriveGeneric #-\}
97--
98-- data MyType f = MyType { fieldA :: Column f T }
99-- deriving ( GHC.Generics.Generic, Rel8able )
100-- @
101type Rel8able :: K.Rel8able -> Constraint
102class
103 ( HTable (GColumns t)
104 , HTable (GColumnsADT t)
105 , GContext t Result ~ Result
106 )
107 => Rel8able t
108 where
109 type Algebra t :: K.Algebra
111 type GRep t (context :: K.Context) :: Type -> Type
113 type GColumns t :: K.HTable
115 type GContext t (context :: K.Context) :: K.Context
117 gfromColumns :: (Labelable context, Reifiable context, GContext t context ~ context)
118 => GColumns t (Col (Reify context)) -> t (Reify context)
120 gtoColumns :: (Labelable context, Reifiable context, GContext t context ~ context)
121 => t (Reify context) -> GColumns t (Col (Reify context))
123 gfromColumnsADT :: GColumnsADT t (Col (Reify Result)) -> t (Reify Result)
125 gtoColumnsADT :: t (Reify Result) -> GColumnsADT t (Col (Reify Result))
127 greify :: (Labelable context, Reifiable context)
128 => t context -> t (Reify context)
130 gunreify :: (Labelable context, Reifiable context)
131 => t (Reify context) -> t context
133 type Algebra t = GAlgebra (GRep t (Reify Result))
135 type GRep t context = Rep (Record (t context))
137 type GColumns t = Eval (GGColumns (Algebra t) TColumns (GRep t (Reify Result)))
139 type GContext t context =
140 Eval (GGContext (Algebra t) TUnreifyContext (GRep t (Reify context)))
142 default gfromColumns :: forall context.
143 ( Generic (Record (t (Reify context)))
144 , GRep t (Reify context) ~ Rep (Record (t (Reify context)))
145 , KnownAlgebra (Algebra t)
146 , Eval (GGTable (Algebra t) (TTable (Reify context)) TColumns (Col (Reify context)) (GRep t (Reify context)))
147 , Eval (GGColumns (Algebra t) TColumns (GRep t (Reify context))) ~ GColumns t
148 , Eval (GGContext (Algebra t) TUnreifyContext (GRep t (Reify context))) ~ context
149 )
150 => GColumns t (Col (Reify context)) -> t (Reify context)
151 gfromColumns =
152 unrecord .
153 to .
154 ggfromColumns
155 @(Algebra t)
156 @(TTable (Reify context))
157 @TColumns
158 (\(Reify a) -> a)
159 Reify
160 fromColumns
162 default gtoColumns :: forall context.
163 ( Generic (Record (t (Reify context)))
164 , GRep t (Reify context) ~ Rep (Record (t (Reify context)))
165 , KnownAlgebra (Algebra t)
166 , Eval (GGTable (Algebra t) (TTable (Reify context)) TColumns (Col (Reify context)) (GRep t (Reify context)))
167 , Eval (GGColumns (Algebra t) TColumns (GRep t (Reify context))) ~ GColumns t
168 , Eval (GGContext (Algebra t) TUnreifyContext (GRep t (Reify context))) ~ context
169 )
170 => t (Reify context) -> GColumns t (Col (Reify context))
171 gtoColumns =
172 ggtoColumns
173 @(Algebra t)
174 @(TTable (Reify context))
175 @TColumns
176 (\(Reify a) -> a)
177 Reify
178 toColumns .
179 from .
180 Record
182 default gfromColumnsADT ::
183 ( Generic (Record (t (Reify Result)))
184 , GRep t (Reify Result) ~ Rep (Record (t (Reify Result)))
185 , G.GTableADT (TTable (Reify Result)) TColumns (Col (Reify Result)) (GRep t (Reify Result))
186 )
187 => GColumnsADT t (Col (Reify Result)) -> t (Reify Result)
188 gfromColumnsADT =
189 unrecord .
190 to .
191 G.gfromColumnsADT
192 @(TTable (Reify Result))
193 @TColumns
194 (\(Reify a) -> a)
195 Reify
196 fromColumns
198 default gtoColumnsADT ::
199 ( Generic (Record (t (Reify Result)))
200 , GRep t (Reify Result) ~ Rep (Record (t (Reify Result)))
201 , G.GTableADT (TTable (Reify Result)) TColumns (Col (Reify Result)) (GRep t (Reify Result))
202 )
203 => t (Reify Result) -> GColumnsADT t (Col (Reify Result))
204 gtoColumnsADT =
205 G.gtoColumnsADT
206 @(TTable (Reify Result))
207 @TColumns
208 (\(Reify a) -> a)
209 Reify
210 toColumns .
211 from .
212 Record
214 default greify :: forall context.
215 ( Generic (Record (t context))
216 , GRep t context ~ Rep (Record (t context))
217 , Generic (Record (t (Reify context)))
218 , GRep t (Reify context) ~ Rep (Record (t (Reify context)))
219 , GMappable (TTable (Reify context)) (GRep t (Reify context))
220 , GRep t context ~ GMap TUnreify (GRep t (Reify context))
221 )
222 => t context -> t (Reify context)
223 greify =
224 unrecord .
225 to .
226 gunmap @(TTable (Reify context)) (Proxy @TUnreify) (reify Refl) .
227 from .
228 Record
230 default gunreify :: forall context.
231 ( Generic (Record (t context))
232 , GRep t context ~ Rep (Record (t context))
233 , Generic (Record (t (Reify context)))
234 , GRep t (Reify context) ~ Rep (Record (t (Reify context)))
235 , GMappable (TTable (Reify context)) (GRep t (Reify context))
236 , GRep t context ~ GMap TUnreify (GRep t (Reify context))
237 )
238 => t (Reify context) -> t context
239 gunreify =
240 unrecord .
241 to .
242 gmap @(TTable (Reify context)) (Proxy @TUnreify) (unreify Refl) .
243 from .
244 Record
247type GColumnsADT t = G.GColumnsADT TColumns (GRep t (Reify Result))
250data TUnreifyContext :: Type -> Exp K.Context
251type instance Eval (TUnreifyContext a) = UnwrapReify (Eval (TContext a))