git.iko.soy/rel8
on ca7aaef help sign in
rel8/src/Rel8/Schema/Column.hs
168 lines 4.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.
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 (UnwrapDefault (UnwrapLabel a))
116type HEither :: K.Context -> Type -> Type -> Type
117type family HEither context where
118 HEither Structure = Shape2 'Either
119 HEither Aggregate = EitherTable
120 HEither Expr = EitherTable
121 HEither Identity = Either
122 HEither Insert = EitherTable
123 HEither Name = EitherTable
124 HEither _ = Either
127type HList :: K.Context -> Type -> Type
128type family HList context where
129 HList Structure = Shape1 'List
130 HList Aggregate = ListTable
131 HList Expr = ListTable
132 HList Identity = []
133 HList Insert = ListTable
134 HList Name = ListTable
135 HList _ = []
138type HMaybe :: K.Context -> Type -> Type
139type family HMaybe context where
140 HMaybe Structure = Shape1 'Maybe
141 HMaybe Aggregate = MaybeTable
142 HMaybe Expr = MaybeTable
143 HMaybe Identity = Maybe
144 HMaybe Insert = MaybeTable
145 HMaybe Name = MaybeTable
146 HMaybe _ = Maybe
149type HNonEmpty :: K.Context -> Type -> Type
150type family HNonEmpty context where
151 HNonEmpty Structure = Shape1 'NonEmpty
152 HNonEmpty Aggregate = NonEmptyTable
153 HNonEmpty Expr = NonEmptyTable
154 HNonEmpty Identity = NonEmpty
155 HNonEmpty Insert = NonEmptyTable
156 HNonEmpty Name = NonEmptyTable
157 HNonEmpty _ = NonEmpty
160type HThese :: K.Context -> Type -> Type -> Type
161type family HThese context where
162 HThese Structure = Shape2 'These
163 HThese Aggregate = TheseTable
164 HThese Expr = TheseTable
165 HThese Identity = These
166 HThese Insert = TheseTable
167 HThese Name = TheseTable
168 HThese _ = These