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