git.iko.soy/rel8
on 5824baa help sign in
rel8/src/Rel8/Column/Field.hs
115 lines 3.7 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language LambdaCase #-}
4{-# language MultiParamTypeClasses #-}
5{-# language StandaloneKindSignatures #-}
6{-# language TypeFamilies #-}
8module Rel8.Column.Field
9 ( Field, AField(..)
10 )
11where
13-- base
14import Data.Kind ( Type )
15import Prelude
17-- rel8
18import Rel8.Aggregate ( Aggregate, Col(..) )
19import Rel8.Expr ( Expr, Col(..) )
20import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
21import Rel8.Kind.Necessity
22 ( Necessity( Required, Optional )
23 , SNecessity( SRequired, SOptional )
24 , KnownNecessity, necessitySing
25 )
26import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
27import Rel8.Schema.Insert ( Insert, Insertion(..), Col(..) )
28import qualified Rel8.Schema.Kind as K
29import Rel8.Schema.Name ( Name(..), Col(..) )
30import Rel8.Schema.Null ( Sql )
31import Rel8.Schema.Reify ( Reify, Col(..) )
32import Rel8.Schema.Result ( Col( Result ), Result )
33import Rel8.Schema.Spec ( Spec( Spec ) )
34import Rel8.Table
35 ( Table, Columns, Context, fromColumns, toColumns
36 , Unreify, reify, unreify
37 )
38import Rel8.Table.Recontextualize ( Recontextualize )
39import Rel8.Type ( DBType )
42type Field :: K.Context -> Necessity -> Type -> Type
43type family Field context necessity a where
44 Field (Reify context) necessity a = AField context necessity a
45 Field Aggregate _necessity a = Aggregate (Expr a)
46 Field Expr _necessity a = Expr a
47 Field Insert 'Required a = Expr a
48 Field Insert 'Optional a = Maybe (Expr a)
49 Field Name _necessity a = Name a
50 Field Result _necessity a = a
53type AField :: K.Context -> Necessity -> Type -> Type
54newtype AField context necessity a = AField (Field context necessity a)
57instance (Reifiable context, KnownNecessity necessity, Sql DBType a) =>
58 Table (Reify context) (AField context necessity a)
59 where
60 type Context (AField context necessity a) = Reify context
61 type Columns (AField context necessity a) = HIdentity ('Spec '[] necessity a)
62 type Unreify (AField context necessity a) = Field context necessity a
64 fromColumns (HIdentity (Reify a)) = sfromColumn contextSing necessitySing a
65 toColumns = HIdentity . Reify . stoColumn contextSing necessitySing
66 reify _ = AField
67 unreify _ (AField a) = a
70instance
71 ( Reifiable context, Reifiable context'
72 , KnownNecessity necessity, Sql DBType a
73 ) =>
74 Recontextualize
75 (Reify context)
76 (Reify context')
77 (AField context necessity a)
78 (AField context' necessity a)
81sfromColumn :: ()
82 => SContext context
83 -> SNecessity necessity
84 -> Col context ('Spec labels necessity a)
85 -> AField context necessity a
86sfromColumn = \case
87 SAggregate -> \_ (Aggregation a) -> AField a
88 SExpr -> \_ (DB a) -> AField a
89 SResult -> \_ (Result a) -> AField a
90 SInsert -> \case
91 SRequired -> \case
92 InsertCol (Insertion a) -> AField a
93 SOptional -> \case
94 InsertCol Default -> AField Nothing
95 InsertCol (Insertion a) -> AField (Just a)
96 SName -> \_ (NameCol a) -> AField (Name a)
97 SReify context ->
98 \necessity (Reify a) -> AField (sfromColumn context necessity a)
101stoColumn :: ()
102 => SContext context
103 -> SNecessity necessity
104 -> AField context necessity a
105 -> Col context ('Spec labels necessity a)
106stoColumn = \case
107 SAggregate -> \_ (AField a) -> Aggregation a
108 SExpr -> \_ (AField a) -> DB a
109 SResult -> \_ (AField a) -> Result a
110 SInsert -> \case
111 SRequired -> \(AField a) -> InsertCol (Insertion a)
112 SOptional -> \(AField ma) -> InsertCol $ maybe Default Insertion ma
113 SName -> \_ (AField (Name a)) -> NameCol a
114 SReify context ->
115 \necessity (AField a) -> Reify (stoColumn context necessity a)