@@ -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,94 +35,16 @@ module Squeal.PostgreSQL.Definition
34 Definition (..)
35 Definition (..)
36 , manipDefinition
37 , manipDefinition
40− , createSchemaIfNotExists
42− , createTableIfNotExists
46− , createTypeComposite
47− , createTypeCompositeFrom
53− , createOrReplaceFunction
55− , createOrReplaceSetFunction
59− , TableConstraintExpression (..)
65− , OnDeleteClause (..)
66− , OnUpdateClause (..)
67− , FunctionDefinition(..)
95− , ColumnTypeExpression (..)
107import Control.Category
40import Control.Category
108import Control.DeepSeq
41import Control.DeepSeq
109import Data.ByteString
42import Data.ByteString
110import Data.Monoid
43import Data.Monoid
112import Prelude hiding ((.), id)
44import Prelude hiding ((.), id)
114−import qualified Generics.SOP as SOP
115import qualified GHC.Generics as GHC
46import qualified GHC.Generics as GHC
117−import Squeal.PostgreSQL.Alias
118−import Squeal.PostgreSQL.Expression
119−import Squeal.PostgreSQL.Expression.Logic
120−import Squeal.PostgreSQL.Expression.Sort
121−import Squeal.PostgreSQL.Expression.Type
122−import Squeal.PostgreSQL.List
123−import Squeal.PostgreSQL.PG
124−import Squeal.PostgreSQL.Query
125import Squeal.PostgreSQL.Manipulation
48import Squeal.PostgreSQL.Manipulation
126import Squeal.PostgreSQL.Render
49import Squeal.PostgreSQL.Render
127import Squeal.PostgreSQL.Schema
50import Squeal.PostgreSQL.Schema
@@ -157,1221 +80,3 @@ manipDefinition
157 -- ^ no input or output
80 -- ^ no input or output
158 -> Definition schemas schemas
81 -> Definition schemas schemas
159manipDefinition = UnsafeDefinition . (<> ";") . renderSQL
82manipDefinition = UnsafeDefinition . (<> ";") . renderSQL
161−{-----------------------------------------
163−-----------------------------------------}
166−`createSchema` enters a new schema into the current database.
167−The schema name must be distinct from the name of any existing schema
168−in the current database.
170−A schema is essentially a namespace: it contains named objects
171−(tables, data types, functions, and operators) whose names
172−can duplicate those of other objects existing in other schemas.
173−Named objects are accessed by `QualifiedAlias`es with the schema
179− -> Definition schemas (Create sch '[] schemas)
180−createSchema sch = UnsafeDefinition $
181− "CREATE" <+> "SCHEMA" <+> renderSQL sch <> ";"
183−{- | Idempotent version of `createSchema`. -}
184−createSchemaIfNotExists
185− :: (KnownSymbol sch, Has sch schemas schema)
187− -> Definition schemas (CreateIfNotExists sch '[] schemas)
188−createSchemaIfNotExists sch = UnsafeDefinition $
189− "CREATE" <+> "SCHEMA" <+> "IF" <+> "NOT" <+> "EXISTS"
190− <+> renderSQL sch <> ";"
192−{- | `createTable` adds a table to the schema.
194−>>> :set -XOverloadedLabels
197− '[ "a" ::: 'NoDef :=> 'Null 'PGint4
198− , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
203− setup :: Definition (Public '[]) (Public '["tab" ::: 'Table Table])
204− setup = createTable #tab
205− (nullable int `as` #a :* nullable real `as` #b) Nil
208−CREATE TABLE "tab" ("a" int NULL, "b" real NULL);
211− :: ( KnownSymbol sch
213− , columns ~ (col ': cols)
214− , SOP.SListI columns
215− , SOP.SListI constraints
216− , Has sch schemas0 schema0
217− , schemas1 ~ Alter sch (Create tab ('Table (constraints :=> columns)) schema0) schemas0 )
218− => QualifiedAlias sch tab -- ^ the name of the table to add
219− -> NP (Aliased (ColumnTypeExpression schemas0)) columns
220− -- ^ the names and datatype of each column
221− -> NP (Aliased (TableConstraintExpression sch tab schemas1)) constraints
222− -- ^ constraints that must hold for the table
223− -> Definition schemas0 schemas1
224−createTable tab columns constraints = UnsafeDefinition $
225− "CREATE TABLE" <+> renderCreation tab columns constraints
227−{-| `createTableIfNotExists` creates a table if it doesn't exist, but does not add it to the schema.
228−Instead, the schema already has the table so if the table did not yet exist, the schema was wrong.
229−`createTableIfNotExists` fixes this. Interestingly, this property makes it an idempotent in
230−the `Category` of `Definition`s.
232−>>> :set -XOverloadedLabels -XTypeApplications
235− '[ "a" ::: 'NoDef :=> 'Null 'PGint4
236− , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
239−>>> type Schemas = Public '["tab" ::: 'Table Table]
243− setup :: Definition Schemas Schemas
244− setup = createTableIfNotExists #tab
245− (nullable int `as` #a :* nullable real `as` #b) Nil
248−CREATE TABLE IF NOT EXISTS "tab" ("a" int NULL, "b" real NULL);
250−createTableIfNotExists
251− :: ( KnownSymbol sch
253− , columns ~ (col ': cols)
254− , SOP.SListI columns
255− , SOP.SListI constraints
256− , Has sch schemas0 schema0
257− , schemas1 ~ Alter sch (CreateIfNotExists tab ('Table (constraints :=> columns)) schema0) schemas0 )
258− => QualifiedAlias sch tab -- ^ the name of the table to add
259− -> NP (Aliased (ColumnTypeExpression schemas0)) columns
260− -- ^ the names and datatype of each column
261− -> NP (Aliased (TableConstraintExpression sch tab schemas1)) constraints
262− -- ^ constraints that must hold for the table
263− -> Definition schemas0 schemas1
264−createTableIfNotExists tab columns constraints = UnsafeDefinition $
265− "CREATE TABLE IF NOT EXISTS"
266− <+> renderCreation tab columns constraints
268−-- helper function for `createTable` and `createTableIfNotExists`
270− :: ( KnownSymbol sch
272− , SOP.SListI columns
273− , SOP.SListI constraints )
274− => QualifiedAlias sch tab -- ^ the name of the table to add
275− -> NP (Aliased (ColumnTypeExpression schemas0)) columns
276− -- ^ the names and datatype of each column
277− -> NP (Aliased (TableConstraintExpression sch tab schemas1)) constraints
278− -- ^ constraints that must hold for the table
280−renderCreation tab columns constraints = renderSQL tab
282− ( renderCommaSeparated renderColumnDef columns
283− <> ( case constraints of
286− renderCommaSeparated renderConstraint constraints ) )
289− renderColumnDef :: Aliased (ColumnTypeExpression schemas) x -> ByteString
290− renderColumnDef (ty `As` column) =
291− renderSQL column <+> renderColumnTypeExpression ty
293− :: Aliased (TableConstraintExpression sch tab schemas) constraint
295− renderConstraint (constraint `As` alias) =
296− "CONSTRAINT" <+> renderSQL alias <+> renderSQL constraint
298−-- | Data types are a way to limit the kind of data that can be stored in a
299−-- table. For many applications, however, the constraint they provide is
300−-- too coarse. For example, a column containing a product price should
301−-- probably only accept positive values. But there is no standard data type
302−-- that accepts only positive numbers. Another issue is that you might want
303−-- to constrain column data with respect to other columns or rows.
304−-- For example, in a table containing product information,
305−-- there should be only one row for each product number.
306−-- `TableConstraint`s give you as much control over the data in your tables
307−-- as you wish. If a user attempts to store data in a column that would
308−-- violate a constraint, an error is raised. This applies
309−-- even if the value came from the default value definition.
310−newtype TableConstraintExpression
313− (schemas :: SchemasType)
314− (constraint :: TableConstraint)
315− = UnsafeTableConstraintExpression
316− { renderTableConstraintExpression :: ByteString }
317− deriving (GHC.Generic,Show,Eq,Ord,NFData)
319− (TableConstraintExpression sch tab schemas constraint) where
320− renderSQL = renderTableConstraintExpression
322−{-| A `check` constraint is the most generic `TableConstraint` type.
323−It allows you to specify that the value in a certain column must satisfy
324−a Boolean (truth-value) expression.
328− "tab" ::: 'Table ('[ "inequality" ::: 'Check '["a","b"]] :=> '[
329− "a" ::: 'NoDef :=> 'NotNull 'PGint4,
330− "b" ::: 'NoDef :=> 'NotNull 'PGint4
336− definition :: Definition (Public '[]) (Public Schema)
337− definition = createTable #tab
338− ( (int & notNullable) `as` #a :*
339− (int & notNullable) `as` #b )
340− ( check (#a :* #b) (#a .> #b) `as` #inequality )
343−>>> printSQL definition
344−CREATE TABLE "tab" ("a" int NOT NULL, "b" int NOT NULL, CONSTRAINT "inequality" CHECK (("a" > "b")));
347− :: ( Has sch schemas schema
348− , Has tab schema ('Table table)
349− , HasAll aliases (TableToRow table) subcolumns )
351− -- ^ specify the subcolumns which are getting checked
352− -> (forall t. Condition '[] '[] 'Ungrouped schemas '[] '[t ::: subcolumns])
353− -- ^ a closed `Condition` on those subcolumns
354− -> TableConstraintExpression sch tab schemas ('Check aliases)
355−check _cols condition = UnsafeTableConstraintExpression $
356− "CHECK" <+> parenthesized (renderSQL condition)
358−{-| A `unique` constraint ensure that the data contained in a column,
359−or a group of columns, is unique among all the rows in the table.
363− "tab" ::: 'Table( '[ "uq_a_b" ::: 'Unique '["a","b"]] :=> '[
364− "a" ::: 'NoDef :=> 'Null 'PGint4,
365− "b" ::: 'NoDef :=> 'Null 'PGint4
371− definition :: Definition (Public '[]) (Public Schema)
372− definition = createTable #tab
373− ( (int & nullable) `as` #a :*
374− (int & nullable) `as` #b )
375− ( unique (#a :* #b) `as` #uq_a_b )
378−>>> printSQL definition
379−CREATE TABLE "tab" ("a" int NULL, "b" int NULL, CONSTRAINT "uq_a_b" UNIQUE ("a", "b"));
382− :: ( Has sch schemas schema
383− , Has tab schema('Table table)
384− , HasAll aliases (TableToRow table) subcolumns )
386− -- ^ specify subcolumns which together are unique for each row
387− -> TableConstraintExpression sch tab schemas ('Unique aliases)
388−unique columns = UnsafeTableConstraintExpression $
389− "UNIQUE" <+> parenthesized (renderSQL columns)
391−{-| A `primaryKey` constraint indicates that a column, or group of columns,
392−can be used as a unique identifier for rows in the table.
393−This requires that the values be both unique and not null.
397− "tab" ::: 'Table ('[ "pk_id" ::: 'PrimaryKey '["id"]] :=> '[
398− "id" ::: 'Def :=> 'NotNull 'PGint4,
399− "name" ::: 'NoDef :=> 'NotNull 'PGtext
405− definition :: Definition (Public '[]) (Public Schema)
406− definition = createTable #tab
407− ( serial `as` #id :*
408− (text & notNullable) `as` #name )
409− ( primaryKey #id `as` #pk_id )
412−>>> printSQL definition
413−CREATE TABLE "tab" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_id" PRIMARY KEY ("id"));
416− :: ( Has sch schemas schema
417− , Has tab schema ('Table table)
418− , HasAll aliases (TableToColumns table) subcolumns
419− , AllNotNull subcolumns )
421− -- ^ specify the subcolumns which together form a primary key.
422− -> TableConstraintExpression sch tab schemas ('PrimaryKey aliases)
423−primaryKey columns = UnsafeTableConstraintExpression $
424− "PRIMARY KEY" <+> parenthesized (renderSQL columns)
426−{-| A `foreignKey` specifies that the values in a column
427−(or a group of columns) must match the values appearing in some row of
428−another table. We say this maintains the referential integrity
429−between two related tables.
433− '[ "users" ::: 'Table (
434− '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>
435− '[ "id" ::: 'Def :=> 'NotNull 'PGint4
436− , "name" ::: 'NoDef :=> 'NotNull 'PGtext
438− , "emails" ::: 'Table (
439− '[ "pk_emails" ::: 'PrimaryKey '["id"]
440− , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]
442− '[ "id" ::: 'Def :=> 'NotNull 'PGint4
443− , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4
444− , "email" ::: 'NoDef :=> 'Null 'PGtext
451− setup :: Definition (Public '[]) (Public Schema)
454− ( serial `as` #id :*
455− (text & notNullable) `as` #name )
456− ( primaryKey #id `as` #pk_users ) >>>
458− ( serial `as` #id :*
459− (int & notNullable) `as` #user_id :*
460− (text & nullable) `as` #email )
461− ( primaryKey #id `as` #pk_emails :*
462− foreignKey #user_id #users #id
463− OnDeleteCascade OnUpdateCascade `as` #fk_user_id )
466−CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id"));
467−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−A `foreignKey` can even be a table self-reference.
473− '[ "employees" ::: 'Table (
474− '[ "employees_pk" ::: 'PrimaryKey '["id"]
475− , "employees_employer_fk" ::: 'ForeignKey '["employer_id"] "employees" '["id"]
477− '[ "id" ::: 'Def :=> 'NotNull 'PGint4
478− , "name" ::: 'NoDef :=> 'NotNull 'PGtext
479− , "employer_id" ::: 'NoDef :=> 'Null 'PGint4
486− setup :: Definition (Public '[]) (Public Schema)
488− createTable #employees
489− ( serial `as` #id :*
490− (text & notNullable) `as` #name :*
491− (integer & nullable) `as` #employer_id )
492− ( primaryKey #id `as` #employees_pk :*
493− foreignKey #employer_id #employees #id
494− OnDeleteCascade OnUpdateCascade `as` #employees_employer_fk )
497−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);
500− :: (ForeignKeyed schemas sch schema child parent
506− -- ^ column or columns in the table
508− -- ^ reference table
509− -> NP Alias refcolumns
510− -- ^ reference column or columns in the reference table
512− -- ^ what to do when reference is deleted
514− -- ^ what to do when reference is updated
515− -> TableConstraintExpression sch child schemas
516− ('ForeignKey columns parent refcolumns)
517−foreignKey keys parent refs ondel onupd = UnsafeTableConstraintExpression $
518− "FOREIGN KEY" <+> parenthesized (renderSQL keys)
519− <+> "REFERENCES" <+> renderSQL parent
520− <+> parenthesized (renderSQL refs)
524−-- | A constraint synonym between types involved in a foreign key constraint.
525−type ForeignKeyed schemas
533− ( Has sch schemas schema
534− , Has child schema ('Table table)
535− , Has parent schema ('Table reftable)
536− , HasAll columns (TableToColumns table) tys
537− , reftable ~ (constraints :=> cols)
538− , HasAll refcolumns cols reftys
539− , SOP.AllZip SamePGType tys reftys
540− , Uniquely refcolumns constraints )
542−-- | `OnDeleteClause` indicates what to do with rows that reference a deleted row.
545− -- ^ if any referencing rows still exist when the constraint is checked,
546− -- an error is raised
547− | OnDeleteRestrict -- ^ prevents deletion of a referenced row
549− -- ^ specifies that when a referenced row is deleted,
550− -- row(s) referencing it should be automatically deleted as well
551− deriving (GHC.Generic,Show,Eq,Ord)
552−instance NFData OnDeleteClause
553−-- | Render `OnDeleteClause`.
554−instance RenderSQL OnDeleteClause where
556− OnDeleteNoAction -> "ON DELETE NO ACTION"
557− OnDeleteRestrict -> "ON DELETE RESTRICT"
558− OnDeleteCascade -> "ON DELETE CASCADE"
560−-- | Analagous to `OnDeleteClause` there is also `OnUpdateClause` which is invoked
561−-- when a referenced column is changed (updated).
564− -- ^ if any referencing rows has not changed when the constraint is checked,
565− -- an error is raised
566− | OnUpdateRestrict -- ^ prevents update of a referenced row
568− -- ^ the updated values of the referenced column(s) should be copied
569− -- into the referencing row(s)
570− deriving (GHC.Generic,Show,Eq,Ord)
571−instance NFData OnUpdateClause
573−-- | Render `OnUpdateClause`.
574−instance RenderSQL OnUpdateClause where
576− OnUpdateNoAction -> "ON UPDATE NO ACTION"
577− OnUpdateRestrict -> "ON UPDATE RESTRICT"
578− OnUpdateCascade -> "ON UPDATE CASCADE"
580−{-----------------------------------------
582−-----------------------------------------}
586−-- definition :: Definition '["muh_schema" ::: schema, "public" ::: public] '["public" ::: public]
587−-- definition = dropSchema #muh_schema
590−-- >>> printSQL definition
591−-- DROP SCHEMA "muh_schema";
593− :: Has sch schemas schema
595− -- ^ user defined schema
596− -> Definition schemas (Drop sch schemas)
597−dropSchema sch = UnsafeDefinition $ "DROP SCHEMA" <+> renderSQL sch <> ";"
599−-- | `dropTable` removes a table from the schema.
603−-- definition :: Definition '["public" ::: '["muh_table" ::: 'Table t]] (Public '[])
604−-- definition = dropTable #muh_table
607−-- >>> printSQL definition
608−-- DROP TABLE "muh_table";
610− :: ( Has sch schemas schema
611− , Has tab schema ('Table table))
612− => QualifiedAlias sch tab -- ^ table to remove
613− -> Definition schemas (Alter sch (Drop tab schema) schemas)
614−dropTable tab = UnsafeDefinition $ "DROP TABLE" <+> renderSQL tab <> ";"
616−{-----------------------------------------
618−-----------------------------------------}
620−-- | `alterTable` changes the definition of a table from the schema.
622− :: (Has sch schemas schema, Has tab schema ('Table table0))
623− => QualifiedAlias sch tab -- ^ table to alter
624− -> AlterTable sch tab schemas table1 -- ^ alteration to perform
625− -> Definition schemas (Alter sch (Alter tab ('Table table1) schema) schemas)
626−alterTable tab alteration = UnsafeDefinition $
629− <+> renderAlterTable alteration
632−-- | `alterTableRename` changes the name of a table from the schema.
634−-- >>> printSQL $ alterTableRename #foo #bar
635−-- ALTER TABLE "foo" RENAME TO "bar";
637− :: (KnownSymbol table0, KnownSymbol table1)
638− => Alias table0 -- ^ table to rename
639− -> Alias table1 -- ^ what to rename it
640− -> Definition schema (Rename table0 table1 schema)
641−alterTableRename table0 table1 = UnsafeDefinition $
642− "ALTER TABLE" <+> renderSQL table0
643− <+> "RENAME TO" <+> renderSQL table1 <> ";"
645−-- | An `AlterTable` describes the alteration to perform on the columns
650− (schemas :: SchemasType)
651− (table :: TableType) =
652− UnsafeAlterTable {renderAlterTable :: ByteString}
653− deriving (GHC.Generic,Show,Eq,Ord,NFData)
655−-- | An `addConstraint` adds a table constraint.
659−-- definition :: Definition
660−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
661−-- '["public" ::: '["tab" ::: 'Table ('["positive" ::: 'Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
662−-- definition = alterTable #tab (addConstraint #positive (check #col (#col .> 0)))
663−-- in printSQL definition
665−-- ALTER TABLE "tab" ADD CONSTRAINT "positive" CHECK (("col" > 0));
667− :: ( KnownSymbol alias
668− , Has sch schemas schema
669− , Has tab schema ('Table table0)
670− , table0 ~ (constraints :=> columns)
671− , table1 ~ (Create alias constraint constraints :=> columns) )
673− -> TableConstraintExpression sch tab schemas constraint
674− -- ^ constraint to add
675− -> AlterTable sch tab schemas table1
676−addConstraint alias constraint = UnsafeAlterTable $
677− "ADD" <+> "CONSTRAINT" <+> renderSQL alias
678− <+> renderSQL constraint
680−-- | A `dropConstraint` drops a table constraint.
684−-- definition :: Definition
685−-- '["public" ::: '["tab" ::: 'Table ('["positive" ::: Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
686−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
687−-- definition = alterTable #tab (dropConstraint #positive)
688−-- in printSQL definition
690−-- ALTER TABLE "tab" DROP CONSTRAINT "positive";
692− :: ( KnownSymbol constraint
693− , Has sch schemas schema
694− , Has tab schema ('Table table0)
695− , table0 ~ (constraints :=> columns)
696− , table1 ~ (Drop constraint constraints :=> columns) )
698− -- ^ constraint to drop
699− -> AlterTable sch tab schemas table1
700−dropConstraint constraint = UnsafeAlterTable $
701− "DROP" <+> "CONSTRAINT" <+> renderSQL constraint
703−-- | An `AddColumn` is either @NULL@ or has @DEFAULT@.
704−class AddColumn ty where
705− -- | `addColumn` adds a new column, initially filled with whatever
706− -- default value is given or with @NULL@.
710− -- definition :: Definition
711− -- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
712− -- '["public" ::: '["tab" ::: 'Table ('[] :=>
713− -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
714− -- , "col2" ::: 'Def :=> 'Null 'PGtext ])]]
715− -- definition = alterTable #tab (addColumn #col2 (text & nullable & default_ "foo"))
716− -- in printSQL definition
718− -- ALTER TABLE "tab" ADD COLUMN "col2" text NULL DEFAULT E'foo';
722− -- definition :: Definition
723− -- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
724− -- '["public" ::: '["tab" ::: 'Table ('[] :=>
725− -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
726− -- , "col2" ::: 'NoDef :=> 'Null 'PGtext ])]]
727− -- definition = alterTable #tab (addColumn #col2 (text & nullable))
728− -- in printSQL definition
730− -- ALTER TABLE "tab" ADD COLUMN "col2" text NULL;
732− :: ( KnownSymbol column
733− , Has sch schemas schema
734− , Has tab schema ('Table table0)
735− , table0 ~ (constraints :=> columns) )
736− => Alias column -- ^ column to add
737− -> ColumnTypeExpression schemas ty -- ^ type of the new column
738− -> AlterTable sch tab schemas (constraints :=> Create column ty columns)
739− addColumn column ty = UnsafeAlterTable $
740− "ADD COLUMN" <+> renderSQL column <+> renderColumnTypeExpression ty
741−instance {-# OVERLAPPING #-} AddColumn ('Def :=> ty)
742−instance {-# OVERLAPPABLE #-} AddColumn ('NoDef :=> 'Null ty)
744−-- | A `dropColumn` removes a column. Whatever data was in the column
745−-- disappears. Table constraints involving the column are dropped, too.
746−-- However, if the column is referenced by a foreign key constraint of
747−-- another table, PostgreSQL will not silently drop that constraint.
751−-- definition :: Definition
752−-- '["public" ::: '["tab" ::: 'Table ('[] :=>
753−-- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
754−-- , "col2" ::: 'NoDef :=> 'Null 'PGtext ])]]
755−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
756−-- definition = alterTable #tab (dropColumn #col2)
757−-- in printSQL definition
759−-- ALTER TABLE "tab" DROP COLUMN "col2";
761− :: ( KnownSymbol column
762− , Has sch schemas schema
763− , Has tab schema ('Table table0)
764− , table0 ~ (constraints :=> columns)
765− , table1 ~ (constraints :=> Drop column columns) )
766− => Alias column -- ^ column to remove
767− -> AlterTable sch tab schemas table1
768−dropColumn column = UnsafeAlterTable $
769− "DROP COLUMN" <+> renderSQL column
771−-- | A `renameColumn` renames a column.
775−-- definition :: Definition
776−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["foo" ::: 'NoDef :=> 'Null 'PGint4])]]
777−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["bar" ::: 'NoDef :=> 'Null 'PGint4])]]
778−-- definition = alterTable #tab (renameColumn #foo #bar)
779−-- in printSQL definition
781−-- ALTER TABLE "tab" RENAME COLUMN "foo" TO "bar";
783− :: ( KnownSymbol column0
784− , KnownSymbol column1
785− , Has sch schemas schema
786− , Has tab schema ('Table table0)
787− , table0 ~ (constraints :=> columns)
788− , table1 ~ (constraints :=> Rename column0 column1 columns) )
789− => Alias column0 -- ^ column to rename
790− -> Alias column1 -- ^ what to rename the column
791− -> AlterTable sch tab schemas table1
792−renameColumn column0 column1 = UnsafeAlterTable $
793− "RENAME COLUMN" <+> renderSQL column0 <+> "TO" <+> renderSQL column1
795−-- | An `alterColumn` alters a single column.
797− :: ( KnownSymbol column
798− , Has sch schemas schema
799− , Has tab schema ('Table table0)
800− , table0 ~ (constraints :=> columns)
801− , Has column columns ty0
802− , table1 ~ (constraints :=> Alter column ty1 columns))
803− => Alias column -- ^ column to alter
804− -> AlterColumn schemas ty0 ty1 -- ^ alteration to perform
805− -> AlterTable sch tab schemas table1
806−alterColumn column alteration = UnsafeAlterTable $
807− "ALTER COLUMN" <+> renderSQL column <+> renderAlterColumn alteration
809−-- | An `AlterColumn` describes the alteration to perform on a single column.
810−newtype AlterColumn (schemas :: SchemasType) (ty0 :: ColumnType) (ty1 :: ColumnType) =
811− UnsafeAlterColumn {renderAlterColumn :: ByteString}
812− deriving (GHC.Generic,Show,Eq,Ord,NFData)
814−-- | A `setDefault` sets a new default for a column. Note that this doesn't
815−-- affect any existing rows in the table, it just changes the default for
816−-- future insert and update commands.
820−-- definition :: Definition
821−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
822−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'Def :=> 'Null 'PGint4])]]
823−-- definition = alterTable #tab (alterColumn #col (setDefault 5))
824−-- in printSQL definition
826−-- ALTER TABLE "tab" ALTER COLUMN "col" SET DEFAULT 5;
828− :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty -- ^ default value to set
829− -> AlterColumn schemas (constraint :=> ty) ('Def :=> ty)
830−setDefault expression = UnsafeAlterColumn $
831− "SET DEFAULT" <+> renderExpression expression
833−-- | A `dropDefault` removes any default value for a column.
837−-- definition :: Definition
838−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'Def :=> 'Null 'PGint4])]]
839−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
840−-- definition = alterTable #tab (alterColumn #col dropDefault)
841−-- in printSQL definition
843−-- ALTER TABLE "tab" ALTER COLUMN "col" DROP DEFAULT;
844−dropDefault :: AlterColumn schemas ('Def :=> ty) ('NoDef :=> ty)
845−dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"
847−-- | A `setNotNull` adds a @NOT NULL@ constraint to a column.
848−-- The constraint will be checked immediately, so the table data must satisfy
849−-- the constraint before it can be added.
853−-- definition :: Definition
854−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
855−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
856−-- definition = alterTable #tab (alterColumn #col setNotNull)
857−-- in printSQL definition
859−-- ALTER TABLE "tab" ALTER COLUMN "col" SET NOT NULL;
861− :: AlterColumn schemas (constraint :=> 'Null ty) (constraint :=> 'NotNull ty)
862−setNotNull = UnsafeAlterColumn $ "SET NOT NULL"
864−-- | A `dropNotNull` drops a @NOT NULL@ constraint from a column.
868−-- definition :: Definition
869−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
870−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
871−-- definition = alterTable #tab (alterColumn #col dropNotNull)
872−-- in printSQL definition
874−-- ALTER TABLE "tab" ALTER COLUMN "col" DROP NOT NULL;
876− :: AlterColumn schemas (constraint :=> 'NotNull ty) (constraint :=> 'Null ty)
877−dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"
879−-- | An `alterType` converts a column to a different data type.
880−-- This will succeed only if each existing entry in the column can be
881−-- converted to the new type by an implicit cast.
885−-- definition :: Definition
886−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
887−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGnumeric])]]
889−-- alterTable #tab (alterColumn #col (alterType (numeric & notNullable)))
890−-- in printSQL definition
892−-- ALTER TABLE "tab" ALTER COLUMN "col" TYPE numeric NOT NULL;
893−alterType :: ColumnTypeExpression schemas ty -> AlterColumn schemas ty0 ty
894−alterType ty = UnsafeAlterColumn $ "TYPE" <+> renderColumnTypeExpression ty
897−>>> type ABC = '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4]
898−>>> type BC = '["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4]
901− definition :: Definition
902− '[ "public" ::: '["abc" ::: 'Table ('[] :=> ABC)]]
903− '[ "public" ::: '["abc" ::: 'Table ('[] :=> ABC), "bc" ::: 'View BC]]
905− createView #bc (select_ (#b :* #c) (from (table #abc)))
906−in printSQL definition
908−CREATE VIEW "bc" AS SELECT "b" AS "b", "c" AS "c" FROM "abc" AS "abc";
911− :: (KnownSymbol sch, KnownSymbol vw, Has sch schemas schema)
912− => QualifiedAlias sch vw -- ^ the name of the view to add
913− -> Query '[] '[] schemas '[] view -- ^ query
914− -> Definition schemas (Alter sch (Create vw ('View view) schema) schemas)
915−createView alias query = UnsafeDefinition $
916− "CREATE" <+> "VIEW" <+> renderSQL alias <+> "AS"
917− <+> renderQuery query <> ";"
923−-- definition :: Definition
924−-- '[ "public" ::: '["abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])
925−-- , "bc" ::: 'View ('["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4])]]
926−-- '[ "public" ::: '["abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])]]
927−-- definition = dropView #bc
928−-- in printSQL definition
932− :: (Has sch schemas schema, Has vw schema ('View view))
933− => QualifiedAlias sch vw -- ^ view to remove
934− -> Definition schemas (Alter sch (Drop vw schema) schemas)
935−dropView vw = UnsafeDefinition $ "DROP VIEW" <+> renderSQL vw <> ";"
937−-- | Enumerated types are created using the `createTypeEnum` command, for example
939−-- >>> printSQL $ (createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy") :: Definition (Public '[]) '["public" ::: '["mood" ::: 'Typedef ('PGenum '["sad","ok","happy"])]])
940−-- CREATE TYPE "mood" AS ENUM ('sad', 'ok', 'happy');
942− :: (KnownSymbol enum, Has sch schemas schema, SOP.All KnownSymbol labels)
943− => QualifiedAlias sch enum
944− -- ^ name of the user defined enumerated type
945− -> NP PGlabel labels
946− -- ^ labels of the enumerated type
947− -> Definition schemas (Alter sch (Create enum ('Typedef ('PGenum labels)) schema) schemas)
948−createTypeEnum enum labels = UnsafeDefinition $
949− "CREATE" <+> "TYPE" <+> renderSQL enum <+> "AS" <+> "ENUM" <+>
950− parenthesized (renderSQL labels) <> ";"
952−-- | Enumerated types can also be generated from a Haskell type, for example
954−-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
955−-- >>> instance SOP.Generic Schwarma
956−-- >>> instance SOP.HasDatatypeInfo Schwarma
959−-- createSchwarma :: Definition (Public '[]) '["public" ::: '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))]]
960−-- createSchwarma = createTypeEnumFrom @Schwarma #schwarma
962−-- printSQL createSchwarma
964−-- CREATE TYPE "schwarma" AS ENUM ('Beef', 'Lamb', 'Chicken');
966− :: forall hask sch enum schemas schema.
968− , SOP.All KnownSymbol (LabelsPG hask)
970− , Has sch schemas schema )
971− => QualifiedAlias sch enum
972− -- ^ name of the user defined enumerated type
973− -> Definition schemas (Alter sch (Create enum ('Typedef (PG (Enumerated hask))) schema) schemas)
974−createTypeEnumFrom enum = createTypeEnum enum
975− (SOP.hpure label :: NP PGlabel (LabelsPG hask))
977−{- | `createTypeComposite` creates a composite type. The composite type is
978−specified by a list of attribute names and data types.
981−type PGcomplex = 'PGcomposite
982− '[ "real" ::: 'NotNull 'PGfloat8
983− , "imaginary" ::: 'NotNull 'PGfloat8 ]
988− setup :: Definition (Public '[]) '["public" ::: '["complex" ::: 'Typedef PGcomplex]]
989− setup = createTypeComposite #complex
990− (float8 `as` #real :* float8 `as` #imaginary)
993−CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
996− :: (KnownSymbol ty, Has sch schemas schema, SOP.SListI fields)
997− => QualifiedAlias sch ty
998− -- ^ name of the user defined composite type
999− -> NP (Aliased (TypeExpression schemas)) fields
1000− -- ^ list of attribute names and data types
1001− -> Definition schemas (Alter sch (Create ty ('Typedef ('PGcomposite fields)) schema) schemas)
1002−createTypeComposite ty fields = UnsafeDefinition $
1003− "CREATE" <+> "TYPE" <+> renderSQL ty <+> "AS" <+> parenthesized
1004− (renderCommaSeparated renderField fields) <> ";"
1006− renderField :: Aliased (TypeExpression schemas) x -> ByteString
1007− renderField (typ `As` alias) =
1008− renderSQL alias <+> renderSQL typ
1010−-- | Composite types can also be generated from a Haskell type, for example
1012−-- >>> data Complex = Complex {real :: Double, imaginary :: Double} deriving GHC.Generic
1013−-- >>> instance SOP.Generic Complex
1014−-- >>> instance SOP.HasDatatypeInfo Complex
1015−-- >>> type Schema = '["complex" ::: 'Typedef (PG (Composite Complex))]
1018−-- createComplex :: Definition (Public '[]) (Public Schema)
1019−-- createComplex = createTypeCompositeFrom @Complex #complex
1021−-- printSQL createComplex
1023−-- CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
1024−createTypeCompositeFrom
1025− :: forall hask sch ty schemas schema.
1026− ( SOP.All (FieldTyped schemas) (RowPG hask)
1028− , Has sch schemas schema )
1029− => QualifiedAlias sch ty
1030− -- ^ name of the user defined composite type
1031− -> Definition schemas (Alter sch (Create ty ( 'Typedef (PG (Composite hask))) schema) schemas)
1032−createTypeCompositeFrom ty = createTypeComposite ty
1033− (SOP.hcpure (SOP.Proxy :: SOP.Proxy (FieldTyped schemas)) fieldtype
1034− :: NP (Aliased (TypeExpression schemas)) (RowPG hask))
1037−`createDomain` creates a new domain. A domain is essentially a data type
1038−with constraints (restrictions on the allowed set of values).
1040−Domains are useful for abstracting common constraints on fields
1041−into a single location for maintenance. For example, several tables might
1042−contain email address columns, all requiring the same `check` constraint
1043−to verify the address syntax. Define a domain rather than setting up
1044−each table's constraint individually.
1048− createPositive :: Definition (Public '[]) (Public '["positive" ::: 'Typedef 'PGfloat4])
1049− createPositive = createDomain #positive real (#value .> 0 .&& (#value & isNotNull))
1050−in printSQL createPositive
1052−CREATE DOMAIN "positive" AS real CHECK ((("value" > 0) AND "value" IS NOT NULL));
1055− :: (Has sch schemas schema, KnownSymbol dom)
1056− => QualifiedAlias sch dom
1057− -> (forall null. TypeExpression schemas (null ty))
1058− -> (forall tab. Condition '[] '[] 'Ungrouped schemas '[] '[tab ::: '["value" ::: 'Null ty]])
1059− -> Definition schemas (Alter sch (Create dom ('Typedef ty) schema) schemas)
1060−createDomain dom ty condition =
1061− UnsafeDefinition $ "CREATE DOMAIN" <+> renderSQL dom
1062− <+> "AS" <+> renderTypeExpression ty
1063− <+> "CHECK" <+> parenthesized (renderSQL condition) <> ";"
1068− createSmallIntRange :: Definition (Public '[]) (Public '["int2range" ::: 'Typedef ('PGrange 'PGint2)])
1069− createSmallIntRange = createTypeRange #int2range int2
1070−in printSQL createSmallIntRange
1072−CREATE TYPE "int2range" AS RANGE (subtype = int2);
1075− :: (Has sch schemas schema, KnownSymbol range)
1076− => QualifiedAlias sch range
1077− -> (forall null. TypeExpression schemas (null ty))
1078− -> Definition schemas (Alter sch (Create range ('Typedef ('PGrange ty)) schema) schemas)
1079−createTypeRange range ty = UnsafeDefinition $
1080− "CREATE" <+> "TYPE" <+> renderSQL range <+> "AS" <+> "RANGE" <+>
1081− parenthesized ("subtype" <+> "=" <+> renderTypeExpression ty) <> ";"
1085−type Table = '[] :=>
1086− '[ "a" ::: 'NoDef :=> 'Null 'PGint4
1087− , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
1092− setup :: Definition (Public '[]) (Public '["tab" ::: 'Table Table, "ix" ::: 'Index])
1094− createTable #tab (nullable int `as` #a :* nullable real `as` #b) Nil >>>
1095− createIndex #ix #tab Btree [#a & AscNullsFirst, #b & AscNullsLast]
1098−CREATE TABLE "tab" ("a" int NULL, "b" real NULL);
1099−CREATE INDEX "ix" ON "tab" USING btree (("a") ASC NULLS FIRST, ("b") ASC NULLS LAST);
1102− :: (Has sch schemas schema, Has tab schema ('Table table), KnownSymbol ix)
1104− -> QualifiedAlias sch tab
1106− -> [SortExpression '[] '[] 'Ungrouped schemas '[] '[tab ::: TableToRow table]]
1107− -> Definition schemas (Alter sch (Create ix 'Index schema) schemas)
1108−createIndex ix tab method cols = UnsafeDefinition $
1109− "CREATE" <+> "INDEX" <+> renderSQL ix <+> "ON" <+> renderSQL tab
1110− <+> "USING" <+> renderSQL method
1111− <+> parenthesized (commaSeparated (renderIndex <$> cols))
1114− renderIndex = \case
1115− Asc expression -> parenthesized (renderSQL expression) <+> "ASC"
1116− Desc expression -> parenthesized (renderSQL expression) <+> "DESC"
1117− AscNullsFirst expression -> parenthesized (renderSQL expression)
1118− <+> "ASC NULLS FIRST"
1119− DescNullsFirst expression -> parenthesized (renderSQL expression)
1120− <+> "DESC NULLS FIRST"
1121− AscNullsLast expression -> parenthesized (renderSQL expression)
1122− <+> "ASC NULLS LAST"
1123− DescNullsLast expression -> parenthesized (renderSQL expression)
1124− <+> "DESC NULLS LAST"
1133− deriving stock (Eq, Ord, Show, GHC.Generic)
1134− deriving anyclass (SOP.HasDatatypeInfo, SOP.Generic)
1135−instance RenderSQL IndexMethod where
1145− :: ( Has sch schemas schema
1147− , SOP.SListI args )
1148− => QualifiedAlias sch fun
1149− -> NP (TypeExpression schemas) args
1150− -> TypeExpression schemas ret
1151− -> FunctionDefinition schemas args ('Returns ret)
1152− -> Definition schemas (Alter sch (Create fun ('Function args ('Returns ret)) schema) schemas)
1153−createFunction fun args ret fundef = UnsafeDefinition $
1154− "CREATE" <+> "FUNCTION" <+> renderSQL fun
1155− <+> parenthesized (renderCommaSeparated renderSQL args)
1156− <+> "RETURNS" <+> renderSQL ret <+> renderSQL fundef <> ";"
1158−createOrReplaceFunction
1159− :: ( Has sch schemas schema
1160− , Has fun schema ('Function args0 ret0)
1161− , SOP.SListI args )
1162− => QualifiedAlias sch fun
1163− -> NP (TypeExpression schemas) args
1164− -> TypeExpression schemas ret
1165− -> FunctionDefinition schemas args ('Returns ret)
1166− -> Definition schemas (Alter sch (Alter fun ('Function args ('Returns ret)) schema) schemas)
1167−createOrReplaceFunction fun args ret fundef = UnsafeDefinition $
1168− "CREATE" <+> "OR" <+> "REPLACE" <+> "FUNCTION" <+> renderSQL fun
1169− <+> parenthesized (renderCommaSeparated renderSQL args)
1170− <+> "RETURNS" <+> renderSQL ret <+> renderSQL fundef <> ";"
1173− :: Expression '[] '[] 'Ungrouped schemas args '[] ret
1174− -> FunctionDefinition schemas args ('Returns ret)
1175−languageSqlExpr expr = UnsafeFunctionDefinition $
1177− <+> "$$" <+> renderSQL (values_ (expr `as` #ret)) <+> "$$"
1180− :: Query '[] '[] schemas args rets
1181− -> FunctionDefinition schemas args ('ReturnsTable rets)
1182−languageSqlQuery qry = UnsafeFunctionDefinition $
1183− "language sql as" <+> "$$" <+> renderSQL qry <+> "$$"
1186− :: ( Has sch schemas schema
1189− , SOP.SListI rets )
1190− => QualifiedAlias sch fun
1191− -> NP (TypeExpression schemas) args
1192− -> NP (Aliased (TypeExpression schemas)) rets
1193− -> FunctionDefinition schemas args ('ReturnsTable rets)
1194− -> Definition schemas (Alter sch (Create fun ('Function args ('ReturnsTable rets)) schema) schemas)
1195−createSetFunction fun args rets fundef = UnsafeDefinition $
1196− "CREATE" <+> "FUNCTION" <+> renderSQL fun
1197− <+> parenthesized (renderCommaSeparated renderSQL args)
1198− <+> "RETURNS" <+> "TABLE"
1199− <+> parenthesized (renderCommaSeparated renderRet rets)
1200− <+> renderSQL fundef <> ";"
1202− renderRet :: Aliased (TypeExpression s) r -> ByteString
1203− renderRet (ty `As` col) = renderSQL col <+> renderSQL ty
1205−createOrReplaceSetFunction
1206− :: ( Has sch schemas schema
1207− , Has fun schema ('Function args0 ret0)
1209− , SOP.SListI rets )
1210− => QualifiedAlias sch fun
1211− -> NP (TypeExpression schemas) args
1212− -> NP (Aliased (TypeExpression schemas)) rets
1213− -> FunctionDefinition schemas args ('ReturnsTable rets)
1214− -> Definition schemas (Alter sch (Alter fun ('Function args ('ReturnsTable rets)) schema) schemas)
1215−createOrReplaceSetFunction fun args rets fundef = UnsafeDefinition $
1216− "CREATE" <+> "OR" <+> "REPLACE" <+> "FUNCTION" <+> renderSQL fun
1217− <+> parenthesized (renderCommaSeparated renderSQL args)
1218− <+> "RETURNS" <+> "TABLE"
1219− <+> parenthesized (renderCommaSeparated renderRet rets)
1220− <+> renderSQL fundef <> ";"
1222− renderRet :: Aliased (TypeExpression s) r -> ByteString
1223− renderRet (ty `As` col) = renderSQL col <+> renderSQL ty
1226− :: forall op fun sch schemas schema x y z.
1227− ( Has sch schemas schema
1228− , Has fun schema ('Function '[x,y] ('Returns z))
1231− -> TypeExpression schemas x
1232− -> TypeExpression schemas y
1233− -> Definition schemas
1234− (Alter sch (Create op ('Operator ('BinaryOp x y z)) schema) schemas)
1235−createBinaryOp fun x y = UnsafeDefinition $
1236− "CREATE" <+> "OPERATOR" <+> renderSymbol @op
1237− <+> parenthesized (commaSeparated opdef)
1240− [ "FUNCTION" <+> "=" <+> renderSQL fun
1241− , "LEFTARG" <+> "=" <+> renderSQL x
1242− , "RIGHTARG" <+> "=" <+> renderSQL y ]
1245− :: forall op fun sch schemas schema x y.
1246− ( Has sch schemas schema
1247− , Has fun schema ('Function '[x] ('Returns y))
1250− -> TypeExpression schemas x
1251− -> Definition schemas
1252− (Alter sch (Create op ('Operator ('LeftOp x y)) schema) schemas)
1253−createLeftOp fun x = UnsafeDefinition $
1254− "CREATE" <+> "OPERATOR" <+> renderSymbol @op
1255− <+> parenthesized (commaSeparated opdef)
1258− [ "FUNCTION" <+> "=" <+> renderSQL fun
1259− , "RIGHTARG" <+> "=" <+> renderSQL x ]
1262− :: forall op fun sch schemas schema x y.
1263− ( Has sch schemas schema
1264− , Has fun schema ('Function '[x] ('Returns y))
1267− -> TypeExpression schemas x
1268− -> Definition schemas
1269− (Alter sch (Create op ('Operator ('RightOp x y)) schema) schemas)
1270−createRightOp fun x = UnsafeDefinition $
1271− "CREATE" <+> "OPERATOR" <+> renderSymbol @op
1272− <+> parenthesized (commaSeparated opdef)
1275− [ "FUNCTION" <+> "=" <+> renderSQL fun
1276− , "LEFTARG" <+> "=" <+> renderSQL x ]
1279− :: (Has sch schemas schema, Has fun schema ('Function args ret))
1280− => QualifiedAlias sch fun
1281− -- ^ name of the user defined function
1282− -> Definition schemas (Alter sch (Drop fun schema) schemas)
1283−dropFunction fun = UnsafeDefinition $
1284− "DROP" <+> "FUNCTION" <+> renderSQL fun <> ";"
1287− :: (Has sch schemas schema, Has op schema ('Operator oper))
1288− => QualifiedAlias sch op
1289− -- ^ name of the user defined operator
1290− -> Definition schemas (Alter sch (Drop op schema) schemas)
1291−dropOperator op = UnsafeDefinition $
1292− "DROP" <+> "OPERATOR" <+> renderSQL op <> ";"
1294−newtype FunctionDefinition schemas args ret = UnsafeFunctionDefinition
1295− { renderFunctionDefinition :: ByteString }
1296− deriving (Eq,Show,GHC.Generic,NFData)
1297−instance RenderSQL (FunctionDefinition schemas args ret) where
1298− renderSQL = renderFunctionDefinition
1301−-- >>> printSQL (dropIndex #ix :: Definition (Public '["ix" ::: 'Index]) (Public '[]))
1304− :: (Has sch schemas schema, Has ix schema 'Index)
1305− => QualifiedAlias sch ix
1306− -- ^ name of the user defined index
1307− -> Definition schemas (Alter sch (Drop ix schema) schemas)
1308−dropIndex ix = UnsafeDefinition $ "DROP" <+> "INDEX" <+> renderSQL ix <> ";"
1310−-- | Lift `PGTyped` to a field
1311−class FieldTyped schemas ty where
1312− fieldtype :: Aliased (TypeExpression schemas) ty
1313−instance (KnownSymbol alias, PGTyped schemas ty)
1314− => FieldTyped schemas (alias ::: ty) where
1315− fieldtype = pgtype `As` Alias
1319−-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
1320−-- >>> instance SOP.Generic Schwarma
1321−-- >>> instance SOP.HasDatatypeInfo Schwarma
1322−-- >>> printSQL (dropType #schwarma :: Definition '["public" ::: '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))]] (Public '[]))
1323−-- DROP TYPE "schwarma";
1325− :: (Has sch schemas schema, Has td schema ('Typedef ty))
1326− => QualifiedAlias sch td
1327− -- ^ name of the user defined type
1328− -> Definition schemas (Alter sch (Drop td schema) schemas)
1329−dropType tydef = UnsafeDefinition $ "DROP" <+> "TYPE" <+> renderSQL tydef <> ";"
1331−-- | `ColumnTypeExpression`s are used in `createTable` commands.
1332−newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType)
1333− = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }
1334− deriving (GHC.Generic,Show,Eq,Ord,NFData)
1335−instance RenderSQL (ColumnTypeExpression schemas ty) where
1336− renderSQL = renderColumnTypeExpression
1338−-- | used in `createTable` commands as a column constraint to note that
1339−-- @NULL@ may be present in a column
1341− :: TypeExpression schemas (nullity ty)
1342− -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty)
1343−nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL"
1345−-- | used in `createTable` commands as a column constraint to ensure
1346−-- @NULL@ is not present in a column
1348− :: TypeExpression schemas (nullity ty)
1349− -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty)
1350−notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL"
1352−-- | used in `createTable` commands as a column constraint to give a default
1354− :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty
1355− -> ColumnTypeExpression schemas ('NoDef :=> ty)
1356− -> ColumnTypeExpression schemas ('Def :=> ty)
1357−default_ x ty = UnsafeColumnTypeExpression $
1358− renderSQL ty <+> "DEFAULT" <+> renderExpression x
1360−-- | not a true type, but merely a notational convenience for creating
1361−-- unique identifier columns with type `PGint2`
1362−serial2, smallserial
1363− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2)
1364−serial2 = UnsafeColumnTypeExpression "serial2"
1365−smallserial = UnsafeColumnTypeExpression "smallserial"
1366−-- | not a true type, but merely a notational convenience for creating
1367−-- unique identifier columns with type `PGint4`
1369− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4)
1370−serial4 = UnsafeColumnTypeExpression "serial4"
1371−serial = UnsafeColumnTypeExpression "serial"
1372−-- | not a true type, but merely a notational convenience for creating
1373−-- unique identifier columns with type `PGint8`
1375− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8)
1376−serial8 = UnsafeColumnTypeExpression "serial8"
1377−bigserial = UnsafeColumnTypeExpression "bigserial"