git.iko.soy/rel8
on da76712 help sign in
rel8/src/Rel8/Table.hs
222 lines 6.2 kB history raw
1{-# language AllowAmbiguousTypes #-}
2{-# language DataKinds #-}
3{-# language DefaultSignatures #-}
4{-# language FlexibleContexts #-}
5{-# language FlexibleInstances #-}
6{-# language FunctionalDependencies #-}
7{-# language ScopedTypeVariables #-}
8{-# language StandaloneKindSignatures #-}
9{-# language TypeApplications #-}
10{-# language TypeFamilies #-}
11{-# language UndecidableInstances #-}
13module Rel8.Table
14 ( Table
15 ( Columns, Context, fromColumns, toColumns
16 , FromExprs, fromResult, toResult
17 , Transpose
18 )
19 , Congruent
20 , TTable, TColumns, TContext, TFromExprs, TTranspose
21 , TSerialize
22 )
23where
25-- base
26import Data.Functor.Identity ( Identity( Identity ) )
27import Data.Kind ( Constraint, Type )
28import GHC.Generics ( Generic, Rep, from, to )
29import Prelude hiding ( null )
31-- rel8
32import Rel8.FCF ( Eval, Exp )
33import Rel8.Generic.Map ( Map )
34import Rel8.Generic.Table.Record
35 ( GTable, GColumns, GContext, gfromColumns, gtoColumns
36 , GSerialize, gfromResult, gtoResult
37 )
38import Rel8.Generic.Record ( Record(..) )
39import Rel8.Schema.HTable ( HTable )
40import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
41import qualified Rel8.Schema.Kind as K
42import Rel8.Schema.Null ( Sql )
43import Rel8.Schema.Result ( Result )
44import Rel8.Type ( DBType )
47-- | @Table@s are one of the foundational elements of Rel8, and describe data
48-- types that have a finite number of columns. Each of these columns contains
49-- data under a shared context, and contexts describe how to interpret the
50-- metadata about a column to a particular Haskell type. In Rel8, we have
51-- contexts for expressions (the 'Rel8.Expr' context), aggregations (the
52-- 'Rel8.Aggregate' context), insert values (the 'Rel8.Insert' contex), among
53-- others.
54--
55-- In typical usage of Rel8 you don't need to derive instances of 'Table'
56-- yourself, as anything that's an instance of 'Rel8.Rel8able' is always a
57-- 'Table'.
58type Table :: K.Context -> Type -> Constraint
59class
60 ( HTable (Columns a)
61 , context ~ Context a
62 , a ~ Transpose context a
63 )
64 => Table context a | a -> context
65 where
66 -- | The 'HTable' functor that describes the schema of this table.
67 type Columns a :: K.HTable
69 -- | The common context that all columns use as an interpretation.
70 type Context a :: K.Context
72 -- | The @FromExprs@ type family maps a type in the @Expr@ context to the
73 -- corresponding Haskell type.
74 type FromExprs a :: Type
76 type Transpose (context' :: K.Context) a :: Type
79 toColumns :: a -> Columns a context
80 fromColumns :: Columns a context -> a
82 fromResult :: Columns a Result -> FromExprs a
83 toResult :: FromExprs a -> Columns a Result
85 type Columns a = GColumns TColumns (Rep (Record a))
86 type Context a = GContext TContext (Rep (Record a))
87 type FromExprs a = Map TFromExprs a
88 type Transpose context a = Map (TTranspose context) a
90 default toColumns ::
91 ( Generic (Record a)
92 , GTable (TTable context) TColumns (Rep (Record a))
93 , Columns a ~ GColumns TColumns (Rep (Record a))
94 )
95 => a -> Columns a context
96 toColumns =
97 gtoColumns @(TTable context) @TColumns toColumns .
98 from .
99 Record
101 default fromColumns ::
102 ( Generic (Record a)
103 , GTable (TTable context) TColumns (Rep (Record a))
104 , Columns a ~ GColumns TColumns (Rep (Record a))
105 )
106 => Columns a context -> a
107 fromColumns =
108 unrecord .
109 to .
110 gfromColumns @(TTable context) @TColumns fromColumns
112 default toResult ::
113 ( Generic (Record (FromExprs a))
114 , GSerialize TSerialize TColumns (Rep (Record a)) (Rep (Record (FromExprs a)))
115 , Columns a ~ GColumns TColumns (Rep (Record a))
116 )
117 => FromExprs a -> Columns a Result
118 toResult =
119 gtoResult
120 @TSerialize
121 @TColumns
122 @(Rep (Record a))
123 @(Rep (Record (FromExprs a)))
124 (\(_ :: proxy x) -> toResult @(Context x) @x) .
125 from .
126 Record
128 default fromResult ::
129 ( Generic (Record (FromExprs a))
130 , GSerialize TSerialize TColumns (Rep (Record a)) (Rep (Record (FromExprs a)))
131 , Columns a ~ GColumns TColumns (Rep (Record a))
132 )
133 => Columns a Result -> FromExprs a
134 fromResult =
135 unrecord .
136 to .
137 gfromResult
138 @TSerialize
139 @TColumns
140 @(Rep (Record a))
141 @(Rep (Record (FromExprs a)))
142 (\(_ :: proxy x) -> fromResult @(Context x) @x)
145instance Sql DBType a => Table Result (Identity a) where
146 type Columns (Identity a) = HIdentity a
147 type Context (Identity a) = Result
148 type FromExprs (Identity a) = a
149 type Transpose to (Identity a) = to a
151 toColumns = HIdentity
152 fromColumns (HIdentity a) = a
153 toResult a = HIdentity (Identity a)
154 fromResult (HIdentity (Identity a)) = a
157data TTable :: K.Context -> Type -> Exp Constraint
158type instance Eval (TTable context a) = Table context a
161data TColumns :: Type -> Exp K.HTable
162type instance Eval (TColumns a) = Columns a
165data TContext :: Type -> Exp K.Context
166type instance Eval (TContext a) = Context a
169data TFromExprs :: Type -> Exp Type
170type instance Eval (TFromExprs a) = FromExprs a
173data TTranspose :: K.Context -> Type -> Exp Type
174type instance Eval (TTranspose context a) = Transpose context a
177data TSerialize :: Type -> Type -> Exp Constraint
178type instance Eval (TSerialize expr a) =
179 ( Table (Context expr) expr
180 , a ~ FromExprs expr
181 )
184instance (Table context a, Table context b) => Table context (a, b)
187instance
188 ( Table context a, Table context b, Table context c
189 )
190 => Table context (a, b, c)
193instance
194 ( Table context a, Table context b, Table context c, Table context d
195 )
196 => Table context (a, b, c, d)
199instance
200 ( Table context a, Table context b, Table context c, Table context d
201 , Table context e
202 )
203 => Table context (a, b, c, d, e)
206instance
207 ( Table context a, Table context b, Table context c, Table context d
208 , Table context e, Table context f
209 )
210 => Table context (a, b, c, d, e, f)
213instance
214 ( Table context a, Table context b, Table context c, Table context d
215 , Table context e, Table context f, Table context g
216 )
217 => Table context (a, b, c, d, e, f, g)
220type Congruent :: Type -> Type -> Constraint
221class Columns a ~ Columns b => Congruent a b
222instance Columns a ~ Columns b => Congruent a b