on 7c5422f help sign in
rel8/src/Rel8/Table/Rel8able.hs
99 lines 2.5 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleInstances #-}
3{-# language MultiParamTypeClasses #-}
4{-# language ScopedTypeVariables #-}
5{-# language StandaloneKindSignatures #-}
6{-# language TypeApplications #-}
7{-# language TypeFamilies #-}
8{-# language UndecidableInstances #-}
10{-# options_ghc -fno-warn-orphans #-}
12module Rel8.Table.Rel8able
13 (
14 )
15where
17-- base
18import Prelude ()
20-- rel8
21import Rel8.Expr ( Expr )
22import qualified Rel8.Kind.Algebra as K
23import Rel8.Generic.Rel8able
24 ( Rel8able, Algebra
25 , GColumns, gfromColumns, gtoColumns
26 , GFromExprs, gfromResult, gtoResult
27 )
28import Rel8.Schema.Context.Virtual ( Virtual, virtual )
29import qualified Rel8.Schema.Kind as K
30import Rel8.Schema.HTable ( HConstrainTable, hdicts )
31import Rel8.Schema.Null ( Sql )
32import Rel8.Schema.Result ( Result )
33import Rel8.Table
34 ( Table, Columns, Context, Congruent, fromColumns, toColumns
35 , FromExprs, fromResult, toResult
36 )
37import Rel8.Schema.Spec.Constrain ( ConstrainSpec )
38import Rel8.Table.ADT ( ADT )
39import Rel8.Table.Eq ( EqTable, eqTable )
40import Rel8.Table.Ord ( OrdTable, ordTable )
41import Rel8.Table.Recontextualize ( Recontextualize )
42import Rel8.Table.Serialize ( ToExprs )
43import Rel8.Type.Eq ( DBEq )
44import Rel8.Type.Ord ( DBOrd )
47instance (Rel8able t, Virtual context) => Table context (t context) where
48 type Columns (t context) = GColumns t
49 type Context (t context) = context
50 type FromExprs (t context) = GFromExprs t
52 fromColumns = gfromColumns virtual
53 toColumns = gtoColumns virtual
54 fromResult = gfromResult @t
55 toResult = gtoResult @t
58instance
59 ( Rel8able t
60 , Virtual from
61 , Virtual to
62 , Congruent (t from) (t to)
63 )
64 => Recontextualize from to (t from) (t to)
67instance
68 ( context ~ Expr
69 , Rel8able t
70 , HConstrainTable (Columns (t context)) (ConstrainSpec (Sql DBEq))
71 )
72 => EqTable (t context)
73 where
74 eqTable = hdicts @(Columns (t context)) @(ConstrainSpec (Sql DBEq))
77instance
78 ( context ~ Expr
79 , Rel8able t
80 , HConstrainTable (Columns (t context)) (ConstrainSpec (Sql DBEq))
81 , HConstrainTable (Columns (t context)) (ConstrainSpec (Sql DBOrd))
82 )
83 => OrdTable (t context)
84 where
85 ordTable = hdicts @(Columns (t context)) @(ConstrainSpec (Sql DBOrd))
88instance
89 ( Rel8able t', t' ~ Choose (Algebra t) t
90 , x ~ t' Expr
91 , result ~ Result
92 )
93 => ToExprs x (t result)
96type Choose :: K.Algebra -> K.Rel8able -> K.Rel8able
97type family Choose algebra t where
98 Choose 'K.Sum t = ADT t
99 Choose 'K.Product t = t