@@ -27,6 +27,7 @@ Squeal data definition language.
27 , TypeInType
27 , TypeInType
28 , TypeOperators
28 , TypeOperators
29 , UndecidableSuperClasses
29 , UndecidableSuperClasses
30+ , UndecidableInstances
32module Squeal.PostgreSQL.Definition
33module Squeal.PostgreSQL.Definition
@@ -34,105 +35,16 @@ module Squeal.PostgreSQL.Definition
34 Definition (..)
35 Definition (..)
36 , manipDefinition
37 , manipDefinition
40− , createSchemaIfNotExists
42− , createTableIfNotExists
44− , createOrReplaceView
47− , createTypeComposite
48− , createTypeCompositeFrom
53− , createIndexIfNotExists
55− , btree, hash, gist, spgist, gin, brin
57− , createOrReplaceFunction
59− , createOrReplaceSetFunction
63− , TableConstraintExpression (..)
69− , OnDeleteClause (..)
70− , OnUpdateClause (..)
71− , FunctionDefinition(..)
86− , dropFunctionIfExists
88− , dropOperatorIfExists
106− , ColumnTypeExpression (..)
118import Control.Category
40import Control.Category
119import Control.DeepSeq
41import Control.DeepSeq
120import Data.ByteString
42import Data.ByteString
121import Data.Monoid
43import Data.Monoid
123import Prelude hiding ((.), id)
44import Prelude hiding ((.), id)
125−import qualified Generics.SOP as SOP
126import qualified GHC.Generics as GHC
46import qualified GHC.Generics as GHC
128−import Squeal.PostgreSQL.Alias
129−import Squeal.PostgreSQL.Expression
130−import Squeal.PostgreSQL.Expression.Logic
131−import Squeal.PostgreSQL.Expression.Sort
132−import Squeal.PostgreSQL.Expression.Type
133−import Squeal.PostgreSQL.List
134−import Squeal.PostgreSQL.PG
135−import Squeal.PostgreSQL.Query
136import Squeal.PostgreSQL.Manipulation
48import Squeal.PostgreSQL.Manipulation
137import Squeal.PostgreSQL.Render
49import Squeal.PostgreSQL.Render
138import Squeal.PostgreSQL.Schema
50import Squeal.PostgreSQL.Schema
@@ -168,1303 +80,3 @@ manipDefinition
168 -- ^ no input or output
80 -- ^ no input or output
169 -> Definition schemas schemas
81 -> Definition schemas schemas
170manipDefinition = UnsafeDefinition . (<> ";") . renderSQL
82manipDefinition = UnsafeDefinition . (<> ";") . renderSQL
172−{-----------------------------------------
174−-----------------------------------------}
177−`createSchema` enters a new schema into the current database.
178−The schema name must be distinct from the name of any existing schema
179−in the current database.
181−A schema is essentially a namespace: it contains named objects
182−(tables, data types, functions, and operators) whose names
183−can duplicate those of other objects existing in other schemas.
184−Named objects are accessed by `QualifiedAlias`es with the schema
190− -> Definition schemas (Create sch '[] schemas)
191−createSchema sch = UnsafeDefinition $
192− "CREATE" <+> "SCHEMA" <+> renderSQL sch <> ";"
194−{- | Idempotent version of `createSchema`. -}
195−createSchemaIfNotExists
196− :: (KnownSymbol sch, Has sch schemas schema)
198− -> Definition schemas (CreateIfNotExists sch '[] schemas)
199−createSchemaIfNotExists sch = UnsafeDefinition $
200− "CREATE" <+> "SCHEMA" <+> "IF" <+> "NOT" <+> "EXISTS"
201− <+> renderSQL sch <> ";"
203−{- | `createTable` adds a table to the schema.
205−>>> :set -XOverloadedLabels
208− '[ "a" ::: 'NoDef :=> 'Null 'PGint4
209− , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
214− setup :: Definition (Public '[]) (Public '["tab" ::: 'Table Table])
215− setup = createTable #tab
216− (nullable int `as` #a :* nullable real `as` #b) Nil
219−CREATE TABLE "tab" ("a" int NULL, "b" real NULL);
222− :: ( KnownSymbol sch
224− , columns ~ (col ': cols)
225− , SOP.SListI columns
226− , SOP.SListI constraints
227− , Has sch schemas0 schema0
228− , schemas1 ~ Alter sch (Create tab ('Table (constraints :=> columns)) schema0) schemas0 )
229− => QualifiedAlias sch tab -- ^ the name of the table to add
230− -> NP (Aliased (ColumnTypeExpression schemas0)) columns
231− -- ^ the names and datatype of each column
232− -> NP (Aliased (TableConstraintExpression sch tab schemas1)) constraints
233− -- ^ constraints that must hold for the table
234− -> Definition schemas0 schemas1
235−createTable tab columns constraints = UnsafeDefinition $
236− "CREATE TABLE" <+> renderCreation tab columns constraints
238−{-| `createTableIfNotExists` creates a table if it doesn't exist, but does not add it to the schema.
239−Instead, the schema already has the table so if the table did not yet exist, the schema was wrong.
240−`createTableIfNotExists` fixes this. Interestingly, this property makes it an idempotent in
241−the `Category` of `Definition`s.
243−>>> :set -XOverloadedLabels -XTypeApplications
246− '[ "a" ::: 'NoDef :=> 'Null 'PGint4
247− , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
250−>>> type Schemas = Public '["tab" ::: 'Table Table]
254− setup :: Definition Schemas Schemas
255− setup = createTableIfNotExists #tab
256− (nullable int `as` #a :* nullable real `as` #b) Nil
259−CREATE TABLE IF NOT EXISTS "tab" ("a" int NULL, "b" real NULL);
261−createTableIfNotExists
262− :: ( KnownSymbol sch
264− , columns ~ (col ': cols)
265− , SOP.SListI columns
266− , SOP.SListI constraints
267− , Has sch schemas0 schema0
268− , schemas1 ~ Alter sch (CreateIfNotExists tab ('Table (constraints :=> columns)) schema0) schemas0 )
269− => QualifiedAlias sch tab -- ^ the name of the table to add
270− -> NP (Aliased (ColumnTypeExpression schemas0)) columns
271− -- ^ the names and datatype of each column
272− -> NP (Aliased (TableConstraintExpression sch tab schemas1)) constraints
273− -- ^ constraints that must hold for the table
274− -> Definition schemas0 schemas1
275−createTableIfNotExists tab columns constraints = UnsafeDefinition $
276− "CREATE TABLE IF NOT EXISTS"
277− <+> renderCreation tab columns constraints
279−-- helper function for `createTable` and `createTableIfNotExists`
281− :: ( KnownSymbol sch
283− , SOP.SListI columns
284− , SOP.SListI constraints )
285− => QualifiedAlias sch tab -- ^ the name of the table to add
286− -> NP (Aliased (ColumnTypeExpression schemas0)) columns
287− -- ^ the names and datatype of each column
288− -> NP (Aliased (TableConstraintExpression sch tab schemas1)) constraints
289− -- ^ constraints that must hold for the table
291−renderCreation tab columns constraints = renderSQL tab
293− ( renderCommaSeparated renderColumnDef columns
294− <> ( case constraints of
297− renderCommaSeparated renderConstraint constraints ) )
300− renderColumnDef :: Aliased (ColumnTypeExpression schemas) x -> ByteString
301− renderColumnDef (ty `As` column) =
302− renderSQL column <+> renderColumnTypeExpression ty
304− :: Aliased (TableConstraintExpression sch tab schemas) constraint
306− renderConstraint (constraint `As` alias) =
307− "CONSTRAINT" <+> renderSQL alias <+> renderSQL constraint
309−-- | Data types are a way to limit the kind of data that can be stored in a
310−-- table. For many applications, however, the constraint they provide is
311−-- too coarse. For example, a column containing a product price should
312−-- probably only accept positive values. But there is no standard data type
313−-- that accepts only positive numbers. Another issue is that you might want
314−-- to constrain column data with respect to other columns or rows.
315−-- For example, in a table containing product information,
316−-- there should be only one row for each product number.
317−-- `TableConstraint`s give you as much control over the data in your tables
318−-- as you wish. If a user attempts to store data in a column that would
319−-- violate a constraint, an error is raised. This applies
320−-- even if the value came from the default value definition.
321−newtype TableConstraintExpression
324− (schemas :: SchemasType)
325− (constraint :: TableConstraint)
326− = UnsafeTableConstraintExpression
327− { renderTableConstraintExpression :: ByteString }
328− deriving (GHC.Generic,Show,Eq,Ord,NFData)
330− (TableConstraintExpression sch tab schemas constraint) where
331− renderSQL = renderTableConstraintExpression
333−{-| A `check` constraint is the most generic `TableConstraint` type.
334−It allows you to specify that the value in a certain column must satisfy
335−a Boolean (truth-value) expression.
339− "tab" ::: 'Table ('[ "inequality" ::: 'Check '["a","b"]] :=> '[
340− "a" ::: 'NoDef :=> 'NotNull 'PGint4,
341− "b" ::: 'NoDef :=> 'NotNull 'PGint4
347− definition :: Definition (Public '[]) (Public Schema)
348− definition = createTable #tab
349− ( (int & notNullable) `as` #a :*
350− (int & notNullable) `as` #b )
351− ( check (#a :* #b) (#a .> #b) `as` #inequality )
354−>>> printSQL definition
355−CREATE TABLE "tab" ("a" int NOT NULL, "b" int NOT NULL, CONSTRAINT "inequality" CHECK (("a" > "b")));
358− :: ( Has sch schemas schema
359− , Has tab schema ('Table table)
360− , HasAll aliases (TableToRow table) subcolumns )
362− -- ^ specify the subcolumns which are getting checked
363− -> (forall t. Condition '[] '[] 'Ungrouped schemas '[] '[t ::: subcolumns])
364− -- ^ a closed `Condition` on those subcolumns
365− -> TableConstraintExpression sch tab schemas ('Check aliases)
366−check _cols condition = UnsafeTableConstraintExpression $
367− "CHECK" <+> parenthesized (renderSQL condition)
369−{-| A `unique` constraint ensure that the data contained in a column,
370−or a group of columns, is unique among all the rows in the table.
374− "tab" ::: 'Table( '[ "uq_a_b" ::: 'Unique '["a","b"]] :=> '[
375− "a" ::: 'NoDef :=> 'Null 'PGint4,
376− "b" ::: 'NoDef :=> 'Null 'PGint4
382− definition :: Definition (Public '[]) (Public Schema)
383− definition = createTable #tab
384− ( (int & nullable) `as` #a :*
385− (int & nullable) `as` #b )
386− ( unique (#a :* #b) `as` #uq_a_b )
389−>>> printSQL definition
390−CREATE TABLE "tab" ("a" int NULL, "b" int NULL, CONSTRAINT "uq_a_b" UNIQUE ("a", "b"));
393− :: ( Has sch schemas schema
394− , Has tab schema('Table table)
395− , HasAll aliases (TableToRow table) subcolumns )
397− -- ^ specify subcolumns which together are unique for each row
398− -> TableConstraintExpression sch tab schemas ('Unique aliases)
399−unique columns = UnsafeTableConstraintExpression $
400− "UNIQUE" <+> parenthesized (renderSQL columns)
402−{-| A `primaryKey` constraint indicates that a column, or group of columns,
403−can be used as a unique identifier for rows in the table.
404−This requires that the values be both unique and not null.
408− "tab" ::: 'Table ('[ "pk_id" ::: 'PrimaryKey '["id"]] :=> '[
409− "id" ::: 'Def :=> 'NotNull 'PGint4,
410− "name" ::: 'NoDef :=> 'NotNull 'PGtext
416− definition :: Definition (Public '[]) (Public Schema)
417− definition = createTable #tab
418− ( serial `as` #id :*
419− (text & notNullable) `as` #name )
420− ( primaryKey #id `as` #pk_id )
423−>>> printSQL definition
424−CREATE TABLE "tab" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_id" PRIMARY KEY ("id"));
427− :: ( Has sch schemas schema
428− , Has tab schema ('Table table)
429− , HasAll aliases (TableToColumns table) subcolumns
430− , AllNotNull subcolumns )
432− -- ^ specify the subcolumns which together form a primary key.
433− -> TableConstraintExpression sch tab schemas ('PrimaryKey aliases)
434−primaryKey columns = UnsafeTableConstraintExpression $
435− "PRIMARY KEY" <+> parenthesized (renderSQL columns)
437−{-| A `foreignKey` specifies that the values in a column
438−(or a group of columns) must match the values appearing in some row of
439−another table. We say this maintains the referential integrity
440−between two related tables.
444− '[ "users" ::: 'Table (
445− '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>
446− '[ "id" ::: 'Def :=> 'NotNull 'PGint4
447− , "name" ::: 'NoDef :=> 'NotNull 'PGtext
449− , "emails" ::: 'Table (
450− '[ "pk_emails" ::: 'PrimaryKey '["id"]
451− , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]
453− '[ "id" ::: 'Def :=> 'NotNull 'PGint4
454− , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4
455− , "email" ::: 'NoDef :=> 'Null 'PGtext
462− setup :: Definition (Public '[]) (Public Schema)
465− ( serial `as` #id :*
466− (text & notNullable) `as` #name )
467− ( primaryKey #id `as` #pk_users ) >>>
469− ( serial `as` #id :*
470− (int & notNullable) `as` #user_id :*
471− (text & nullable) `as` #email )
472− ( primaryKey #id `as` #pk_emails :*
473− foreignKey #user_id #users #id
474− OnDeleteCascade OnUpdateCascade `as` #fk_user_id )
477−CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id"));
478−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);
480−A `foreignKey` can even be a table self-reference.
484− '[ "employees" ::: 'Table (
485− '[ "employees_pk" ::: 'PrimaryKey '["id"]
486− , "employees_employer_fk" ::: 'ForeignKey '["employer_id"] "employees" '["id"]
488− '[ "id" ::: 'Def :=> 'NotNull 'PGint4
489− , "name" ::: 'NoDef :=> 'NotNull 'PGtext
490− , "employer_id" ::: 'NoDef :=> 'Null 'PGint4
497− setup :: Definition (Public '[]) (Public Schema)
499− createTable #employees
500− ( serial `as` #id :*
501− (text & notNullable) `as` #name :*
502− (integer & nullable) `as` #employer_id )
503− ( primaryKey #id `as` #employees_pk :*
504− foreignKey #employer_id #employees #id
505− OnDeleteCascade OnUpdateCascade `as` #employees_employer_fk )
508−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);
511− :: (ForeignKeyed schemas sch schema child parent
517− -- ^ column or columns in the table
519− -- ^ reference table
520− -> NP Alias refcolumns
521− -- ^ reference column or columns in the reference table
523− -- ^ what to do when reference is deleted
525− -- ^ what to do when reference is updated
526− -> TableConstraintExpression sch child schemas
527− ('ForeignKey columns parent refcolumns)
528−foreignKey keys parent refs ondel onupd = UnsafeTableConstraintExpression $
529− "FOREIGN KEY" <+> parenthesized (renderSQL keys)
530− <+> "REFERENCES" <+> renderSQL parent
531− <+> parenthesized (renderSQL refs)
535−-- | A constraint synonym between types involved in a foreign key constraint.
536−type ForeignKeyed schemas
544− ( Has sch schemas schema
545− , Has child schema ('Table table)
546− , Has parent schema ('Table reftable)
547− , HasAll columns (TableToColumns table) tys
548− , reftable ~ (constraints :=> cols)
549− , HasAll refcolumns cols reftys
550− , SOP.AllZip SamePGType tys reftys
551− , Uniquely refcolumns constraints )
553−-- | `OnDeleteClause` indicates what to do with rows that reference a deleted row.
556− -- ^ if any referencing rows still exist when the constraint is checked,
557− -- an error is raised
558− | OnDeleteRestrict -- ^ prevents deletion of a referenced row
560− -- ^ specifies that when a referenced row is deleted,
561− -- row(s) referencing it should be automatically deleted as well
562− deriving (GHC.Generic,Show,Eq,Ord)
563−instance NFData OnDeleteClause
564−-- | Render `OnDeleteClause`.
565−instance RenderSQL OnDeleteClause where
567− OnDeleteNoAction -> "ON DELETE NO ACTION"
568− OnDeleteRestrict -> "ON DELETE RESTRICT"
569− OnDeleteCascade -> "ON DELETE CASCADE"
571−-- | Analagous to `OnDeleteClause` there is also `OnUpdateClause` which is invoked
572−-- when a referenced column is changed (updated).
575− -- ^ if any referencing rows has not changed when the constraint is checked,
576− -- an error is raised
577− | OnUpdateRestrict -- ^ prevents update of a referenced row
579− -- ^ the updated values of the referenced column(s) should be copied
580− -- into the referencing row(s)
581− deriving (GHC.Generic,Show,Eq,Ord)
582−instance NFData OnUpdateClause
584−-- | Render `OnUpdateClause`.
585−instance RenderSQL OnUpdateClause where
587− OnUpdateNoAction -> "ON UPDATE NO ACTION"
588− OnUpdateRestrict -> "ON UPDATE RESTRICT"
589− OnUpdateCascade -> "ON UPDATE CASCADE"
591−{-----------------------------------------
593−-----------------------------------------}
597−-- definition :: Definition '["muh_schema" ::: schema, "public" ::: public] '["public" ::: public]
598−-- definition = dropSchema #muh_schema
601−-- >>> printSQL definition
602−-- DROP SCHEMA "muh_schema";
606− -- ^ user defined schema
607− -> Definition schemas (Drop sch schemas)
608−dropSchema sch = UnsafeDefinition $ "DROP SCHEMA" <+> renderSQL sch <> ";"
613− -- ^ user defined schema
614− -> Definition schemas (DropIfExists sch schemas)
615−dropSchemaIfExists sch = UnsafeDefinition $ "DROP SCHEMA" <+> renderSQL sch <> ";"
617−-- | `dropTable` removes a table from the schema.
621−-- definition :: Definition '["public" ::: '["muh_table" ::: 'Table t]] (Public '[])
622−-- definition = dropTable #muh_table
625−-- >>> printSQL definition
626−-- DROP TABLE "muh_table";
628− :: ( Has sch schemas schema
630− => QualifiedAlias sch tab -- ^ table to remove
631− -> Definition schemas (Alter sch (DropSchemum tab 'Table schema) schemas)
632−dropTable tab = UnsafeDefinition $ "DROP TABLE" <+> renderSQL tab <> ";"
635− :: ( Has sch schemas schema
636− , Has tab schema ('Table table))
637− => QualifiedAlias sch tab -- ^ table to remove
638− -> Definition schemas (Alter sch (DropIfExists tab schema) schemas)
639−dropTableIfExists tab = UnsafeDefinition $ "DROP TABLE IF EXISTS" <+> renderSQL tab <> ";"
641−{-----------------------------------------
643−-----------------------------------------}
645−-- | `alterTable` changes the definition of a table from the schema.
647− :: (Has sch schemas schema, Has tab schema ('Table table0))
648− => QualifiedAlias sch tab -- ^ table to alter
649− -> AlterTable sch tab schemas table1 -- ^ alteration to perform
650− -> Definition schemas (Alter sch (Alter tab ('Table table1) schema) schemas)
651−alterTable tab alteration = UnsafeDefinition $
654− <+> renderAlterTable alteration
657−-- | `alterTableRename` changes the name of a table from the schema.
659−-- >>> printSQL $ alterTableRename #foo #bar
660−-- ALTER TABLE "foo" RENAME TO "bar";
662− :: (KnownSymbol table0, KnownSymbol table1)
663− => Alias table0 -- ^ table to rename
664− -> Alias table1 -- ^ what to rename it
665− -> Definition schema (Rename table0 table1 schema)
666−alterTableRename table0 table1 = UnsafeDefinition $
667− "ALTER TABLE" <+> renderSQL table0
668− <+> "RENAME TO" <+> renderSQL table1 <> ";"
670−-- | An `AlterTable` describes the alteration to perform on the columns
675− (schemas :: SchemasType)
676− (table :: TableType) =
677− UnsafeAlterTable {renderAlterTable :: ByteString}
678− deriving (GHC.Generic,Show,Eq,Ord,NFData)
680−-- | An `addConstraint` adds a table constraint.
684−-- definition :: Definition
685−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
686−-- '["public" ::: '["tab" ::: 'Table ('["positive" ::: 'Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
687−-- definition = alterTable #tab (addConstraint #positive (check #col (#col .> 0)))
688−-- in printSQL definition
690−-- ALTER TABLE "tab" ADD CONSTRAINT "positive" CHECK (("col" > 0));
692− :: ( KnownSymbol alias
693− , Has sch schemas schema
694− , Has tab schema ('Table table0)
695− , table0 ~ (constraints :=> columns)
696− , table1 ~ (Create alias constraint constraints :=> columns) )
698− -> TableConstraintExpression sch tab schemas constraint
699− -- ^ constraint to add
700− -> AlterTable sch tab schemas table1
701−addConstraint alias constraint = UnsafeAlterTable $
702− "ADD" <+> "CONSTRAINT" <+> renderSQL alias
703− <+> renderSQL constraint
705−-- | A `dropConstraint` drops a table constraint.
709−-- definition :: Definition
710−-- '["public" ::: '["tab" ::: 'Table ('["positive" ::: Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
711−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
712−-- definition = alterTable #tab (dropConstraint #positive)
713−-- in printSQL definition
715−-- ALTER TABLE "tab" DROP CONSTRAINT "positive";
717− :: ( KnownSymbol constraint
718− , Has sch schemas schema
719− , Has tab schema ('Table table0)
720− , table0 ~ (constraints :=> columns)
721− , table1 ~ (Drop constraint constraints :=> columns) )
723− -- ^ constraint to drop
724− -> AlterTable sch tab schemas table1
725−dropConstraint constraint = UnsafeAlterTable $
726− "DROP" <+> "CONSTRAINT" <+> renderSQL constraint
728−-- | An `AddColumn` is either @NULL@ or has @DEFAULT@.
729−class AddColumn ty where
730− -- | `addColumn` adds a new column, initially filled with whatever
731− -- default value is given or with @NULL@.
735− -- definition :: Definition
736− -- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
737− -- '["public" ::: '["tab" ::: 'Table ('[] :=>
738− -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
739− -- , "col2" ::: 'Def :=> 'Null 'PGtext ])]]
740− -- definition = alterTable #tab (addColumn #col2 (text & nullable & default_ "foo"))
741− -- in printSQL definition
743− -- ALTER TABLE "tab" ADD COLUMN "col2" text NULL DEFAULT E'foo';
747− -- definition :: Definition
748− -- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
749− -- '["public" ::: '["tab" ::: 'Table ('[] :=>
750− -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
751− -- , "col2" ::: 'NoDef :=> 'Null 'PGtext ])]]
752− -- definition = alterTable #tab (addColumn #col2 (text & nullable))
753− -- in printSQL definition
755− -- ALTER TABLE "tab" ADD COLUMN "col2" text NULL;
757− :: ( KnownSymbol column
758− , Has sch schemas schema
759− , Has tab schema ('Table table0)
760− , table0 ~ (constraints :=> columns) )
761− => Alias column -- ^ column to add
762− -> ColumnTypeExpression schemas ty -- ^ type of the new column
763− -> AlterTable sch tab schemas (constraints :=> Create column ty columns)
764− addColumn column ty = UnsafeAlterTable $
765− "ADD COLUMN" <+> renderSQL column <+> renderColumnTypeExpression ty
766−instance {-# OVERLAPPING #-} AddColumn ('Def :=> ty)
767−instance {-# OVERLAPPABLE #-} AddColumn ('NoDef :=> 'Null ty)
769−-- | A `dropColumn` removes a column. Whatever data was in the column
770−-- disappears. Table constraints involving the column are dropped, too.
771−-- However, if the column is referenced by a foreign key constraint of
772−-- another table, PostgreSQL will not silently drop that constraint.
776−-- definition :: Definition
777−-- '["public" ::: '["tab" ::: 'Table ('[] :=>
778−-- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
779−-- , "col2" ::: 'NoDef :=> 'Null 'PGtext ])]]
780−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
781−-- definition = alterTable #tab (dropColumn #col2)
782−-- in printSQL definition
784−-- ALTER TABLE "tab" DROP COLUMN "col2";
786− :: ( KnownSymbol column
787− , Has sch schemas schema
788− , Has tab schema ('Table table0)
789− , table0 ~ (constraints :=> columns)
790− , table1 ~ (constraints :=> Drop column columns) )
791− => Alias column -- ^ column to remove
792− -> AlterTable sch tab schemas table1
793−dropColumn column = UnsafeAlterTable $
794− "DROP COLUMN" <+> renderSQL column
796−-- | A `renameColumn` renames a column.
800−-- definition :: Definition
801−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["foo" ::: 'NoDef :=> 'Null 'PGint4])]]
802−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["bar" ::: 'NoDef :=> 'Null 'PGint4])]]
803−-- definition = alterTable #tab (renameColumn #foo #bar)
804−-- in printSQL definition
806−-- ALTER TABLE "tab" RENAME COLUMN "foo" TO "bar";
808− :: ( KnownSymbol column0
809− , KnownSymbol column1
810− , Has sch schemas schema
811− , Has tab schema ('Table table0)
812− , table0 ~ (constraints :=> columns)
813− , table1 ~ (constraints :=> Rename column0 column1 columns) )
814− => Alias column0 -- ^ column to rename
815− -> Alias column1 -- ^ what to rename the column
816− -> AlterTable sch tab schemas table1
817−renameColumn column0 column1 = UnsafeAlterTable $
818− "RENAME COLUMN" <+> renderSQL column0 <+> "TO" <+> renderSQL column1
820−-- | An `alterColumn` alters a single column.
822− :: ( KnownSymbol column
823− , Has sch schemas schema
824− , Has tab schema ('Table table0)
825− , table0 ~ (constraints :=> columns)
826− , Has column columns ty0
827− , table1 ~ (constraints :=> Alter column ty1 columns))
828− => Alias column -- ^ column to alter
829− -> AlterColumn schemas ty0 ty1 -- ^ alteration to perform
830− -> AlterTable sch tab schemas table1
831−alterColumn column alteration = UnsafeAlterTable $
832− "ALTER COLUMN" <+> renderSQL column <+> renderAlterColumn alteration
834−-- | An `AlterColumn` describes the alteration to perform on a single column.
835−newtype AlterColumn (schemas :: SchemasType) (ty0 :: ColumnType) (ty1 :: ColumnType) =
836− UnsafeAlterColumn {renderAlterColumn :: ByteString}
837− deriving (GHC.Generic,Show,Eq,Ord,NFData)
839−-- | A `setDefault` sets a new default for a column. Note that this doesn't
840−-- affect any existing rows in the table, it just changes the default for
841−-- future insert and update commands.
845−-- definition :: Definition
846−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
847−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'Def :=> 'Null 'PGint4])]]
848−-- definition = alterTable #tab (alterColumn #col (setDefault 5))
849−-- in printSQL definition
851−-- ALTER TABLE "tab" ALTER COLUMN "col" SET DEFAULT 5;
853− :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty -- ^ default value to set
854− -> AlterColumn schemas (constraint :=> ty) ('Def :=> ty)
855−setDefault expression = UnsafeAlterColumn $
856− "SET DEFAULT" <+> renderExpression expression
858−-- | A `dropDefault` removes any default value for a column.
862−-- definition :: Definition
863−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'Def :=> 'Null 'PGint4])]]
864−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
865−-- definition = alterTable #tab (alterColumn #col dropDefault)
866−-- in printSQL definition
868−-- ALTER TABLE "tab" ALTER COLUMN "col" DROP DEFAULT;
869−dropDefault :: AlterColumn schemas ('Def :=> ty) ('NoDef :=> ty)
870−dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"
872−-- | A `setNotNull` adds a @NOT NULL@ constraint to a column.
873−-- The constraint will be checked immediately, so the table data must satisfy
874−-- the constraint before it can be added.
878−-- definition :: Definition
879−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
880−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
881−-- definition = alterTable #tab (alterColumn #col setNotNull)
882−-- in printSQL definition
884−-- ALTER TABLE "tab" ALTER COLUMN "col" SET NOT NULL;
886− :: AlterColumn schemas (constraint :=> 'Null ty) (constraint :=> 'NotNull ty)
887−setNotNull = UnsafeAlterColumn $ "SET NOT NULL"
889−-- | A `dropNotNull` drops a @NOT NULL@ constraint from a column.
893−-- definition :: Definition
894−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
895−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
896−-- definition = alterTable #tab (alterColumn #col dropNotNull)
897−-- in printSQL definition
899−-- ALTER TABLE "tab" ALTER COLUMN "col" DROP NOT NULL;
901− :: AlterColumn schemas (constraint :=> 'NotNull ty) (constraint :=> 'Null ty)
902−dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"
904−-- | An `alterType` converts a column to a different data type.
905−-- This will succeed only if each existing entry in the column can be
906−-- converted to the new type by an implicit cast.
910−-- definition :: Definition
911−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
912−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGnumeric])]]
914−-- alterTable #tab (alterColumn #col (alterType (numeric & notNullable)))
915−-- in printSQL definition
917−-- ALTER TABLE "tab" ALTER COLUMN "col" TYPE numeric NOT NULL;
918−alterType :: ColumnTypeExpression schemas ty -> AlterColumn schemas ty0 ty
919−alterType ty = UnsafeAlterColumn $ "TYPE" <+> renderColumnTypeExpression ty
922−>>> type ABC = '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4]
923−>>> type BC = '["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4]
926− definition :: Definition
927− '[ "public" ::: '["abc" ::: 'Table ('[] :=> ABC)]]
928− '[ "public" ::: '["abc" ::: 'Table ('[] :=> ABC), "bc" ::: 'View BC]]
930− createView #bc (select_ (#b :* #c) (from (table #abc)))
931−in printSQL definition
933−CREATE VIEW "bc" AS SELECT "b" AS "b", "c" AS "c" FROM "abc" AS "abc";
936− :: (Has sch schemas schema, KnownSymbol vw)
937− => QualifiedAlias sch vw -- ^ the name of the view to add
938− -> Query '[] '[] schemas '[] view -- ^ query
939− -> Definition schemas (Alter sch (Create vw ('View view) schema) schemas)
940−createView alias query = UnsafeDefinition $
941− "CREATE" <+> "VIEW" <+> renderSQL alias <+> "AS"
942− <+> renderQuery query <> ";"
945− :: (Has sch schemas schema, KnownSymbol vw)
946− => QualifiedAlias sch vw -- ^ the name of the view to add
947− -> Query '[] '[] schemas '[] view -- ^ query
948− -> Definition schemas (Alter sch (CreateOrReplace vw ('View view) schema) schemas)
949−createOrReplaceView alias query = UnsafeDefinition $
950− "CREATE OR REPLACE VIEW" <+> renderSQL alias <+> "AS"
951− <+> renderQuery query <> ";"
957−-- definition :: Definition
958−-- '[ "public" ::: '["abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])
959−-- , "bc" ::: 'View ('["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4])]]
960−-- '[ "public" ::: '["abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])]]
961−-- definition = dropView #bc
962−-- in printSQL definition
966− :: (Has sch schemas schema, KnownSymbol vw)
967− => QualifiedAlias sch vw -- ^ view to remove
968− -> Definition schemas (Alter sch (DropSchemum vw 'View schema) schemas)
969−dropView vw = UnsafeDefinition $ "DROP VIEW" <+> renderSQL vw <> ";"
972− :: (Has sch schemas schema, KnownSymbol vw)
973− => QualifiedAlias sch vw -- ^ view to remove
974− -> Definition schemas (Alter sch (DropIfExists vw schema) schemas)
975−dropViewIfExists vw = UnsafeDefinition $ "DROP VIEW IF EXISTS" <+> renderSQL vw <> ";"
977−-- | Enumerated types are created using the `createTypeEnum` command, for example
979−-- >>> printSQL $ (createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy") :: Definition (Public '[]) '["public" ::: '["mood" ::: 'Typedef ('PGenum '["sad","ok","happy"])]])
980−-- CREATE TYPE "mood" AS ENUM ('sad', 'ok', 'happy');
982− :: (KnownSymbol enum, Has sch schemas schema, SOP.All KnownSymbol labels)
983− => QualifiedAlias sch enum
984− -- ^ name of the user defined enumerated type
985− -> NP PGlabel labels
986− -- ^ labels of the enumerated type
987− -> Definition schemas (Alter sch (Create enum ('Typedef ('PGenum labels)) schema) schemas)
988−createTypeEnum enum labels = UnsafeDefinition $
989− "CREATE" <+> "TYPE" <+> renderSQL enum <+> "AS" <+> "ENUM" <+>
990− parenthesized (renderSQL labels) <> ";"
992−-- | Enumerated types can also be generated from a Haskell type, for example
994−-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
995−-- >>> instance SOP.Generic Schwarma
996−-- >>> instance SOP.HasDatatypeInfo Schwarma
999−-- createSchwarma :: Definition (Public '[]) '["public" ::: '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))]]
1000−-- createSchwarma = createTypeEnumFrom @Schwarma #schwarma
1002−-- printSQL createSchwarma
1004−-- CREATE TYPE "schwarma" AS ENUM ('Beef', 'Lamb', 'Chicken');
1006− :: forall hask sch enum schemas schema.
1008− , SOP.All KnownSymbol (LabelsPG hask)
1010− , Has sch schemas schema )
1011− => QualifiedAlias sch enum
1012− -- ^ name of the user defined enumerated type
1013− -> Definition schemas (Alter sch (Create enum ('Typedef (PG (Enumerated hask))) schema) schemas)
1014−createTypeEnumFrom enum = createTypeEnum enum
1015− (SOP.hpure label :: NP PGlabel (LabelsPG hask))
1017−{- | `createTypeComposite` creates a composite type. The composite type is
1018−specified by a list of attribute names and data types.
1021−type PGcomplex = 'PGcomposite
1022− '[ "real" ::: 'NotNull 'PGfloat8
1023− , "imaginary" ::: 'NotNull 'PGfloat8 ]
1028− setup :: Definition (Public '[]) '["public" ::: '["complex" ::: 'Typedef PGcomplex]]
1029− setup = createTypeComposite #complex
1030− (float8 `as` #real :* float8 `as` #imaginary)
1033−CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
1036− :: (KnownSymbol ty, Has sch schemas schema, SOP.SListI fields)
1037− => QualifiedAlias sch ty
1038− -- ^ name of the user defined composite type
1039− -> NP (Aliased (TypeExpression schemas)) fields
1040− -- ^ list of attribute names and data types
1041− -> Definition schemas (Alter sch (Create ty ('Typedef ('PGcomposite fields)) schema) schemas)
1042−createTypeComposite ty fields = UnsafeDefinition $
1043− "CREATE" <+> "TYPE" <+> renderSQL ty <+> "AS" <+> parenthesized
1044− (renderCommaSeparated renderField fields) <> ";"
1046− renderField :: Aliased (TypeExpression schemas) x -> ByteString
1047− renderField (typ `As` alias) =
1048− renderSQL alias <+> renderSQL typ
1050−-- | Composite types can also be generated from a Haskell type, for example
1052−-- >>> data Complex = Complex {real :: Double, imaginary :: Double} deriving GHC.Generic
1053−-- >>> instance SOP.Generic Complex
1054−-- >>> instance SOP.HasDatatypeInfo Complex
1055−-- >>> type Schema = '["complex" ::: 'Typedef (PG (Composite Complex))]
1058−-- createComplex :: Definition (Public '[]) (Public Schema)
1059−-- createComplex = createTypeCompositeFrom @Complex #complex
1061−-- printSQL createComplex
1063−-- CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
1064−createTypeCompositeFrom
1065− :: forall hask sch ty schemas schema.
1066− ( SOP.All (FieldTyped schemas) (RowPG hask)
1068− , Has sch schemas schema )
1069− => QualifiedAlias sch ty
1070− -- ^ name of the user defined composite type
1071− -> Definition schemas (Alter sch (Create ty ( 'Typedef (PG (Composite hask))) schema) schemas)
1072−createTypeCompositeFrom ty = createTypeComposite ty
1073− (SOP.hcpure (SOP.Proxy :: SOP.Proxy (FieldTyped schemas)) fieldtype
1074− :: NP (Aliased (TypeExpression schemas)) (RowPG hask))
1077−`createDomain` creates a new domain. A domain is essentially a data type
1078−with constraints (restrictions on the allowed set of values).
1080−Domains are useful for abstracting common constraints on fields
1081−into a single location for maintenance. For example, several tables might
1082−contain email address columns, all requiring the same `check` constraint
1083−to verify the address syntax. Define a domain rather than setting up
1084−each table's constraint individually.
1088− createPositive :: Definition (Public '[]) (Public '["positive" ::: 'Typedef 'PGfloat4])
1089− createPositive = createDomain #positive real (#value .> 0 .&& (#value & isNotNull))
1090−in printSQL createPositive
1092−CREATE DOMAIN "positive" AS real CHECK ((("value" > 0) AND "value" IS NOT NULL));
1095− :: (Has sch schemas schema, KnownSymbol dom)
1096− => QualifiedAlias sch dom
1097− -> (forall null. TypeExpression schemas (null ty))
1098− -> (forall tab. Condition '[] '[] 'Ungrouped schemas '[] '[tab ::: '["value" ::: 'Null ty]])
1099− -> Definition schemas (Alter sch (Create dom ('Typedef ty) schema) schemas)
1100−createDomain dom ty condition =
1101− UnsafeDefinition $ "CREATE DOMAIN" <+> renderSQL dom
1102− <+> "AS" <+> renderTypeExpression ty
1103− <+> "CHECK" <+> parenthesized (renderSQL condition) <> ";"
1108− createSmallIntRange :: Definition (Public '[]) (Public '["int2range" ::: 'Typedef ('PGrange 'PGint2)])
1109− createSmallIntRange = createTypeRange #int2range int2
1110−in printSQL createSmallIntRange
1112−CREATE TYPE "int2range" AS RANGE (subtype = int2);
1115− :: (Has sch schemas schema, KnownSymbol range)
1116− => QualifiedAlias sch range
1117− -> (forall null. TypeExpression schemas (null ty))
1118− -> Definition schemas (Alter sch (Create range ('Typedef ('PGrange ty)) schema) schemas)
1119−createTypeRange range ty = UnsafeDefinition $
1120− "CREATE" <+> "TYPE" <+> renderSQL range <+> "AS" <+> "RANGE" <+>
1121− parenthesized ("subtype" <+> "=" <+> renderTypeExpression ty) <> ";"
1125−type Table = '[] :=>
1126− '[ "a" ::: 'NoDef :=> 'Null 'PGint4
1127− , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
1132− setup :: Definition (Public '[]) (Public '["tab" ::: 'Table Table, "ix" ::: 'Index 'Btree])
1134− createTable #tab (nullable int `as` #a :* nullable real `as` #b) Nil >>>
1135− createIndex #ix #tab btree [#a & AscNullsFirst, #b & AscNullsLast]
1138−CREATE TABLE "tab" ("a" int NULL, "b" real NULL);
1139−CREATE INDEX "ix" ON "tab" USING btree (("a") ASC NULLS FIRST, ("b") ASC NULLS LAST);
1142− :: (Has sch schemas schema, Has tab schema ('Table table), KnownSymbol ix)
1144− -> QualifiedAlias sch tab
1145− -> IndexMethod method
1146− -> [SortExpression '[] '[] 'Ungrouped schemas '[] '[tab ::: TableToRow table]]
1147− -> Definition schemas (Alter sch (Create ix ('Index method) schema) schemas)
1148−createIndex ix tab method cols = UnsafeDefinition $
1149− "CREATE" <+> "INDEX" <+> renderSQL ix <+> "ON" <+> renderSQL tab
1150− <+> "USING" <+> renderSQL method
1151− <+> parenthesized (commaSeparated (renderIndex <$> cols))
1154− renderIndex = \case
1155− Asc expression -> parenthesized (renderSQL expression) <+> "ASC"
1156− Desc expression -> parenthesized (renderSQL expression) <+> "DESC"
1157− AscNullsFirst expression -> parenthesized (renderSQL expression)
1158− <+> "ASC NULLS FIRST"
1159− DescNullsFirst expression -> parenthesized (renderSQL expression)
1160− <+> "DESC NULLS FIRST"
1161− AscNullsLast expression -> parenthesized (renderSQL expression)
1162− <+> "ASC NULLS LAST"
1163− DescNullsLast expression -> parenthesized (renderSQL expression)
1164− <+> "DESC NULLS LAST"
1166−createIndexIfNotExists
1167− :: (Has sch schemas schema, Has tab schema ('Table table), KnownSymbol ix)
1169− -> QualifiedAlias sch tab
1170− -> IndexMethod method
1171− -> [SortExpression '[] '[] 'Ungrouped schemas '[] '[tab ::: TableToRow table]]
1172− -> Definition schemas (Alter sch (CreateIfNotExists ix ('Index method) schema) schemas)
1173−createIndexIfNotExists ix tab method cols = UnsafeDefinition $
1174− "CREATE INDEX IF NOT EXISTS" <+> renderSQL ix <+> "ON" <+> renderSQL tab
1175− <+> "USING" <+> renderSQL method
1176− <+> parenthesized (commaSeparated (renderIndex <$> cols))
1179− renderIndex = \case
1180− Asc expression -> parenthesized (renderSQL expression) <+> "ASC"
1181− Desc expression -> parenthesized (renderSQL expression) <+> "DESC"
1182− AscNullsFirst expression -> parenthesized (renderSQL expression)
1183− <+> "ASC NULLS FIRST"
1184− DescNullsFirst expression -> parenthesized (renderSQL expression)
1185− <+> "DESC NULLS FIRST"
1186− AscNullsLast expression -> parenthesized (renderSQL expression)
1187− <+> "ASC NULLS LAST"
1188− DescNullsLast expression -> parenthesized (renderSQL expression)
1189− <+> "DESC NULLS LAST"
1191−newtype IndexMethod ty = UnsafeIndexMethod {renderIndexMethod :: ByteString}
1192− deriving stock (Eq, Ord, Show, GHC.Generic)
1193−instance RenderSQL (IndexMethod ty) where renderSQL = renderIndexMethod
1194−btree :: IndexMethod 'Btree
1195−btree = UnsafeIndexMethod "btree"
1196−hash :: IndexMethod 'Hash
1197−hash = UnsafeIndexMethod "hash"
1198−gist :: IndexMethod 'Gist
1199−gist = UnsafeIndexMethod "gist"
1200−spgist :: IndexMethod 'Spgist
1201−spgist = UnsafeIndexMethod "spgist"
1202−gin :: IndexMethod 'Gin
1203−gin = UnsafeIndexMethod "gin"
1204−brin :: IndexMethod 'Brin
1205−brin = UnsafeIndexMethod "brin"
1208− :: ( Has sch schemas schema
1210− , SOP.SListI args )
1211− => QualifiedAlias sch fun
1212− -> NP (TypeExpression schemas) args
1213− -> TypeExpression schemas ret
1214− -> FunctionDefinition schemas args ('Returns ret)
1215− -> Definition schemas (Alter sch (Create fun ('Function (args '::--> 'Returns ret)) schema) schemas)
1216−createFunction fun args ret fundef = UnsafeDefinition $
1217− "CREATE" <+> "FUNCTION" <+> renderSQL fun
1218− <+> parenthesized (renderCommaSeparated renderSQL args)
1219− <+> "RETURNS" <+> renderSQL ret <+> renderSQL fundef <> ";"
1221−createOrReplaceFunction
1222− :: ( Has sch schemas schema
1224− , SOP.SListI args )
1225− => QualifiedAlias sch fun
1226− -> NP (TypeExpression schemas) args
1227− -> TypeExpression schemas ret
1228− -> FunctionDefinition schemas args ('Returns ret)
1229− -> Definition schemas (Alter sch (CreateOrReplace fun ('Function (args '::--> 'Returns ret)) schema) schemas)
1230−createOrReplaceFunction fun args ret fundef = UnsafeDefinition $
1231− "CREATE" <+> "OR" <+> "REPLACE" <+> "FUNCTION" <+> renderSQL fun
1232− <+> parenthesized (renderCommaSeparated renderSQL args)
1233− <+> "RETURNS" <+> renderSQL ret <+> renderSQL fundef <> ";"
1236− :: Expression '[] '[] 'Ungrouped schemas args '[] ret
1237− -> FunctionDefinition schemas args ('Returns ret)
1238−languageSqlExpr expr = UnsafeFunctionDefinition $
1240− <+> "$$" <+> renderSQL (values_ (expr `as` #ret)) <+> "$$"
1243− :: Query '[] '[] schemas args rets
1244− -> FunctionDefinition schemas args ('ReturnsTable rets)
1245−languageSqlQuery qry = UnsafeFunctionDefinition $
1246− "language sql as" <+> "$$" <+> renderSQL qry <+> "$$"
1249− :: ( Has sch schemas schema
1252− , SOP.SListI rets )
1253− => QualifiedAlias sch fun
1254− -> NP (TypeExpression schemas) args
1255− -> NP (Aliased (TypeExpression schemas)) rets
1256− -> FunctionDefinition schemas args ('ReturnsTable rets)
1257− -> Definition schemas (Alter sch (Create fun ('Function (args '::--> 'ReturnsTable rets)) schema) schemas)
1258−createSetFunction fun args rets fundef = UnsafeDefinition $
1259− "CREATE" <+> "FUNCTION" <+> renderSQL fun
1260− <+> parenthesized (renderCommaSeparated renderSQL args)
1261− <+> "RETURNS" <+> "TABLE"
1262− <+> parenthesized (renderCommaSeparated renderRet rets)
1263− <+> renderSQL fundef <> ";"
1265− renderRet :: Aliased (TypeExpression s) r -> ByteString
1266− renderRet (ty `As` col) = renderSQL col <+> renderSQL ty
1268−createOrReplaceSetFunction
1269− :: ( Has sch schemas schema
1270− , Has fun schema ('Function (args0 '::--> ret0))
1272− , SOP.SListI rets )
1273− => QualifiedAlias sch fun
1274− -> NP (TypeExpression schemas) args
1275− -> NP (Aliased (TypeExpression schemas)) rets
1276− -> FunctionDefinition schemas args ('ReturnsTable rets)
1277− -> Definition schemas (Alter sch (CreateOrReplace fun ('Function (args '::--> 'ReturnsTable rets)) schema) schemas)
1278−createOrReplaceSetFunction fun args rets fundef = UnsafeDefinition $
1279− "CREATE" <+> "OR" <+> "REPLACE" <+> "FUNCTION" <+> renderSQL fun
1280− <+> parenthesized (renderCommaSeparated renderSQL args)
1281− <+> "RETURNS" <+> "TABLE"
1282− <+> parenthesized (renderCommaSeparated renderRet rets)
1283− <+> renderSQL fundef <> ";"
1285− renderRet :: Aliased (TypeExpression s) r -> ByteString
1286− renderRet (ty `As` col) = renderSQL col <+> renderSQL ty
1289− :: forall op fun sch schemas schema x y z.
1290− ( Has sch schemas schema
1291− , Has fun schema ('Function ('[x,y] '::--> 'Returns z))
1294− -> TypeExpression schemas x
1295− -> TypeExpression schemas y
1296− -> Definition schemas
1297− (Alter sch (Create op ('Operator ('BinaryOp x y z)) schema) schemas)
1298−createBinaryOp fun x y = UnsafeDefinition $
1299− "CREATE" <+> "OPERATOR" <+> renderSymbol @op
1300− <+> parenthesized (commaSeparated opdef)
1303− [ "FUNCTION" <+> "=" <+> renderSQL fun
1304− , "LEFTARG" <+> "=" <+> renderSQL x
1305− , "RIGHTARG" <+> "=" <+> renderSQL y ]
1308− :: forall op fun sch schemas schema x y.
1309− ( Has sch schemas schema
1310− , Has fun schema ('Function ('[x] '::--> 'Returns y))
1313− -> TypeExpression schemas x
1314− -> Definition schemas
1315− (Alter sch (Create op ('Operator ('LeftOp x y)) schema) schemas)
1316−createLeftOp fun x = UnsafeDefinition $
1317− "CREATE" <+> "OPERATOR" <+> renderSymbol @op
1318− <+> parenthesized (commaSeparated opdef)
1321− [ "FUNCTION" <+> "=" <+> renderSQL fun
1322− , "RIGHTARG" <+> "=" <+> renderSQL x ]
1325− :: forall op fun sch schemas schema x y.
1326− ( Has sch schemas schema
1327− , Has fun schema ('Function ('[x] '::--> 'Returns y))
1330− -> TypeExpression schemas x
1331− -> Definition schemas
1332− (Alter sch (Create op ('Operator ('RightOp x y)) schema) schemas)
1333−createRightOp fun x = UnsafeDefinition $
1334− "CREATE" <+> "OPERATOR" <+> renderSymbol @op
1335− <+> parenthesized (commaSeparated opdef)
1338− [ "FUNCTION" <+> "=" <+> renderSQL fun
1339− , "LEFTARG" <+> "=" <+> renderSQL x ]
1342− :: (Has sch schemas schema, KnownSymbol fun)
1343− => QualifiedAlias sch fun
1344− -- ^ name of the user defined function
1345− -> Definition schemas (Alter sch (DropSchemum fun 'Function schema) schemas)
1346−dropFunction fun = UnsafeDefinition $
1347− "DROP" <+> "FUNCTION" <+> renderSQL fun <> ";"
1349−dropFunctionIfExists
1350− :: (Has sch schemas schema, KnownSymbol fun)
1351− => QualifiedAlias sch fun
1352− -- ^ name of the user defined function
1353− -> Definition schemas (Alter sch (DropSchemumIfExists fun 'Function schema) schemas)
1354−dropFunctionIfExists fun = UnsafeDefinition $
1355− "DROP FUNCTION IF EXISTS" <+> renderSQL fun <> ";"
1358− :: (Has sch schemas schema, KnownSymbol op)
1359− => QualifiedAlias sch op
1360− -- ^ name of the user defined operator
1361− -> Definition schemas (Alter sch (DropSchemum op 'Operator schema) schemas)
1362−dropOperator op = UnsafeDefinition $
1363− "DROP" <+> "OPERATOR" <+> renderSQL op <> ";"
1365−dropOperatorIfExists
1366− :: (Has sch schemas schema, KnownSymbol op)
1367− => QualifiedAlias sch op
1368− -- ^ name of the user defined operator
1369− -> Definition schemas (Alter sch (DropSchemumIfExists op 'Operator schema) schemas)
1370−dropOperatorIfExists op = UnsafeDefinition $
1371− "DROP OPERATOR IF EXISTS" <+> renderSQL op <> ";"
1373−newtype FunctionDefinition schemas args ret = UnsafeFunctionDefinition
1374− { renderFunctionDefinition :: ByteString }
1375− deriving (Eq,Show,GHC.Generic,NFData)
1376−instance RenderSQL (FunctionDefinition schemas args ret) where
1377− renderSQL = renderFunctionDefinition
1380−-- >>> printSQL (dropIndex #ix :: Definition (Public '["ix" ::: 'Index 'Btree]) (Public '[]))
1383− :: (Has sch schemas schema, KnownSymbol ix)
1384− => QualifiedAlias sch ix
1385− -- ^ name of the user defined index
1386− -> Definition schemas (Alter sch (DropSchemum ix 'Index schema) schemas)
1387−dropIndex ix = UnsafeDefinition $ "DROP" <+> "INDEX" <+> renderSQL ix <> ";"
1390− :: (Has sch schemas schema, KnownSymbol ix)
1391− => QualifiedAlias sch ix
1392− -- ^ name of the user defined index
1393− -> Definition schemas (Alter sch (DropSchemumIfExists ix 'Index schema) schemas)
1394−dropIndexIfExists ix = UnsafeDefinition $ "DROP INDEX IF EXISTS" <+> renderSQL ix <> ";"
1396−-- | Lift `PGTyped` to a field
1397−class FieldTyped schemas ty where
1398− fieldtype :: Aliased (TypeExpression schemas) ty
1399−instance (KnownSymbol alias, PGTyped schemas ty)
1400− => FieldTyped schemas (alias ::: ty) where
1401− fieldtype = pgtype `As` Alias
1405−-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
1406−-- >>> instance SOP.Generic Schwarma
1407−-- >>> instance SOP.HasDatatypeInfo Schwarma
1408−-- >>> printSQL (dropType #schwarma :: Definition '["public" ::: '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))]] (Public '[]))
1409−-- DROP TYPE "schwarma";
1411− :: (Has sch schemas schema, KnownSymbol td)
1412− => QualifiedAlias sch td
1413− -- ^ name of the user defined type
1414− -> Definition schemas (Alter sch (DropSchemum td 'Typedef schema) schemas)
1415−dropType tydef = UnsafeDefinition $ "DROP" <+> "TYPE" <+> renderSQL tydef <> ";"
1418− :: (Has sch schemas schema, KnownSymbol td)
1419− => QualifiedAlias sch td
1420− -- ^ name of the user defined type
1421− -> Definition schemas (Alter sch (DropSchemumIfExists td 'Typedef schema) schemas)
1422−dropTypeIfExists tydef = UnsafeDefinition $ "DROP" <+> "TYPE" <+> renderSQL tydef <> ";"
1424−-- | `ColumnTypeExpression`s are used in `createTable` commands.
1425−newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType)
1426− = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }
1427− deriving (GHC.Generic,Show,Eq,Ord,NFData)
1428−instance RenderSQL (ColumnTypeExpression schemas ty) where
1429− renderSQL = renderColumnTypeExpression
1431−-- | used in `createTable` commands as a column constraint to note that
1432−-- @NULL@ may be present in a column
1434− :: TypeExpression schemas (nullity ty)
1435− -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty)
1436−nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL"
1438−-- | used in `createTable` commands as a column constraint to ensure
1439−-- @NULL@ is not present in a column
1441− :: TypeExpression schemas (nullity ty)
1442− -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty)
1443−notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL"
1445−-- | used in `createTable` commands as a column constraint to give a default
1447− :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty
1448− -> ColumnTypeExpression schemas ('NoDef :=> ty)
1449− -> ColumnTypeExpression schemas ('Def :=> ty)
1450−default_ x ty = UnsafeColumnTypeExpression $
1451− renderSQL ty <+> "DEFAULT" <+> renderExpression x
1453−-- | not a true type, but merely a notational convenience for creating
1454−-- unique identifier columns with type `PGint2`
1455−serial2, smallserial
1456− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2)
1457−serial2 = UnsafeColumnTypeExpression "serial2"
1458−smallserial = UnsafeColumnTypeExpression "smallserial"
1459−-- | not a true type, but merely a notational convenience for creating
1460−-- unique identifier columns with type `PGint4`
1462− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4)
1463−serial4 = UnsafeColumnTypeExpression "serial4"
1464−serial = UnsafeColumnTypeExpression "serial"
1465−-- | not a true type, but merely a notational convenience for creating
1466−-- unique identifier columns with type `PGint8`
1468− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8)
1469−serial8 = UnsafeColumnTypeExpression "serial8"
1470−bigserial = UnsafeColumnTypeExpression "bigserial"