git.iko.soy/rel8
on f47423e help sign in
rel8/src/Rel8/Generic/Table.hs
104 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 qualified Rel8.Schema.Kind as K
38import Rel8.Schema.Result ( Result )
41data GGTable
42 :: Algebra
43 -> (Type -> Exp Constraint)
44 -> (Type -> Exp K.HTable)
45 -> (Type -> Exp Type)
46 -> (Type -> Type)
47 -> Exp Constraint
50type instance Eval (GGTable 'Product _Table _Columns _FromExprs rep) =
51 GTable _Table _Columns _FromExprs rep
54type instance Eval (GGTable 'Sum _Table _Columns _FromExprs rep) =
55 GTableADT _Table _Columns _FromExprs rep
58data GGColumns
59 :: Algebra
60 -> (Type -> Exp K.HTable)
61 -> (Type -> Type)
62 -> Exp K.HTable
65type instance Eval (GGColumns 'Product _Columns rep) = GColumns _Columns rep
68type instance Eval (GGColumns 'Sum _Columns rep) = GColumnsADT _Columns rep
71type GAlgebra :: (Type -> Type) -> Algebra
72type family GAlgebra rep where
73 GAlgebra (M1 _ _ rep) = GAlgebra rep
74 GAlgebra V1 = 'Sum
75 GAlgebra (_ :+: _) = 'Sum
76 GAlgebra U1 = 'Sum
77 GAlgebra (_ :*: _) = 'Product
78 GAlgebra (K1 _ _) = 'Product
81ggfromResult :: forall algebra _Table _Columns _FromExprs rep x.
82 ( KnownAlgebra algebra
83 , Eval (GGTable algebra _Table _Columns _FromExprs rep)
84 )
85 => (forall a proxy. Eval (_Table a)
86 => proxy a -> Eval (_Columns a) Result -> Eval (_FromExprs a))
87 -> Eval (GGColumns algebra _Columns rep) Result
88 -> GMap _FromExprs rep x
89ggfromResult f x = case algebraSing @algebra of
90 SProduct -> gfromResult @_Table @_Columns @_FromExprs @rep f x
91 SSum -> gfromResultADT @_Table @_Columns @_FromExprs @rep f x
94ggtoResult :: forall algebra _Table _Columns _FromExprs rep x.
95 ( KnownAlgebra algebra
96 , Eval (GGTable algebra _Table _Columns _FromExprs rep)
97 )
98 => (forall a proxy. Eval (_Table a)
99 => proxy a -> Eval (_FromExprs a) -> Eval (_Columns a) Result)
100 -> GMap _FromExprs rep x
101 -> Eval (GGColumns algebra _Columns rep) Result
102ggtoResult f x = case algebraSing @algebra of
103 SProduct -> gtoResult @_Table @_Columns @_FromExprs @rep f x
104 SSum -> gtoResultADT @_Table @_Columns @_FromExprs @rep f x