on 97d89cf help sign in
rel8/src/Rel8/Table/Rel8able.hs
101 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 f, f ~ g) => Table f (t g) where
48 type Columns (t g) = GColumns t
49 type Context (t g) = g
50 type FromExprs (t g) = 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 , from ~ from'
64 , to ~ to'
65 )
66 => Recontextualize from' to' (t from) (t to)
69instance
70 ( context ~ Expr
71 , Rel8able t
72 , HConstrainTable (Columns (t context)) (ConstrainSpec (Sql DBEq))
73 )
74 => EqTable (t context)
75 where
76 eqTable = hdicts @(Columns (t context)) @(ConstrainSpec (Sql DBEq))
79instance
80 ( context ~ Expr
81 , Rel8able t
82 , HConstrainTable (Columns (t context)) (ConstrainSpec (Sql DBEq))
83 , HConstrainTable (Columns (t context)) (ConstrainSpec (Sql DBOrd))
84 )
85 => OrdTable (t context)
86 where
87 ordTable = hdicts @(Columns (t context)) @(ConstrainSpec (Sql DBOrd))
90instance
91 ( Rel8able t', t' ~ Choose (Algebra t) t
92 , x ~ t' Expr
93 , result ~ Result
94 )
95 => ToExprs x (t result)
98type Choose :: K.Algebra -> K.Rel8able -> K.Rel8able
99type family Choose algebra t where
100 Choose 'K.Sum t = ADT t
101 Choose 'K.Product t = t