git.iko.soy/rel8
on da76712 help sign in
rel8/src/Rel8/Generic/Table.hs
103 lines 2.9 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 ( GGSerialize, 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.Table.ADT
28 ( GSerializeADT, GColumnsADT, gtoResultADT, gfromResultADT
29 )
30import Rel8.Generic.Table.Record ( GSerialize, GColumns, gtoResult, gfromResult )
31import Rel8.Kind.Algebra
32 ( Algebra( Product, Sum )
33 , SAlgebra( SProduct, SSum )
34 , KnownAlgebra, algebraSing
35 )
36import qualified Rel8.Schema.Kind as K
37import Rel8.Schema.Result ( Result )
40data GGSerialize
41 :: Algebra
42 -> (Type -> Type -> Exp Constraint)
43 -> (Type -> Exp K.HTable)
44 -> (Type -> Type)
45 -> (Type -> Type)
46 -> Exp Constraint
49type instance Eval (GGSerialize 'Product _Serialize _Columns exprs rep) =
50 GSerialize _Serialize _Columns exprs rep
53type instance Eval (GGSerialize 'Sum _Serialize _Columns exprs rep) =
54 GSerializeADT _Serialize _Columns exprs rep
57data GGColumns
58 :: Algebra
59 -> (Type -> Exp K.HTable)
60 -> (Type -> Type)
61 -> Exp K.HTable
64type instance Eval (GGColumns 'Product _Columns rep) = GColumns _Columns rep
67type instance Eval (GGColumns 'Sum _Columns rep) = GColumnsADT _Columns rep
70type GAlgebra :: (Type -> Type) -> Algebra
71type family GAlgebra rep where
72 GAlgebra (M1 _ _ rep) = GAlgebra rep
73 GAlgebra V1 = 'Sum
74 GAlgebra (_ :+: _) = 'Sum
75 GAlgebra U1 = 'Sum
76 GAlgebra (_ :*: _) = 'Product
77 GAlgebra (K1 _ _) = 'Product
80ggfromResult :: forall algebra _Serialize _Columns exprs rep x.
81 ( KnownAlgebra algebra
82 , Eval (GGSerialize algebra _Serialize _Columns exprs rep)
83 )
84 => (forall expr a proxy. Eval (_Serialize expr a)
85 => proxy expr -> Eval (_Columns expr) Result -> a)
86 -> Eval (GGColumns algebra _Columns exprs) Result
87 -> rep x
88ggfromResult f x = case algebraSing @algebra of
89 SProduct -> gfromResult @_Serialize @_Columns @exprs @rep f x
90 SSum -> gfromResultADT @_Serialize @_Columns @exprs @rep f x
93ggtoResult :: forall algebra _Serialize _Columns exprs rep x.
94 ( KnownAlgebra algebra
95 , Eval (GGSerialize algebra _Serialize _Columns exprs rep)
96 )
97 => (forall expr a proxy. Eval (_Serialize expr a)
98 => proxy expr -> a -> Eval (_Columns expr) Result)
99 -> rep x
100 -> Eval (GGColumns algebra _Columns exprs) Result
101ggtoResult f x = case algebraSing @algebra of
102 SProduct -> gtoResult @_Serialize @_Columns @exprs @rep f x
103 SSum -> gtoResultADT @_Serialize @_Columns @exprs @rep f x