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