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