git.iko.soy/squeal
on dev help sign in
Added hask and PGNullityTyped
7d5cdc4iko
squeal-postgresql/exe/Example.hs+2−2
compare with dev
unifiedsplit
@@ -53,8 +53,8 @@ setup =
53 >>>
53 >>>
54 createTable #emails
54 createTable #emails
55 ( serial `as` #id :*
55 ( serial `as` #id :*
56− (int & notNullable) `as` #user_id :*
56+ hask @Int32 `as` #user_id :*
57− (text & nullable) `as` #email )
57+ hask @(Maybe Text) `as` #email )
58 ( primaryKey #id `as` #pk_emails :*
58 ( primaryKey #id `as` #pk_emails :*
59 foreignKey #user_id #users #id
59 foreignKey #user_id #users #id
60 OnDeleteCascade OnUpdateCascade `as` #fk_user_id )
60 OnDeleteCascade OnUpdateCascade `as` #fk_user_id )
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+20
@@ -27,6 +27,7 @@ Squeal data definition language.
27 , TypeInType
27 , TypeInType
28 , TypeOperators
28 , TypeOperators
29 , UndecidableSuperClasses
29 , UndecidableSuperClasses
30+ , UndecidableInstances
30#-}
31#-}
31
32
32module Squeal.PostgreSQL.Definition
33module Squeal.PostgreSQL.Definition
@@ -34,6 +35,8 @@ module Squeal.PostgreSQL.Definition
34 Definition (..)
35 Definition (..)
35 , (>>>)
36 , (>>>)
36 , manipDefinition
37 , manipDefinition
38+ , PGNullityTyped (..)
39+ , hask
37 ) where
40 ) where
38
41
39import Control.Category
42import Control.Category
@@ -44,7 +47,10 @@ import Prelude hiding ((.), id)
44
47
45import qualified GHC.Generics as GHC
48import qualified GHC.Generics as GHC
46
49
50+import Squeal.PostgreSQL.Definition.Table.Column
51+import Squeal.PostgreSQL.Expression.Type
47import Squeal.PostgreSQL.Manipulation
52import Squeal.PostgreSQL.Manipulation
53+import Squeal.PostgreSQL.PG
48import Squeal.PostgreSQL.Render
54import Squeal.PostgreSQL.Render
49import Squeal.PostgreSQL.Schema
55import Squeal.PostgreSQL.Schema
50
56
@@ -79,3 +85,17 @@ manipDefinition
79 -- ^ no input or output
85 -- ^ no input or output
80 -> Definition schemas schemas
86 -> Definition schemas schemas
81manipDefinition = UnsafeDefinition . (<> ";") . renderSQL
87manipDefinition = UnsafeDefinition . (<> ";") . renderSQL
88+
89+class PGNullityTyped schemas (nullty :: NullityType) where
90+ pgNullityType :: ColumnTypeExpression schemas ('NoDef :=> nullty)
91+
92+instance PGTyped schemas ('Null ty) => PGNullityTyped schemas ('Null ty) where
93+ pgNullityType = nullable (pgtype @_ @('Null ty))
94+
95+instance PGTyped schemas ('NotNull ty) => PGNullityTyped schemas ('NotNull ty) where
96+ pgNullityType = notNullable (pgtype @_ @('NotNull ty))
97+
98+hask
99+ :: forall h schemas. PGNullityTyped schemas (NullPG h)
100+ => ColumnTypeExpression schemas ('NoDef :=> NullPG h)
101+hask = pgNullityType