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