git.iko.soy/rel8
on 7c5422f help sign in
rel8/src/Rel8/Table.hs
239 lines 7.0 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 )
18 , Congruent
19 , TTable, TColumns, TContext, TFromExprs
20 )
21where
23-- base
24import Data.Kind ( Constraint, Type )
25import GHC.Generics ( Generic, Rep, from, to )
26import Prelude hiding ( null )
28-- rel8
29import Rel8.FCF ( Eval, Exp )
30import Rel8.Generic.Map ( GMap )
31import Rel8.Generic.Table.Record
32 ( GTable, GColumns, GContext
33 , gfromColumns, gtoColumns, gfromResult, gtoResult
34 )
35import Rel8.Generic.Record ( Record(..) )
36import Rel8.Schema.Context ( Col, UnCol )
37import Rel8.Schema.HTable ( HTable )
38import Rel8.Schema.HTable.Identity ( HIdentity(..) )
39import qualified Rel8.Schema.Kind as K
40import Rel8.Schema.Result ( Result )
41import Rel8.Schema.Spec ( KnownSpec )
44-- | @Table@s are one of the foundational elements of Rel8, and describe data
45-- types that have a finite number of columns. Each of these columns contains
46-- data under a shared context, and contexts describe how to interpret the
47-- metadata about a column to a particular Haskell type. In Rel8, we have
48-- contexts for expressions (the 'Rel8.Expr' context), aggregations (the
49-- 'Rel8.Aggregate' context), insert values (the 'Rel8.Insert' contex), among
50-- others.
51--
52-- In typical usage of Rel8 you don't need to derive instances of 'Table'
53-- yourself, as anything that's an instance of 'Rel8.Rel8able' is always a
54-- 'Table'.
55type Table :: K.Context -> Type -> Constraint
56class (HTable (Columns a), context ~ Context a) => Table context a | a -> context where
57 -- | The 'HTable' functor that describes the schema of this table.
58 type Columns a :: K.HTable
60 -- | The common context that all columns use as an interpretation.
61 type Context a :: K.Context
63 -- | The @FromExprs@ type family maps a type in the @Expr@ context to the
64 -- corresponding Haskell type.
65 type FromExprs a :: Type
67 toColumns :: a -> Columns a (Col context)
68 fromColumns :: Columns a (Col context) -> a
70 fromResult :: Columns a (Col Result) -> FromExprs a
71 toResult :: FromExprs a -> Columns a (Col Result)
73 type Columns a = GColumns TColumns (Rep (Record a))
74 type Context a = GContext TContext (Rep (Record a))
75 type FromExprs a = DefaultFromExprs a
77 default toColumns ::
78 ( Generic (Record a)
79 , GTable (TTable context) TColumns TFromExprs (Rep (Record a))
80 , Columns a ~ GColumns TColumns (Rep (Record a))
81 )
82 => a -> Columns a (Col context)
83 toColumns =
84 gtoColumns
85 @(TTable context)
86 @TColumns
87 @TFromExprs
88 toColumns .
89 from .
90 Record
92 default fromColumns ::
93 ( Generic (Record a)
94 , GTable (TTable context) TColumns TFromExprs (Rep (Record a))
95 , Columns a ~ GColumns TColumns (Rep (Record a))
96 )
97 => Columns a (Col context) -> a
98 fromColumns =
99 unrecord .
100 to .
101 gfromColumns
102 @(TTable context)
103 @TColumns
104 @TFromExprs
105 fromColumns
107 default toResult ::
108 ( Generic (Record (FromExprs a))
109 , GTable (TTable context) TColumns TFromExprs (Rep (Record a))
110 , Columns a ~ GColumns TColumns (Rep (Record a))
111 , Rep (Record (FromExprs a)) ~ GMap TFromExprs (Rep (Record a))
112 )
113 => FromExprs a -> Columns a (Col Result)
114 toResult =
115 gtoResult
116 @(TTable context)
117 @TColumns
118 @TFromExprs
119 @(Rep (Record a))
120 (\(_ :: proxy x) -> toResult @(Context x) @x) .
121 from .
122 Record
124 default fromResult ::
125 ( Generic (Record (FromExprs a))
126 , GTable (TTable context) TColumns TFromExprs (Rep (Record a))
127 , Columns a ~ GColumns TColumns (Rep (Record a))
128 , Rep (Record (FromExprs a)) ~ GMap TFromExprs (Rep (Record a))
129 )
130 => Columns a (Col Result) -> FromExprs a
131 fromResult =
132 unrecord .
133 to .
134 gfromResult
135 @(TTable context)
136 @TColumns
137 @TFromExprs
138 @(Rep (Record a))
139 (\(_ :: proxy x) -> fromResult @(Context x) @x)
142type DefaultFromExprs :: Type -> Type
143type family DefaultFromExprs a where
144 DefaultFromExprs (t a b c d e f g) =
145 t (FromExprs a) (FromExprs b) (FromExprs c) (FromExprs d) (FromExprs e)
146 (FromExprs f) (FromExprs g)
147 DefaultFromExprs (t a b c d e f) =
148 t (FromExprs a) (FromExprs b) (FromExprs c) (FromExprs d) (FromExprs e)
149 (FromExprs f)
150 DefaultFromExprs (t a b c d e) =
151 t (FromExprs a) (FromExprs b) (FromExprs c) (FromExprs d) (FromExprs e)
152 DefaultFromExprs (t a b c d) =
153 t (FromExprs a) (FromExprs b) (FromExprs c) (FromExprs d)
154 DefaultFromExprs (t a b c) = t (FromExprs a) (FromExprs b) (FromExprs c)
155 DefaultFromExprs (t a b) = t (FromExprs a) (FromExprs b)
156 DefaultFromExprs (t a) = t (FromExprs a)
159data TTable :: K.Context -> Type -> Exp Constraint
160type instance Eval (TTable context a) = Table context a
163data TColumns :: Type -> Exp K.HTable
164type instance Eval (TColumns a) = Columns a
167data TContext :: Type -> Exp K.Context
168type instance Eval (TContext a) = Context a
171data TFromExprs :: Type -> Exp Type
172type instance Eval (TFromExprs a) = FromExprs a
175-- | Any 'HTable' is also a 'Table'.
176instance (context ~ UnCol hcontext, hcontext ~ Col context, HTable t) =>
177 Table context (t hcontext)
178 where
179 type Columns (t hcontext) = t
180 type Context (t hcontext) = UnCol hcontext
181 type FromExprs (t hcontext) = t (Col Result)
183 toColumns = id
184 fromColumns = id
185 toResult = id
186 fromResult = id
189-- | Any context is trivially a table.
190instance KnownSpec spec => Table context (Col context spec) where
191 type Columns (Col context spec) = HIdentity spec
192 type Context (Col context spec) = context
193 type FromExprs (Col context spec) = Col Result spec
195 toColumns = HIdentity
196 fromColumns = unHIdentity
197 toResult = HIdentity
198 fromResult = unHIdentity
201instance (Table context a, Table context b) => Table context (a, b)
204instance
205 ( Table context a, Table context b, Table context c
206 )
207 => Table context (a, b, c)
210instance
211 ( Table context a, Table context b, Table context c, Table context d
212 )
213 => Table context (a, b, c, d)
216instance
217 ( Table context a, Table context b, Table context c, Table context d
218 , Table context e
219 )
220 => Table context (a, b, c, d, e)
223instance
224 ( Table context a, Table context b, Table context c, Table context d
225 , Table context e, Table context f
226 )
227 => Table context (a, b, c, d, e, f)
230instance
231 ( Table context a, Table context b, Table context c, Table context d
232 , Table context e, Table context f, Table context g
233 )
234 => Table context (a, b, c, d, e, f, g)
237type Congruent :: Type -> Type -> Constraint
238class Columns a ~ Columns b => Congruent a b
239instance Columns a ~ Columns b => Congruent a b