git.iko.soy/rel8
on 6360f10 help sign in
rel8/src/Rel8/Schema/HTable/Type.hs
60 lines 1.7 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.Bool ( KnownBool, boolSing, IsList )
19import Rel8.Kind.Labels ( SLabels( SLabel ) )
20import Rel8.Kind.Necessity ( Necessity( Required ), SNecessity( SRequired ) )
21import Rel8.Schema.Dict ( Dict( Dict ) )
22import Rel8.Schema.HTable
23 ( HTable, HConstrainTable, HField
24 , hfield, htabulate, htraverse, hdicts, hspecs
25 )
26import Rel8.Schema.HTable.Context ( H, HKTable )
27import Rel8.Schema.Nullability ( Unnullify, Nullabilizes, nullabilization )
28import Rel8.Schema.Spec ( Context, Spec( Spec ), SSpec(..) )
29import Rel8.Type ( DBType, typeInformation )
32type HType :: Type -> HKTable
33data HType a context where
34 HType ::
35 { unHType :: context ('Spec '[""] 'Required (Unnullify a) a)
36 } -> HType a (H context)
39type HTypeField :: Type -> Context
40data HTypeField a spec where
41 HTypeField :: HTypeField a ('Spec '[""] 'Required (Unnullify a) a)
44instance (DBType db, Nullabilizes db a, KnownBool (IsList db)) =>
45 HTable (HType a)
46 where
47 type HConstrainTable (HType a) c = c ('Spec '[""] 'Required (Unnullify a) a)
48 type HField (HType a) = HTypeField a
50 hfield (HType a) HTypeField = a
51 htabulate f = HType $ f HTypeField
52 htraverse f (HType a) = HType <$> f a
53 hdicts = HType Dict
54 hspecs = HType SSpec
55 { labels = SLabel Proxy
56 , necessity = SRequired
57 , info = typeInformation
58 , nullability = nullabilization
59 , isList = boolSing
60 }