git.iko.soy/rel8
on 9ef8fd8 help sign in
rel8/src/Rel8/Table/Lifted.hs
81 lines 2.3 kB history raw
1{-# language ConstraintKinds #-}
2{-# language DataKinds #-}
3{-# language FlexibleContexts #-}
4{-# language FlexibleInstances #-}
5{-# language MultiParamTypeClasses #-}
6{-# language QuantifiedConstraints #-}
7{-# language StandaloneKindSignatures #-}
8{-# language TypeFamilies #-}
9{-# language UndecidableInstances #-}
11module Rel8.Table.Lifted
12 ( Table1( Columns1, ConstrainHContext1, toColumns1, fromColumns1 )
13 , Table2( Columns2, ConstrainHContext2, toColumns2, fromColumns2 )
14 , ConstrainContext
15 )
16where
18-- base
19import Data.Kind ( Constraint, Type )
20import Prelude ()
22-- rel8
23import Rel8.Schema.Context ( Col )
24import Rel8.Schema.HTable ( HTable )
25import Rel8.Schema.HTable.Pair
26import qualified Rel8.Schema.Kind as K
29type Table1 :: (Type -> Type) -> Constraint
30class Table1 f where
31 type Columns1 f :: K.HTable -> K.HTable
32 type ConstrainHContext1 f :: K.HContext -> Constraint
33 type ConstrainHContext1 _ = DefaultConstrainContext
35 toColumns1 :: (ConstrainHContext1 f context, HTable t)
36 => (a -> t context)
37 -> f a
38 -> Columns1 f t context
40 fromColumns1 :: (ConstrainHContext1 f context, HTable t)
41 => (t context -> a)
42 -> Columns1 f t context
43 -> f a
46type Table2 :: (Type -> Type -> Type) -> Constraint
47class Table2 p where
48 type Columns2 p :: K.HTable -> K.HTable -> K.HTable
49 type ConstrainHContext2 p :: K.HContext -> Constraint
50 type ConstrainHContext2 _ = DefaultConstrainContext
52 toColumns2 :: (ConstrainHContext2 p context, HTable t, HTable u)
53 => (a -> t context)
54 -> (b -> u context)
55 -> p a b
56 -> Columns2 p t u context
58 fromColumns2 :: (ConstrainHContext2 p context, HTable t, HTable u)
59 => (t context -> a)
60 -> (u context -> b)
61 -> Columns2 p t u context
62 -> p a b
65instance Table2 (,) where
66 type Columns2 (,) = HPair
68 toColumns2 f g (a, b) = HPair (f a) (g b)
69 fromColumns2 f g (HPair a b) = (f a, g b)
72type DefaultConstrainContext :: K.HContext -> Constraint
73class DefaultConstrainContext context
74instance DefaultConstrainContext context
77type ConstrainContext :: (K.Context -> Constraint) -> K.HContext -> Constraint
78class (forall context. hcontext ~ Col context => constraint context)
79 => ConstrainContext constraint hcontext
80instance (hcontext ~ Col context, constraint context) =>
81 ConstrainContext constraint hcontext