git.iko.soy/rel8
on dec2074 help sign in
rel8/src/Rel8/Schema/Column.hs
170 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.Field ( Field )
28import Rel8.Schema.Insert ( Insert )
29import qualified Rel8.Schema.Kind as K
30import Rel8.Schema.Name ( Name )
31import Rel8.Schema.Nullability ( Unnullify )
32import Rel8.Schema.Structure
33 ( Structure
34 , Shape( Either, List, Maybe, NonEmpty, These )
35 , Shape1
36 , Shape2
37 )
38import Rel8.Table.Either ( EitherTable )
39import Rel8.Table.List ( ListTable )
40import Rel8.Table.Maybe ( MaybeTable )
41import Rel8.Table.NonEmpty ( NonEmptyTable )
42import Rel8.Table.These ( TheseTable )
44-- these
45import Data.These ( These )
48type Label :: Symbol -> Type -> Type
49data Label label a
52type Default :: Type -> Type
53data Default a
56type GetLabel :: Type -> Labels
57type family GetLabel a where
58 GetLabel (Label label _) = '[label]
59 GetLabel _ = '[]
62type UnwrapLabel :: Type -> Type
63type family UnwrapLabel a where
64 UnwrapLabel (Label _ a) = a
65 UnwrapLabel a = a
68type GetNecessity :: Type -> Necessity
69type family GetNecessity a where
70 GetNecessity (Default _) = 'Optional
71 GetNecessity _ = 'Required
74type UnwrapDefault :: Type -> Type
75type family UnwrapDefault a where
76 UnwrapDefault (Default a) = a
77 UnwrapDefault a = a
80-- | The @Column@ type family should be used to indicate which fields of your
81-- data types are single columns in queries. This type family has special
82-- support when a query is executed, allowing you to use a single data type for
83-- both query data and rows decoded to Haskell.
84--
85-- To understand why this type family is special, let's consider a simple
86-- higher-kinded data type of Haskell packages:
87--
88-- >>> :{
89-- data Package f = Package
90-- { packageName :: Column f Text
91-- , packageAuthor :: Column f Text
92-- }
93-- :}
94--
95-- In queries, @f@ will be some type of 'Expr', and @Column Expr a@ reduces to
96-- just @Expr a@:
97--
98-- >>> :t packageName (undefined :: Package Expr)
99-- packageName (undefined :: Package Expr) :: Expr Text
100--
101-- When we 'select' queries of this type, @f@ will be instantiated as
102-- @Identity@, at which point all wrapping entire disappears:
103--
104-- >>> :t packageName (undefined :: Package Identity)
105-- packageName (undefined :: Package Identity) :: Text
106--
107-- In @rel8@ we try hard to always know what @f@ is, which means holes should
108-- mention precise types, rather than the @Column@ type family. You should only
109-- need to be aware of the type family when defining your table types.
110type Column :: K.Context -> Type -> Type
111type Column context a =
112 Field context (GetLabel a)
113 (GetNecessity (UnwrapLabel a))
114 (Unnullify (UnwrapDefault (UnwrapLabel a)))
115 (UnwrapDefault (UnwrapLabel a))
118type HEither :: K.Context -> Type -> Type -> Type
119type family HEither context where
120 HEither Structure = Shape2 'Either
121 HEither Aggregate = EitherTable
122 HEither Expr = EitherTable
123 HEither Identity = Either
124 HEither Insert = EitherTable
125 HEither Name = EitherTable
126 HEither _ = Either
129type HList :: K.Context -> Type -> Type
130type family HList context where
131 HList Structure = Shape1 'List
132 HList Aggregate = ListTable
133 HList Expr = ListTable
134 HList Identity = []
135 HList Insert = ListTable
136 HList Name = ListTable
137 HList _ = []
140type HMaybe :: K.Context -> Type -> Type
141type family HMaybe context where
142 HMaybe Structure = Shape1 'Maybe
143 HMaybe Aggregate = MaybeTable
144 HMaybe Expr = MaybeTable
145 HMaybe Identity = Maybe
146 HMaybe Insert = MaybeTable
147 HMaybe Name = MaybeTable
148 HMaybe _ = Maybe
151type HNonEmpty :: K.Context -> Type -> Type
152type family HNonEmpty context where
153 HNonEmpty Structure = Shape1 'NonEmpty
154 HNonEmpty Aggregate = NonEmptyTable
155 HNonEmpty Expr = NonEmptyTable
156 HNonEmpty Identity = NonEmpty
157 HNonEmpty Insert = NonEmptyTable
158 HNonEmpty Name = NonEmptyTable
159 HNonEmpty _ = NonEmpty
162type HThese :: K.Context -> Type -> Type -> Type
163type family HThese context where
164 HThese Structure = Shape2 'These
165 HThese Aggregate = TheseTable
166 HThese Expr = TheseTable
167 HThese Identity = These
168 HThese Insert = TheseTable
169 HThese Name = TheseTable
170 HThese _ = These