git.iko.soy/rel8
on 71aac66 help sign in
rel8/src/Rel8/Schema/Column.hs
142 lines 3.5 kB history raw
1{-# language DataKinds #-}
2{-# language TypeFamilies #-}
3{-# language StandaloneKindSignatures #-}
5module Rel8.Schema.Column
6 ( Column, Default, Label
7 , HEither
8 , HList
9 , HMaybe
10 , HNonEmpty
11 , HThese
12 )
13where
15-- base
16import Data.Functor.Identity ( Identity )
17import Data.Kind ( Type )
18import Data.List.NonEmpty ( NonEmpty )
19import GHC.TypeLits ( Symbol )
20import Prelude
22-- rel8
23import Rel8.Aggregate ( Aggregate )
24import Rel8.Expr ( Expr )
25import Rel8.Kind.Labels ( Labels )
26import Rel8.Kind.Necessity ( Necessity( Required, Optional ) )
27import Rel8.Schema.Field ( Field )
28import Rel8.Schema.Insert ( Insert )
29import qualified Rel8.Schema.Kind as K
30import Rel8.Schema.Name ( Name )
31import Rel8.Schema.Structure
32 ( Structure
33 , Shape( Either, List, Maybe, NonEmpty, These )
34 , Shape1
35 , Shape2
36 )
37import Rel8.Table.Either ( EitherTable )
38import Rel8.Table.List ( ListTable )
39import Rel8.Table.Maybe ( MaybeTable )
40import Rel8.Table.NonEmpty ( NonEmptyTable )
41import Rel8.Table.These ( TheseTable )
43-- these
44import Data.These ( These )
47type Label :: Symbol -> Type -> Type
48data Label label a
51type Default :: Type -> Type
52data Default a
55type GetLabel :: Type -> Labels
56type family GetLabel a where
57 GetLabel (Label label _) = '[label]
58 GetLabel _ = '[]
61type UnwrapLabel :: Type -> Type
62type family UnwrapLabel a where
63 UnwrapLabel (Label _ a) = a
64 UnwrapLabel a = a
67type GetNecessity :: Type -> Necessity
68type family GetNecessity a where
69 GetNecessity (Default _) = 'Optional
70 GetNecessity _ = 'Required
73type UnwrapDefault :: Type -> Type
74type family UnwrapDefault a where
75 UnwrapDefault (Default a) = a
76 UnwrapDefault a = a
79-- | The @Column@ type family should be used to indicate which fields of your
80-- data types are single columns in queries. This type family has special
81-- support when a query is executed, allowing you to use a single data type for
82-- both query data and rows decoded to Haskell.
83type Column :: K.Context -> Type -> Type
84type Column context a =
85 Field context (GetLabel a)
86 (GetNecessity (UnwrapLabel a))
87 (UnwrapDefault (UnwrapLabel a))
90type HEither :: K.Context -> Type -> Type -> Type
91type family HEither context where
92 HEither Structure = Shape2 'Either
93 HEither Aggregate = EitherTable
94 HEither Expr = EitherTable
95 HEither Identity = Either
96 HEither Insert = EitherTable
97 HEither Name = EitherTable
98 HEither _ = Either
101type HList :: K.Context -> Type -> Type
102type family HList context where
103 HList Structure = Shape1 'List
104 HList Aggregate = ListTable
105 HList Expr = ListTable
106 HList Identity = []
107 HList Insert = ListTable
108 HList Name = ListTable
109 HList _ = []
112type HMaybe :: K.Context -> Type -> Type
113type family HMaybe context where
114 HMaybe Structure = Shape1 'Maybe
115 HMaybe Aggregate = MaybeTable
116 HMaybe Expr = MaybeTable
117 HMaybe Identity = Maybe
118 HMaybe Insert = MaybeTable
119 HMaybe Name = MaybeTable
120 HMaybe _ = Maybe
123type HNonEmpty :: K.Context -> Type -> Type
124type family HNonEmpty context where
125 HNonEmpty Structure = Shape1 'NonEmpty
126 HNonEmpty Aggregate = NonEmptyTable
127 HNonEmpty Expr = NonEmptyTable
128 HNonEmpty Identity = NonEmpty
129 HNonEmpty Insert = NonEmptyTable
130 HNonEmpty Name = NonEmptyTable
131 HNonEmpty _ = NonEmpty
134type HThese :: K.Context -> Type -> Type -> Type
135type family HThese context where
136 HThese Structure = Shape2 'These
137 HThese Aggregate = TheseTable
138 HThese Expr = TheseTable
139 HThese Identity = These
140 HThese Insert = TheseTable
141 HThese Name = TheseTable
142 HThese _ = These