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