git.iko.soy/rel8
on 97d89cf help sign in
rel8/src/Rel8/Table.hs
224 lines 6.6 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.HTable ( HTable )
37import Rel8.Schema.HTable.Identity ( HIdentity(..) )
38import qualified Rel8.Schema.Kind as K
39import Rel8.Schema.Result ( Result )
40import Rel8.Schema.Spec ( KnownSpec )
43-- | @Table@s are one of the foundational elements of Rel8, and describe data
44-- types that have a finite number of columns. Each of these columns contains
45-- data under a shared context, and contexts describe how to interpret the
46-- metadata about a column to a particular Haskell type. In Rel8, we have
47-- contexts for expressions (the 'Rel8.Expr' context), aggregations (the
48-- 'Rel8.Aggregate' context), insert values (the 'Rel8.Insert' contex), among
49-- others.
50--
51-- In typical usage of Rel8 you don't need to derive instances of 'Table'
52-- yourself, as anything that's an instance of 'Rel8.Rel8able' is always a
53-- 'Table'.
54type Table :: K.Context -> Type -> Constraint
55class (HTable (Columns a), context ~ Context a) => Table context a | a -> context where
56 -- | The 'HTable' functor that describes the schema of this table.
57 type Columns a :: K.HTable
59 -- | The common context that all columns use as an interpretation.
60 type Context a :: K.Context
62 -- | The @FromExprs@ type family maps a type in the @Expr@ context to the
63 -- corresponding Haskell type.
64 type FromExprs a :: Type
66 toColumns :: a -> Columns a context
67 fromColumns :: Columns a context -> a
69 fromResult :: Columns a Result -> FromExprs a
70 toResult :: FromExprs a -> Columns a Result
72 type Columns a = GColumns TColumns (Rep (Record a))
73 type Context a = GContext TContext (Rep (Record a))
74 type FromExprs a = DefaultFromExprs a
76 default toColumns ::
77 ( Generic (Record a)
78 , GTable (TTable context) TColumns TFromExprs (Rep (Record a))
79 , Columns a ~ GColumns TColumns (Rep (Record a))
80 )
81 => a -> Columns a context
82 toColumns =
83 gtoColumns
84 @(TTable context)
85 @TColumns
86 @TFromExprs
87 toColumns .
88 from .
89 Record
91 default fromColumns ::
92 ( Generic (Record a)
93 , GTable (TTable context) TColumns TFromExprs (Rep (Record a))
94 , Columns a ~ GColumns TColumns (Rep (Record a))
95 )
96 => Columns a context -> a
97 fromColumns =
98 unrecord .
99 to .
100 gfromColumns
101 @(TTable context)
102 @TColumns
103 @TFromExprs
104 fromColumns
106 default toResult ::
107 ( Generic (Record (FromExprs a))
108 , GTable (TTable context) TColumns TFromExprs (Rep (Record a))
109 , Columns a ~ GColumns TColumns (Rep (Record a))
110 , Rep (Record (FromExprs a)) ~ GMap TFromExprs (Rep (Record a))
111 )
112 => FromExprs a -> Columns a Result
113 toResult =
114 gtoResult
115 @(TTable context)
116 @TColumns
117 @TFromExprs
118 @(Rep (Record a))
119 (\(_ :: proxy x) -> toResult @(Context x) @x) .
120 from .
121 Record
123 default fromResult ::
124 ( Generic (Record (FromExprs a))
125 , GTable (TTable context) TColumns TFromExprs (Rep (Record a))
126 , Columns a ~ GColumns TColumns (Rep (Record a))
127 , Rep (Record (FromExprs a)) ~ GMap TFromExprs (Rep (Record a))
128 )
129 => Columns a Result -> FromExprs a
130 fromResult =
131 unrecord .
132 to .
133 gfromResult
134 @(TTable context)
135 @TColumns
136 @TFromExprs
137 @(Rep (Record a))
138 (\(_ :: proxy x) -> fromResult @(Context x) @x)
141type DefaultFromExprs :: Type -> Type
142type family DefaultFromExprs a where
143 DefaultFromExprs (t a b c d e f g) =
144 t (FromExprs a) (FromExprs b) (FromExprs c) (FromExprs d) (FromExprs e)
145 (FromExprs f) (FromExprs g)
146 DefaultFromExprs (t a b c d e f) =
147 t (FromExprs a) (FromExprs b) (FromExprs c) (FromExprs d) (FromExprs e)
148 (FromExprs f)
149 DefaultFromExprs (t a b c d e) =
150 t (FromExprs a) (FromExprs b) (FromExprs c) (FromExprs d) (FromExprs e)
151 DefaultFromExprs (t a b c d) =
152 t (FromExprs a) (FromExprs b) (FromExprs c) (FromExprs d)
153 DefaultFromExprs (t a b c) = t (FromExprs a) (FromExprs b) (FromExprs c)
154 DefaultFromExprs (t a b) = t (FromExprs a) (FromExprs b)
155 DefaultFromExprs (t a) = t (FromExprs a)
158data TTable :: K.Context -> Type -> Exp Constraint
159type instance Eval (TTable context a) = Table context a
162data TColumns :: Type -> Exp K.HTable
163type instance Eval (TColumns a) = Columns a
166data TContext :: Type -> Exp K.Context
167type instance Eval (TContext a) = Context a
170data TFromExprs :: Type -> Exp Type
171type instance Eval (TFromExprs a) = FromExprs a
174-- | Any context is trivially a table.
175instance KnownSpec spec => Table context (context spec) where
176 type Columns (context spec) = HIdentity spec
177 type Context (context spec) = context
178 type FromExprs (context spec) = Result spec
180 toColumns = HIdentity
181 fromColumns = unHIdentity
182 toResult = HIdentity
183 fromResult = unHIdentity
186instance (Table context a, Table context b) => Table context (a, b)
189instance
190 ( Table context a, Table context b, Table context c
191 )
192 => Table context (a, b, c)
195instance
196 ( Table context a, Table context b, Table context c, Table context d
197 )
198 => Table context (a, b, c, d)
201instance
202 ( Table context a, Table context b, Table context c, Table context d
203 , Table context e
204 )
205 => Table context (a, b, c, d, e)
208instance
209 ( Table context a, Table context b, Table context c, Table context d
210 , Table context e, Table context f
211 )
212 => Table context (a, b, c, d, e, f)
215instance
216 ( Table context a, Table context b, Table context c, Table context d
217 , Table context e, Table context f, Table context g
218 )
219 => Table context (a, b, c, d, e, f, g)
222type Congruent :: Type -> Type -> Constraint
223class Columns a ~ Columns b => Congruent a b
224instance Columns a ~ Columns b => Congruent a b