@@ -1,60 +0,0 @@
1−{-# language DataKinds #-}
2−{-# language GADTs #-}
3−{-# language StandaloneKindSignatures #-}
4−{-# language TypeFamilies #-}
5−{-# language UndecidableInstances #-}
6−
7−module Rel8.Schema.HTable.Type
8− ( HType(..)
9− )
10−where
11−
12−-- base
13−import Data.Kind ( Type )
14−import Prelude
15−
16−-- rel8
17−import Rel8.Kind.Labels ( SLabels( SNil ) )
18−import Rel8.Kind.Necessity ( Necessity( Required ), SNecessity( SRequired ) )
19−import Rel8.Schema.Dict ( Dict( Dict ) )
20−import Rel8.Schema.HTable
21− ( HTable, HConstrainTable, HField
22− , hfield, htabulate, htraverse, hdicts, hspecs
23− )
24−import qualified Rel8.Schema.Kind as K
25−import Rel8.Schema.Null ( Sql, nullable )
26−import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
27−import Rel8.Type ( DBType, typeInformation )
28−
29−
30−type HType :: Type -> K.HTable
31−newtype HType a context = HType
32− { unHType :: context ('Spec '[] 'Required a)
33− }
34−
35−
36−type HTypeField :: Type -> Spec -> Type
37−data HTypeField a spec where
38− HTypeField :: HTypeField a ('Spec '[] 'Required a)
39−
40−
41−instance Sql DBType a => HTable (HType a) where
42− type HConstrainTable (HType a) c = c ('Spec '[] 'Required a)
43− type HField (HType a) = HTypeField a
44−
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− }
55−
56− {-# INLINABLE hfield #-}
57− {-# INLINABLE htabulate #-}
58− {-# INLINABLE htraverse #-}
59− {-# INLINABLE hdicts #-}
60− {-# INLINABLE hspecs #-}