on e0a1851 help sign in
rel8/src/Rel8/Table.hs
223 lines 6.1 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
21 )
22where
24-- base
25import Data.Kind ( Constraint, Type )
26import GHC.Generics ( Generic, Rep, from, to )
27import Prelude hiding ( null )
29-- rel8
30import Rel8.FCF ( Eval, Exp )
31import Rel8.Generic.Map ( GMap, Map )
32import Rel8.Generic.Table.Record
33 ( GTable, GColumns, GContext
34 , gfromColumns, gtoColumns, gfromResult, gtoResult
35 )
36import Rel8.Generic.Record ( Record(..) )
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
57 ( HTable (Columns a)
58 , context ~ Context a
59 , a ~ Transpose context a
60 )
61 => Table context a | a -> context
62 where
63 -- | The 'HTable' functor that describes the schema of this table.
64 type Columns a :: K.HTable
66 -- | The common context that all columns use as an interpretation.
67 type Context a :: K.Context
69 -- | The @FromExprs@ type family maps a type in the @Expr@ context to the
70 -- corresponding Haskell type.
71 type FromExprs a :: Type
73 type Transpose (context' :: K.Context) a :: Type
76 toColumns :: a -> Columns a context
77 fromColumns :: Columns a context -> a
79 fromResult :: Columns a Result -> FromExprs a
80 toResult :: FromExprs a -> Columns a Result
82 type Columns a = GColumns TColumns (Rep (Record a))
83 type Context a = GContext TContext (Rep (Record a))
84 type FromExprs a = Map TFromExprs a
85 type Transpose context a = Map (TTranspose context) a
87 default toColumns ::
88 ( Generic (Record a)
89 , GTable (TTable context) TColumns TFromExprs (Rep (Record a))
90 , Columns a ~ GColumns TColumns (Rep (Record a))
91 )
92 => a -> Columns a context
93 toColumns =
94 gtoColumns
95 @(TTable context)
96 @TColumns
97 @TFromExprs
98 toColumns .
99 from .
100 Record
102 default fromColumns ::
103 ( Generic (Record a)
104 , GTable (TTable context) TColumns TFromExprs (Rep (Record a))
105 , Columns a ~ GColumns TColumns (Rep (Record a))
106 )
107 => Columns a context -> a
108 fromColumns =
109 unrecord .
110 to .
111 gfromColumns
112 @(TTable context)
113 @TColumns
114 @TFromExprs
115 fromColumns
117 default toResult ::
118 ( Generic (Record (FromExprs a))
119 , GTable (TTable context) TColumns TFromExprs (Rep (Record a))
120 , Columns a ~ GColumns TColumns (Rep (Record a))
121 , Rep (Record (FromExprs a)) ~ GMap TFromExprs (Rep (Record a))
122 )
123 => FromExprs a -> Columns a Result
124 toResult =
125 gtoResult
126 @(TTable context)
127 @TColumns
128 @TFromExprs
129 @(Rep (Record a))
130 (\(_ :: proxy x) -> toResult @(Context x) @x) .
131 from .
132 Record
134 default fromResult ::
135 ( Generic (Record (FromExprs a))
136 , GTable (TTable context) TColumns TFromExprs (Rep (Record a))
137 , Columns a ~ GColumns TColumns (Rep (Record a))
138 , Rep (Record (FromExprs a)) ~ GMap TFromExprs (Rep (Record a))
139 )
140 => Columns a Result -> FromExprs a
141 fromResult =
142 unrecord .
143 to .
144 gfromResult
145 @(TTable context)
146 @TColumns
147 @TFromExprs
148 @(Rep (Record a))
149 (\(_ :: proxy x) -> fromResult @(Context x) @x)
152data TTable :: K.Context -> Type -> Exp Constraint
153type instance Eval (TTable context a) = Table context a
156data TColumns :: Type -> Exp K.HTable
157type instance Eval (TColumns a) = Columns a
160data TContext :: Type -> Exp K.Context
161type instance Eval (TContext a) = Context a
164data TFromExprs :: Type -> Exp Type
165type instance Eval (TFromExprs a) = FromExprs a
168data TTranspose :: K.Context -> Type -> Exp Type
169type instance Eval (TTranspose context a) = Transpose context a
172-- | Any context is trivially a table.
173instance KnownSpec spec => Table context (context spec) where
174 type Columns (context spec) = HIdentity spec
175 type Context (context spec) = context
176 type FromExprs (context spec) = Result spec
177 type Transpose to (context spec) = to spec
179 toColumns = HIdentity
180 fromColumns = unHIdentity
181 toResult = HIdentity
182 fromResult = unHIdentity
185instance (Table context a, Table context b) => Table context (a, b)
188instance
189 ( Table context a, Table context b, Table context c
190 )
191 => Table context (a, b, c)
194instance
195 ( Table context a, Table context b, Table context c, Table context d
196 )
197 => Table context (a, b, c, d)
200instance
201 ( Table context a, Table context b, Table context c, Table context d
202 , Table context e
203 )
204 => Table context (a, b, c, d, e)
207instance
208 ( Table context a, Table context b, Table context c, Table context d
209 , Table context e, Table context f
210 )
211 => Table context (a, b, c, d, e, f)
214instance
215 ( Table context a, Table context b, Table context c, Table context d
216 , Table context e, Table context f, Table context g
217 )
218 => Table context (a, b, c, d, e, f, g)
221type Congruent :: Type -> Type -> Constraint
222class Columns a ~ Columns b => Congruent a b
223instance Columns a ~ Columns b => Congruent a b