git.iko.soy/rel8
on 1c73ec6 help sign in
rel8/src/Rel8/Generic/Table.hs
163 lines 5.5 kB history raw
1{-# language AllowAmbiguousTypes #-}
2{-# language DataKinds #-}
3{-# language FlexibleInstances #-}
4{-# language MultiParamTypeClasses #-}
5{-# language PolyKinds #-}
6{-# language RankNTypes #-}
7{-# language ScopedTypeVariables #-}
8{-# language StandaloneKindSignatures #-}
9{-# language TypeApplications #-}
10{-# language TypeFamilies #-}
11{-# language TypeOperators #-}
12{-# language UndecidableInstances #-}
14module Rel8.Generic.Table
15 ( GTable, GColumns, GContext, GUnreify
16 , fromGColumns, toGColumns, gtable, greify, gunreify
17 )
18where
20-- base
21import Data.Kind ( Constraint, Type )
22import Data.Proxy ( Proxy( Proxy ) )
23import GHC.Generics
24 ( (:*:)( (:*:) ), K1( K1 ), M1( M1 )
25 , C, D, S
26 , Meta( MetaSel )
27 )
28import GHC.TypeLits ( KnownSymbol )
29import Prelude hiding ( null )
31-- rel8
32import Rel8.FCF ( Eval, Exp )
33import Rel8.Schema.Context.Label ( HLabelable, hlabeler, hunlabeler )
34import Rel8.Schema.HTable ( HTable )
35import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
36import Rel8.Schema.HTable.Product ( HProduct(..) )
37import qualified Rel8.Schema.Kind as K
40type GColumns :: (Type -> Exp K.HTable) -> (Type -> Type) -> K.HTable
41type family GColumns _Columns rep where
42 GColumns _Columns (M1 D _ rep) = GColumns _Columns rep
43 GColumns _Columns (M1 C _ rep) = GColumns _Columns rep
44 GColumns _Columns (rep1 :*: rep2) =
45 HProduct (GColumns _Columns rep1) (GColumns _Columns rep2)
46 GColumns _Columns (M1 S ('MetaSel ('Just label) _ _ _) (K1 _ a)) =
47 HLabel label (Eval (_Columns a))
50type GContext :: (Type -> Exp a) -> (Type -> Type) -> a
51type family GContext _Context rep where
52 GContext _Context (M1 _ _ rep) = GContext _Context rep
53 GContext _Context (rep1 :*: _rep2) = GContext _Context rep1
54 GContext _Context (K1 _ a) = Eval (_Context a)
57type GUnreify :: (Type -> Exp a) -> (Type -> Type) -> Type -> Type
58type family GUnreify _Unreify rep where
59 GUnreify _Unreify (M1 i c rep) = M1 i c (GUnreify _Unreify rep)
60 GUnreify _Unreify (rep1 :*: rep2) =
61 GUnreify _Unreify rep1 :*: GUnreify _Unreify rep2
62 GUnreify _Unreify (K1 i a) = K1 i (Eval (_Unreify a))
65type GTable
66 :: (Type -> Exp Constraint)
67 -> (Type -> Exp K.HTable)
68 -> K.HContext -> (Type -> Type) -> Constraint
69class GTable _Table _Columns context rep
70 where
71 fromGColumns :: ()
72 => (forall a. Eval (_Table a) => Eval (_Columns a) context -> a)
73 -> GColumns _Columns rep context
74 -> rep x
76 toGColumns :: ()
77 => (forall a. Eval (_Table a) => a -> Eval (_Columns a) context)
78 -> rep x
79 -> GColumns _Columns rep context
81 gtable :: ()
82 => (forall a. Eval (_Table a) => Proxy a -> Eval (_Columns a) context)
83 -> GColumns _Columns rep context
85 greify :: ()
86 => Proxy _Unreify
87 -> (forall a. Eval (_Table a) => Eval (_Unreify a) -> a)
88 -> GUnreify _Unreify rep x
89 -> rep x
91 gunreify :: ()
92 => Proxy _Unreify
93 -> (forall a. Eval (_Table a) => a -> Eval (_Unreify a))
94 -> rep x
95 -> GUnreify _Unreify rep x
98instance GTable _Table _Columns context rep =>
99 GTable _Table _Columns context (M1 D c rep)
100 where
101 fromGColumns fromColumns =
102 M1 . fromGColumns @_Table @_Columns @context @rep fromColumns
103 toGColumns toColumns (M1 a) =
104 toGColumns @_Table @_Columns @context @rep toColumns a
105 gtable = gtable @_Table @_Columns @context @rep
106 greify proxy reify (M1 a) =
107 M1 (greify @_Table @_Columns @context @rep proxy reify a)
108 gunreify proxy unreify (M1 a) =
109 M1 (gunreify @_Table @_Columns @context @rep proxy unreify a)
112instance GTable _Table _Columns context rep =>
113 GTable _Table _Columns context (M1 C c rep)
114 where
115 fromGColumns fromColumns =
116 M1 . fromGColumns @_Table @_Columns @context @rep fromColumns
117 toGColumns toColumns (M1 a) =
118 toGColumns @_Table @_Columns @context @rep toColumns a
119 gtable = gtable @_Table @_Columns @context @rep
120 greify proxy reify (M1 a) =
121 M1 (greify @_Table @_Columns @context @rep proxy reify a)
122 gunreify proxy unreify (M1 a) =
123 M1 (gunreify @_Table @_Columns @context @rep proxy unreify a)
126instance
127 ( GTable _Table _Columns context rep1
128 , GTable _Table _Columns context rep2
129 )
130 => GTable _Table _Columns context (rep1 :*: rep2)
131 where
132 fromGColumns fromColumns (HProduct a b) =
133 fromGColumns @_Table @_Columns @context @rep1 fromColumns a :*:
134 fromGColumns @_Table @_Columns @context @rep2 fromColumns b
135 toGColumns toColumns (a :*: b) = HProduct
136 (toGColumns @_Table @_Columns @context @rep1 toColumns a)
137 (toGColumns @_Table @_Columns @context @rep2 toColumns b)
138 gtable table = HProduct
139 (gtable @_Table @_Columns @context @rep1 table)
140 (gtable @_Table @_Columns @context @rep2 table)
141 greify proxy reify (a :*: b) =
142 greify @_Table @_Columns @context @rep1 proxy reify a :*:
143 greify @_Table @_Columns @context @rep2 proxy reify b
144 gunreify proxy unreify (a :*: b) =
145 gunreify @_Table @_Columns @context @rep1 proxy unreify a :*:
146 gunreify @_Table @_Columns @context @rep2 proxy unreify b
149instance
150 ( HTable (Eval (_Columns a))
151 , Eval (_Table a)
152 , HLabelable context
153 , KnownSymbol label
154 , meta ~ 'MetaSel ('Just label) _su _ss _ds
155 , k1 ~ K1 i a
156 )
157 => GTable _Table _Columns context (M1 S meta k1)
158 where
159 fromGColumns fromColumns = M1 . K1 . fromColumns . hunlabel hunlabeler
160 toGColumns toColumns (M1 (K1 a)) = hlabel hlabeler (toColumns a)
161 gtable table = hlabel hlabeler (table (Proxy @a))
162 greify _ reify (M1 (K1 a)) = M1 (K1 (reify a))
163 gunreify _ unreify (M1 (K1 a)) = M1 (K1 (unreify a))