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