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