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