@@ -34,14 +34,6 @@ module Squeal.PostgreSQL.Definition.Table
3434 , createTableIfNotExists
3535 , dropTable
3636 , dropTableIfExists
37− , TableConstraintExpression (..)
38− , check
39− , unique
40− , primaryKey
41− , foreignKey
42− , ForeignKeyed
43− , OnDeleteClause (..)
44− , OnUpdateClause (..)
4537 , alterTable
4638 , alterTableRename
4739 , AlterTable (..)
@@ -57,17 +49,6 @@ module Squeal.PostgreSQL.Definition.Table
5749 , setNotNull
5850 , dropNotNull
5951 , alterType
60− -- * Columns
61− , ColumnTypeExpression (..)
62− , nullable
63− , notNullable
64− , default_
65− , serial2
66− , smallserial
67− , serial4
68− , serial
69− , serial8
70− , bigserial
7152 ) where
7253
7354import Control.DeepSeq
@@ -78,10 +59,10 @@ import qualified Generics.SOP as SOP
7859import qualified GHC.Generics as GHC
7960
8061import Squeal.PostgreSQL.Alias
81−import Squeal.PostgreSQL.Definition (Definition (..))
62+import Squeal.PostgreSQL.Definition
63+import Squeal.PostgreSQL.Definition.Table.Column
64+import Squeal.PostgreSQL.Definition.Table.Constraint
8265import Squeal.PostgreSQL.Expression
83−import Squeal.PostgreSQL.Expression.Logic
84−import Squeal.PostgreSQL.Expression.Type
8566import Squeal.PostgreSQL.List
8667import Squeal.PostgreSQL.Render
8768import Squeal.PostgreSQL.Schema
@@ -195,288 +176,6 @@ renderCreation tab columns constraints = renderSQL tab
195176 renderConstraint (constraint `As` alias) =
196177 "CONSTRAINT" <+> renderSQL alias <+> renderSQL constraint
197178
198−-- | Data types are a way to limit the kind of data that can be stored in a
199−-- table. For many applications, however, the constraint they provide is
200−-- too coarse. For example, a column containing a product price should
201−-- probably only accept positive values. But there is no standard data type
202−-- that accepts only positive numbers. Another issue is that you might want
203−-- to constrain column data with respect to other columns or rows.
204−-- For example, in a table containing product information,
205−-- there should be only one row for each product number.
206−-- `TableConstraint`s give you as much control over the data in your tables
207−-- as you wish. If a user attempts to store data in a column that would
208−-- violate a constraint, an error is raised. This applies
209−-- even if the value came from the default value definition.
210−newtype TableConstraintExpression
211− (sch :: Symbol)
212− (tab :: Symbol)
213− (schemas :: SchemasType)
214− (constraint :: TableConstraint)
215− = UnsafeTableConstraintExpression
216− { renderTableConstraintExpression :: ByteString }
217− deriving (GHC.Generic,Show,Eq,Ord,NFData)
218−instance RenderSQL
219− (TableConstraintExpression sch tab schemas constraint) where
220− renderSQL = renderTableConstraintExpression
221−
222−{-| A `check` constraint is the most generic `TableConstraint` type.
223−It allows you to specify that the value in a certain column must satisfy
224−a Boolean (truth-value) expression.
225−
226−>>> :{
227−type Schema = '[
228− "tab" ::: 'Table ('[ "inequality" ::: 'Check '["a","b"]] :=> '[
229− "a" ::: 'NoDef :=> 'NotNull 'PGint4,
230− "b" ::: 'NoDef :=> 'NotNull 'PGint4
231− ])]
232−:}
233−
234−>>> :{
235−let
236− definition :: Definition (Public '[]) (Public Schema)
237− definition = createTable #tab
238− ( (int & notNullable) `as` #a :*
239− (int & notNullable) `as` #b )
240− ( check (#a :* #b) (#a .> #b) `as` #inequality )
241−:}
242−
243−>>> printSQL definition
244−CREATE TABLE "tab" ("a" int NOT NULL, "b" int NOT NULL, CONSTRAINT "inequality" CHECK (("a" > "b")));
245−-}
246−check
247− :: ( Has sch schemas schema
248− , Has tab schema ('Table table)
249− , HasAll aliases (TableToRow table) subcolumns )
250− => NP Alias aliases
251− -- ^ specify the subcolumns which are getting checked
252− -> (forall t. Condition '[] '[] 'Ungrouped schemas '[] '[t ::: subcolumns])
253− -- ^ a closed `Condition` on those subcolumns
254− -> TableConstraintExpression sch tab schemas ('Check aliases)
255−check _cols condition = UnsafeTableConstraintExpression $
256− "CHECK" <+> parenthesized (renderSQL condition)
257−
258−{-| A `unique` constraint ensure that the data contained in a column,
259−or a group of columns, is unique among all the rows in the table.
260−
261−>>> :{
262−type Schema = '[
263− "tab" ::: 'Table( '[ "uq_a_b" ::: 'Unique '["a","b"]] :=> '[
264− "a" ::: 'NoDef :=> 'Null 'PGint4,
265− "b" ::: 'NoDef :=> 'Null 'PGint4
266− ])]
267−:}
268−
269−>>> :{
270−let
271− definition :: Definition (Public '[]) (Public Schema)
272− definition = createTable #tab
273− ( (int & nullable) `as` #a :*
274− (int & nullable) `as` #b )
275− ( unique (#a :* #b) `as` #uq_a_b )
276−:}
277−
278−>>> printSQL definition
279−CREATE TABLE "tab" ("a" int NULL, "b" int NULL, CONSTRAINT "uq_a_b" UNIQUE ("a", "b"));
280−-}
281−unique
282− :: ( Has sch schemas schema
283− , Has tab schema('Table table)
284− , HasAll aliases (TableToRow table) subcolumns )
285− => NP Alias aliases
286− -- ^ specify subcolumns which together are unique for each row
287− -> TableConstraintExpression sch tab schemas ('Unique aliases)
288−unique columns = UnsafeTableConstraintExpression $
289− "UNIQUE" <+> parenthesized (renderSQL columns)
290−
291−{-| A `primaryKey` constraint indicates that a column, or group of columns,
292−can be used as a unique identifier for rows in the table.
293−This requires that the values be both unique and not null.
294−
295−>>> :{
296−type Schema = '[
297− "tab" ::: 'Table ('[ "pk_id" ::: 'PrimaryKey '["id"]] :=> '[
298− "id" ::: 'Def :=> 'NotNull 'PGint4,
299− "name" ::: 'NoDef :=> 'NotNull 'PGtext
300− ])]
301−:}
302−
303−>>> :{
304−let
305− definition :: Definition (Public '[]) (Public Schema)
306− definition = createTable #tab
307− ( serial `as` #id :*
308− (text & notNullable) `as` #name )
309− ( primaryKey #id `as` #pk_id )
310−:}
311−
312−>>> printSQL definition
313−CREATE TABLE "tab" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_id" PRIMARY KEY ("id"));
314−-}
315−primaryKey
316− :: ( Has sch schemas schema
317− , Has tab schema ('Table table)
318− , HasAll aliases (TableToColumns table) subcolumns
319− , AllNotNull subcolumns )
320− => NP Alias aliases
321− -- ^ specify the subcolumns which together form a primary key.
322− -> TableConstraintExpression sch tab schemas ('PrimaryKey aliases)
323−primaryKey columns = UnsafeTableConstraintExpression $
324− "PRIMARY KEY" <+> parenthesized (renderSQL columns)
325−
326−{-| A `foreignKey` specifies that the values in a column
327−(or a group of columns) must match the values appearing in some row of
328−another table. We say this maintains the referential integrity
329−between two related tables.
330−
331−>>> :{
332−type Schema =
333− '[ "users" ::: 'Table (
334− '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>
335− '[ "id" ::: 'Def :=> 'NotNull 'PGint4
336− , "name" ::: 'NoDef :=> 'NotNull 'PGtext
337− ])
338− , "emails" ::: 'Table (
339− '[ "pk_emails" ::: 'PrimaryKey '["id"]
340− , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]
341− ] :=>
342− '[ "id" ::: 'Def :=> 'NotNull 'PGint4
343− , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4
344− , "email" ::: 'NoDef :=> 'Null 'PGtext
345− ])
346− ]
347−:}
348−
349−>>> :{
350−let
351− setup :: Definition (Public '[]) (Public Schema)
352− setup =
353− createTable #users
354− ( serial `as` #id :*
355− (text & notNullable) `as` #name )
356− ( primaryKey #id `as` #pk_users ) >>>
357− createTable #emails
358− ( serial `as` #id :*
359− (int & notNullable) `as` #user_id :*
360− (text & nullable) `as` #email )
361− ( primaryKey #id `as` #pk_emails :*
362− foreignKey #user_id #users #id
363− OnDeleteCascade OnUpdateCascade `as` #fk_user_id )
364−in printSQL setup
365−:}
366−CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id"));
367−CREATE TABLE "emails" ("id" serial, "user_id" int NOT NULL, "email" text NULL, CONSTRAINT "pk_emails" PRIMARY KEY ("id"), CONSTRAINT "fk_user_id" FOREIGN KEY ("user_id") REFERENCES "users" ("id") ON DELETE CASCADE ON UPDATE CASCADE);
368−
369−A `foreignKey` can even be a table self-reference.
370−
371−>>> :{
372−type Schema =
373− '[ "employees" ::: 'Table (
374− '[ "employees_pk" ::: 'PrimaryKey '["id"]
375− , "employees_employer_fk" ::: 'ForeignKey '["employer_id"] "employees" '["id"]
376− ] :=>
377− '[ "id" ::: 'Def :=> 'NotNull 'PGint4
378− , "name" ::: 'NoDef :=> 'NotNull 'PGtext
379− , "employer_id" ::: 'NoDef :=> 'Null 'PGint4
380− ])
381− ]
382−:}
383−
384−>>> :{
385−let
386− setup :: Definition (Public '[]) (Public Schema)
387− setup =
388− createTable #employees
389− ( serial `as` #id :*
390− (text & notNullable) `as` #name :*
391− (integer & nullable) `as` #employer_id )
392− ( primaryKey #id `as` #employees_pk :*
393− foreignKey #employer_id #employees #id
394− OnDeleteCascade OnUpdateCascade `as` #employees_employer_fk )
395−in printSQL setup
396−:}
397−CREATE TABLE "employees" ("id" serial, "name" text NOT NULL, "employer_id" integer NULL, CONSTRAINT "employees_pk" PRIMARY KEY ("id"), CONSTRAINT "employees_employer_fk" FOREIGN KEY ("employer_id") REFERENCES "employees" ("id") ON DELETE CASCADE ON UPDATE CASCADE);
398−-}
399−foreignKey
400− :: (ForeignKeyed schemas sch schema child parent
401− table reftable
402− columns refcolumns
403− constraints cols
404− reftys tys )
405− => NP Alias columns
406− -- ^ column or columns in the table
407− -> Alias parent
408− -- ^ reference table
409− -> NP Alias refcolumns
410− -- ^ reference column or columns in the reference table
411− -> OnDeleteClause
412− -- ^ what to do when reference is deleted
413− -> OnUpdateClause
414− -- ^ what to do when reference is updated
415− -> TableConstraintExpression sch child schemas
416− ('ForeignKey columns parent refcolumns)
417−foreignKey keys parent refs ondel onupd = UnsafeTableConstraintExpression $
418− "FOREIGN KEY" <+> parenthesized (renderSQL keys)
419− <+> "REFERENCES" <+> renderSQL parent
420− <+> parenthesized (renderSQL refs)
421− <+> renderSQL ondel
422− <+> renderSQL onupd
423−
424−-- | A constraint synonym between types involved in a foreign key constraint.
425−type ForeignKeyed schemas
426− sch
427− schema
428− child parent
429− table reftable
430− columns refcolumns
431− constraints cols
432− reftys tys =
433− ( Has sch schemas schema
434− , Has child schema ('Table table)
435− , Has parent schema ('Table reftable)
436− , HasAll columns (TableToColumns table) tys
437− , reftable ~ (constraints :=> cols)
438− , HasAll refcolumns cols reftys
439− , SOP.AllZip SamePGType tys reftys
440− , Uniquely refcolumns constraints )
441−
442−-- | `OnDeleteClause` indicates what to do with rows that reference a deleted row.
443−data OnDeleteClause
444− = OnDeleteNoAction
445− -- ^ if any referencing rows still exist when the constraint is checked,
446− -- an error is raised
447− | OnDeleteRestrict -- ^ prevents deletion of a referenced row
448− | OnDeleteCascade
449− -- ^ specifies that when a referenced row is deleted,
450− -- row(s) referencing it should be automatically deleted as well
451− deriving (GHC.Generic,Show,Eq,Ord)
452−instance NFData OnDeleteClause
453−-- | Render `OnDeleteClause`.
454−instance RenderSQL OnDeleteClause where
455− renderSQL = \case
456− OnDeleteNoAction -> "ON DELETE NO ACTION"
457− OnDeleteRestrict -> "ON DELETE RESTRICT"
458− OnDeleteCascade -> "ON DELETE CASCADE"
459−
460−-- | Analagous to `OnDeleteClause` there is also `OnUpdateClause` which is invoked
461−-- when a referenced column is changed (updated).
462−data OnUpdateClause
463− = OnUpdateNoAction
464− -- ^ if any referencing rows has not changed when the constraint is checked,
465− -- an error is raised
466− | OnUpdateRestrict -- ^ prevents update of a referenced row
467− | OnUpdateCascade
468− -- ^ the updated values of the referenced column(s) should be copied
469− -- into the referencing row(s)
470− deriving (GHC.Generic,Show,Eq,Ord)
471−instance NFData OnUpdateClause
472−
473−-- | Render `OnUpdateClause`.
474−instance RenderSQL OnUpdateClause where
475− renderSQL = \case
476− OnUpdateNoAction -> "ON UPDATE NO ACTION"
477− OnUpdateRestrict -> "ON UPDATE RESTRICT"
478− OnUpdateCascade -> "ON UPDATE CASCADE"
479−
480179-- | `dropTable` removes a table from the schema.
481180--
482181-- >>> :{
@@ -776,51 +475,3 @@ dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"
776475-- ALTER TABLE "tab" ALTER COLUMN "col" TYPE numeric NOT NULL;
777476alterType :: ColumnTypeExpression schemas ty -> AlterColumn schemas ty0 ty
778477alterType ty = UnsafeAlterColumn $ "TYPE" <+> renderColumnTypeExpression ty
779−
780−-- | `ColumnTypeExpression`s are used in `createTable` commands.
781−newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType)
782− = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }
783− deriving (GHC.Generic,Show,Eq,Ord,NFData)
784−instance RenderSQL (ColumnTypeExpression schemas ty) where
785− renderSQL = renderColumnTypeExpression
786−
787−-- | used in `createTable` commands as a column constraint to note that
788−-- @NULL@ may be present in a column
789−nullable
790− :: TypeExpression schemas (nullity ty)
791− -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty)
792−nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL"
793−
794−-- | used in `createTable` commands as a column constraint to ensure
795−-- @NULL@ is not present in a column
796−notNullable
797− :: TypeExpression schemas (nullity ty)
798− -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty)
799−notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL"
800−
801−-- | used in `createTable` commands as a column constraint to give a default
802−default_
803− :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty
804− -> ColumnTypeExpression schemas ('NoDef :=> ty)
805− -> ColumnTypeExpression schemas ('Def :=> ty)
806−default_ x ty = UnsafeColumnTypeExpression $
807− renderSQL ty <+> "DEFAULT" <+> renderExpression x
808−
809−-- | not a true type, but merely a notational convenience for creating
810−-- unique identifier columns with type `PGint2`
811−serial2, smallserial
812− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2)
813−serial2 = UnsafeColumnTypeExpression "serial2"
814−smallserial = UnsafeColumnTypeExpression "smallserial"
815−-- | not a true type, but merely a notational convenience for creating
816−-- unique identifier columns with type `PGint4`
817−serial4, serial
818− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4)
819−serial4 = UnsafeColumnTypeExpression "serial4"
820−serial = UnsafeColumnTypeExpression "serial"
821−-- | not a true type, but merely a notational convenience for creating
822−-- unique identifier columns with type `PGint8`
823−serial8, bigserial
824− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8)
825−serial8 = UnsafeColumnTypeExpression "serial8"
826−bigserial = UnsafeColumnTypeExpression "bigserial"