git.iko.soy/rel8
on 7c5422f help sign in
rel8/src/Rel8/Generic/Table.hs
105 lines 3.0 kB history raw
1{-# language AllowAmbiguousTypes #-}
2{-# language DataKinds #-}
3{-# language FlexibleContexts #-}
4{-# language FlexibleInstances #-}
5{-# language MultiParamTypeClasses #-}
6{-# language RankNTypes #-}
7{-# language ScopedTypeVariables #-}
8{-# language StandaloneKindSignatures #-}
9{-# language TypeApplications #-}
10{-# language TypeFamilies #-}
11{-# language TypeOperators #-}
12{-# language UndecidableInstances #-}
14module Rel8.Generic.Table
15 ( GGTable, GGColumns, ggfromResult, ggtoResult
16 , GAlgebra
17 )
18where
20-- base
21import Data.Kind ( Constraint, Type )
22import GHC.Generics ( (:+:), (:*:), K1, M1, U1, V1 )
23import Prelude ()
25-- rel8
26import Rel8.FCF ( Eval, Exp )
27import Rel8.Generic.Map ( GMap )
28import Rel8.Generic.Table.ADT
29 ( GTableADT, GColumnsADT, gtoResultADT, gfromResultADT
30 )
31import Rel8.Generic.Table.Record ( GTable, GColumns, gtoResult, gfromResult )
32import Rel8.Kind.Algebra
33 ( Algebra( Product, Sum )
34 , SAlgebra( SProduct, SSum )
35 , KnownAlgebra, algebraSing
36 )
37import Rel8.Schema.Context ( Col )
38import qualified Rel8.Schema.Kind as K
39import Rel8.Schema.Result ( Result )
42data GGTable
43 :: Algebra
44 -> (Type -> Exp Constraint)
45 -> (Type -> Exp K.HTable)
46 -> (Type -> Exp Type)
47 -> (Type -> Type)
48 -> Exp Constraint
51type instance Eval (GGTable 'Product _Table _Columns _FromExprs rep) =
52 GTable _Table _Columns _FromExprs rep
55type instance Eval (GGTable 'Sum _Table _Columns _FromExprs rep) =
56 GTableADT _Table _Columns _FromExprs rep
59data GGColumns
60 :: Algebra
61 -> (Type -> Exp K.HTable)
62 -> (Type -> Type)
63 -> Exp K.HTable
66type instance Eval (GGColumns 'Product _Columns rep) = GColumns _Columns rep
69type instance Eval (GGColumns 'Sum _Columns rep) = GColumnsADT _Columns rep
72type GAlgebra :: (Type -> Type) -> Algebra
73type family GAlgebra rep where
74 GAlgebra (M1 _ _ rep) = GAlgebra rep
75 GAlgebra V1 = 'Sum
76 GAlgebra (_ :+: _) = 'Sum
77 GAlgebra U1 = 'Sum
78 GAlgebra (_ :*: _) = 'Product
79 GAlgebra (K1 _ _) = 'Product
82ggfromResult :: forall algebra _Table _Columns _FromExprs rep x.
83 ( KnownAlgebra algebra
84 , Eval (GGTable algebra _Table _Columns _FromExprs rep)
85 )
86 => (forall a proxy. Eval (_Table a)
87 => proxy a -> Eval (_Columns a) (Col Result) -> Eval (_FromExprs a))
88 -> Eval (GGColumns algebra _Columns rep) (Col Result)
89 -> GMap _FromExprs rep x
90ggfromResult f x = case algebraSing @algebra of
91 SProduct -> gfromResult @_Table @_Columns @_FromExprs @rep f x
92 SSum -> gfromResultADT @_Table @_Columns @_FromExprs @rep f x
95ggtoResult :: forall algebra _Table _Columns _FromExprs rep x.
96 ( KnownAlgebra algebra
97 , Eval (GGTable algebra _Table _Columns _FromExprs rep)
98 )
99 => (forall a proxy. Eval (_Table a)
100 => proxy a -> Eval (_FromExprs a) -> Eval (_Columns a) (Col Result))
101 -> GMap _FromExprs rep x
102 -> Eval (GGColumns algebra _Columns rep) (Col Result)
103ggtoResult f x = case algebraSing @algebra of
104 SProduct -> gtoResult @_Table @_Columns @_FromExprs @rep f x
105 SSum -> gtoResultADT @_Table @_Columns @_FromExprs @rep f x