git.iko.soy/rel8
on 04e24ae help sign in
rel8/src/Rel8/Schema/Column.hs
172 lines 4.9 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.Kind.Labels ( Labels )
24import Rel8.Kind.Necessity ( Necessity( Required, Optional ) )
25import Rel8.Schema.Context ( IsSpecialContext )
26import Rel8.Schema.Field ( Field )
27import qualified Rel8.Schema.Kind as K
28import Rel8.Schema.Nullability ( Unnullify )
29import Rel8.Schema.Structure
30 ( Structure
31 , Shape( Either, List, Maybe, NonEmpty, These )
32 , Shape1
33 , Shape2
34 )
35import Rel8.Table.Either ( EitherTable )
36import Rel8.Table.List ( ListTable )
37import Rel8.Table.Maybe ( MaybeTable )
38import Rel8.Table.NonEmpty ( NonEmptyTable )
39import Rel8.Table.These ( TheseTable )
41-- these
42import Data.These ( These )
45type Label :: Symbol -> Type -> Type
46data Label label a
49type Default :: Type -> Type
50data Default a
53type GetLabel :: Type -> Labels
54type family GetLabel a where
55 GetLabel (Label label _) = '[label]
56 GetLabel _ = '[]
59type UnwrapLabel :: Type -> Type
60type family UnwrapLabel a where
61 UnwrapLabel (Label _ a) = a
62 UnwrapLabel a = a
65type GetNecessity :: Type -> Necessity
66type family GetNecessity a where
67 GetNecessity (Default _) = 'Optional
68 GetNecessity _ = 'Required
71type UnwrapDefault :: Type -> Type
72type family UnwrapDefault a where
73 UnwrapDefault (Default a) = a
74 UnwrapDefault a = a
77-- | The @Column@ type family should be used to indicate which fields of your
78-- data types are single columns in queries. This type family has special
79-- support when a query is executed, allowing you to use a single data type for
80-- both query data and rows decoded to Haskell.
81--
82-- To understand why this type family is special, let's consider a simple
83-- higher-kinded data type of Haskell packages:
84--
85-- >>> :{
86-- data Package f = Package
87-- { packageName :: Column f Text
88-- , packageAuthor :: Column f Text
89-- }
90-- :}
91--
92-- In queries, @f@ will be some type of 'Expr', and @Column Expr a@ reduces to
93-- just @Expr a@:
94--
95-- >>> :t packageName (undefined :: Package Expr)
96-- packageName (undefined :: Package Expr) :: Expr Text
97--
98-- When we 'select' queries of this type, @f@ will be instantiated as
99-- @Identity@, at which point all wrapping entire disappears:
100--
101-- >>> :t packageName (undefined :: Package Identity)
102-- packageName (undefined :: Package Identity) :: Text
103--
104-- In @rel8@ we try hard to always know what @f@ is, which means holes should
105-- mention precise types, rather than the @Column@ type family. You should only
106-- need to be aware of the type family when defining your table types.
107type Column :: K.Context -> Type -> Type
108type Column context a =
109 Field context (GetLabel a)
110 (GetNecessity (UnwrapLabel a))
111 (Unnullify (UnwrapDefault (UnwrapLabel a)))
112 (UnwrapDefault (UnwrapLabel a))
115type IHEither :: Bool -> K.Context -> Type -> Type -> Type
116type family IHEither isSpecialContext context where
117 IHEither 'False _ = EitherTable
118 IHEither 'True Identity = Either
119 IHEither 'True Structure = Shape2 'Either
120 IHEither 'True _ = EitherTable
123type IHList :: Bool -> K.Context -> Type -> Type
124type family IHList isSpecialContext context where
125 IHList 'False _ = ListTable
126 IHList 'True Identity = []
127 IHList 'True Structure = Shape1 'List
128 IHList 'True _ = ListTable
131type IHMaybe :: Bool -> K.Context -> Type -> Type
132type family IHMaybe isSpecialContext context where
133 IHMaybe 'False _ = MaybeTable
134 IHMaybe 'True Identity = Maybe
135 IHMaybe 'True Structure = Shape1 'Maybe
136 IHMaybe 'True _ = MaybeTable
139type IHNonEmpty :: Bool -> K.Context -> Type -> Type
140type family IHNonEmpty isSpecialContext context where
141 IHNonEmpty 'False _ = NonEmptyTable
142 IHNonEmpty 'True Identity = NonEmpty
143 IHNonEmpty 'True Structure = Shape1 'NonEmpty
144 IHNonEmpty 'True _ = NonEmptyTable
147type IHThese :: Bool -> K.Context -> Type -> Type -> Type
148type family IHThese isSpecialContext context where
149 IHThese 'False _ = TheseTable
150 IHThese 'True Identity = These
151 IHThese 'True Structure = Shape2 'These
152 IHThese 'True _ = TheseTable
155type HEither :: K.Context -> Type -> Type -> Type
156type HEither context = IHEither (IsSpecialContext context) context
159type HList :: K.Context -> Type -> Type
160type HList context = IHList (IsSpecialContext context) context
163type HMaybe :: K.Context -> Type -> Type
164type HMaybe context = IHMaybe (IsSpecialContext context) context
167type HNonEmpty :: K.Context -> Type -> Type
168type HNonEmpty context = IHNonEmpty (IsSpecialContext context) context
171type HThese :: K.Context -> Type -> Type -> Type
172type HThese context = IHThese (IsSpecialContext context) context