@@ -23,15 +23,16 @@ Type expressions.
2323 , ScopedTypeVariables
2424 , TypeApplications
2525 , TypeOperators
26+ , UndecidableInstances
2627#-}
2728
2829module Squeal.PostgreSQL.Expression.Type
29− ( TypeExpression (..)
30− , cast
30+ ( -- * type casting
31+ cast
3132 , astype
3233 , inferredtype
33− , PGTyped (..)
34− , FieldTyped (..)
34+ -- * type expressions
35+ , TypeExpression (..)
3536 , typedef
3637 , typetable
3738 , typeview
@@ -78,6 +79,22 @@ module Squeal.PostgreSQL.Expression.Type
7879 , tsrange
7980 , tstzrange
8081 , daterange
82+ -- * column type definitions
83+ , ColumnTypeExpression (..)
84+ , nullable
85+ , notNullable
86+ , default_
87+ , serial2
88+ , smallserial
89+ , serial4
90+ , serial
91+ , serial8
92+ , bigserial
93+ , hask
94+ -- * type inference
95+ , PGTyped (..)
96+ , PGNullityTyped (..)
97+ , FieldTyped (..)
8198 ) where
8299
83100import Control.DeepSeq
@@ -91,6 +108,7 @@ import qualified Generics.SOP as SOP
91108
92109import Squeal.PostgreSQL.Alias
93110import Squeal.PostgreSQL.Expression
111+import Squeal.PostgreSQL.PG
94112import Squeal.PostgreSQL.Render
95113import Squeal.PostgreSQL.Schema
96114
@@ -132,6 +150,7 @@ astype = cast
132150inferredtype
133151 :: PGTyped schemas ty
134152 => Expression outer common grp schemas params from ty
153+ -- ^ value
135154 -> Expression outer common grp schemas params from ty
136155inferredtype = astype pgtype
137156
@@ -151,6 +170,7 @@ instance RenderSQL (TypeExpression schemas ty) where
151170typedef
152171 :: (Has sch schemas schema, Has td schema ('Typedef ty))
153172 => QualifiedAlias sch td
173+ -- ^ type alias
154174 -> TypeExpression schemas (null ty)
155175typedef = UnsafeTypeExpression . renderSQL
156176
@@ -159,6 +179,7 @@ typedef = UnsafeTypeExpression . renderSQL
159179typetable
160180 :: (Has sch schemas schema, Has tab schema ('Table table))
161181 => QualifiedAlias sch tab
182+ -- ^ table alias
162183 -> TypeExpression schemas (null ('PGcomposite (TableToRow table)))
163184typetable = UnsafeTypeExpression . renderSQL
164185
@@ -167,6 +188,7 @@ typetable = UnsafeTypeExpression . renderSQL
167188typeview
168189 :: (Has sch schemas schema, Has vw schema ('View view))
169190 => QualifiedAlias sch vw
191+ -- ^ view alias
170192 -> TypeExpression schemas (null ('PGcomposite view))
171193typeview = UnsafeTypeExpression . renderSQL
172194
@@ -353,3 +375,72 @@ class FieldTyped schemas ty where
353375instance (KnownSymbol alias, PGTyped schemas ty)
354376 => FieldTyped schemas (alias ::: ty) where
355377 fieldtype = pgtype `As` Alias
378+
379+-- | `ColumnTypeExpression`s are used in `createTable` commands.
380+newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType)
381+ = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }
382+ deriving (GHC.Generic,Show,Eq,Ord,NFData)
383+instance RenderSQL (ColumnTypeExpression schemas ty) where
384+ renderSQL = renderColumnTypeExpression
385+
386+-- | used in `createTable` commands as a column constraint to note that
387+-- @NULL@ may be present in a column
388+nullable
389+ :: TypeExpression schemas (nullity ty)
390+ -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty)
391+nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL"
392+
393+-- | used in `createTable` commands as a column constraint to ensure
394+-- @NULL@ is not present in a column
395+notNullable
396+ :: TypeExpression schemas (nullity ty)
397+ -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty)
398+notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL"
399+
400+-- | used in `createTable` commands as a column constraint to give a default
401+default_
402+ :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty
403+ -> ColumnTypeExpression schemas ('NoDef :=> ty)
404+ -> ColumnTypeExpression schemas ('Def :=> ty)
405+default_ x ty = UnsafeColumnTypeExpression $
406+ renderSQL ty <+> "DEFAULT" <+> renderExpression x
407+
408+-- | not a true type, but merely a notational convenience for creating
409+-- unique identifier columns with type `PGint2`
410+serial2, smallserial
411+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2)
412+serial2 = UnsafeColumnTypeExpression "serial2"
413+smallserial = UnsafeColumnTypeExpression "smallserial"
414+-- | not a true type, but merely a notational convenience for creating
415+-- unique identifier columns with type `PGint4`
416+serial4, serial
417+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4)
418+serial4 = UnsafeColumnTypeExpression "serial4"
419+serial = UnsafeColumnTypeExpression "serial"
420+-- | not a true type, but merely a notational convenience for creating
421+-- unique identifier columns with type `PGint8`
422+serial8, bigserial
423+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8)
424+serial8 = UnsafeColumnTypeExpression "serial8"
425+bigserial = UnsafeColumnTypeExpression "bigserial"
426+
427+-- | Like @PGTyped@ but also accounts for nullity.
428+class PGNullityTyped schemas (nullty :: NullityType) where
429+ pgNullityType :: ColumnTypeExpression schemas ('NoDef :=> nullty)
430+
431+instance PGTyped schemas ('Null ty) => PGNullityTyped schemas ('Null ty) where
432+ pgNullityType = nullable (pgtype @_ @('Null ty))
433+
434+instance PGTyped schemas ('NotNull ty) => PGNullityTyped schemas ('NotNull ty) where
435+ pgNullityType = notNullable (pgtype @_ @('NotNull ty))
436+
437+-- | Allow you to specify pg column types in relation to haskell types.
438+-- >>> printSQL $ hask @(Maybe String)
439+-- text NULL
440+--
441+-- >>> printSQL $ hask @Double
442+-- float8 NOT NULL
443+hask
444+ :: forall hask schemas. PGNullityTyped schemas (NullPG hask)
445+ => ColumnTypeExpression schemas ('NoDef :=> NullPG hask)
446+hask = pgNullityType