git.iko.soy/rel8
on f3daaff help sign in
rel8/src/Rel8/Schema/Column.hs
169 lines 4.6 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.Context ( Name, Insertion )
28import Rel8.Schema.Field ( Field )
29import qualified Rel8.Schema.Kind as K
30import Rel8.Schema.Nullability ( Unnullify )
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.
83--
84-- To understand why this type family is special, let's consider a simple
85-- higher-kinded data type of Haskell packages:
86--
87-- >>> :{
88-- data Package f = Package
89-- { packageName :: Column f Text
90-- , packageAuthor :: Column f Text
91-- }
92-- :}
93--
94-- In queries, @f@ will be some type of 'Expr', and @Column Expr a@ reduces to
95-- just @Expr a@:
96--
97-- >>> :t packageName (undefined :: Package Expr)
98-- packageName (undefined :: Package Expr) :: Expr Text
99--
100-- When we 'select' queries of this type, @f@ will be instantiated as
101-- @Identity@, at which point all wrapping entire disappears:
102--
103-- >>> :t packageName (undefined :: Package Identity)
104-- packageName (undefined :: Package Identity) :: Text
105--
106-- In @rel8@ we try hard to always know what @f@ is, which means holes should
107-- mention precise types, rather than the @Column@ type family. You should only
108-- need to be aware of the type family when defining your table types.
109type Column :: K.Context -> Type -> Type
110type Column context a =
111 Field context (GetLabel a)
112 (GetNecessity (UnwrapLabel a))
113 (Unnullify (UnwrapDefault (UnwrapLabel a)))
114 (UnwrapDefault (UnwrapLabel a))
117type HEither :: K.Context -> Type -> Type -> Type
118type family HEither context where
119 HEither Structure = Shape2 'Either
120 HEither Aggregate = EitherTable
121 HEither Expr = EitherTable
122 HEither Identity = Either
123 HEither Insertion = EitherTable
124 HEither Name = EitherTable
125 HEither _ = Either
128type HList :: K.Context -> Type -> Type
129type family HList context where
130 HList Structure = Shape1 'List
131 HList Aggregate = ListTable
132 HList Expr = ListTable
133 HList Identity = []
134 HList Insertion = ListTable
135 HList Name = ListTable
136 HList _ = []
139type HMaybe :: K.Context -> Type -> Type
140type family HMaybe context where
141 HMaybe Structure = Shape1 'Maybe
142 HMaybe Aggregate = MaybeTable
143 HMaybe Expr = MaybeTable
144 HMaybe Identity = Maybe
145 HMaybe Insertion = MaybeTable
146 HMaybe Name = MaybeTable
147 HMaybe _ = Maybe
150type HNonEmpty :: K.Context -> Type -> Type
151type family HNonEmpty context where
152 HNonEmpty Structure = Shape1 'NonEmpty
153 HNonEmpty Aggregate = NonEmptyTable
154 HNonEmpty Expr = NonEmptyTable
155 HNonEmpty Identity = NonEmpty
156 HNonEmpty Insertion = NonEmptyTable
157 HNonEmpty Name = NonEmptyTable
158 HNonEmpty _ = NonEmpty
161type HThese :: K.Context -> Type -> Type -> Type
162type family HThese context where
163 HThese Structure = Shape2 'These
164 HThese Aggregate = TheseTable
165 HThese Expr = TheseTable
166 HThese Identity = These
167 HThese Insertion = TheseTable
168 HThese Name = TheseTable
169 HThese _ = These