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