git.iko.soy/rel8
on 7aa4f92 help sign in
rel8/src/Rel8/Schema/HTable/Type.hs
56 lines 1.6 kB history raw
1{-# language DataKinds #-}
2{-# language GADTs #-}
3{-# language StandaloneKindSignatures #-}
4{-# language TypeFamilies #-}
5{-# language UndecidableInstances #-}
7module Rel8.Schema.HTable.Type
8 ( HType(..)
9 )
10where
12-- base
13import Data.Kind ( Type )
14import Data.Proxy ( Proxy( Proxy ) )
15import Prelude
17-- rel8
18import Rel8.Kind.Labels ( SLabels( SLabel ) )
19import Rel8.Kind.Necessity ( Necessity( Required ), SNecessity( SRequired ) )
20import Rel8.Schema.Dict ( Dict( Dict ) )
21import Rel8.Schema.HTable
22 ( HTable, HConstrainTable, HField
23 , hfield, htabulate, htraverse, hdicts, hspecs
24 )
25import Rel8.Schema.HTable.Context ( H, HKTable )
26import Rel8.Schema.Nullability ( Unnullify, Nullabilizes, nullabilization )
27import Rel8.Schema.Spec ( Context, Spec( Spec ), SSpec(..) )
28import Rel8.Type ( DBType, typeInformation )
31type HType :: Type -> HKTable
32data HType a context where
33 HType ::
34 { unHType :: context ('Spec '[""] 'Required (Unnullify a) a)
35 } -> HType a (H context)
38type HTypeField :: Type -> Context
39data HTypeField a spec where
40 HTypeField :: HTypeField a ('Spec '[""] 'Required (Unnullify a) a)
43instance (DBType db, Nullabilizes db a) => HTable (HType a) where
44 type HConstrainTable (HType a) c = c ('Spec '[""] 'Required (Unnullify a) a)
45 type HField (HType a) = HTypeField a
47 hfield (HType a) HTypeField = a
48 htabulate f = HType $ f HTypeField
49 htraverse f (HType a) = HType <$> f a
50 hdicts = HType Dict
51 hspecs = HType SSpec
52 { labels = SLabel Proxy
53 , necessity = SRequired
54 , info = typeInformation
55 , nullability = nullabilization
56 }