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