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