git.iko.soy/rel8
on 1c73ec6 help sign in
rel8/src/Rel8/Schema/Generic.hs
188 lines 5.8 kB history raw
1{-# language DataKinds #-}
2{-# language DefaultSignatures #-}
3{-# language FlexibleContexts #-}
4{-# language FlexibleInstances #-}
5{-# language MultiParamTypeClasses #-}
6{-# language ScopedTypeVariables #-}
7{-# language StandaloneKindSignatures #-}
8{-# language TypeApplications #-}
9{-# language TypeFamilies #-}
10{-# language UndecidableInstances #-}
12{-# options_ghc -fno-warn-orphans #-}
14module Rel8.Schema.Generic
15 ( Rel8able
16 , KRel8able
17 )
18where
20-- base
21import Data.Kind ( Constraint, Type )
22import Data.Proxy ( Proxy( Proxy ) )
23import Data.Type.Equality ( (:~:)( Refl ) )
24import GHC.Generics ( Generic, Rep, from, to )
25import Prelude
27-- rel8
28import Rel8.Kind.Context
29 ( SContext( SReify )
30 , Reifiable, contextSing
31 , sLabelable, sReifiable
32 )
33import Rel8.Generic.Record ( Record(..) )
34import Rel8.Generic.Table
35 ( GTable, GColumns, fromGColumns, toGColumns
36 , GUnreify
37 )
38import qualified Rel8.Generic.Table as G
39import Rel8.Schema.Context ( Col )
40import Rel8.Schema.Context.Label ( Labelable )
41import Rel8.Schema.Dict ( Dict( Dict ) )
42import Rel8.Schema.HTable ( HTable )
43import qualified Rel8.Schema.Kind as K
44import Rel8.Schema.Name ( Name )
45import Rel8.Schema.Reify ( Reify, UnwrapReify, hreify, hunreify )
46import Rel8.Table
47 ( Table, Columns, Context, fromColumns, toColumns
48 , Unreify, reify, unreify
49 , TTable, TColumns, TUnreify
50 )
53instance (Rel8able t, Labelable context, Reifiable context) =>
54 Table context (t context)
55 where
56 type Columns (t context) = GRep t
57 type Context (t context) = context
58 type Unreify (t context) = t (UnwrapReify context)
60 fromColumns = gunreify . gfromColumns . hreify
61 toColumns = hunreify . gtoColumns . greify
63 reify Refl = case contextSing @context of
64 SReify context -> case sLabelable context of
65 Dict -> case sReifiable context of
66 Dict -> greify
68 unreify Refl = case contextSing @context of
69 SReify context -> case sLabelable context of
70 Dict -> case sReifiable context of
71 Dict -> gunreify
74type KRel8able :: Type
75type KRel8able = K.Table
78-- | This type class allows you to define custom 'Table's using higher-kinded
79-- data types. Higher-kinded data types are data types of the pattern:
80--
81-- @
82-- data MyType f =
83-- MyType { field1 :: Column f T1 OR HK1 f
84-- , field2 :: Column f T2 OR HK2 f
85-- , ...
86-- , fieldN :: Column f Tn OR HKn f
87-- }
88-- @
89--
90-- where @Tn@ is any Haskell type, and @HKn@ is any higher-kinded type.
91--
92-- That is, higher-kinded data are records where all fields in the record are
93-- all either of the type @Column f T@ (for any @T@), or are themselves
94-- higher-kinded data:
95--
96-- [Nested]
97--
98-- @
99-- data Nested f =
100-- Nested { nested1 :: MyType f
101-- , nested2 :: MyType f
102-- }
103-- @
104--
105-- The @Rel8able@ type class is used to give us a special mapping operation
106-- that lets us change the type parameter @f@.
107--
108-- [Supplying @Rel8able@ instances]
109--
110-- This type class should be derived generically for all table types in your
111-- project. To do this, enable the @DeriveAnyType@ and @DeriveGeneric@ language
112-- extensions:
113--
114-- @
115-- \{\-\# LANGUAGE DeriveAnyClass, DeriveGeneric #-\}
116--
117-- data MyType f = MyType { fieldA :: Column f T }
118-- deriving ( GHC.Generics.Generic, Rel8able )
119-- @
120type Rel8able :: KRel8able -> Constraint
121class HTable (GRep t) => Rel8able t where
122 type GRep t :: K.HTable
124 gfromColumns :: (Labelable context, Reifiable context)
125 => GRep t (Col (Reify context)) -> t (Reify context)
127 gtoColumns :: (Labelable context, Reifiable context)
128 => t (Reify context) -> GRep t (Col (Reify context))
130 greify :: (Labelable context, Reifiable context)
131 => t context -> t (Reify context)
133 gunreify :: (Labelable context, Reifiable context)
134 => t (Reify context) -> t context
136 type GRep t = GColumns TColumns (Rep (Record (t (Reify Name))))
138 default gfromColumns :: forall context.
139 ( Generic (Record (t (Reify context)))
140 , GColumns TColumns (Rep (Record (t (Reify context)))) ~ GRep t
141 , GTable (TTable (Reify context)) TColumns (Col (Reify context)) (Rep (Record (t (Reify context))))
142 )
143 => GRep t (Col (Reify context)) -> t (Reify context)
144 gfromColumns =
145 unrecord .
146 to .
147 fromGColumns @(TTable (Reify context)) @TColumns fromColumns
149 default gtoColumns :: forall context.
150 ( Generic (Record (t (Reify context)))
151 , GColumns TColumns (Rep (Record (t (Reify context)))) ~ GRep t
152 , GTable (TTable (Reify context)) TColumns (Col (Reify context)) (Rep (Record (t (Reify context))))
153 )
154 => t (Reify context) -> GRep t (Col (Reify context))
155 gtoColumns =
156 toGColumns @(TTable (Reify context)) @TColumns toColumns .
157 from .
158 Record
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
175 default gunreify :: forall context.
176 ( Generic (Record (t context))
177 , Generic (Record (t (Reify context)))
178 , GTable (TTable (Reify context)) TColumns (Col (Reify context)) (Rep (Record (t (Reify context))))
179 , Rep (Record (t context)) ~ GUnreify TUnreify (Rep (Record (t (Reify context))))
180 )
181 => t (Reify context) -> t context
182 gunreify =
183 unrecord .
184 to .
185 G.gunreify @(TTable (Reify context)) @TColumns @(Col (Reify context)) (Proxy @TUnreify)
186 (unreify Refl) .
187 from .
188 Record