git.iko.soy/rel8
on db148ff help sign in
rel8/src/Rel8/Column/Field.hs
110 lines 3.5 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, 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 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 -> Col context ('Spec labels necessity a)
84 -> AField context necessity a
85sfromColumn = \case
86 SAggregate -> \(Aggregation a) -> AField a
87 SExpr -> \(DB a) -> AField a
88 SResult -> \(Result a) -> AField a
89 SInsert -> \case
90 RequiredInsert a -> AField a
91 OptionalInsert a -> AField a
92 SName -> \(NameCol a) -> AField (Name a)
93 SReify context -> \(Reify a) -> AField (sfromColumn context a)
96stoColumn :: ()
97 => SContext context
98 -> SNecessity necessity
99 -> AField context necessity a
100 -> Col context ('Spec labels necessity a)
101stoColumn = \case
102 SAggregate -> \_ (AField a) -> Aggregation a
103 SExpr -> \_ (AField a) -> DB a
104 SResult -> \_ (AField a) -> Result a
105 SInsert -> \case
106 SRequired -> \(AField a) -> RequiredInsert a
107 SOptional -> \(AField a) -> OptionalInsert a
108 SName -> \_ (AField (Name a)) -> NameCol a
109 SReify context ->
110 \necessity (AField a) -> Reify (stoColumn context necessity a)