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