git.iko.soy/rel8
on 63c5e03 help sign in
rel8/src/Rel8/Column/Field.hs
115 lines 3.6 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( A ) )
19import Rel8.Expr ( Expr, Col( E ) )
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( I ) )
28import qualified Rel8.Schema.Kind as K
29import Rel8.Schema.Name ( Name(..), Col( N ) )
30import Rel8.Schema.Null ( Sql )
31import Rel8.Schema.Reify ( Reify, Col(..) )
32import Rel8.Schema.Result ( Col( R ), 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 -> \_ (A a) -> AField a
88 SExpr -> \_ (E a) -> AField a
89 SInsert -> \case
90 SRequired -> \case
91 I (Value a) -> AField a
92 SOptional -> \case
93 I Default -> AField Nothing
94 I (Value a) -> AField (Just a)
95 SName -> \_ (N a) -> AField a
96 SResult -> \_ (R a) -> AField 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) -> A a
108 SExpr -> \_ (AField a) -> E a
109 SInsert -> \case
110 SRequired -> \(AField a) -> I (Value a)
111 SOptional -> \(AField ma) -> I $ maybe Default Value ma
112 SName -> \_ (AField a) -> N a
113 SResult -> \_ (AField a) -> R a
114 SReify context ->
115 \necessity (AField a) -> Reify (stoColumn context necessity a)