on 5a47018 help sign in
rel8/src/Rel8/Column.hs
117 lines 3.4 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language LambdaCase #-}
4{-# language MultiParamTypeClasses #-}
5{-# language ScopedTypeVariables #-}
6{-# language StandaloneKindSignatures #-}
7{-# language TypeApplications #-}
8{-# language TypeFamilies #-}
10module Rel8.Column
11 ( Column, AColumn(..)
12 , TColumn
13 )
14where
16-- base
17import Data.Kind ( Type )
18import Data.Type.Equality ( (:~:)( Refl ) )
19import Prelude
21-- rel8
22import Rel8.Aggregate ( Aggregate, Col( A ) )
23import Rel8.Expr ( Expr, Col( E ) )
24import Rel8.FCF ( Eval, Exp )
25import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
26import Rel8.Schema.HTable.Identity ( HIdentity(..), HType )
27import qualified Rel8.Schema.Kind as K
28import Rel8.Schema.Name ( Name(..), Col( N ) )
29import Rel8.Schema.Null ( Sql )
30import Rel8.Schema.Reify ( Reify, Col(..) )
31import Rel8.Schema.Result ( Col( R ), Result, absurd )
32import Rel8.Schema.Spec ( Spec( Spec ) )
33import Rel8.Table
34 ( Table, Columns, Context, fromColumns, toColumns
35 , Unreify, reify, unreify, coherence, congruence
36 )
37import Rel8.Table.Recontextualize ( Recontextualize )
38import Rel8.Type ( DBType )
41-- | This type family is used to specify columns in 'Rel8able's. In @Column f
42-- a@, @f@ is the context of the column (which should be left polymorphic in
43-- 'Rel8able' definitions), and @a@ is the type of the column.
44type Column :: K.Context -> Type -> Type
45type family Column context a where
46 Column (Reify context) a = AColumn context a
47 Column Aggregate a = Aggregate a
48 Column Expr a = Expr a
49 Column Name a = Name a
50 Column Result a = a
53type AColumn :: K.Context -> Type -> Type
54newtype AColumn context a = AColumn (Column context a)
57instance (Reifiable context, Sql DBType a) =>
58 Table (Reify context) (AColumn context a)
59 where
60 type Context (AColumn context a) = Reify context
61 type Columns (AColumn context a) = HType a
62 type Unreify (AColumn context a) = Column context a
64 fromColumns (HType (Reify a)) = sfromColumn contextSing a
65 toColumns = HType . Reify . stoColumn contextSing
66 reify _ = AColumn
67 unreify _ (AColumn a) = a
69 coherence Refl = case contextSing @context of
70 SAggregate -> const Refl
71 SExpr -> const Refl
72 SName -> const Refl
73 SResult -> absurd
74 SReify _ -> const Refl
76 congruence Refl = case contextSing @context of
77 SAggregate -> const Refl
78 SExpr -> const Refl
79 SName -> const Refl
80 SResult -> absurd
81 SReify _ -> const Refl
84instance (Reifiable context, Reifiable context', Sql DBType a) =>
85 Recontextualize
86 (Reify context)
87 (Reify context')
88 (AColumn context a)
89 (AColumn context' a)
92sfromColumn :: ()
93 => SContext context
94 -> Col context ('Spec a)
95 -> AColumn context a
96sfromColumn = \case
97 SAggregate -> \(A a) -> AColumn a
98 SExpr -> \(E a) -> AColumn a
99 SName -> \(N a) -> AColumn a
100 SResult -> \(R a) -> AColumn a
101 SReify context -> \(Reify a) -> AColumn (sfromColumn context a)
104stoColumn :: ()
105 => SContext context
106 -> AColumn context a
107 -> Col context ('Spec a)
108stoColumn = \case
109 SAggregate -> \(AColumn a) -> A a
110 SExpr -> \(AColumn a) -> E a
111 SName -> \(AColumn a) -> N a
112 SResult -> \(AColumn a) -> R a
113 SReify context -> \(AColumn a) -> Reify (stoColumn context a)
116data TColumn :: K.Context -> Type -> Exp Type
117type instance Eval (TColumn f a) = Column f a