git.iko.soy/rel8
on b983def help sign in
rel8/src/Rel8/Schema/Column.hs
141 lines 3.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.Kind ( Type )
17import Data.List.NonEmpty ( NonEmpty )
18import GHC.TypeLits ( Symbol )
19import Prelude
21-- rel8
22import Rel8.Kind.Labels ( Labels )
23import Rel8.Kind.Necessity ( Necessity( Required, Optional ) )
24import Rel8.Schema.Context ( Result, IsSpecialContext )
25import Rel8.Schema.Field ( Field )
26import Rel8.Schema.Nullability ( Unnullify )
27import Rel8.Schema.Spec ( Context )
28import Rel8.Schema.Structure
29 ( Structure
30 , Shape( Either, List, Maybe, NonEmpty, These )
31 , Shape1
32 , Shape2
33 )
34import Rel8.Table.Either ( EitherTable )
35import Rel8.Table.List ( ListTable )
36import Rel8.Table.Maybe ( MaybeTable )
37import Rel8.Table.NonEmpty ( NonEmptyTable )
38import Rel8.Table.These ( TheseTable )
40-- these
41import Data.These ( These )
44type Label :: Symbol -> Type -> Type
45data Label label a
48type Default :: Type -> Type
49data Default a
52type GetLabel :: Type -> Labels
53type family GetLabel a where
54 GetLabel (Label label _) = '[label]
55 GetLabel _ = '[]
58type UnwrapLabel :: Type -> Type
59type family UnwrapLabel a where
60 UnwrapLabel (Label _ a) = a
61 UnwrapLabel a = a
64type GetNecessity :: Type -> Necessity
65type family GetNecessity a where
66 GetNecessity (Default _) = 'Optional
67 GetNecessity _ = 'Required
70type UnwrapDefault :: Type -> Type
71type family UnwrapDefault a where
72 UnwrapDefault (Default a) = a
73 UnwrapDefault a = a
76type Column :: Context -> Type -> Type
77type Column context a =
78 Field context (GetLabel a)
79 (GetNecessity (UnwrapLabel a))
80 (Unnullify (UnwrapDefault (UnwrapLabel a)))
81 (UnwrapDefault (UnwrapLabel a))
84type IHEither :: Bool -> Context -> Type -> Type -> Type
85type family IHEither isSpecialContext context where
86 IHEither 'False _ = EitherTable
87 IHEither 'True Result = Either
88 IHEither 'True Structure = Shape2 'Either
89 IHEither 'True _ = EitherTable
92type IHList :: Bool -> Context -> Type -> Type
93type family IHList isSpecialContext context where
94 IHList 'False _ = ListTable
95 IHList 'True Result = []
96 IHList 'True Structure = Shape1 'List
97 IHList 'True _ = ListTable
100type IHMaybe :: Bool -> Context -> Type -> Type
101type family IHMaybe isSpecialContext context where
102 IHMaybe 'False _ = MaybeTable
103 IHMaybe 'True Result = Maybe
104 IHMaybe 'True Structure = Shape1 'Maybe
105 IHMaybe 'True _ = MaybeTable
108type IHNonEmpty :: Bool -> Context -> Type -> Type
109type family IHNonEmpty isSpecialContext context where
110 IHNonEmpty 'False _ = NonEmptyTable
111 IHNonEmpty 'True Result = NonEmpty
112 IHNonEmpty 'True Structure = Shape1 'NonEmpty
113 IHNonEmpty 'True _ = NonEmptyTable
116type IHThese :: Bool -> Context -> Type -> Type -> Type
117type family IHThese isSpecialContext context where
118 IHThese 'False _ = TheseTable
119 IHThese 'True Result = These
120 IHThese 'True Structure = Shape2 'These
121 IHThese 'True _ = TheseTable
124type HEither :: Context -> Type -> Type -> Type
125type HEither context = IHEither (IsSpecialContext context) context
128type HList :: Context -> Type -> Type
129type HList context = IHList (IsSpecialContext context) context
132type HMaybe :: Context -> Type -> Type
133type HMaybe context = IHMaybe (IsSpecialContext context) context
136type HNonEmpty :: Context -> Type -> Type
137type HNonEmpty context = IHNonEmpty (IsSpecialContext context) context
140type HThese :: Context -> Type -> Type -> Type
141type HThese context = IHThese (IsSpecialContext context) context