git.iko.soy/rel8
on 00a36f5 help sign in
rel8/src/Rel8/Schema/HTable/Type.hs
55 lines 1.5 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 qualified Rel8.Schema.Kind as K
26import Rel8.Schema.Nullability ( Unnullify, Sql, nullabilization )
27import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
28import Rel8.Type ( DBType, typeInformation )
31type HType :: Type -> K.HTable
32newtype HType a context = HType
33 { unHType :: context ('Spec '[""] 'Required (Unnullify a) a)
34 }
37type HTypeField :: Type -> Spec -> Type
38data HTypeField a spec where
39 HTypeField :: HTypeField a ('Spec '[""] 'Required (Unnullify a) a)
42instance Sql DBType a => HTable (HType a) where
43 type HConstrainTable (HType a) c = c ('Spec '[""] 'Required (Unnullify a) a)
44 type HField (HType a) = HTypeField a
46 hfield (HType a) HTypeField = a
47 htabulate f = HType $ f HTypeField
48 htraverse f (HType a) = HType <$> f a
49 hdicts = HType Dict
50 hspecs = HType SSpec
51 { labels = SLabel Proxy
52 , necessity = SRequired
53 , info = typeInformation
54 , nullability = nullabilization
55 }