@@ -27,6 +27,7 @@ Squeal data definition language.
2727 , TypeInType
2828 , TypeOperators
2929 , UndecidableSuperClasses
30+ , UndecidableInstances
3031#-}
3132
3233module Squeal.PostgreSQL.Definition
@@ -34,6 +35,8 @@ module Squeal.PostgreSQL.Definition
3435 Definition (..)
3536 , (>>>)
3637 , manipDefinition
38+ , PGNullityTyped (..)
39+ , hask
3740 ) where
3841
3942import Control.Category
@@ -44,7 +47,10 @@ import Prelude hiding ((.), id)
4447
4548import qualified GHC.Generics as GHC
4649
50+import Squeal.PostgreSQL.Definition.Table.Column
51+import Squeal.PostgreSQL.Expression.Type
4752import Squeal.PostgreSQL.Manipulation
53+import Squeal.PostgreSQL.PG
4854import Squeal.PostgreSQL.Render
4955import Squeal.PostgreSQL.Schema
5056
@@ -79,3 +85,24 @@ manipDefinition
7985 -- ^ no input or output
8086 -> Definition schemas schemas
8187manipDefinition = UnsafeDefinition . (<> ";") . renderSQL
88+
89+-- | Like @PGTyped@ but also accounts for nullity.
90+class PGNullityTyped schemas (nullty :: NullityType) where
91+ pgNullityType :: ColumnTypeExpression schemas ('NoDef :=> nullty)
92+
93+instance PGTyped schemas ('Null ty) => PGNullityTyped schemas ('Null ty) where
94+ pgNullityType = nullable (pgtype @_ @('Null ty))
95+
96+instance PGTyped schemas ('NotNull ty) => PGNullityTyped schemas ('NotNull ty) where
97+ pgNullityType = notNullable (pgtype @_ @('NotNull ty))
98+
99+-- | Allow you to specify pg column types in relation to haskell types.
100+-- >>> printSQL $ hask @(Maybe String)
101+-- text NULL
102+--
103+-- >>> printSQL $ hask @Double
104+-- float8 NOT NULL
105+hask
106+ :: forall h schemas. PGNullityTyped schemas (NullPG h)
107+ => ColumnTypeExpression schemas ('NoDef :=> NullPG h)
108+hask = pgNullityType