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