git.iko.soy/rel8
on db148ff help sign in
rel8/src/Rel8/Schema/HTable/Type.hs
60 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 Prelude
16-- rel8
17import Rel8.Kind.Labels ( SLabels( SNil ) )
18import Rel8.Kind.Necessity ( Necessity( Required ), SNecessity( SRequired ) )
19import Rel8.Schema.Dict ( Dict( Dict ) )
20import Rel8.Schema.HTable
21 ( HTable, HConstrainTable, HField
22 , hfield, htabulate, htraverse, hdicts, hspecs
23 )
24import qualified Rel8.Schema.Kind as K
25import Rel8.Schema.Null ( Sql, nullable )
26import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
27import Rel8.Type ( DBType, typeInformation )
30type HType :: Type -> K.HTable
31newtype HType a context = HType
32 { unHType :: context ('Spec '[] 'Required a)
33 }
36type HTypeField :: Type -> Spec -> Type
37data HTypeField a spec where
38 HTypeField :: HTypeField a ('Spec '[] 'Required a)
41instance Sql DBType a => HTable (HType a) where
42 type HConstrainTable (HType a) c = c ('Spec '[] 'Required a)
43 type HField (HType a) = HTypeField a
45 hfield (HType a) HTypeField = a
46 htabulate f = HType $ f HTypeField
47 htraverse f (HType a) = HType <$> f a
48 hdicts = HType Dict
49 hspecs = HType SSpec
50 { labels = SNil
51 , necessity = SRequired
52 , info = typeInformation
53 , nullity = nullable
54 }
56 {-# INLINABLE hfield #-}
57 {-# INLINABLE htabulate #-}
58 {-# INLINABLE htraverse #-}
59 {-# INLINABLE hdicts #-}
60 {-# INLINABLE hspecs #-}