@@ -11,15 +11,13 @@ Squeal data definition language.
1111{-# LANGUAGE
1212 AllowAmbiguousTypes
1313 , ConstraintKinds
14− , DeriveAnyClass
1514 , DeriveGeneric
16− , DerivingStrategies
1715 , FlexibleContexts
1816 , FlexibleInstances
1917 , GADTs
18+ , GeneralizedNewtypeDeriving
2019 , LambdaCase
2120 , MultiParamTypeClasses
22− , OverloadedLabels
2321 , OverloadedStrings
2422 , RankNTypes
2523 , ScopedTypeVariables
@@ -27,7 +25,6 @@ Squeal data definition language.
2725 , TypeInType
2826 , TypeOperators
2927 , UndecidableSuperClasses
30− , UndecidableInstances
3128#-}
3229
3330module Squeal.PostgreSQL.Definition
@@ -35,16 +32,79 @@ module Squeal.PostgreSQL.Definition
3532 Definition (..)
3633 , (>>>)
3734 , manipDefinition
35+ -- * Tables
36+ -- ** Create
37+ , createSchema
38+ , createSchemaIfNotExists
39+ , createTable
40+ , createTableIfNotExists
41+ , createView
42+ , createTypeEnum
43+ , createTypeEnumFrom
44+ , createTypeComposite
45+ , createTypeCompositeFrom
46+ , FieldTyped (..)
47+ , createDomain
48+ , createTypeRange
49+ , TableConstraintExpression (..)
50+ , check
51+ , unique
52+ , primaryKey
53+ , foreignKey
54+ , ForeignKeyed
55+ , OnDeleteClause (..)
56+ , OnUpdateClause (..)
57+ -- ** Drop
58+ , dropSchema
59+ , dropTable
60+ , dropView
61+ , dropType
62+ -- ** Alter
63+ , alterTable
64+ , alterTableRename
65+ , AlterTable (..)
66+ , addConstraint
67+ , dropConstraint
68+ , AddColumn (..)
69+ , dropColumn
70+ , renameColumn
71+ , alterColumn
72+ , AlterColumn (..)
73+ , setDefault
74+ , dropDefault
75+ , setNotNull
76+ , dropNotNull
77+ , alterType
78+ -- * Columns
79+ , ColumnTypeExpression (..)
80+ , nullable
81+ , notNullable
82+ , default_
83+ , serial2
84+ , smallserial
85+ , serial4
86+ , serial
87+ , serial8
88+ , bigserial
3889 ) where
3990
4091import Control.Category
4192import Control.DeepSeq
4293import Data.ByteString
4394import Data.Monoid
95+import GHC.TypeLits
4496import Prelude hiding ((.), id)
4597
98+import qualified Generics.SOP as SOP
4699import qualified GHC.Generics as GHC
47100
101+import Squeal.PostgreSQL.Alias
102+import Squeal.PostgreSQL.Expression
103+import Squeal.PostgreSQL.Expression.Logic
104+import Squeal.PostgreSQL.Expression.Type
105+import Squeal.PostgreSQL.List
106+import Squeal.PostgreSQL.PG
107+import Squeal.PostgreSQL.Query
48108import Squeal.PostgreSQL.Manipulation
49109import Squeal.PostgreSQL.Render
50110import Squeal.PostgreSQL.Schema
@@ -80,3 +140,981 @@ manipDefinition
80140 -- ^ no input or output
81141 -> Definition schemas schemas
82142manipDefinition = UnsafeDefinition . (<> ";") . renderSQL
143+
144+{-----------------------------------------
145+CREATE statements
146+-----------------------------------------}
147+
148+{- |
149+`createSchema` enters a new schema into the current database.
150+The schema name must be distinct from the name of any existing schema
151+in the current database.
152+
153+A schema is essentially a namespace: it contains named objects
154+(tables, data types, functions, and operators) whose names
155+can duplicate those of other objects existing in other schemas.
156+Named objects are accessed by `QualifiedAlias`es with the schema
157+name as a prefix.
158+-}
159+createSchema
160+ :: KnownSymbol sch
161+ => Alias sch
162+ -> Definition schemas (Create sch '[] schemas)
163+createSchema sch = UnsafeDefinition $
164+ "CREATE" <+> "SCHEMA" <+> renderSQL sch <> ";"
165+
166+{- | Idempotent version of `createSchema`. -}
167+createSchemaIfNotExists
168+ :: (KnownSymbol sch, Has sch schemas schema)
169+ => Alias sch
170+ -> Definition schemas schemas
171+createSchemaIfNotExists sch = UnsafeDefinition $
172+ "CREATE" <+> "SCHEMA" <+> "IF" <+> "NOT" <+> "EXISTS"
173+ <+> renderSQL sch <> ";"
174+
175+{- | `createTable` adds a table to the schema.
176+
177+>>> :set -XOverloadedLabels
178+>>> :{
179+type Table = '[] :=>
180+ '[ "a" ::: 'NoDef :=> 'Null 'PGint4
181+ , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
182+:}
183+
184+>>> :{
185+let
186+ setup :: Definition (Public '[]) (Public '["tab" ::: 'Table Table])
187+ setup = createTable #tab
188+ (nullable int `as` #a :* nullable real `as` #b) Nil
189+in printSQL setup
190+:}
191+CREATE TABLE "tab" ("a" int NULL, "b" real NULL);
192+-}
193+createTable
194+ :: ( KnownSymbol sch
195+ , KnownSymbol tab
196+ , columns ~ (col ': cols)
197+ , SOP.SListI columns
198+ , SOP.SListI constraints
199+ , Has sch schemas0 schema0
200+ , schemas1 ~ Alter sch (Create tab ('Table (constraints :=> columns)) schema0) schemas0 )
201+ => QualifiedAlias sch tab -- ^ the name of the table to add
202+ -> NP (Aliased (ColumnTypeExpression schemas0)) columns
203+ -- ^ the names and datatype of each column
204+ -> NP (Aliased (TableConstraintExpression sch tab schemas1)) constraints
205+ -- ^ constraints that must hold for the table
206+ -> Definition schemas0 schemas1
207+createTable tab columns constraints = UnsafeDefinition $
208+ "CREATE TABLE" <+> renderCreation tab columns constraints
209+
210+{-| `createTableIfNotExists` creates a table if it doesn't exist, but does not add it to the schema.
211+Instead, the schema already has the table so if the table did not yet exist, the schema was wrong.
212+`createTableIfNotExists` fixes this. Interestingly, this property makes it an idempotent in
213+the `Category` of `Definition`s.
214+
215+>>> :set -XOverloadedLabels -XTypeApplications
216+>>> :{
217+type Table = '[] :=>
218+ '[ "a" ::: 'NoDef :=> 'Null 'PGint4
219+ , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
220+:}
221+
222+>>> type Schemas = Public '["tab" ::: 'Table Table]
223+
224+>>> :{
225+let
226+ setup :: Definition Schemas Schemas
227+ setup = createTableIfNotExists #tab
228+ (nullable int `as` #a :* nullable real `as` #b) Nil
229+in printSQL setup
230+:}
231+CREATE TABLE IF NOT EXISTS "tab" ("a" int NULL, "b" real NULL);
232+-}
233+createTableIfNotExists
234+ :: ( Has sch schemas schema
235+ , Has tab schema ('Table (constraints :=> columns))
236+ , SOP.SListI columns
237+ , SOP.SListI constraints )
238+ => QualifiedAlias sch tab -- ^ the name of the table to add
239+ -> NP (Aliased (ColumnTypeExpression schemas)) columns
240+ -- ^ the names and datatype of each column
241+ -> NP (Aliased (TableConstraintExpression sch tab schemas)) constraints
242+ -- ^ constraints that must hold for the table
243+ -> Definition schemas schemas
244+createTableIfNotExists tab columns constraints = UnsafeDefinition $
245+ "CREATE TABLE IF NOT EXISTS"
246+ <+> renderCreation tab columns constraints
247+
248+-- helper function for `createTable` and `createTableIfNotExists`
249+renderCreation
250+ :: ( KnownSymbol sch
251+ , KnownSymbol tab
252+ , SOP.SListI columns
253+ , SOP.SListI constraints )
254+ => QualifiedAlias sch tab -- ^ the name of the table to add
255+ -> NP (Aliased (ColumnTypeExpression schemas0)) columns
256+ -- ^ the names and datatype of each column
257+ -> NP (Aliased (TableConstraintExpression sch tab schemas1)) constraints
258+ -- ^ constraints that must hold for the table
259+ -> ByteString
260+renderCreation tab columns constraints = renderSQL tab
261+ <+> parenthesized
262+ ( renderCommaSeparated renderColumnDef columns
263+ <> ( case constraints of
264+ Nil -> ""
265+ _ -> ", " <>
266+ renderCommaSeparated renderConstraint constraints ) )
267+ <> ";"
268+ where
269+ renderColumnDef :: Aliased (ColumnTypeExpression schemas) x -> ByteString
270+ renderColumnDef (ty `As` column) =
271+ renderSQL column <+> renderColumnTypeExpression ty
272+ renderConstraint
273+ :: Aliased (TableConstraintExpression sch tab schemas) constraint
274+ -> ByteString
275+ renderConstraint (constraint `As` alias) =
276+ "CONSTRAINT" <+> renderSQL alias <+> renderSQL constraint
277+
278+-- | Data types are a way to limit the kind of data that can be stored in a
279+-- table. For many applications, however, the constraint they provide is
280+-- too coarse. For example, a column containing a product price should
281+-- probably only accept positive values. But there is no standard data type
282+-- that accepts only positive numbers. Another issue is that you might want
283+-- to constrain column data with respect to other columns or rows.
284+-- For example, in a table containing product information,
285+-- there should be only one row for each product number.
286+-- `TableConstraint`s give you as much control over the data in your tables
287+-- as you wish. If a user attempts to store data in a column that would
288+-- violate a constraint, an error is raised. This applies
289+-- even if the value came from the default value definition.
290+newtype TableConstraintExpression
291+ (sch :: Symbol)
292+ (tab :: Symbol)
293+ (schemas :: SchemasType)
294+ (constraint :: TableConstraint)
295+ = UnsafeTableConstraintExpression
296+ { renderTableConstraintExpression :: ByteString }
297+ deriving (GHC.Generic,Show,Eq,Ord,NFData)
298+instance RenderSQL
299+ (TableConstraintExpression sch tab schemas constraint) where
300+ renderSQL = renderTableConstraintExpression
301+
302+{-| A `check` constraint is the most generic `TableConstraint` type.
303+It allows you to specify that the value in a certain column must satisfy
304+a Boolean (truth-value) expression.
305+
306+>>> :{
307+type Schema = '[
308+ "tab" ::: 'Table ('[ "inequality" ::: 'Check '["a","b"]] :=> '[
309+ "a" ::: 'NoDef :=> 'NotNull 'PGint4,
310+ "b" ::: 'NoDef :=> 'NotNull 'PGint4
311+ ])]
312+:}
313+
314+>>> :{
315+let
316+ definition :: Definition (Public '[]) (Public Schema)
317+ definition = createTable #tab
318+ ( (int & notNullable) `as` #a :*
319+ (int & notNullable) `as` #b )
320+ ( check (#a :* #b) (#a .> #b) `as` #inequality )
321+:}
322+
323+>>> printSQL definition
324+CREATE TABLE "tab" ("a" int NOT NULL, "b" int NOT NULL, CONSTRAINT "inequality" CHECK (("a" > "b")));
325+-}
326+check
327+ :: ( Has sch schemas schema
328+ , Has tab schema ('Table table)
329+ , HasAll aliases (TableToRow table) subcolumns )
330+ => NP Alias aliases
331+ -- ^ specify the subcolumns which are getting checked
332+ -> (forall t. Condition '[] '[] 'Ungrouped schemas '[] '[t ::: subcolumns])
333+ -- ^ a closed `Condition` on those subcolumns
334+ -> TableConstraintExpression sch tab schemas ('Check aliases)
335+check _cols condition = UnsafeTableConstraintExpression $
336+ "CHECK" <+> parenthesized (renderSQL condition)
337+
338+{-| A `unique` constraint ensure that the data contained in a column,
339+or a group of columns, is unique among all the rows in the table.
340+
341+>>> :{
342+type Schema = '[
343+ "tab" ::: 'Table( '[ "uq_a_b" ::: 'Unique '["a","b"]] :=> '[
344+ "a" ::: 'NoDef :=> 'Null 'PGint4,
345+ "b" ::: 'NoDef :=> 'Null 'PGint4
346+ ])]
347+:}
348+
349+>>> :{
350+let
351+ definition :: Definition (Public '[]) (Public Schema)
352+ definition = createTable #tab
353+ ( (int & nullable) `as` #a :*
354+ (int & nullable) `as` #b )
355+ ( unique (#a :* #b) `as` #uq_a_b )
356+:}
357+
358+>>> printSQL definition
359+CREATE TABLE "tab" ("a" int NULL, "b" int NULL, CONSTRAINT "uq_a_b" UNIQUE ("a", "b"));
360+-}
361+unique
362+ :: ( Has sch schemas schema
363+ , Has tab schema('Table table)
364+ , HasAll aliases (TableToRow table) subcolumns )
365+ => NP Alias aliases
366+ -- ^ specify subcolumns which together are unique for each row
367+ -> TableConstraintExpression sch tab schemas ('Unique aliases)
368+unique columns = UnsafeTableConstraintExpression $
369+ "UNIQUE" <+> parenthesized (renderSQL columns)
370+
371+{-| A `primaryKey` constraint indicates that a column, or group of columns,
372+can be used as a unique identifier for rows in the table.
373+This requires that the values be both unique and not null.
374+
375+>>> :{
376+type Schema = '[
377+ "tab" ::: 'Table ('[ "pk_id" ::: 'PrimaryKey '["id"]] :=> '[
378+ "id" ::: 'Def :=> 'NotNull 'PGint4,
379+ "name" ::: 'NoDef :=> 'NotNull 'PGtext
380+ ])]
381+:}
382+
383+>>> :{
384+let
385+ definition :: Definition (Public '[]) (Public Schema)
386+ definition = createTable #tab
387+ ( serial `as` #id :*
388+ (text & notNullable) `as` #name )
389+ ( primaryKey #id `as` #pk_id )
390+:}
391+
392+>>> printSQL definition
393+CREATE TABLE "tab" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_id" PRIMARY KEY ("id"));
394+-}
395+primaryKey
396+ :: ( Has sch schemas schema
397+ , Has tab schema ('Table table)
398+ , HasAll aliases (TableToColumns table) subcolumns
399+ , AllNotNull subcolumns )
400+ => NP Alias aliases
401+ -- ^ specify the subcolumns which together form a primary key.
402+ -> TableConstraintExpression sch tab schemas ('PrimaryKey aliases)
403+primaryKey columns = UnsafeTableConstraintExpression $
404+ "PRIMARY KEY" <+> parenthesized (renderSQL columns)
405+
406+{-| A `foreignKey` specifies that the values in a column
407+(or a group of columns) must match the values appearing in some row of
408+another table. We say this maintains the referential integrity
409+between two related tables.
410+
411+>>> :{
412+type Schema =
413+ '[ "users" ::: 'Table (
414+ '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>
415+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4
416+ , "name" ::: 'NoDef :=> 'NotNull 'PGtext
417+ ])
418+ , "emails" ::: 'Table (
419+ '[ "pk_emails" ::: 'PrimaryKey '["id"]
420+ , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]
421+ ] :=>
422+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4
423+ , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4
424+ , "email" ::: 'NoDef :=> 'Null 'PGtext
425+ ])
426+ ]
427+:}
428+
429+>>> :{
430+let
431+ setup :: Definition (Public '[]) (Public Schema)
432+ setup =
433+ createTable #users
434+ ( serial `as` #id :*
435+ (text & notNullable) `as` #name )
436+ ( primaryKey #id `as` #pk_users ) >>>
437+ createTable #emails
438+ ( serial `as` #id :*
439+ (int & notNullable) `as` #user_id :*
440+ (text & nullable) `as` #email )
441+ ( primaryKey #id `as` #pk_emails :*
442+ foreignKey #user_id #users #id
443+ OnDeleteCascade OnUpdateCascade `as` #fk_user_id )
444+in printSQL setup
445+:}
446+CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id"));
447+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);
448+
449+A `foreignKey` can even be a table self-reference.
450+
451+>>> :{
452+type Schema =
453+ '[ "employees" ::: 'Table (
454+ '[ "employees_pk" ::: 'PrimaryKey '["id"]
455+ , "employees_employer_fk" ::: 'ForeignKey '["employer_id"] "employees" '["id"]
456+ ] :=>
457+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4
458+ , "name" ::: 'NoDef :=> 'NotNull 'PGtext
459+ , "employer_id" ::: 'NoDef :=> 'Null 'PGint4
460+ ])
461+ ]
462+:}
463+
464+>>> :{
465+let
466+ setup :: Definition (Public '[]) (Public Schema)
467+ setup =
468+ createTable #employees
469+ ( serial `as` #id :*
470+ (text & notNullable) `as` #name :*
471+ (integer & nullable) `as` #employer_id )
472+ ( primaryKey #id `as` #employees_pk :*
473+ foreignKey #employer_id #employees #id
474+ OnDeleteCascade OnUpdateCascade `as` #employees_employer_fk )
475+in printSQL setup
476+:}
477+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);
478+-}
479+foreignKey
480+ :: (ForeignKeyed schemas sch schema child parent
481+ table reftable
482+ columns refcolumns
483+ constraints cols
484+ reftys tys )
485+ => NP Alias columns
486+ -- ^ column or columns in the table
487+ -> Alias parent
488+ -- ^ reference table
489+ -> NP Alias refcolumns
490+ -- ^ reference column or columns in the reference table
491+ -> OnDeleteClause
492+ -- ^ what to do when reference is deleted
493+ -> OnUpdateClause
494+ -- ^ what to do when reference is updated
495+ -> TableConstraintExpression sch child schemas
496+ ('ForeignKey columns parent refcolumns)
497+foreignKey keys parent refs ondel onupd = UnsafeTableConstraintExpression $
498+ "FOREIGN KEY" <+> parenthesized (renderSQL keys)
499+ <+> "REFERENCES" <+> renderSQL parent
500+ <+> parenthesized (renderSQL refs)
501+ <+> renderSQL ondel
502+ <+> renderSQL onupd
503+
504+-- | A constraint synonym between types involved in a foreign key constraint.
505+type ForeignKeyed schemas
506+ sch
507+ schema
508+ child parent
509+ table reftable
510+ columns refcolumns
511+ constraints cols
512+ reftys tys =
513+ ( Has sch schemas schema
514+ , Has child schema ('Table table)
515+ , Has parent schema ('Table reftable)
516+ , HasAll columns (TableToColumns table) tys
517+ , reftable ~ (constraints :=> cols)
518+ , HasAll refcolumns cols reftys
519+ , SOP.AllZip SamePGType tys reftys
520+ , Uniquely refcolumns constraints )
521+
522+-- | `OnDeleteClause` indicates what to do with rows that reference a deleted row.
523+data OnDeleteClause
524+ = OnDeleteNoAction
525+ -- ^ if any referencing rows still exist when the constraint is checked,
526+ -- an error is raised
527+ | OnDeleteRestrict -- ^ prevents deletion of a referenced row
528+ | OnDeleteCascade
529+ -- ^ specifies that when a referenced row is deleted,
530+ -- row(s) referencing it should be automatically deleted as well
531+ deriving (GHC.Generic,Show,Eq,Ord)
532+instance NFData OnDeleteClause
533+-- | Render `OnDeleteClause`.
534+instance RenderSQL OnDeleteClause where
535+ renderSQL = \case
536+ OnDeleteNoAction -> "ON DELETE NO ACTION"
537+ OnDeleteRestrict -> "ON DELETE RESTRICT"
538+ OnDeleteCascade -> "ON DELETE CASCADE"
539+
540+-- | Analagous to `OnDeleteClause` there is also `OnUpdateClause` which is invoked
541+-- when a referenced column is changed (updated).
542+data OnUpdateClause
543+ = OnUpdateNoAction
544+ -- ^ if any referencing rows has not changed when the constraint is checked,
545+ -- an error is raised
546+ | OnUpdateRestrict -- ^ prevents update of a referenced row
547+ | OnUpdateCascade
548+ -- ^ the updated values of the referenced column(s) should be copied
549+ -- into the referencing row(s)
550+ deriving (GHC.Generic,Show,Eq,Ord)
551+instance NFData OnUpdateClause
552+
553+-- | Render `OnUpdateClause`.
554+instance RenderSQL OnUpdateClause where
555+ renderSQL = \case
556+ OnUpdateNoAction -> "ON UPDATE NO ACTION"
557+ OnUpdateRestrict -> "ON UPDATE RESTRICT"
558+ OnUpdateCascade -> "ON UPDATE CASCADE"
559+
560+{-----------------------------------------
561+DROP statements
562+-----------------------------------------}
563+
564+-- | >>> :{
565+-- let
566+-- definition :: Definition '["muh_schema" ::: schema, "public" ::: public] '["public" ::: public]
567+-- definition = dropSchema #muh_schema
568+-- :}
569+--
570+-- >>> printSQL definition
571+-- DROP SCHEMA "muh_schema";
572+dropSchema
573+ :: Has sch schemas schema
574+ => Alias sch
575+ -> Definition schemas (Drop sch schemas)
576+dropSchema sch = UnsafeDefinition $ "DROP SCHEMA" <+> renderSQL sch <> ";"
577+
578+-- | `dropTable` removes a table from the schema.
579+--
580+-- >>> :{
581+-- let
582+-- definition :: Definition '["public" ::: '["muh_table" ::: 'Table t]] (Public '[])
583+-- definition = dropTable #muh_table
584+-- :}
585+--
586+-- >>> printSQL definition
587+-- DROP TABLE "muh_table";
588+dropTable
589+ :: ( Has sch schemas schema
590+ , Has tab schema ('Table table))
591+ => QualifiedAlias sch tab -- ^ table to remove
592+ -> Definition schemas (Alter sch (Drop tab schema) schemas)
593+dropTable tab = UnsafeDefinition $ "DROP TABLE" <+> renderSQL tab <> ";"
594+
595+{-----------------------------------------
596+ALTER statements
597+-----------------------------------------}
598+
599+-- | `alterTable` changes the definition of a table from the schema.
600+alterTable
601+ :: (Has sch schemas schema, Has tab schema ('Table table0))
602+ => QualifiedAlias sch tab -- ^ table to alter
603+ -> AlterTable sch tab schemas table1 -- ^ alteration to perform
604+ -> Definition schemas (Alter sch (Alter tab ('Table table1) schema) schemas)
605+alterTable tab alteration = UnsafeDefinition $
606+ "ALTER TABLE"
607+ <+> renderSQL tab
608+ <+> renderAlterTable alteration
609+ <> ";"
610+
611+-- | `alterTableRename` changes the name of a table from the schema.
612+--
613+-- >>> printSQL $ alterTableRename #foo #bar
614+-- ALTER TABLE "foo" RENAME TO "bar";
615+alterTableRename
616+ :: (KnownSymbol table0, KnownSymbol table1)
617+ => Alias table0 -- ^ table to rename
618+ -> Alias table1 -- ^ what to rename it
619+ -> Definition schema (Rename table0 table1 schema)
620+alterTableRename table0 table1 = UnsafeDefinition $
621+ "ALTER TABLE" <+> renderSQL table0
622+ <+> "RENAME TO" <+> renderSQL table1 <> ";"
623+
624+-- | An `AlterTable` describes the alteration to perform on the columns
625+-- of a table.
626+newtype AlterTable
627+ (sch :: Symbol)
628+ (tab :: Symbol)
629+ (schemas :: SchemasType)
630+ (table :: TableType) =
631+ UnsafeAlterTable {renderAlterTable :: ByteString}
632+ deriving (GHC.Generic,Show,Eq,Ord,NFData)
633+
634+-- | An `addConstraint` adds a table constraint.
635+--
636+-- >>> :{
637+-- let
638+-- definition :: Definition
639+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
640+-- '["public" ::: '["tab" ::: 'Table ('["positive" ::: 'Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
641+-- definition = alterTable #tab (addConstraint #positive (check #col (#col .> 0)))
642+-- in printSQL definition
643+-- :}
644+-- ALTER TABLE "tab" ADD CONSTRAINT "positive" CHECK (("col" > 0));
645+addConstraint
646+ :: ( KnownSymbol alias
647+ , Has sch schemas schema
648+ , Has tab schema ('Table table0)
649+ , table0 ~ (constraints :=> columns)
650+ , table1 ~ (Create alias constraint constraints :=> columns) )
651+ => Alias alias
652+ -> TableConstraintExpression sch tab schemas constraint
653+ -- ^ constraint to add
654+ -> AlterTable sch tab schemas table1
655+addConstraint alias constraint = UnsafeAlterTable $
656+ "ADD" <+> "CONSTRAINT" <+> renderSQL alias
657+ <+> renderSQL constraint
658+
659+-- | A `dropConstraint` drops a table constraint.
660+--
661+-- >>> :{
662+-- let
663+-- definition :: Definition
664+-- '["public" ::: '["tab" ::: 'Table ('["positive" ::: Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
665+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
666+-- definition = alterTable #tab (dropConstraint #positive)
667+-- in printSQL definition
668+-- :}
669+-- ALTER TABLE "tab" DROP CONSTRAINT "positive";
670+dropConstraint
671+ :: ( KnownSymbol constraint
672+ , Has sch schemas schema
673+ , Has tab schema ('Table table0)
674+ , table0 ~ (constraints :=> columns)
675+ , table1 ~ (Drop constraint constraints :=> columns) )
676+ => Alias constraint
677+ -- ^ constraint to drop
678+ -> AlterTable sch tab schemas table1
679+dropConstraint constraint = UnsafeAlterTable $
680+ "DROP" <+> "CONSTRAINT" <+> renderSQL constraint
681+
682+-- | An `AddColumn` is either @NULL@ or has @DEFAULT@.
683+class AddColumn ty where
684+ -- | `addColumn` adds a new column, initially filled with whatever
685+ -- default value is given or with @NULL@.
686+ --
687+ -- >>> :{
688+ -- let
689+ -- definition :: Definition
690+ -- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
691+ -- '["public" ::: '["tab" ::: 'Table ('[] :=>
692+ -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
693+ -- , "col2" ::: 'Def :=> 'Null 'PGtext ])]]
694+ -- definition = alterTable #tab (addColumn #col2 (text & nullable & default_ "foo"))
695+ -- in printSQL definition
696+ -- :}
697+ -- ALTER TABLE "tab" ADD COLUMN "col2" text NULL DEFAULT E'foo';
698+ --
699+ -- >>> :{
700+ -- let
701+ -- definition :: Definition
702+ -- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
703+ -- '["public" ::: '["tab" ::: 'Table ('[] :=>
704+ -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
705+ -- , "col2" ::: 'NoDef :=> 'Null 'PGtext ])]]
706+ -- definition = alterTable #tab (addColumn #col2 (text & nullable))
707+ -- in printSQL definition
708+ -- :}
709+ -- ALTER TABLE "tab" ADD COLUMN "col2" text NULL;
710+ addColumn
711+ :: ( KnownSymbol column
712+ , Has sch schemas schema
713+ , Has tab schema ('Table table0)
714+ , table0 ~ (constraints :=> columns) )
715+ => Alias column -- ^ column to add
716+ -> ColumnTypeExpression schemas ty -- ^ type of the new column
717+ -> AlterTable sch tab schemas (constraints :=> Create column ty columns)
718+ addColumn column ty = UnsafeAlterTable $
719+ "ADD COLUMN" <+> renderSQL column <+> renderColumnTypeExpression ty
720+instance {-# OVERLAPPING #-} AddColumn ('Def :=> ty)
721+instance {-# OVERLAPPABLE #-} AddColumn ('NoDef :=> 'Null ty)
722+
723+-- | A `dropColumn` removes a column. Whatever data was in the column
724+-- disappears. Table constraints involving the column are dropped, too.
725+-- However, if the column is referenced by a foreign key constraint of
726+-- another table, PostgreSQL will not silently drop that constraint.
727+--
728+-- >>> :{
729+-- let
730+-- definition :: Definition
731+-- '["public" ::: '["tab" ::: 'Table ('[] :=>
732+-- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
733+-- , "col2" ::: 'NoDef :=> 'Null 'PGtext ])]]
734+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
735+-- definition = alterTable #tab (dropColumn #col2)
736+-- in printSQL definition
737+-- :}
738+-- ALTER TABLE "tab" DROP COLUMN "col2";
739+dropColumn
740+ :: ( KnownSymbol column
741+ , Has sch schemas schema
742+ , Has tab schema ('Table table0)
743+ , table0 ~ (constraints :=> columns)
744+ , table1 ~ (constraints :=> Drop column columns) )
745+ => Alias column -- ^ column to remove
746+ -> AlterTable sch tab schemas table1
747+dropColumn column = UnsafeAlterTable $
748+ "DROP COLUMN" <+> renderSQL column
749+
750+-- | A `renameColumn` renames a column.
751+--
752+-- >>> :{
753+-- let
754+-- definition :: Definition
755+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["foo" ::: 'NoDef :=> 'Null 'PGint4])]]
756+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["bar" ::: 'NoDef :=> 'Null 'PGint4])]]
757+-- definition = alterTable #tab (renameColumn #foo #bar)
758+-- in printSQL definition
759+-- :}
760+-- ALTER TABLE "tab" RENAME COLUMN "foo" TO "bar";
761+renameColumn
762+ :: ( KnownSymbol column0
763+ , KnownSymbol column1
764+ , Has sch schemas schema
765+ , Has tab schema ('Table table0)
766+ , table0 ~ (constraints :=> columns)
767+ , table1 ~ (constraints :=> Rename column0 column1 columns) )
768+ => Alias column0 -- ^ column to rename
769+ -> Alias column1 -- ^ what to rename the column
770+ -> AlterTable sch tab schemas table1
771+renameColumn column0 column1 = UnsafeAlterTable $
772+ "RENAME COLUMN" <+> renderSQL column0 <+> "TO" <+> renderSQL column1
773+
774+-- | An `alterColumn` alters a single column.
775+alterColumn
776+ :: ( KnownSymbol column
777+ , Has sch schemas schema
778+ , Has tab schema ('Table table0)
779+ , table0 ~ (constraints :=> columns)
780+ , Has column columns ty0
781+ , table1 ~ (constraints :=> Alter column ty1 columns))
782+ => Alias column -- ^ column to alter
783+ -> AlterColumn schemas ty0 ty1 -- ^ alteration to perform
784+ -> AlterTable sch tab schemas table1
785+alterColumn column alteration = UnsafeAlterTable $
786+ "ALTER COLUMN" <+> renderSQL column <+> renderAlterColumn alteration
787+
788+-- | An `AlterColumn` describes the alteration to perform on a single column.
789+newtype AlterColumn (schemas :: SchemasType) (ty0 :: ColumnType) (ty1 :: ColumnType) =
790+ UnsafeAlterColumn {renderAlterColumn :: ByteString}
791+ deriving (GHC.Generic,Show,Eq,Ord,NFData)
792+
793+-- | A `setDefault` sets a new default for a column. Note that this doesn't
794+-- affect any existing rows in the table, it just changes the default for
795+-- future insert and update commands.
796+--
797+-- >>> :{
798+-- let
799+-- definition :: Definition
800+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
801+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'Def :=> 'Null 'PGint4])]]
802+-- definition = alterTable #tab (alterColumn #col (setDefault 5))
803+-- in printSQL definition
804+-- :}
805+-- ALTER TABLE "tab" ALTER COLUMN "col" SET DEFAULT 5;
806+setDefault
807+ :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty -- ^ default value to set
808+ -> AlterColumn schemas (constraint :=> ty) ('Def :=> ty)
809+setDefault expression = UnsafeAlterColumn $
810+ "SET DEFAULT" <+> renderExpression expression
811+
812+-- | A `dropDefault` removes any default value for a column.
813+--
814+-- >>> :{
815+-- let
816+-- definition :: Definition
817+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'Def :=> 'Null 'PGint4])]]
818+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
819+-- definition = alterTable #tab (alterColumn #col dropDefault)
820+-- in printSQL definition
821+-- :}
822+-- ALTER TABLE "tab" ALTER COLUMN "col" DROP DEFAULT;
823+dropDefault :: AlterColumn schemas ('Def :=> ty) ('NoDef :=> ty)
824+dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"
825+
826+-- | A `setNotNull` adds a @NOT NULL@ constraint to a column.
827+-- The constraint will be checked immediately, so the table data must satisfy
828+-- the constraint before it can be added.
829+--
830+-- >>> :{
831+-- let
832+-- definition :: Definition
833+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
834+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
835+-- definition = alterTable #tab (alterColumn #col setNotNull)
836+-- in printSQL definition
837+-- :}
838+-- ALTER TABLE "tab" ALTER COLUMN "col" SET NOT NULL;
839+setNotNull
840+ :: AlterColumn schemas (constraint :=> 'Null ty) (constraint :=> 'NotNull ty)
841+setNotNull = UnsafeAlterColumn $ "SET NOT NULL"
842+
843+-- | A `dropNotNull` drops a @NOT NULL@ constraint from a column.
844+--
845+-- >>> :{
846+-- let
847+-- definition :: Definition
848+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
849+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
850+-- definition = alterTable #tab (alterColumn #col dropNotNull)
851+-- in printSQL definition
852+-- :}
853+-- ALTER TABLE "tab" ALTER COLUMN "col" DROP NOT NULL;
854+dropNotNull
855+ :: AlterColumn schemas (constraint :=> 'NotNull ty) (constraint :=> 'Null ty)
856+dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"
857+
858+-- | An `alterType` converts a column to a different data type.
859+-- This will succeed only if each existing entry in the column can be
860+-- converted to the new type by an implicit cast.
861+--
862+-- >>> :{
863+-- let
864+-- definition :: Definition
865+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
866+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGnumeric])]]
867+-- definition =
868+-- alterTable #tab (alterColumn #col (alterType (numeric & notNullable)))
869+-- in printSQL definition
870+-- :}
871+-- ALTER TABLE "tab" ALTER COLUMN "col" TYPE numeric NOT NULL;
872+alterType :: ColumnTypeExpression schemas ty -> AlterColumn schemas ty0 ty
873+alterType ty = UnsafeAlterColumn $ "TYPE" <+> renderColumnTypeExpression ty
874+
875+{- | Create a view.
876+>>> type ABC = '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4]
877+>>> type BC = '["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4]
878+>>> :{
879+let
880+ definition :: Definition
881+ '[ "public" ::: '["abc" ::: 'Table ('[] :=> ABC)]]
882+ '[ "public" ::: '["abc" ::: 'Table ('[] :=> ABC), "bc" ::: 'View BC]]
883+ definition =
884+ createView #bc (select_ (#b :* #c) (from (table #abc)))
885+in printSQL definition
886+:}
887+CREATE VIEW "bc" AS SELECT "b" AS "b", "c" AS "c" FROM "abc" AS "abc";
888+-}
889+createView
890+ :: (KnownSymbol sch, KnownSymbol vw, Has sch schemas schema)
891+ => QualifiedAlias sch vw -- ^ the name of the view to add
892+ -> Query '[] '[] schemas '[] view -- ^ query
893+ -> Definition schemas (Alter sch (Create vw ('View view) schema) schemas)
894+createView alias query = UnsafeDefinition $
895+ "CREATE" <+> "VIEW" <+> renderSQL alias <+> "AS"
896+ <+> renderQuery query <> ";"
897+
898+-- | Drop a view.
899+--
900+-- >>> :{
901+-- let
902+-- definition :: Definition
903+-- '[ "public" ::: '["abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])
904+-- , "bc" ::: 'View ('["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4])]]
905+-- '[ "public" ::: '["abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])]]
906+-- definition = dropView #bc
907+-- in printSQL definition
908+-- :}
909+-- DROP VIEW "bc";
910+dropView
911+ :: (Has sch schemas schema, Has vw schema ('View view))
912+ => QualifiedAlias sch vw -- ^ view to remove
913+ -> Definition schemas (Alter sch (Drop vw schema) schemas)
914+dropView vw = UnsafeDefinition $ "DROP VIEW" <+> renderSQL vw <> ";"
915+
916+-- | Enumerated types are created using the `createTypeEnum` command, for example
917+--
918+-- >>> printSQL $ (createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy") :: Definition (Public '[]) '["public" ::: '["mood" ::: 'Typedef ('PGenum '["sad","ok","happy"])]])
919+-- CREATE TYPE "mood" AS ENUM ('sad', 'ok', 'happy');
920+createTypeEnum
921+ :: (KnownSymbol enum, Has sch schemas schema, SOP.All KnownSymbol labels)
922+ => QualifiedAlias sch enum
923+ -- ^ name of the user defined enumerated type
924+ -> NP PGlabel labels
925+ -- ^ labels of the enumerated type
926+ -> Definition schemas (Alter sch (Create enum ('Typedef ('PGenum labels)) schema) schemas)
927+createTypeEnum enum labels = UnsafeDefinition $
928+ "CREATE" <+> "TYPE" <+> renderSQL enum <+> "AS" <+> "ENUM" <+>
929+ parenthesized (renderSQL labels) <> ";"
930+
931+-- | Enumerated types can also be generated from a Haskell type, for example
932+--
933+-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
934+-- >>> instance SOP.Generic Schwarma
935+-- >>> instance SOP.HasDatatypeInfo Schwarma
936+-- >>> :{
937+-- let
938+-- createSchwarma :: Definition (Public '[]) '["public" ::: '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))]]
939+-- createSchwarma = createTypeEnumFrom @Schwarma #schwarma
940+-- in
941+-- printSQL createSchwarma
942+-- :}
943+-- CREATE TYPE "schwarma" AS ENUM ('Beef', 'Lamb', 'Chicken');
944+createTypeEnumFrom
945+ :: forall hask sch enum schemas schema.
946+ ( SOP.Generic hask
947+ , SOP.All KnownSymbol (LabelsPG hask)
948+ , KnownSymbol enum
949+ , Has sch schemas schema )
950+ => QualifiedAlias sch enum
951+ -- ^ name of the user defined enumerated type
952+ -> Definition schemas (Alter sch (Create enum ('Typedef (PG (Enumerated hask))) schema) schemas)
953+createTypeEnumFrom enum = createTypeEnum enum
954+ (SOP.hpure label :: NP PGlabel (LabelsPG hask))
955+
956+{- | `createTypeComposite` creates a composite type. The composite type is
957+specified by a list of attribute names and data types.
958+
959+>>> :{
960+type PGcomplex = 'PGcomposite
961+ '[ "real" ::: 'NotNull 'PGfloat8
962+ , "imaginary" ::: 'NotNull 'PGfloat8 ]
963+:}
964+
965+>>> :{
966+let
967+ setup :: Definition (Public '[]) '["public" ::: '["complex" ::: 'Typedef PGcomplex]]
968+ setup = createTypeComposite #complex
969+ (float8 `as` #real :* float8 `as` #imaginary)
970+in printSQL setup
971+:}
972+CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
973+-}
974+createTypeComposite
975+ :: (KnownSymbol ty, Has sch schemas schema, SOP.SListI fields)
976+ => QualifiedAlias sch ty
977+ -- ^ name of the user defined composite type
978+ -> NP (Aliased (TypeExpression schemas)) fields
979+ -- ^ list of attribute names and data types
980+ -> Definition schemas (Alter sch (Create ty ('Typedef ('PGcomposite fields)) schema) schemas)
981+createTypeComposite ty fields = UnsafeDefinition $
982+ "CREATE" <+> "TYPE" <+> renderSQL ty <+> "AS" <+> parenthesized
983+ (renderCommaSeparated renderField fields) <> ";"
984+ where
985+ renderField :: Aliased (TypeExpression schemas) x -> ByteString
986+ renderField (typ `As` alias) =
987+ renderSQL alias <+> renderSQL typ
988+
989+-- | Composite types can also be generated from a Haskell type, for example
990+--
991+-- >>> data Complex = Complex {real :: Double, imaginary :: Double} deriving GHC.Generic
992+-- >>> instance SOP.Generic Complex
993+-- >>> instance SOP.HasDatatypeInfo Complex
994+-- >>> type Schema = '["complex" ::: 'Typedef (PG (Composite Complex))]
995+-- >>> :{
996+-- let
997+-- createComplex :: Definition (Public '[]) (Public Schema)
998+-- createComplex = createTypeCompositeFrom @Complex #complex
999+-- in
1000+-- printSQL createComplex
1001+-- :}
1002+-- CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
1003+createTypeCompositeFrom
1004+ :: forall hask sch ty schemas schema.
1005+ ( SOP.All (FieldTyped schemas) (RowPG hask)
1006+ , KnownSymbol ty
1007+ , Has sch schemas schema )
1008+ => QualifiedAlias sch ty
1009+ -- ^ name of the user defined composite type
1010+ -> Definition schemas (Alter sch (Create ty ( 'Typedef (PG (Composite hask))) schema) schemas)
1011+createTypeCompositeFrom ty = createTypeComposite ty
1012+ (SOP.hcpure (SOP.Proxy :: SOP.Proxy (FieldTyped schemas)) fieldtype
1013+ :: NP (Aliased (TypeExpression schemas)) (RowPG hask))
1014+
1015+{-|
1016+`createDomain` creates a new domain. A domain is essentially a data type
1017+with constraints (restrictions on the allowed set of values).
1018+
1019+Domains are useful for abstracting common constraints on fields
1020+into a single location for maintenance. For example, several tables might
1021+contain email address columns, all requiring the same `check` constraint
1022+to verify the address syntax. Define a domain rather than setting up
1023+each table's constraint individually.
1024+
1025+>>> :{
1026+let
1027+ createPositive :: Definition (Public '[]) (Public '["positive" ::: 'Typedef 'PGfloat4])
1028+ createPositive = createDomain #positive real (#value .> 0 .&& (#value & isNotNull))
1029+in printSQL createPositive
1030+:}
1031+CREATE DOMAIN "positive" AS real CHECK ((("value" > 0) AND "value" IS NOT NULL));
1032+-}
1033+createDomain
1034+ :: (Has sch schemas schema, KnownSymbol dom)
1035+ => QualifiedAlias sch dom
1036+ -> (forall null. TypeExpression schemas (null ty))
1037+ -> (forall tab. Condition '[] '[] 'Ungrouped schemas '[] '[tab ::: '["value" ::: 'Null ty]])
1038+ -> Definition schemas (Alter sch (Create dom ('Typedef ty) schema) schemas)
1039+createDomain dom ty condition =
1040+ UnsafeDefinition $ "CREATE DOMAIN" <+> renderSQL dom
1041+ <+> "AS" <+> renderTypeExpression ty
1042+ <+> "CHECK" <+> parenthesized (renderSQL condition) <> ";"
1043+
1044+createTypeRange
1045+ :: (Has sch schemas schema, KnownSymbol range)
1046+ => QualifiedAlias sch range
1047+ -> (forall null. TypeExpression schemas (null ty))
1048+ -> Definition schemas (Alter sch (Create range ('Typedef ('PGrange ty)) schema) schemas)
1049+createTypeRange range ty = UnsafeDefinition $
1050+ "CREATE" <+> "TYPE" <+> renderSQL range <+> "AS" <+> "RANGE" <+>
1051+ parenthesized ("subtype" <+> "=" <+> renderTypeExpression ty)
1052+
1053+-- | Lift `PGTyped` to a field
1054+class FieldTyped schemas ty where
1055+ fieldtype :: Aliased (TypeExpression schemas) ty
1056+instance (KnownSymbol alias, PGTyped schemas ty)
1057+ => FieldTyped schemas (alias ::: ty) where
1058+ fieldtype = pgtype `As` Alias
1059+
1060+-- | Drop a type.
1061+--
1062+-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
1063+-- >>> instance SOP.Generic Schwarma
1064+-- >>> instance SOP.HasDatatypeInfo Schwarma
1065+-- >>> printSQL (dropType #schwarma :: Definition '["public" ::: '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))]] (Public '[]))
1066+-- DROP TYPE "schwarma";
1067+dropType
1068+ :: (Has sch schemas schema, Has td schema ('Typedef ty))
1069+ => QualifiedAlias sch td
1070+ -- ^ name of the user defined type
1071+ -> Definition schemas (Alter sch (Drop td schema) schemas)
1072+dropType tydef = UnsafeDefinition $ "DROP" <+> "TYPE" <+> renderSQL tydef <> ";"
1073+
1074+-- | `ColumnTypeExpression`s are used in `createTable` commands.
1075+newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType)
1076+ = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }
1077+ deriving (GHC.Generic,Show,Eq,Ord,NFData)
1078+instance RenderSQL (ColumnTypeExpression schemas ty) where
1079+ renderSQL = renderColumnTypeExpression
1080+
1081+-- | used in `createTable` commands as a column constraint to note that
1082+-- @NULL@ may be present in a column
1083+nullable
1084+ :: TypeExpression schemas (nullity ty)
1085+ -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty)
1086+nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL"
1087+
1088+-- | used in `createTable` commands as a column constraint to ensure
1089+-- @NULL@ is not present in a column
1090+notNullable
1091+ :: TypeExpression schemas (nullity ty)
1092+ -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty)
1093+notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL"
1094+
1095+-- | used in `createTable` commands as a column constraint to give a default
1096+default_
1097+ :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty
1098+ -> ColumnTypeExpression schemas ('NoDef :=> ty)
1099+ -> ColumnTypeExpression schemas ('Def :=> ty)
1100+default_ x ty = UnsafeColumnTypeExpression $
1101+ renderSQL ty <+> "DEFAULT" <+> renderExpression x
1102+
1103+-- | not a true type, but merely a notational convenience for creating
1104+-- unique identifier columns with type `PGint2`
1105+serial2, smallserial
1106+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2)
1107+serial2 = UnsafeColumnTypeExpression "serial2"
1108+smallserial = UnsafeColumnTypeExpression "smallserial"
1109+-- | not a true type, but merely a notational convenience for creating
1110+-- unique identifier columns with type `PGint4`
1111+serial4, serial
1112+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4)
1113+serial4 = UnsafeColumnTypeExpression "serial4"
1114+serial = UnsafeColumnTypeExpression "serial"
1115+-- | not a true type, but merely a notational convenience for creating
1116+-- unique identifier columns with type `PGint8`
1117+serial8, bigserial
1118+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8)
1119+serial8 = UnsafeColumnTypeExpression "serial8"
1120+bigserial = UnsafeColumnTypeExpression "bigserial"