git.iko.soy/squeal
on dev help sign in
Merge pull request #149 from morphismtech/dev-if-not-exists
64d641aEitan Chatav
RELEASE NOTES.md+2−2
compare with dev
unifiedsplit
@@ -138,11 +138,11 @@ type Expr x
138 . Expression outer commons grp schemas params from x
138 . Expression outer commons grp schemas params from x
139```
139```
140
140
141−There is also a function type `(:-->)`, which is a subtype of the usual Haskell function
141+There is also a function type `(-->)`, which is a subtype of the usual Haskell function
142type `(->)`.
142type `(->)`.
143
143
144```Haskell
144```Haskell
145−type (:-->) x y
145+type (-->) x y
146 = forall outer commons grp schemas params from
146 = forall outer commons grp schemas params from
147 . Expression outer commons grp schemas params from x
147 . Expression outer commons grp schemas params from x
148 -> Expression outer commons grp schemas params from y
148 -> Expression outer commons grp schemas params from y
squeal-postgresql/squeal-postgresql.cabal+9−1
@@ -25,6 +25,14 @@ library
25 Squeal.PostgreSQL.Alias
25 Squeal.PostgreSQL.Alias
26 Squeal.PostgreSQL.Binary
26 Squeal.PostgreSQL.Binary
27 Squeal.PostgreSQL.Definition
27 Squeal.PostgreSQL.Definition
28+ Squeal.PostgreSQL.Definition.Function
29+ Squeal.PostgreSQL.Definition.Index
30+ Squeal.PostgreSQL.Definition.Table
31+ Squeal.PostgreSQL.Definition.Table.Column
32+ Squeal.PostgreSQL.Definition.Table.Constraint
33+ Squeal.PostgreSQL.Definition.Type
34+ Squeal.PostgreSQL.Definition.Schema
35+ Squeal.PostgreSQL.Definition.View
28 Squeal.PostgreSQL.Expression
36 Squeal.PostgreSQL.Expression
29 Squeal.PostgreSQL.Expression.Aggregate
37 Squeal.PostgreSQL.Expression.Aggregate
30 Squeal.PostgreSQL.Expression.Collection
38 Squeal.PostgreSQL.Expression.Collection
@@ -36,7 +44,7 @@ library
36 Squeal.PostgreSQL.Expression.Null
44 Squeal.PostgreSQL.Expression.Null
37 Squeal.PostgreSQL.Expression.Parameter
45 Squeal.PostgreSQL.Expression.Parameter
38 Squeal.PostgreSQL.Expression.Range
46 Squeal.PostgreSQL.Expression.Range
39− Squeal.PostgreSQL.Expression.SetOf
47+ Squeal.PostgreSQL.Expression.Set
40 Squeal.PostgreSQL.Expression.Sort
48 Squeal.PostgreSQL.Expression.Sort
41 Squeal.PostgreSQL.Expression.Subquery
49 Squeal.PostgreSQL.Expression.Subquery
42 Squeal.PostgreSQL.Expression.Text
50 Squeal.PostgreSQL.Expression.Text
squeal-postgresql/src/Squeal/PostgreSQL.hs+9−1
@@ -195,6 +195,14 @@ module Squeal.PostgreSQL (module X, RenderSQL(..), printSQL) where
195import Squeal.PostgreSQL.Alias as X
195import Squeal.PostgreSQL.Alias as X
196import Squeal.PostgreSQL.Binary as X
196import Squeal.PostgreSQL.Binary as X
197import Squeal.PostgreSQL.Definition as X
197import Squeal.PostgreSQL.Definition as X
198+import Squeal.PostgreSQL.Definition.Function as X
199+import Squeal.PostgreSQL.Definition.Index as X
200+import Squeal.PostgreSQL.Definition.Schema as X
201+import Squeal.PostgreSQL.Definition.Table as X
202+import Squeal.PostgreSQL.Definition.Table.Column as X
203+import Squeal.PostgreSQL.Definition.Table.Constraint as X
204+import Squeal.PostgreSQL.Definition.Type as X
205+import Squeal.PostgreSQL.Definition.View as X
198import Squeal.PostgreSQL.Expression as X
206import Squeal.PostgreSQL.Expression as X
199import Squeal.PostgreSQL.Expression.Aggregate as X
207import Squeal.PostgreSQL.Expression.Aggregate as X
200import Squeal.PostgreSQL.Expression.Collection as X
208import Squeal.PostgreSQL.Expression.Collection as X
@@ -206,7 +214,7 @@ import Squeal.PostgreSQL.Expression.Math as X
206import Squeal.PostgreSQL.Expression.Null as X
214import Squeal.PostgreSQL.Expression.Null as X
207import Squeal.PostgreSQL.Expression.Parameter as X
215import Squeal.PostgreSQL.Expression.Parameter as X
208import Squeal.PostgreSQL.Expression.Range as X
216import Squeal.PostgreSQL.Expression.Range as X
209−import Squeal.PostgreSQL.Expression.SetOf as X
217+import Squeal.PostgreSQL.Expression.Set as X
210import Squeal.PostgreSQL.Expression.Sort as X
218import Squeal.PostgreSQL.Expression.Sort as X
211import Squeal.PostgreSQL.Expression.Subquery as X
219import Squeal.PostgreSQL.Expression.Subquery as X
212import Squeal.PostgreSQL.Expression.Text as X
220import Squeal.PostgreSQL.Expression.Text as X
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs−1293
@@ -34,94 +34,16 @@ module Squeal.PostgreSQL.Definition
34 Definition (..)
34 Definition (..)
35 , (>>>)
35 , (>>>)
36 , manipDefinition
36 , manipDefinition
37− -- * Tables
38− -- ** Create
39− , createSchema
40− , createSchemaIfNotExists
41− , createTable
42− , createTableIfNotExists
43− , createView
44− , createTypeEnum
45− , createTypeEnumFrom
46− , createTypeComposite
47− , createTypeCompositeFrom
48− , FieldTyped (..)
49− , createDomain
50− , createTypeRange
51− , createIndex
52− , createFunction
53− , createOrReplaceFunction
54− , createSetFunction
55− , createOrReplaceSetFunction
56− , createBinaryOp
57− , createLeftOp
58− , createRightOp
59− , TableConstraintExpression (..)
60− , check
61− , unique
62− , primaryKey
63− , foreignKey
64− , ForeignKeyed
65− , OnDeleteClause (..)
66− , OnUpdateClause (..)
67− , FunctionDefinition(..)
68− , languageSqlExpr
69− , languageSqlQuery
70− -- ** Drop
71− , dropSchema
72− , dropTable
73− , dropView
74− , dropType
75− , dropIndex
76− , dropFunction
77− , dropOperator
78− -- ** Alter
79− , alterTable
80− , alterTableRename
81− , AlterTable (..)
82− , addConstraint
83− , dropConstraint
84− , AddColumn (..)
85− , dropColumn
86− , renameColumn
87− , alterColumn
88− , AlterColumn (..)
89− , setDefault
90− , dropDefault
91− , setNotNull
92− , dropNotNull
93− , alterType
94− -- * Columns
95− , ColumnTypeExpression (..)
96− , nullable
97− , notNullable
98− , default_
99− , serial2
100− , smallserial
101− , serial4
102− , serial
103− , serial8
104− , bigserial
105 ) where
37 ) where
106
38
107import Control.Category
39import Control.Category
108import Control.DeepSeq
40import Control.DeepSeq
109import Data.ByteString
41import Data.ByteString
110import Data.Monoid
42import Data.Monoid
111−import GHC.TypeLits
112import Prelude hiding ((.), id)
43import Prelude hiding ((.), id)
113
44
114−import qualified Generics.SOP as SOP
115import qualified GHC.Generics as GHC
45import qualified GHC.Generics as GHC
116
46
117−import Squeal.PostgreSQL.Alias
118−import Squeal.PostgreSQL.Expression
119−import Squeal.PostgreSQL.Expression.Logic
120−import Squeal.PostgreSQL.Expression.Sort
121−import Squeal.PostgreSQL.Expression.Type
122−import Squeal.PostgreSQL.List
123−import Squeal.PostgreSQL.PG
124−import Squeal.PostgreSQL.Query
125import Squeal.PostgreSQL.Manipulation
47import Squeal.PostgreSQL.Manipulation
126import Squeal.PostgreSQL.Render
48import Squeal.PostgreSQL.Render
127import Squeal.PostgreSQL.Schema
49import Squeal.PostgreSQL.Schema
@@ -157,1218 +79,3 @@ manipDefinition
157 -- ^ no input or output
79 -- ^ no input or output
158 -> Definition schemas schemas
80 -> Definition schemas schemas
159manipDefinition = UnsafeDefinition . (<> ";") . renderSQL
81manipDefinition = UnsafeDefinition . (<> ";") . renderSQL
160−
161−{-----------------------------------------
162−CREATE statements
163−-----------------------------------------}
164−
165−{- |
166−`createSchema` enters a new schema into the current database.
167−The schema name must be distinct from the name of any existing schema
168−in the current database.
169−
170−A schema is essentially a namespace: it contains named objects
171−(tables, data types, functions, and operators) whose names
172−can duplicate those of other objects existing in other schemas.
173−Named objects are accessed by `QualifiedAlias`es with the schema
174−name as a prefix.
175−-}
176−createSchema
177− :: KnownSymbol sch
178− => Alias sch
179− -> Definition schemas (Create sch '[] schemas)
180−createSchema sch = UnsafeDefinition $
181− "CREATE" <+> "SCHEMA" <+> renderSQL sch <> ";"
182−
183−{- | Idempotent version of `createSchema`. -}
184−createSchemaIfNotExists
185− :: (KnownSymbol sch, Has sch schemas schema)
186− => Alias sch
187− -> Definition schemas schemas
188−createSchemaIfNotExists sch = UnsafeDefinition $
189− "CREATE" <+> "SCHEMA" <+> "IF" <+> "NOT" <+> "EXISTS"
190− <+> renderSQL sch <> ";"
191−
192−{- | `createTable` adds a table to the schema.
193−
194−>>> :set -XOverloadedLabels
195−>>> :{
196−type Table = '[] :=>
197− '[ "a" ::: 'NoDef :=> 'Null 'PGint4
198− , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
199−:}
200−
201−>>> :{
202−let
203− setup :: Definition (Public '[]) (Public '["tab" ::: 'Table Table])
204− setup = createTable #tab
205− (nullable int `as` #a :* nullable real `as` #b) Nil
206−in printSQL setup
207−:}
208−CREATE TABLE "tab" ("a" int NULL, "b" real NULL);
209−-}
210−createTable
211− :: ( KnownSymbol sch
212− , KnownSymbol tab
213− , columns ~ (col ': cols)
214− , SOP.SListI columns
215− , SOP.SListI constraints
216− , Has sch schemas0 schema0
217− , schemas1 ~ Alter sch (Create tab ('Table (constraints :=> columns)) schema0) schemas0 )
218− => QualifiedAlias sch tab -- ^ the name of the table to add
219− -> NP (Aliased (ColumnTypeExpression schemas0)) columns
220− -- ^ the names and datatype of each column
221− -> NP (Aliased (TableConstraintExpression sch tab schemas1)) constraints
222− -- ^ constraints that must hold for the table
223− -> Definition schemas0 schemas1
224−createTable tab columns constraints = UnsafeDefinition $
225− "CREATE TABLE" <+> renderCreation tab columns constraints
226−
227−{-| `createTableIfNotExists` creates a table if it doesn't exist, but does not add it to the schema.
228−Instead, the schema already has the table so if the table did not yet exist, the schema was wrong.
229−`createTableIfNotExists` fixes this. Interestingly, this property makes it an idempotent in
230−the `Category` of `Definition`s.
231−
232−>>> :set -XOverloadedLabels -XTypeApplications
233−>>> :{
234−type Table = '[] :=>
235− '[ "a" ::: 'NoDef :=> 'Null 'PGint4
236− , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
237−:}
238−
239−>>> type Schemas = Public '["tab" ::: 'Table Table]
240−
241−>>> :{
242−let
243− setup :: Definition Schemas Schemas
244− setup = createTableIfNotExists #tab
245− (nullable int `as` #a :* nullable real `as` #b) Nil
246−in printSQL setup
247−:}
248−CREATE TABLE IF NOT EXISTS "tab" ("a" int NULL, "b" real NULL);
249−-}
250−createTableIfNotExists
251− :: ( Has sch schemas schema
252− , Has tab schema ('Table (constraints :=> columns))
253− , SOP.SListI columns
254− , SOP.SListI constraints )
255− => QualifiedAlias sch tab -- ^ the name of the table to add
256− -> NP (Aliased (ColumnTypeExpression schemas)) columns
257− -- ^ the names and datatype of each column
258− -> NP (Aliased (TableConstraintExpression sch tab schemas)) constraints
259− -- ^ constraints that must hold for the table
260− -> Definition schemas schemas
261−createTableIfNotExists tab columns constraints = UnsafeDefinition $
262− "CREATE TABLE IF NOT EXISTS"
263− <+> renderCreation tab columns constraints
264−
265−-- helper function for `createTable` and `createTableIfNotExists`
266−renderCreation
267− :: ( KnownSymbol sch
268− , KnownSymbol tab
269− , SOP.SListI columns
270− , SOP.SListI constraints )
271− => QualifiedAlias sch tab -- ^ the name of the table to add
272− -> NP (Aliased (ColumnTypeExpression schemas0)) columns
273− -- ^ the names and datatype of each column
274− -> NP (Aliased (TableConstraintExpression sch tab schemas1)) constraints
275− -- ^ constraints that must hold for the table
276− -> ByteString
277−renderCreation tab columns constraints = renderSQL tab
278− <+> parenthesized
279− ( renderCommaSeparated renderColumnDef columns
280− <> ( case constraints of
281− Nil -> ""
282− _ -> ", " <>
283− renderCommaSeparated renderConstraint constraints ) )
284− <> ";"
285− where
286− renderColumnDef :: Aliased (ColumnTypeExpression schemas) x -> ByteString
287− renderColumnDef (ty `As` column) =
288− renderSQL column <+> renderColumnTypeExpression ty
289− renderConstraint
290− :: Aliased (TableConstraintExpression sch tab schemas) constraint
291− -> ByteString
292− renderConstraint (constraint `As` alias) =
293− "CONSTRAINT" <+> renderSQL alias <+> renderSQL constraint
294−
295−-- | Data types are a way to limit the kind of data that can be stored in a
296−-- table. For many applications, however, the constraint they provide is
297−-- too coarse. For example, a column containing a product price should
298−-- probably only accept positive values. But there is no standard data type
299−-- that accepts only positive numbers. Another issue is that you might want
300−-- to constrain column data with respect to other columns or rows.
301−-- For example, in a table containing product information,
302−-- there should be only one row for each product number.
303−-- `TableConstraint`s give you as much control over the data in your tables
304−-- as you wish. If a user attempts to store data in a column that would
305−-- violate a constraint, an error is raised. This applies
306−-- even if the value came from the default value definition.
307−newtype TableConstraintExpression
308− (sch :: Symbol)
309− (tab :: Symbol)
310− (schemas :: SchemasType)
311− (constraint :: TableConstraint)
312− = UnsafeTableConstraintExpression
313− { renderTableConstraintExpression :: ByteString }
314− deriving (GHC.Generic,Show,Eq,Ord,NFData)
315−instance RenderSQL
316− (TableConstraintExpression sch tab schemas constraint) where
317− renderSQL = renderTableConstraintExpression
318−
319−{-| A `check` constraint is the most generic `TableConstraint` type.
320−It allows you to specify that the value in a certain column must satisfy
321−a Boolean (truth-value) expression.
322−
323−>>> :{
324−type Schema = '[
325− "tab" ::: 'Table ('[ "inequality" ::: 'Check '["a","b"]] :=> '[
326− "a" ::: 'NoDef :=> 'NotNull 'PGint4,
327− "b" ::: 'NoDef :=> 'NotNull 'PGint4
328− ])]
329−:}
330−
331−>>> :{
332−let
333− definition :: Definition (Public '[]) (Public Schema)
334− definition = createTable #tab
335− ( (int & notNullable) `as` #a :*
336− (int & notNullable) `as` #b )
337− ( check (#a :* #b) (#a .> #b) `as` #inequality )
338−:}
339−
340−>>> printSQL definition
341−CREATE TABLE "tab" ("a" int NOT NULL, "b" int NOT NULL, CONSTRAINT "inequality" CHECK (("a" > "b")));
342−-}
343−check
344− :: ( Has sch schemas schema
345− , Has tab schema ('Table table)
346− , HasAll aliases (TableToRow table) subcolumns )
347− => NP Alias aliases
348− -- ^ specify the subcolumns which are getting checked
349− -> (forall t. Condition '[] '[] 'Ungrouped schemas '[] '[t ::: subcolumns])
350− -- ^ a closed `Condition` on those subcolumns
351− -> TableConstraintExpression sch tab schemas ('Check aliases)
352−check _cols condition = UnsafeTableConstraintExpression $
353− "CHECK" <+> parenthesized (renderSQL condition)
354−
355−{-| A `unique` constraint ensure that the data contained in a column,
356−or a group of columns, is unique among all the rows in the table.
357−
358−>>> :{
359−type Schema = '[
360− "tab" ::: 'Table( '[ "uq_a_b" ::: 'Unique '["a","b"]] :=> '[
361− "a" ::: 'NoDef :=> 'Null 'PGint4,
362− "b" ::: 'NoDef :=> 'Null 'PGint4
363− ])]
364−:}
365−
366−>>> :{
367−let
368− definition :: Definition (Public '[]) (Public Schema)
369− definition = createTable #tab
370− ( (int & nullable) `as` #a :*
371− (int & nullable) `as` #b )
372− ( unique (#a :* #b) `as` #uq_a_b )
373−:}
374−
375−>>> printSQL definition
376−CREATE TABLE "tab" ("a" int NULL, "b" int NULL, CONSTRAINT "uq_a_b" UNIQUE ("a", "b"));
377−-}
378−unique
379− :: ( Has sch schemas schema
380− , Has tab schema('Table table)
381− , HasAll aliases (TableToRow table) subcolumns )
382− => NP Alias aliases
383− -- ^ specify subcolumns which together are unique for each row
384− -> TableConstraintExpression sch tab schemas ('Unique aliases)
385−unique columns = UnsafeTableConstraintExpression $
386− "UNIQUE" <+> parenthesized (renderSQL columns)
387−
388−{-| A `primaryKey` constraint indicates that a column, or group of columns,
389−can be used as a unique identifier for rows in the table.
390−This requires that the values be both unique and not null.
391−
392−>>> :{
393−type Schema = '[
394− "tab" ::: 'Table ('[ "pk_id" ::: 'PrimaryKey '["id"]] :=> '[
395− "id" ::: 'Def :=> 'NotNull 'PGint4,
396− "name" ::: 'NoDef :=> 'NotNull 'PGtext
397− ])]
398−:}
399−
400−>>> :{
401−let
402− definition :: Definition (Public '[]) (Public Schema)
403− definition = createTable #tab
404− ( serial `as` #id :*
405− (text & notNullable) `as` #name )
406− ( primaryKey #id `as` #pk_id )
407−:}
408−
409−>>> printSQL definition
410−CREATE TABLE "tab" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_id" PRIMARY KEY ("id"));
411−-}
412−primaryKey
413− :: ( Has sch schemas schema
414− , Has tab schema ('Table table)
415− , HasAll aliases (TableToColumns table) subcolumns
416− , AllNotNull subcolumns )
417− => NP Alias aliases
418− -- ^ specify the subcolumns which together form a primary key.
419− -> TableConstraintExpression sch tab schemas ('PrimaryKey aliases)
420−primaryKey columns = UnsafeTableConstraintExpression $
421− "PRIMARY KEY" <+> parenthesized (renderSQL columns)
422−
423−{-| A `foreignKey` specifies that the values in a column
424−(or a group of columns) must match the values appearing in some row of
425−another table. We say this maintains the referential integrity
426−between two related tables.
427−
428−>>> :{
429−type Schema =
430− '[ "users" ::: 'Table (
431− '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>
432− '[ "id" ::: 'Def :=> 'NotNull 'PGint4
433− , "name" ::: 'NoDef :=> 'NotNull 'PGtext
434− ])
435− , "emails" ::: 'Table (
436− '[ "pk_emails" ::: 'PrimaryKey '["id"]
437− , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]
438− ] :=>
439− '[ "id" ::: 'Def :=> 'NotNull 'PGint4
440− , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4
441− , "email" ::: 'NoDef :=> 'Null 'PGtext
442− ])
443− ]
444−:}
445−
446−>>> :{
447−let
448− setup :: Definition (Public '[]) (Public Schema)
449− setup =
450− createTable #users
451− ( serial `as` #id :*
452− (text & notNullable) `as` #name )
453− ( primaryKey #id `as` #pk_users ) >>>
454− createTable #emails
455− ( serial `as` #id :*
456− (int & notNullable) `as` #user_id :*
457− (text & nullable) `as` #email )
458− ( primaryKey #id `as` #pk_emails :*
459− foreignKey #user_id #users #id
460− OnDeleteCascade OnUpdateCascade `as` #fk_user_id )
461−in printSQL setup
462−:}
463−CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id"));
464−CREATE TABLE "emails" ("id" serial, "user_id" int NOT NULL, "email" text NULL, CONSTRAINT "pk_emails" PRIMARY KEY ("id"), CONSTRAINT "fk_user_id" FOREIGN KEY ("user_id") REFERENCES "users" ("id") ON DELETE CASCADE ON UPDATE CASCADE);
465−
466−A `foreignKey` can even be a table self-reference.
467−
468−>>> :{
469−type Schema =
470− '[ "employees" ::: 'Table (
471− '[ "employees_pk" ::: 'PrimaryKey '["id"]
472− , "employees_employer_fk" ::: 'ForeignKey '["employer_id"] "employees" '["id"]
473− ] :=>
474− '[ "id" ::: 'Def :=> 'NotNull 'PGint4
475− , "name" ::: 'NoDef :=> 'NotNull 'PGtext
476− , "employer_id" ::: 'NoDef :=> 'Null 'PGint4
477− ])
478− ]
479−:}
480−
481−>>> :{
482−let
483− setup :: Definition (Public '[]) (Public Schema)
484− setup =
485− createTable #employees
486− ( serial `as` #id :*
487− (text & notNullable) `as` #name :*
488− (integer & nullable) `as` #employer_id )
489− ( primaryKey #id `as` #employees_pk :*
490− foreignKey #employer_id #employees #id
491− OnDeleteCascade OnUpdateCascade `as` #employees_employer_fk )
492−in printSQL setup
493−:}
494−CREATE TABLE "employees" ("id" serial, "name" text NOT NULL, "employer_id" integer NULL, CONSTRAINT "employees_pk" PRIMARY KEY ("id"), CONSTRAINT "employees_employer_fk" FOREIGN KEY ("employer_id") REFERENCES "employees" ("id") ON DELETE CASCADE ON UPDATE CASCADE);
495−-}
496−foreignKey
497− :: (ForeignKeyed schemas sch schema child parent
498− table reftable
499− columns refcolumns
500− constraints cols
501− reftys tys )
502− => NP Alias columns
503− -- ^ column or columns in the table
504− -> Alias parent
505− -- ^ reference table
506− -> NP Alias refcolumns
507− -- ^ reference column or columns in the reference table
508− -> OnDeleteClause
509− -- ^ what to do when reference is deleted
510− -> OnUpdateClause
511− -- ^ what to do when reference is updated
512− -> TableConstraintExpression sch child schemas
513− ('ForeignKey columns parent refcolumns)
514−foreignKey keys parent refs ondel onupd = UnsafeTableConstraintExpression $
515− "FOREIGN KEY" <+> parenthesized (renderSQL keys)
516− <+> "REFERENCES" <+> renderSQL parent
517− <+> parenthesized (renderSQL refs)
518− <+> renderSQL ondel
519− <+> renderSQL onupd
520−
521−-- | A constraint synonym between types involved in a foreign key constraint.
522−type ForeignKeyed schemas
523− sch
524− schema
525− child parent
526− table reftable
527− columns refcolumns
528− constraints cols
529− reftys tys =
530− ( Has sch schemas schema
531− , Has child schema ('Table table)
532− , Has parent schema ('Table reftable)
533− , HasAll columns (TableToColumns table) tys
534− , reftable ~ (constraints :=> cols)
535− , HasAll refcolumns cols reftys
536− , SOP.AllZip SamePGType tys reftys
537− , Uniquely refcolumns constraints )
538−
539−-- | `OnDeleteClause` indicates what to do with rows that reference a deleted row.
540−data OnDeleteClause
541− = OnDeleteNoAction
542− -- ^ if any referencing rows still exist when the constraint is checked,
543− -- an error is raised
544− | OnDeleteRestrict -- ^ prevents deletion of a referenced row
545− | OnDeleteCascade
546− -- ^ specifies that when a referenced row is deleted,
547− -- row(s) referencing it should be automatically deleted as well
548− deriving (GHC.Generic,Show,Eq,Ord)
549−instance NFData OnDeleteClause
550−-- | Render `OnDeleteClause`.
551−instance RenderSQL OnDeleteClause where
552− renderSQL = \case
553− OnDeleteNoAction -> "ON DELETE NO ACTION"
554− OnDeleteRestrict -> "ON DELETE RESTRICT"
555− OnDeleteCascade -> "ON DELETE CASCADE"
556−
557−-- | Analagous to `OnDeleteClause` there is also `OnUpdateClause` which is invoked
558−-- when a referenced column is changed (updated).
559−data OnUpdateClause
560− = OnUpdateNoAction
561− -- ^ if any referencing rows has not changed when the constraint is checked,
562− -- an error is raised
563− | OnUpdateRestrict -- ^ prevents update of a referenced row
564− | OnUpdateCascade
565− -- ^ the updated values of the referenced column(s) should be copied
566− -- into the referencing row(s)
567− deriving (GHC.Generic,Show,Eq,Ord)
568−instance NFData OnUpdateClause
569−
570−-- | Render `OnUpdateClause`.
571−instance RenderSQL OnUpdateClause where
572− renderSQL = \case
573− OnUpdateNoAction -> "ON UPDATE NO ACTION"
574− OnUpdateRestrict -> "ON UPDATE RESTRICT"
575− OnUpdateCascade -> "ON UPDATE CASCADE"
576−
577−{-----------------------------------------
578−DROP statements
579−-----------------------------------------}
580−
581−-- | >>> :{
582−-- let
583−-- definition :: Definition '["muh_schema" ::: schema, "public" ::: public] '["public" ::: public]
584−-- definition = dropSchema #muh_schema
585−-- :}
586−--
587−-- >>> printSQL definition
588−-- DROP SCHEMA "muh_schema";
589−dropSchema
590− :: Has sch schemas schema
591− => Alias sch
592− -- ^ user defined schema
593− -> Definition schemas (Drop sch schemas)
594−dropSchema sch = UnsafeDefinition $ "DROP SCHEMA" <+> renderSQL sch <> ";"
595−
596−-- | `dropTable` removes a table from the schema.
597−--
598−-- >>> :{
599−-- let
600−-- definition :: Definition '["public" ::: '["muh_table" ::: 'Table t]] (Public '[])
601−-- definition = dropTable #muh_table
602−-- :}
603−--
604−-- >>> printSQL definition
605−-- DROP TABLE "muh_table";
606−dropTable
607− :: ( Has sch schemas schema
608− , Has tab schema ('Table table))
609− => QualifiedAlias sch tab -- ^ table to remove
610− -> Definition schemas (Alter sch (Drop tab schema) schemas)
611−dropTable tab = UnsafeDefinition $ "DROP TABLE" <+> renderSQL tab <> ";"
612−
613−{-----------------------------------------
614−ALTER statements
615−-----------------------------------------}
616−
617−-- | `alterTable` changes the definition of a table from the schema.
618−alterTable
619− :: (Has sch schemas schema, Has tab schema ('Table table0))
620− => QualifiedAlias sch tab -- ^ table to alter
621− -> AlterTable sch tab schemas table1 -- ^ alteration to perform
622− -> Definition schemas (Alter sch (Alter tab ('Table table1) schema) schemas)
623−alterTable tab alteration = UnsafeDefinition $
624− "ALTER TABLE"
625− <+> renderSQL tab
626− <+> renderAlterTable alteration
627− <> ";"
628−
629−-- | `alterTableRename` changes the name of a table from the schema.
630−--
631−-- >>> printSQL $ alterTableRename #foo #bar
632−-- ALTER TABLE "foo" RENAME TO "bar";
633−alterTableRename
634− :: (KnownSymbol table0, KnownSymbol table1)
635− => Alias table0 -- ^ table to rename
636− -> Alias table1 -- ^ what to rename it
637− -> Definition schema (Rename table0 table1 schema)
638−alterTableRename table0 table1 = UnsafeDefinition $
639− "ALTER TABLE" <+> renderSQL table0
640− <+> "RENAME TO" <+> renderSQL table1 <> ";"
641−
642−-- | An `AlterTable` describes the alteration to perform on the columns
643−-- of a table.
644−newtype AlterTable
645− (sch :: Symbol)
646− (tab :: Symbol)
647− (schemas :: SchemasType)
648− (table :: TableType) =
649− UnsafeAlterTable {renderAlterTable :: ByteString}
650− deriving (GHC.Generic,Show,Eq,Ord,NFData)
651−
652−-- | An `addConstraint` adds a table constraint.
653−--
654−-- >>> :{
655−-- let
656−-- definition :: Definition
657−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
658−-- '["public" ::: '["tab" ::: 'Table ('["positive" ::: 'Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
659−-- definition = alterTable #tab (addConstraint #positive (check #col (#col .> 0)))
660−-- in printSQL definition
661−-- :}
662−-- ALTER TABLE "tab" ADD CONSTRAINT "positive" CHECK (("col" > 0));
663−addConstraint
664− :: ( KnownSymbol alias
665− , Has sch schemas schema
666− , Has tab schema ('Table table0)
667− , table0 ~ (constraints :=> columns)
668− , table1 ~ (Create alias constraint constraints :=> columns) )
669− => Alias alias
670− -> TableConstraintExpression sch tab schemas constraint
671− -- ^ constraint to add
672− -> AlterTable sch tab schemas table1
673−addConstraint alias constraint = UnsafeAlterTable $
674− "ADD" <+> "CONSTRAINT" <+> renderSQL alias
675− <+> renderSQL constraint
676−
677−-- | A `dropConstraint` drops a table constraint.
678−--
679−-- >>> :{
680−-- let
681−-- definition :: Definition
682−-- '["public" ::: '["tab" ::: 'Table ('["positive" ::: Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
683−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
684−-- definition = alterTable #tab (dropConstraint #positive)
685−-- in printSQL definition
686−-- :}
687−-- ALTER TABLE "tab" DROP CONSTRAINT "positive";
688−dropConstraint
689− :: ( KnownSymbol constraint
690− , Has sch schemas schema
691− , Has tab schema ('Table table0)
692− , table0 ~ (constraints :=> columns)
693− , table1 ~ (Drop constraint constraints :=> columns) )
694− => Alias constraint
695− -- ^ constraint to drop
696− -> AlterTable sch tab schemas table1
697−dropConstraint constraint = UnsafeAlterTable $
698− "DROP" <+> "CONSTRAINT" <+> renderSQL constraint
699−
700−-- | An `AddColumn` is either @NULL@ or has @DEFAULT@.
701−class AddColumn ty where
702− -- | `addColumn` adds a new column, initially filled with whatever
703− -- default value is given or with @NULL@.
704− --
705− -- >>> :{
706− -- let
707− -- definition :: Definition
708− -- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
709− -- '["public" ::: '["tab" ::: 'Table ('[] :=>
710− -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
711− -- , "col2" ::: 'Def :=> 'Null 'PGtext ])]]
712− -- definition = alterTable #tab (addColumn #col2 (text & nullable & default_ "foo"))
713− -- in printSQL definition
714− -- :}
715− -- ALTER TABLE "tab" ADD COLUMN "col2" text NULL DEFAULT E'foo';
716− --
717− -- >>> :{
718− -- let
719− -- definition :: Definition
720− -- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
721− -- '["public" ::: '["tab" ::: 'Table ('[] :=>
722− -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
723− -- , "col2" ::: 'NoDef :=> 'Null 'PGtext ])]]
724− -- definition = alterTable #tab (addColumn #col2 (text & nullable))
725− -- in printSQL definition
726− -- :}
727− -- ALTER TABLE "tab" ADD COLUMN "col2" text NULL;
728− addColumn
729− :: ( KnownSymbol column
730− , Has sch schemas schema
731− , Has tab schema ('Table table0)
732− , table0 ~ (constraints :=> columns) )
733− => Alias column -- ^ column to add
734− -> ColumnTypeExpression schemas ty -- ^ type of the new column
735− -> AlterTable sch tab schemas (constraints :=> Create column ty columns)
736− addColumn column ty = UnsafeAlterTable $
737− "ADD COLUMN" <+> renderSQL column <+> renderColumnTypeExpression ty
738−instance {-# OVERLAPPING #-} AddColumn ('Def :=> ty)
739−instance {-# OVERLAPPABLE #-} AddColumn ('NoDef :=> 'Null ty)
740−
741−-- | A `dropColumn` removes a column. Whatever data was in the column
742−-- disappears. Table constraints involving the column are dropped, too.
743−-- However, if the column is referenced by a foreign key constraint of
744−-- another table, PostgreSQL will not silently drop that constraint.
745−--
746−-- >>> :{
747−-- let
748−-- definition :: Definition
749−-- '["public" ::: '["tab" ::: 'Table ('[] :=>
750−-- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
751−-- , "col2" ::: 'NoDef :=> 'Null 'PGtext ])]]
752−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
753−-- definition = alterTable #tab (dropColumn #col2)
754−-- in printSQL definition
755−-- :}
756−-- ALTER TABLE "tab" DROP COLUMN "col2";
757−dropColumn
758− :: ( KnownSymbol column
759− , Has sch schemas schema
760− , Has tab schema ('Table table0)
761− , table0 ~ (constraints :=> columns)
762− , table1 ~ (constraints :=> Drop column columns) )
763− => Alias column -- ^ column to remove
764− -> AlterTable sch tab schemas table1
765−dropColumn column = UnsafeAlterTable $
766− "DROP COLUMN" <+> renderSQL column
767−
768−-- | A `renameColumn` renames a column.
769−--
770−-- >>> :{
771−-- let
772−-- definition :: Definition
773−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["foo" ::: 'NoDef :=> 'Null 'PGint4])]]
774−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["bar" ::: 'NoDef :=> 'Null 'PGint4])]]
775−-- definition = alterTable #tab (renameColumn #foo #bar)
776−-- in printSQL definition
777−-- :}
778−-- ALTER TABLE "tab" RENAME COLUMN "foo" TO "bar";
779−renameColumn
780− :: ( KnownSymbol column0
781− , KnownSymbol column1
782− , Has sch schemas schema
783− , Has tab schema ('Table table0)
784− , table0 ~ (constraints :=> columns)
785− , table1 ~ (constraints :=> Rename column0 column1 columns) )
786− => Alias column0 -- ^ column to rename
787− -> Alias column1 -- ^ what to rename the column
788− -> AlterTable sch tab schemas table1
789−renameColumn column0 column1 = UnsafeAlterTable $
790− "RENAME COLUMN" <+> renderSQL column0 <+> "TO" <+> renderSQL column1
791−
792−-- | An `alterColumn` alters a single column.
793−alterColumn
794− :: ( KnownSymbol column
795− , Has sch schemas schema
796− , Has tab schema ('Table table0)
797− , table0 ~ (constraints :=> columns)
798− , Has column columns ty0
799− , table1 ~ (constraints :=> Alter column ty1 columns))
800− => Alias column -- ^ column to alter
801− -> AlterColumn schemas ty0 ty1 -- ^ alteration to perform
802− -> AlterTable sch tab schemas table1
803−alterColumn column alteration = UnsafeAlterTable $
804− "ALTER COLUMN" <+> renderSQL column <+> renderAlterColumn alteration
805−
806−-- | An `AlterColumn` describes the alteration to perform on a single column.
807−newtype AlterColumn (schemas :: SchemasType) (ty0 :: ColumnType) (ty1 :: ColumnType) =
808− UnsafeAlterColumn {renderAlterColumn :: ByteString}
809− deriving (GHC.Generic,Show,Eq,Ord,NFData)
810−
811−-- | A `setDefault` sets a new default for a column. Note that this doesn't
812−-- affect any existing rows in the table, it just changes the default for
813−-- future insert and update commands.
814−--
815−-- >>> :{
816−-- let
817−-- definition :: Definition
818−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
819−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'Def :=> 'Null 'PGint4])]]
820−-- definition = alterTable #tab (alterColumn #col (setDefault 5))
821−-- in printSQL definition
822−-- :}
823−-- ALTER TABLE "tab" ALTER COLUMN "col" SET DEFAULT 5;
824−setDefault
825− :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty -- ^ default value to set
826− -> AlterColumn schemas (constraint :=> ty) ('Def :=> ty)
827−setDefault expression = UnsafeAlterColumn $
828− "SET DEFAULT" <+> renderExpression expression
829−
830−-- | A `dropDefault` removes any default value for a column.
831−--
832−-- >>> :{
833−-- let
834−-- definition :: Definition
835−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'Def :=> 'Null 'PGint4])]]
836−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
837−-- definition = alterTable #tab (alterColumn #col dropDefault)
838−-- in printSQL definition
839−-- :}
840−-- ALTER TABLE "tab" ALTER COLUMN "col" DROP DEFAULT;
841−dropDefault :: AlterColumn schemas ('Def :=> ty) ('NoDef :=> ty)
842−dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"
843−
844−-- | A `setNotNull` adds a @NOT NULL@ constraint to a column.
845−-- The constraint will be checked immediately, so the table data must satisfy
846−-- the constraint before it can be added.
847−--
848−-- >>> :{
849−-- let
850−-- definition :: Definition
851−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
852−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
853−-- definition = alterTable #tab (alterColumn #col setNotNull)
854−-- in printSQL definition
855−-- :}
856−-- ALTER TABLE "tab" ALTER COLUMN "col" SET NOT NULL;
857−setNotNull
858− :: AlterColumn schemas (constraint :=> 'Null ty) (constraint :=> 'NotNull ty)
859−setNotNull = UnsafeAlterColumn $ "SET NOT NULL"
860−
861−-- | A `dropNotNull` drops a @NOT NULL@ constraint from a column.
862−--
863−-- >>> :{
864−-- let
865−-- definition :: Definition
866−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
867−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
868−-- definition = alterTable #tab (alterColumn #col dropNotNull)
869−-- in printSQL definition
870−-- :}
871−-- ALTER TABLE "tab" ALTER COLUMN "col" DROP NOT NULL;
872−dropNotNull
873− :: AlterColumn schemas (constraint :=> 'NotNull ty) (constraint :=> 'Null ty)
874−dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"
875−
876−-- | An `alterType` converts a column to a different data type.
877−-- This will succeed only if each existing entry in the column can be
878−-- converted to the new type by an implicit cast.
879−--
880−-- >>> :{
881−-- let
882−-- definition :: Definition
883−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
884−-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGnumeric])]]
885−-- definition =
886−-- alterTable #tab (alterColumn #col (alterType (numeric & notNullable)))
887−-- in printSQL definition
888−-- :}
889−-- ALTER TABLE "tab" ALTER COLUMN "col" TYPE numeric NOT NULL;
890−alterType :: ColumnTypeExpression schemas ty -> AlterColumn schemas ty0 ty
891−alterType ty = UnsafeAlterColumn $ "TYPE" <+> renderColumnTypeExpression ty
892−
893−{- | Create a view.
894−>>> type ABC = '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4]
895−>>> type BC = '["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4]
896−>>> :{
897−let
898− definition :: Definition
899− '[ "public" ::: '["abc" ::: 'Table ('[] :=> ABC)]]
900− '[ "public" ::: '["abc" ::: 'Table ('[] :=> ABC), "bc" ::: 'View BC]]
901− definition =
902− createView #bc (select_ (#b :* #c) (from (table #abc)))
903−in printSQL definition
904−:}
905−CREATE VIEW "bc" AS SELECT "b" AS "b", "c" AS "c" FROM "abc" AS "abc";
906−-}
907−createView
908− :: (KnownSymbol sch, KnownSymbol vw, Has sch schemas schema)
909− => QualifiedAlias sch vw -- ^ the name of the view to add
910− -> Query '[] '[] schemas '[] view -- ^ query
911− -> Definition schemas (Alter sch (Create vw ('View view) schema) schemas)
912−createView alias query = UnsafeDefinition $
913− "CREATE" <+> "VIEW" <+> renderSQL alias <+> "AS"
914− <+> renderQuery query <> ";"
915−
916−-- | Drop a view.
917−--
918−-- >>> :{
919−-- let
920−-- definition :: Definition
921−-- '[ "public" ::: '["abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])
922−-- , "bc" ::: 'View ('["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4])]]
923−-- '[ "public" ::: '["abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])]]
924−-- definition = dropView #bc
925−-- in printSQL definition
926−-- :}
927−-- DROP VIEW "bc";
928−dropView
929− :: (Has sch schemas schema, Has vw schema ('View view))
930− => QualifiedAlias sch vw -- ^ view to remove
931− -> Definition schemas (Alter sch (Drop vw schema) schemas)
932−dropView vw = UnsafeDefinition $ "DROP VIEW" <+> renderSQL vw <> ";"
933−
934−-- | Enumerated types are created using the `createTypeEnum` command, for example
935−--
936−-- >>> printSQL $ (createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy") :: Definition (Public '[]) '["public" ::: '["mood" ::: 'Typedef ('PGenum '["sad","ok","happy"])]])
937−-- CREATE TYPE "mood" AS ENUM ('sad', 'ok', 'happy');
938−createTypeEnum
939− :: (KnownSymbol enum, Has sch schemas schema, SOP.All KnownSymbol labels)
940− => QualifiedAlias sch enum
941− -- ^ name of the user defined enumerated type
942− -> NP PGlabel labels
943− -- ^ labels of the enumerated type
944− -> Definition schemas (Alter sch (Create enum ('Typedef ('PGenum labels)) schema) schemas)
945−createTypeEnum enum labels = UnsafeDefinition $
946− "CREATE" <+> "TYPE" <+> renderSQL enum <+> "AS" <+> "ENUM" <+>
947− parenthesized (renderSQL labels) <> ";"
948−
949−-- | Enumerated types can also be generated from a Haskell type, for example
950−--
951−-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
952−-- >>> instance SOP.Generic Schwarma
953−-- >>> instance SOP.HasDatatypeInfo Schwarma
954−-- >>> :{
955−-- let
956−-- createSchwarma :: Definition (Public '[]) '["public" ::: '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))]]
957−-- createSchwarma = createTypeEnumFrom @Schwarma #schwarma
958−-- in
959−-- printSQL createSchwarma
960−-- :}
961−-- CREATE TYPE "schwarma" AS ENUM ('Beef', 'Lamb', 'Chicken');
962−createTypeEnumFrom
963− :: forall hask sch enum schemas schema.
964− ( SOP.Generic hask
965− , SOP.All KnownSymbol (LabelsPG hask)
966− , KnownSymbol enum
967− , Has sch schemas schema )
968− => QualifiedAlias sch enum
969− -- ^ name of the user defined enumerated type
970− -> Definition schemas (Alter sch (Create enum ('Typedef (PG (Enumerated hask))) schema) schemas)
971−createTypeEnumFrom enum = createTypeEnum enum
972− (SOP.hpure label :: NP PGlabel (LabelsPG hask))
973−
974−{- | `createTypeComposite` creates a composite type. The composite type is
975−specified by a list of attribute names and data types.
976−
977−>>> :{
978−type PGcomplex = 'PGcomposite
979− '[ "real" ::: 'NotNull 'PGfloat8
980− , "imaginary" ::: 'NotNull 'PGfloat8 ]
981−:}
982−
983−>>> :{
984−let
985− setup :: Definition (Public '[]) '["public" ::: '["complex" ::: 'Typedef PGcomplex]]
986− setup = createTypeComposite #complex
987− (float8 `as` #real :* float8 `as` #imaginary)
988−in printSQL setup
989−:}
990−CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
991−-}
992−createTypeComposite
993− :: (KnownSymbol ty, Has sch schemas schema, SOP.SListI fields)
994− => QualifiedAlias sch ty
995− -- ^ name of the user defined composite type
996− -> NP (Aliased (TypeExpression schemas)) fields
997− -- ^ list of attribute names and data types
998− -> Definition schemas (Alter sch (Create ty ('Typedef ('PGcomposite fields)) schema) schemas)
999−createTypeComposite ty fields = UnsafeDefinition $
1000− "CREATE" <+> "TYPE" <+> renderSQL ty <+> "AS" <+> parenthesized
1001− (renderCommaSeparated renderField fields) <> ";"
1002− where
1003− renderField :: Aliased (TypeExpression schemas) x -> ByteString
1004− renderField (typ `As` alias) =
1005− renderSQL alias <+> renderSQL typ
1006−
1007−-- | Composite types can also be generated from a Haskell type, for example
1008−--
1009−-- >>> data Complex = Complex {real :: Double, imaginary :: Double} deriving GHC.Generic
1010−-- >>> instance SOP.Generic Complex
1011−-- >>> instance SOP.HasDatatypeInfo Complex
1012−-- >>> type Schema = '["complex" ::: 'Typedef (PG (Composite Complex))]
1013−-- >>> :{
1014−-- let
1015−-- createComplex :: Definition (Public '[]) (Public Schema)
1016−-- createComplex = createTypeCompositeFrom @Complex #complex
1017−-- in
1018−-- printSQL createComplex
1019−-- :}
1020−-- CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
1021−createTypeCompositeFrom
1022− :: forall hask sch ty schemas schema.
1023− ( SOP.All (FieldTyped schemas) (RowPG hask)
1024− , KnownSymbol ty
1025− , Has sch schemas schema )
1026− => QualifiedAlias sch ty
1027− -- ^ name of the user defined composite type
1028− -> Definition schemas (Alter sch (Create ty ( 'Typedef (PG (Composite hask))) schema) schemas)
1029−createTypeCompositeFrom ty = createTypeComposite ty
1030− (SOP.hcpure (SOP.Proxy :: SOP.Proxy (FieldTyped schemas)) fieldtype
1031− :: NP (Aliased (TypeExpression schemas)) (RowPG hask))
1032−
1033−{-|
1034−`createDomain` creates a new domain. A domain is essentially a data type
1035−with constraints (restrictions on the allowed set of values).
1036−
1037−Domains are useful for abstracting common constraints on fields
1038−into a single location for maintenance. For example, several tables might
1039−contain email address columns, all requiring the same `check` constraint
1040−to verify the address syntax. Define a domain rather than setting up
1041−each table's constraint individually.
1042−
1043−>>> :{
1044−let
1045− createPositive :: Definition (Public '[]) (Public '["positive" ::: 'Typedef 'PGfloat4])
1046− createPositive = createDomain #positive real (#value .> 0 .&& (#value & isNotNull))
1047−in printSQL createPositive
1048−:}
1049−CREATE DOMAIN "positive" AS real CHECK ((("value" > 0) AND "value" IS NOT NULL));
1050−-}
1051−createDomain
1052− :: (Has sch schemas schema, KnownSymbol dom)
1053− => QualifiedAlias sch dom
1054− -> (forall null. TypeExpression schemas (null ty))
1055− -> (forall tab. Condition '[] '[] 'Ungrouped schemas '[] '[tab ::: '["value" ::: 'Null ty]])
1056− -> Definition schemas (Alter sch (Create dom ('Typedef ty) schema) schemas)
1057−createDomain dom ty condition =
1058− UnsafeDefinition $ "CREATE DOMAIN" <+> renderSQL dom
1059− <+> "AS" <+> renderTypeExpression ty
1060− <+> "CHECK" <+> parenthesized (renderSQL condition) <> ";"
1061−
1062−{- |
1063−>>> :{
1064−let
1065− createSmallIntRange :: Definition (Public '[]) (Public '["int2range" ::: 'Typedef ('PGrange 'PGint2)])
1066− createSmallIntRange = createTypeRange #int2range int2
1067−in printSQL createSmallIntRange
1068−:}
1069−CREATE TYPE "int2range" AS RANGE (subtype = int2);
1070−-}
1071−createTypeRange
1072− :: (Has sch schemas schema, KnownSymbol range)
1073− => QualifiedAlias sch range
1074− -> (forall null. TypeExpression schemas (null ty))
1075− -> Definition schemas (Alter sch (Create range ('Typedef ('PGrange ty)) schema) schemas)
1076−createTypeRange range ty = UnsafeDefinition $
1077− "CREATE" <+> "TYPE" <+> renderSQL range <+> "AS" <+> "RANGE" <+>
1078− parenthesized ("subtype" <+> "=" <+> renderTypeExpression ty) <> ";"
1079−
1080−{- |
1081−>>> :{
1082−type Table = '[] :=>
1083− '[ "a" ::: 'NoDef :=> 'Null 'PGint4
1084− , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
1085−:}
1086−
1087−>>> :{
1088−let
1089− setup :: Definition (Public '[]) (Public '["tab" ::: 'Table Table, "ix" ::: 'Index])
1090− setup =
1091− createTable #tab (nullable int `as` #a :* nullable real `as` #b) Nil >>>
1092− createIndex #ix #tab Btree [#a & AscNullsFirst, #b & AscNullsLast]
1093−in printSQL setup
1094−:}
1095−CREATE TABLE "tab" ("a" int NULL, "b" real NULL);
1096−CREATE INDEX "ix" ON "tab" USING btree (("a") ASC NULLS FIRST, ("b") ASC NULLS LAST);
1097−-}
1098−createIndex
1099− :: (Has sch schemas schema, Has tab schema ('Table table), KnownSymbol ix)
1100− => Alias ix
1101− -> QualifiedAlias sch tab
1102− -> IndexMethod
1103− -> [SortExpression '[] '[] 'Ungrouped schemas '[] '[tab ::: TableToRow table]]
1104− -> Definition schemas (Alter sch (Create ix 'Index schema) schemas)
1105−createIndex ix tab method cols = UnsafeDefinition $
1106− "CREATE" <+> "INDEX" <+> renderSQL ix <+> "ON" <+> renderSQL tab
1107− <+> "USING" <+> renderSQL method
1108− <+> parenthesized (commaSeparated (renderIndex <$> cols))
1109− <> ";"
1110− where
1111− renderIndex = \case
1112− Asc expression -> parenthesized (renderSQL expression) <+> "ASC"
1113− Desc expression -> parenthesized (renderSQL expression) <+> "DESC"
1114− AscNullsFirst expression -> parenthesized (renderSQL expression)
1115− <+> "ASC NULLS FIRST"
1116− DescNullsFirst expression -> parenthesized (renderSQL expression)
1117− <+> "DESC NULLS FIRST"
1118− AscNullsLast expression -> parenthesized (renderSQL expression)
1119− <+> "ASC NULLS LAST"
1120− DescNullsLast expression -> parenthesized (renderSQL expression)
1121− <+> "DESC NULLS LAST"
1122−
1123−data IndexMethod
1124− = Btree
1125− | Hash
1126− | Gist
1127− | Spgist
1128− | Gin
1129− | Brin
1130− deriving stock (Eq, Ord, Show, GHC.Generic)
1131− deriving anyclass (SOP.HasDatatypeInfo, SOP.Generic)
1132−instance RenderSQL IndexMethod where
1133− renderSQL = \case
1134− Btree -> "btree"
1135− Hash -> "hash"
1136− Gist -> "gist"
1137− Spgist -> "spgist"
1138− Gin -> "gin"
1139− Brin -> "brin"
1140−
1141−createFunction
1142− :: ( Has sch schemas schema
1143− , KnownSymbol fun
1144− , SOP.SListI args )
1145− => QualifiedAlias sch fun
1146− -> NP (TypeExpression schemas) args
1147− -> TypeExpression schemas ret
1148− -> FunctionDefinition schemas args ('Returns ret)
1149− -> Definition schemas (Alter sch (Create fun ('Function args ('Returns ret)) schema) schemas)
1150−createFunction fun args ret fundef = UnsafeDefinition $
1151− "CREATE" <+> "FUNCTION" <+> renderSQL fun
1152− <+> parenthesized (renderCommaSeparated renderSQL args)
1153− <+> "RETURNS" <+> renderSQL ret <+> renderSQL fundef <> ";"
1154−
1155−createOrReplaceFunction
1156− :: ( Has sch schemas schema
1157− , Has fun schema ('Function args0 ret0)
1158− , SOP.SListI args )
1159− => QualifiedAlias sch fun
1160− -> NP (TypeExpression schemas) args
1161− -> TypeExpression schemas ret
1162− -> FunctionDefinition schemas args ('Returns ret)
1163− -> Definition schemas (Alter sch (Alter fun ('Function args ('Returns ret)) schema) schemas)
1164−createOrReplaceFunction fun args ret fundef = UnsafeDefinition $
1165− "CREATE" <+> "OR" <+> "REPLACE" <+> "FUNCTION" <+> renderSQL fun
1166− <+> parenthesized (renderCommaSeparated renderSQL args)
1167− <+> "RETURNS" <+> renderSQL ret <+> renderSQL fundef <> ";"
1168−
1169−languageSqlExpr
1170− :: Expression '[] '[] 'Ungrouped schemas args '[] ret
1171− -> FunctionDefinition schemas args ('Returns ret)
1172−languageSqlExpr expr = UnsafeFunctionDefinition $
1173− "language sql as"
1174− <+> "$$" <+> renderSQL (values_ (expr `as` #ret)) <+> "$$"
1175−
1176−languageSqlQuery
1177− :: Query '[] '[] schemas args rets
1178− -> FunctionDefinition schemas args ('ReturnsTable rets)
1179−languageSqlQuery qry = UnsafeFunctionDefinition $
1180− "language sql as" <+> "$$" <+> renderSQL qry <+> "$$"
1181−
1182−createSetFunction
1183− :: ( Has sch schemas schema
1184− , KnownSymbol fun
1185− , SOP.SListI args
1186− , SOP.SListI rets )
1187− => QualifiedAlias sch fun
1188− -> NP (TypeExpression schemas) args
1189− -> NP (Aliased (TypeExpression schemas)) rets
1190− -> FunctionDefinition schemas args ('ReturnsTable rets)
1191− -> Definition schemas (Alter sch (Create fun ('Function args ('ReturnsTable rets)) schema) schemas)
1192−createSetFunction fun args rets fundef = UnsafeDefinition $
1193− "CREATE" <+> "FUNCTION" <+> renderSQL fun
1194− <+> parenthesized (renderCommaSeparated renderSQL args)
1195− <+> "RETURNS" <+> "TABLE"
1196− <+> parenthesized (renderCommaSeparated renderRet rets)
1197− <+> renderSQL fundef <> ";"
1198− where
1199− renderRet :: Aliased (TypeExpression s) r -> ByteString
1200− renderRet (ty `As` col) = renderSQL col <+> renderSQL ty
1201−
1202−createOrReplaceSetFunction
1203− :: ( Has sch schemas schema
1204− , Has fun schema ('Function args0 ret0)
1205− , SOP.SListI args
1206− , SOP.SListI rets )
1207− => QualifiedAlias sch fun
1208− -> NP (TypeExpression schemas) args
1209− -> NP (Aliased (TypeExpression schemas)) rets
1210− -> FunctionDefinition schemas args ('ReturnsTable rets)
1211− -> Definition schemas (Alter sch (Alter fun ('Function args ('ReturnsTable rets)) schema) schemas)
1212−createOrReplaceSetFunction fun args rets fundef = UnsafeDefinition $
1213− "CREATE" <+> "OR" <+> "REPLACE" <+> "FUNCTION" <+> renderSQL fun
1214− <+> parenthesized (renderCommaSeparated renderSQL args)
1215− <+> "RETURNS" <+> "TABLE"
1216− <+> parenthesized (renderCommaSeparated renderRet rets)
1217− <+> renderSQL fundef <> ";"
1218− where
1219− renderRet :: Aliased (TypeExpression s) r -> ByteString
1220− renderRet (ty `As` col) = renderSQL col <+> renderSQL ty
1221−
1222−createBinaryOp
1223− :: forall op fun sch schemas schema x y z.
1224− ( Has sch schemas schema
1225− , Has fun schema ('Function '[x,y] ('Returns z))
1226− , KnownSymbol op )
1227− => Alias fun
1228− -> TypeExpression schemas x
1229− -> TypeExpression schemas y
1230− -> Definition schemas
1231− (Alter sch (Create op ('Operator ('BinaryOp x y z)) schema) schemas)
1232−createBinaryOp fun x y = UnsafeDefinition $
1233− "CREATE" <+> "OPERATOR" <+> renderSymbol @op
1234− <+> parenthesized (commaSeparated opdef)
1235− where
1236− opdef =
1237− [ "FUNCTION" <+> "=" <+> renderSQL fun
1238− , "LEFTARG" <+> "=" <+> renderSQL x
1239− , "RIGHTARG" <+> "=" <+> renderSQL y ]
1240−
1241−createLeftOp
1242− :: forall op fun sch schemas schema x y.
1243− ( Has sch schemas schema
1244− , Has fun schema ('Function '[x] ('Returns y))
1245− , KnownSymbol op )
1246− => Alias fun
1247− -> TypeExpression schemas x
1248− -> Definition schemas
1249− (Alter sch (Create op ('Operator ('LeftOp x y)) schema) schemas)
1250−createLeftOp fun x = UnsafeDefinition $
1251− "CREATE" <+> "OPERATOR" <+> renderSymbol @op
1252− <+> parenthesized (commaSeparated opdef)
1253− where
1254− opdef =
1255− [ "FUNCTION" <+> "=" <+> renderSQL fun
1256− , "RIGHTARG" <+> "=" <+> renderSQL x ]
1257−
1258−createRightOp
1259− :: forall op fun sch schemas schema x y.
1260− ( Has sch schemas schema
1261− , Has fun schema ('Function '[x] ('Returns y))
1262− , KnownSymbol op )
1263− => Alias fun
1264− -> TypeExpression schemas x
1265− -> Definition schemas
1266− (Alter sch (Create op ('Operator ('RightOp x y)) schema) schemas)
1267−createRightOp fun x = UnsafeDefinition $
1268− "CREATE" <+> "OPERATOR" <+> renderSymbol @op
1269− <+> parenthesized (commaSeparated opdef)
1270− where
1271− opdef =
1272− [ "FUNCTION" <+> "=" <+> renderSQL fun
1273− , "LEFTARG" <+> "=" <+> renderSQL x ]
1274−
1275−dropFunction
1276− :: (Has sch schemas schema, Has fun schema ('Function args ret))
1277− => QualifiedAlias sch fun
1278− -- ^ name of the user defined function
1279− -> Definition schemas (Alter sch (Drop fun schema) schemas)
1280−dropFunction fun = UnsafeDefinition $
1281− "DROP" <+> "FUNCTION" <+> renderSQL fun <> ";"
1282−
1283−dropOperator
1284− :: (Has sch schemas schema, Has op schema ('Operator oper))
1285− => QualifiedAlias sch op
1286− -- ^ name of the user defined operator
1287− -> Definition schemas (Alter sch (Drop op schema) schemas)
1288−dropOperator op = UnsafeDefinition $
1289− "DROP" <+> "OPERATOR" <+> renderSQL op <> ";"
1290−
1291−newtype FunctionDefinition schemas args ret = UnsafeFunctionDefinition
1292− { renderFunctionDefinition :: ByteString }
1293− deriving (Eq,Show,GHC.Generic,NFData)
1294−instance RenderSQL (FunctionDefinition schemas args ret) where
1295− renderSQL = renderFunctionDefinition
1296−
1297−-- |
1298−-- >>> printSQL (dropIndex #ix :: Definition (Public '["ix" ::: 'Index]) (Public '[]))
1299−-- DROP INDEX "ix";
1300−dropIndex
1301− :: (Has sch schemas schema, Has ix schema 'Index)
1302− => QualifiedAlias sch ix
1303− -- ^ name of the user defined index
1304− -> Definition schemas (Alter sch (Drop ix schema) schemas)
1305−dropIndex ix = UnsafeDefinition $ "DROP" <+> "INDEX" <+> renderSQL ix <> ";"
1306−
1307−-- | Lift `PGTyped` to a field
1308−class FieldTyped schemas ty where
1309− fieldtype :: Aliased (TypeExpression schemas) ty
1310−instance (KnownSymbol alias, PGTyped schemas ty)
1311− => FieldTyped schemas (alias ::: ty) where
1312− fieldtype = pgtype `As` Alias
1313−
1314−-- | Drop a type.
1315−--
1316−-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
1317−-- >>> instance SOP.Generic Schwarma
1318−-- >>> instance SOP.HasDatatypeInfo Schwarma
1319−-- >>> printSQL (dropType #schwarma :: Definition '["public" ::: '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))]] (Public '[]))
1320−-- DROP TYPE "schwarma";
1321−dropType
1322− :: (Has sch schemas schema, Has td schema ('Typedef ty))
1323− => QualifiedAlias sch td
1324− -- ^ name of the user defined type
1325− -> Definition schemas (Alter sch (Drop td schema) schemas)
1326−dropType tydef = UnsafeDefinition $ "DROP" <+> "TYPE" <+> renderSQL tydef <> ";"
1327−
1328−-- | `ColumnTypeExpression`s are used in `createTable` commands.
1329−newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType)
1330− = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }
1331− deriving (GHC.Generic,Show,Eq,Ord,NFData)
1332−instance RenderSQL (ColumnTypeExpression schemas ty) where
1333− renderSQL = renderColumnTypeExpression
1334−
1335−-- | used in `createTable` commands as a column constraint to note that
1336−-- @NULL@ may be present in a column
1337−nullable
1338− :: TypeExpression schemas (nullity ty)
1339− -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty)
1340−nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL"
1341−
1342−-- | used in `createTable` commands as a column constraint to ensure
1343−-- @NULL@ is not present in a column
1344−notNullable
1345− :: TypeExpression schemas (nullity ty)
1346− -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty)
1347−notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL"
1348−
1349−-- | used in `createTable` commands as a column constraint to give a default
1350−default_
1351− :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty
1352− -> ColumnTypeExpression schemas ('NoDef :=> ty)
1353− -> ColumnTypeExpression schemas ('Def :=> ty)
1354−default_ x ty = UnsafeColumnTypeExpression $
1355− renderSQL ty <+> "DEFAULT" <+> renderExpression x
1356−
1357−-- | not a true type, but merely a notational convenience for creating
1358−-- unique identifier columns with type `PGint2`
1359−serial2, smallserial
1360− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2)
1361−serial2 = UnsafeColumnTypeExpression "serial2"
1362−smallserial = UnsafeColumnTypeExpression "smallserial"
1363−-- | not a true type, but merely a notational convenience for creating
1364−-- unique identifier columns with type `PGint4`
1365−serial4, serial
1366− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4)
1367−serial4 = UnsafeColumnTypeExpression "serial4"
1368−serial = UnsafeColumnTypeExpression "serial"
1369−-- | not a true type, but merely a notational convenience for creating
1370−-- unique identifier columns with type `PGint8`
1371−serial8, bigserial
1372− :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8)
1373−serial8 = UnsafeColumnTypeExpression "serial8"
1374−bigserial = UnsafeColumnTypeExpression "bigserial"
squeal-postgresql/src/Squeal/PostgreSQL/Definition/Function.hsnew file+238
@@ -0,0 +1,238 @@
1+{-|
2+Module: Squeal.PostgreSQL.Definition.Function
3+Description: Create and drop function and operator definitions
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+Create and drop function and operator definitions.
9+-}
10+
11+{-# LANGUAGE
12+ AllowAmbiguousTypes
13+ , ConstraintKinds
14+ , DeriveAnyClass
15+ , DeriveGeneric
16+ , DerivingStrategies
17+ , FlexibleContexts
18+ , FlexibleInstances
19+ , GADTs
20+ , LambdaCase
21+ , MultiParamTypeClasses
22+ , OverloadedLabels
23+ , OverloadedStrings
24+ , RankNTypes
25+ , ScopedTypeVariables
26+ , TypeApplications
27+ , TypeInType
28+ , TypeOperators
29+ , UndecidableSuperClasses
30+#-}
31+
32+module Squeal.PostgreSQL.Definition.Function
33+ ( createFunction
34+ , createOrReplaceFunction
35+ , createSetFunction
36+ , createOrReplaceSetFunction
37+ , createBinaryOp
38+ , createLeftOp
39+ , createRightOp
40+ , dropFunction
41+ , dropFunctionIfExists
42+ , dropOperator
43+ , dropOperatorIfExists
44+ , FunctionDefinition(..)
45+ , languageSqlExpr
46+ , languageSqlQuery
47+ ) where
48+
49+import Control.DeepSeq
50+import Data.ByteString
51+import GHC.TypeLits
52+
53+import qualified Generics.SOP as SOP
54+import qualified GHC.Generics as GHC
55+
56+import Squeal.PostgreSQL.Alias
57+import Squeal.PostgreSQL.Definition
58+import Squeal.PostgreSQL.Expression
59+import Squeal.PostgreSQL.Expression.Type
60+import Squeal.PostgreSQL.List
61+import Squeal.PostgreSQL.Query
62+import Squeal.PostgreSQL.Render
63+import Squeal.PostgreSQL.Schema
64+
65+-- $setup
66+-- >>> import Squeal.PostgreSQL
67+
68+createFunction
69+ :: ( Has sch schemas schema
70+ , KnownSymbol fun
71+ , SOP.SListI args )
72+ => QualifiedAlias sch fun
73+ -> NP (TypeExpression schemas) args
74+ -> TypeExpression schemas ret
75+ -> FunctionDefinition schemas args ('Returns ret)
76+ -> Definition schemas (Alter sch (Create fun ('Function (args :=> 'Returns ret)) schema) schemas)
77+createFunction fun args ret fundef = UnsafeDefinition $
78+ "CREATE" <+> "FUNCTION" <+> renderSQL fun
79+ <+> parenthesized (renderCommaSeparated renderSQL args)
80+ <+> "RETURNS" <+> renderSQL ret <+> renderSQL fundef <> ";"
81+
82+createOrReplaceFunction
83+ :: ( Has sch schemas schema
84+ , KnownSymbol fun
85+ , SOP.SListI args )
86+ => QualifiedAlias sch fun
87+ -> NP (TypeExpression schemas) args
88+ -> TypeExpression schemas ret
89+ -> FunctionDefinition schemas args ('Returns ret)
90+ -> Definition schemas (Alter sch (CreateOrReplace fun ('Function (args :=> 'Returns ret)) schema) schemas)
91+createOrReplaceFunction fun args ret fundef = UnsafeDefinition $
92+ "CREATE" <+> "OR" <+> "REPLACE" <+> "FUNCTION" <+> renderSQL fun
93+ <+> parenthesized (renderCommaSeparated renderSQL args)
94+ <+> "RETURNS" <+> renderSQL ret <+> renderSQL fundef <> ";"
95+
96+languageSqlExpr
97+ :: Expression '[] '[] 'Ungrouped schemas args '[] ret
98+ -> FunctionDefinition schemas args ('Returns ret)
99+languageSqlExpr expr = UnsafeFunctionDefinition $
100+ "language sql as"
101+ <+> "$$" <+> renderSQL (values_ (expr `as` #ret)) <+> "$$"
102+
103+languageSqlQuery
104+ :: Query '[] '[] schemas args rets
105+ -> FunctionDefinition schemas args ('ReturnsTable rets)
106+languageSqlQuery qry = UnsafeFunctionDefinition $
107+ "language sql as" <+> "$$" <+> renderSQL qry <+> "$$"
108+
109+createSetFunction
110+ :: ( Has sch schemas schema
111+ , KnownSymbol fun
112+ , SOP.SListI args
113+ , SOP.SListI rets )
114+ => QualifiedAlias sch fun
115+ -> NP (TypeExpression schemas) args
116+ -> NP (Aliased (TypeExpression schemas)) rets
117+ -> FunctionDefinition schemas args ('ReturnsTable rets)
118+ -> Definition schemas (Alter sch (Create fun ('Function (args :=> 'ReturnsTable rets)) schema) schemas)
119+createSetFunction fun args rets fundef = UnsafeDefinition $
120+ "CREATE" <+> "FUNCTION" <+> renderSQL fun
121+ <+> parenthesized (renderCommaSeparated renderSQL args)
122+ <+> "RETURNS" <+> "TABLE"
123+ <+> parenthesized (renderCommaSeparated renderRet rets)
124+ <+> renderSQL fundef <> ";"
125+ where
126+ renderRet :: Aliased (TypeExpression s) r -> ByteString
127+ renderRet (ty `As` col) = renderSQL col <+> renderSQL ty
128+
129+createOrReplaceSetFunction
130+ :: ( Has sch schemas schema
131+ , KnownSymbol fun
132+ , SOP.SListI args
133+ , SOP.SListI rets )
134+ => QualifiedAlias sch fun
135+ -> NP (TypeExpression schemas) args
136+ -> NP (Aliased (TypeExpression schemas)) rets
137+ -> FunctionDefinition schemas args ('ReturnsTable rets)
138+ -> Definition schemas (Alter sch (CreateOrReplace fun ('Function (args :=> 'ReturnsTable rets)) schema) schemas)
139+createOrReplaceSetFunction fun args rets fundef = UnsafeDefinition $
140+ "CREATE" <+> "OR" <+> "REPLACE" <+> "FUNCTION" <+> renderSQL fun
141+ <+> parenthesized (renderCommaSeparated renderSQL args)
142+ <+> "RETURNS" <+> "TABLE"
143+ <+> parenthesized (renderCommaSeparated renderRet rets)
144+ <+> renderSQL fundef <> ";"
145+ where
146+ renderRet :: Aliased (TypeExpression s) r -> ByteString
147+ renderRet (ty `As` col) = renderSQL col <+> renderSQL ty
148+
149+createBinaryOp
150+ :: forall op fun sch schemas schema x y z.
151+ ( Has sch schemas schema
152+ , Has fun schema ('Function ('[x,y] :=> 'Returns z))
153+ , KnownSymbol op )
154+ => QualifiedAlias sch fun
155+ -> TypeExpression schemas x
156+ -> TypeExpression schemas y
157+ -> Definition schemas
158+ (Alter sch (Create op ('Operator ('BinaryOp x y z)) schema) schemas)
159+createBinaryOp fun x y = UnsafeDefinition $
160+ "CREATE" <+> "OPERATOR" <+> renderSymbol @op
161+ <+> parenthesized (commaSeparated opdef)
162+ where
163+ opdef =
164+ [ "FUNCTION" <+> "=" <+> renderSQL fun
165+ , "LEFTARG" <+> "=" <+> renderSQL x
166+ , "RIGHTARG" <+> "=" <+> renderSQL y ]
167+
168+createLeftOp
169+ :: forall op fun sch schemas schema x y.
170+ ( Has sch schemas schema
171+ , Has fun schema ('Function ('[x] :=> 'Returns y))
172+ , KnownSymbol op )
173+ => QualifiedAlias sch fun
174+ -> TypeExpression schemas x
175+ -> Definition schemas
176+ (Alter sch (Create op ('Operator ('LeftOp x y)) schema) schemas)
177+createLeftOp fun x = UnsafeDefinition $
178+ "CREATE" <+> "OPERATOR" <+> renderSymbol @op
179+ <+> parenthesized (commaSeparated opdef)
180+ where
181+ opdef =
182+ [ "FUNCTION" <+> "=" <+> renderSQL fun
183+ , "RIGHTARG" <+> "=" <+> renderSQL x ]
184+
185+createRightOp
186+ :: forall op fun sch schemas schema x y.
187+ ( Has sch schemas schema
188+ , Has fun schema ('Function ('[x] :=> 'Returns y))
189+ , KnownSymbol op )
190+ => QualifiedAlias sch fun
191+ -> TypeExpression schemas x
192+ -> Definition schemas
193+ (Alter sch (Create op ('Operator ('RightOp x y)) schema) schemas)
194+createRightOp fun x = UnsafeDefinition $
195+ "CREATE" <+> "OPERATOR" <+> renderSymbol @op
196+ <+> parenthesized (commaSeparated opdef)
197+ where
198+ opdef =
199+ [ "FUNCTION" <+> "=" <+> renderSQL fun
200+ , "LEFTARG" <+> "=" <+> renderSQL x ]
201+
202+dropFunction
203+ :: (Has sch schemas schema, KnownSymbol fun)
204+ => QualifiedAlias sch fun
205+ -- ^ name of the user defined function
206+ -> Definition schemas (Alter sch (DropSchemum fun 'Function schema) schemas)
207+dropFunction fun = UnsafeDefinition $
208+ "DROP" <+> "FUNCTION" <+> renderSQL fun <> ";"
209+
210+dropFunctionIfExists
211+ :: (Has sch schemas schema, KnownSymbol fun)
212+ => QualifiedAlias sch fun
213+ -- ^ name of the user defined function
214+ -> Definition schemas (Alter sch (DropSchemumIfExists fun 'Function schema) schemas)
215+dropFunctionIfExists fun = UnsafeDefinition $
216+ "DROP FUNCTION IF EXISTS" <+> renderSQL fun <> ";"
217+
218+dropOperator
219+ :: (Has sch schemas schema, KnownSymbol op)
220+ => QualifiedAlias sch op
221+ -- ^ name of the user defined operator
222+ -> Definition schemas (Alter sch (DropSchemum op 'Operator schema) schemas)
223+dropOperator op = UnsafeDefinition $
224+ "DROP" <+> "OPERATOR" <+> renderSQL op <> ";"
225+
226+dropOperatorIfExists
227+ :: (Has sch schemas schema, KnownSymbol op)
228+ => QualifiedAlias sch op
229+ -- ^ name of the user defined operator
230+ -> Definition schemas (Alter sch (DropSchemumIfExists op 'Operator schema) schemas)
231+dropOperatorIfExists op = UnsafeDefinition $
232+ "DROP OPERATOR IF EXISTS" <+> renderSQL op <> ";"
233+
234+newtype FunctionDefinition schemas args ret = UnsafeFunctionDefinition
235+ { renderFunctionDefinition :: ByteString }
236+ deriving (Eq,Show,GHC.Generic,NFData)
237+instance RenderSQL (FunctionDefinition schemas args ret) where
238+ renderSQL = renderFunctionDefinition
squeal-postgresql/src/Squeal/PostgreSQL/Definition/Index.hsnew file+159
@@ -0,0 +1,159 @@
1+{-|
2+Module: Squeal.PostgreSQL.Definition.Index
3+Description: Create and drop index definitions
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+Create and drop index definitions.
9+-}
10+
11+{-# LANGUAGE
12+ AllowAmbiguousTypes
13+ , ConstraintKinds
14+ , DeriveAnyClass
15+ , DeriveGeneric
16+ , DerivingStrategies
17+ , FlexibleContexts
18+ , FlexibleInstances
19+ , GADTs
20+ , LambdaCase
21+ , MultiParamTypeClasses
22+ , OverloadedLabels
23+ , OverloadedStrings
24+ , RankNTypes
25+ , ScopedTypeVariables
26+ , TypeApplications
27+ , TypeInType
28+ , TypeOperators
29+ , UndecidableSuperClasses
30+#-}
31+
32+module Squeal.PostgreSQL.Definition.Index
33+ ( createIndex
34+ , createIndexIfNotExists
35+ , dropIndex
36+ , dropIndexIfExists
37+ , IndexMethod (..)
38+ , btree
39+ , hash
40+ , gist
41+ , spgist
42+ , gin
43+ , brin
44+ ) where
45+
46+import Data.ByteString
47+import GHC.TypeLits
48+
49+import qualified GHC.Generics as GHC
50+
51+import Squeal.PostgreSQL.Alias
52+import Squeal.PostgreSQL.Definition
53+import Squeal.PostgreSQL.Expression.Sort
54+import Squeal.PostgreSQL.Render
55+import Squeal.PostgreSQL.Schema
56+
57+-- $setup
58+-- >>> import Squeal.PostgreSQL
59+
60+{- |
61+>>> :{
62+type Table = '[] :=>
63+ '[ "a" ::: 'NoDef :=> 'Null 'PGint4
64+ , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
65+:}
66+
67+>>> :{
68+let
69+ setup :: Definition (Public '[]) (Public '["tab" ::: 'Table Table, "ix" ::: 'Index 'Btree])
70+ setup =
71+ createTable #tab (nullable int `as` #a :* nullable real `as` #b) Nil >>>
72+ createIndex #ix #tab btree [#a & AscNullsFirst, #b & AscNullsLast]
73+in printSQL setup
74+:}
75+CREATE TABLE "tab" ("a" int NULL, "b" real NULL);
76+CREATE INDEX "ix" ON "tab" USING btree (("a") ASC NULLS FIRST, ("b") ASC NULLS LAST);
77+-}
78+createIndex
79+ :: (Has sch schemas schema, Has tab schema ('Table table), KnownSymbol ix)
80+ => Alias ix
81+ -> QualifiedAlias sch tab
82+ -> IndexMethod method
83+ -> [SortExpression '[] '[] 'Ungrouped schemas '[] '[tab ::: TableToRow table]]
84+ -> Definition schemas (Alter sch (Create ix ('Index method) schema) schemas)
85+createIndex ix tab method cols = UnsafeDefinition $
86+ "CREATE" <+> "INDEX" <+> renderSQL ix <+> "ON" <+> renderSQL tab
87+ <+> "USING" <+> renderSQL method
88+ <+> parenthesized (commaSeparated (renderIndex <$> cols))
89+ <> ";"
90+ where
91+ renderIndex = \case
92+ Asc expression -> parenthesized (renderSQL expression) <+> "ASC"
93+ Desc expression -> parenthesized (renderSQL expression) <+> "DESC"
94+ AscNullsFirst expression -> parenthesized (renderSQL expression)
95+ <+> "ASC NULLS FIRST"
96+ DescNullsFirst expression -> parenthesized (renderSQL expression)
97+ <+> "DESC NULLS FIRST"
98+ AscNullsLast expression -> parenthesized (renderSQL expression)
99+ <+> "ASC NULLS LAST"
100+ DescNullsLast expression -> parenthesized (renderSQL expression)
101+ <+> "DESC NULLS LAST"
102+
103+createIndexIfNotExists
104+ :: (Has sch schemas schema, Has tab schema ('Table table), KnownSymbol ix)
105+ => Alias ix
106+ -> QualifiedAlias sch tab
107+ -> IndexMethod method
108+ -> [SortExpression '[] '[] 'Ungrouped schemas '[] '[tab ::: TableToRow table]]
109+ -> Definition schemas (Alter sch (CreateIfNotExists ix ('Index method) schema) schemas)
110+createIndexIfNotExists ix tab method cols = UnsafeDefinition $
111+ "CREATE INDEX IF NOT EXISTS" <+> renderSQL ix <+> "ON" <+> renderSQL tab
112+ <+> "USING" <+> renderSQL method
113+ <+> parenthesized (commaSeparated (renderIndex <$> cols))
114+ <> ";"
115+ where
116+ renderIndex = \case
117+ Asc expression -> parenthesized (renderSQL expression) <+> "ASC"
118+ Desc expression -> parenthesized (renderSQL expression) <+> "DESC"
119+ AscNullsFirst expression -> parenthesized (renderSQL expression)
120+ <+> "ASC NULLS FIRST"
121+ DescNullsFirst expression -> parenthesized (renderSQL expression)
122+ <+> "DESC NULLS FIRST"
123+ AscNullsLast expression -> parenthesized (renderSQL expression)
124+ <+> "ASC NULLS LAST"
125+ DescNullsLast expression -> parenthesized (renderSQL expression)
126+ <+> "DESC NULLS LAST"
127+
128+newtype IndexMethod ty = UnsafeIndexMethod {renderIndexMethod :: ByteString}
129+ deriving stock (Eq, Ord, Show, GHC.Generic)
130+instance RenderSQL (IndexMethod ty) where renderSQL = renderIndexMethod
131+btree :: IndexMethod 'Btree
132+btree = UnsafeIndexMethod "btree"
133+hash :: IndexMethod 'Hash
134+hash = UnsafeIndexMethod "hash"
135+gist :: IndexMethod 'Gist
136+gist = UnsafeIndexMethod "gist"
137+spgist :: IndexMethod 'Spgist
138+spgist = UnsafeIndexMethod "spgist"
139+gin :: IndexMethod 'Gin
140+gin = UnsafeIndexMethod "gin"
141+brin :: IndexMethod 'Brin
142+brin = UnsafeIndexMethod "brin"
143+
144+-- |
145+-- >>> printSQL (dropIndex #ix :: Definition (Public '["ix" ::: 'Index 'Btree]) (Public '[]))
146+-- DROP INDEX "ix";
147+dropIndex
148+ :: (Has sch schemas schema, KnownSymbol ix)
149+ => QualifiedAlias sch ix
150+ -- ^ name of the user defined index
151+ -> Definition schemas (Alter sch (DropSchemum ix 'Index schema) schemas)
152+dropIndex ix = UnsafeDefinition $ "DROP" <+> "INDEX" <+> renderSQL ix <> ";"
153+
154+dropIndexIfExists
155+ :: (Has sch schemas schema, KnownSymbol ix)
156+ => QualifiedAlias sch ix
157+ -- ^ name of the user defined index
158+ -> Definition schemas (Alter sch (DropSchemumIfExists ix 'Index schema) schemas)
159+dropIndexIfExists ix = UnsafeDefinition $ "DROP INDEX IF EXISTS" <+> renderSQL ix <> ";"
squeal-postgresql/src/Squeal/PostgreSQL/Definition/Schema.hsnew file+96
@@ -0,0 +1,96 @@
1+{-|
2+Module: Squeal.PostgreSQL.Definition.Schema
3+Description: Create and drop schema definitions
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+Create and drop schema definitions.
9+-}
10+
11+{-# LANGUAGE
12+ AllowAmbiguousTypes
13+ , ConstraintKinds
14+ , DeriveAnyClass
15+ , DeriveGeneric
16+ , DerivingStrategies
17+ , FlexibleContexts
18+ , FlexibleInstances
19+ , GADTs
20+ , LambdaCase
21+ , MultiParamTypeClasses
22+ , OverloadedLabels
23+ , OverloadedStrings
24+ , RankNTypes
25+ , ScopedTypeVariables
26+ , TypeApplications
27+ , TypeInType
28+ , TypeOperators
29+ , UndecidableSuperClasses
30+#-}
31+
32+module Squeal.PostgreSQL.Definition.Schema
33+ ( createSchema
34+ , createSchemaIfNotExists
35+ , dropSchema
36+ , dropSchemaIfExists
37+ ) where
38+
39+import GHC.TypeLits
40+
41+import Squeal.PostgreSQL.Alias
42+import Squeal.PostgreSQL.Definition
43+import Squeal.PostgreSQL.Render
44+import Squeal.PostgreSQL.Schema
45+
46+-- $setup
47+-- >>> import Squeal.PostgreSQL
48+
49+{- |
50+`createSchema` enters a new schema into the current database.
51+The schema name must be distinct from the name of any existing schema
52+in the current database.
53+
54+A schema is essentially a namespace: it contains named objects
55+(tables, data types, functions, and operators) whose names
56+can duplicate those of other objects existing in other schemas.
57+Named objects are accessed by `QualifiedAlias`es with the schema
58+name as a prefix.
59+-}
60+createSchema
61+ :: KnownSymbol sch
62+ => Alias sch
63+ -> Definition schemas (Create sch '[] schemas)
64+createSchema sch = UnsafeDefinition $
65+ "CREATE" <+> "SCHEMA" <+> renderSQL sch <> ";"
66+
67+{- | Idempotent version of `createSchema`. -}
68+createSchemaIfNotExists
69+ :: (KnownSymbol sch, Has sch schemas schema)
70+ => Alias sch
71+ -> Definition schemas (CreateIfNotExists sch '[] schemas)
72+createSchemaIfNotExists sch = UnsafeDefinition $
73+ "CREATE" <+> "SCHEMA" <+> "IF" <+> "NOT" <+> "EXISTS"
74+ <+> renderSQL sch <> ";"
75+
76+-- | >>> :{
77+-- let
78+-- definition :: Definition '["muh_schema" ::: schema, "public" ::: public] '["public" ::: public]
79+-- definition = dropSchema #muh_schema
80+-- :}
81+--
82+-- >>> printSQL definition
83+-- DROP SCHEMA "muh_schema";
84+dropSchema
85+ :: KnownSymbol sch
86+ => Alias sch
87+ -- ^ user defined schema
88+ -> Definition schemas (Drop sch schemas)
89+dropSchema sch = UnsafeDefinition $ "DROP SCHEMA" <+> renderSQL sch <> ";"
90+
91+dropSchemaIfExists
92+ :: KnownSymbol sch
93+ => Alias sch
94+ -- ^ user defined schema
95+ -> Definition schemas (DropIfExists sch schemas)
96+dropSchemaIfExists sch = UnsafeDefinition $ "DROP SCHEMA" <+> renderSQL sch <> ";"
squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table.hsnew file+477
@@ -0,0 +1,477 @@
1+{-|
2+Module: Squeal.PostgreSQL.Definition.Table
3+Description: Create, drop and alter table definitions
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+Create, drop and alter table definitions.
9+-}
10+
11+{-# LANGUAGE
12+ AllowAmbiguousTypes
13+ , ConstraintKinds
14+ , DeriveAnyClass
15+ , DeriveGeneric
16+ , DerivingStrategies
17+ , FlexibleContexts
18+ , FlexibleInstances
19+ , GADTs
20+ , LambdaCase
21+ , MultiParamTypeClasses
22+ , OverloadedLabels
23+ , OverloadedStrings
24+ , RankNTypes
25+ , ScopedTypeVariables
26+ , TypeApplications
27+ , TypeInType
28+ , TypeOperators
29+ , UndecidableSuperClasses
30+#-}
31+
32+module Squeal.PostgreSQL.Definition.Table
33+ ( createTable
34+ , createTableIfNotExists
35+ , dropTable
36+ , dropTableIfExists
37+ , alterTable
38+ , alterTableRename
39+ , AlterTable (..)
40+ , addConstraint
41+ , dropConstraint
42+ , AddColumn (..)
43+ , dropColumn
44+ , renameColumn
45+ , alterColumn
46+ , AlterColumn (..)
47+ , setDefault
48+ , dropDefault
49+ , setNotNull
50+ , dropNotNull
51+ , alterType
52+ ) where
53+
54+import Control.DeepSeq
55+import Data.ByteString
56+import GHC.TypeLits
57+
58+import qualified Generics.SOP as SOP
59+import qualified GHC.Generics as GHC
60+
61+import Squeal.PostgreSQL.Alias
62+import Squeal.PostgreSQL.Definition
63+import Squeal.PostgreSQL.Definition.Table.Column
64+import Squeal.PostgreSQL.Definition.Table.Constraint
65+import Squeal.PostgreSQL.Expression
66+import Squeal.PostgreSQL.List
67+import Squeal.PostgreSQL.Render
68+import Squeal.PostgreSQL.Schema
69+
70+-- $setup
71+-- >>> import Squeal.PostgreSQL
72+
73+{- | `createTable` adds a table to the schema.
74+
75+>>> :set -XOverloadedLabels
76+>>> :{
77+type Table = '[] :=>
78+ '[ "a" ::: 'NoDef :=> 'Null 'PGint4
79+ , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
80+:}
81+
82+>>> :{
83+let
84+ setup :: Definition (Public '[]) (Public '["tab" ::: 'Table Table])
85+ setup = createTable #tab
86+ (nullable int `as` #a :* nullable real `as` #b) Nil
87+in printSQL setup
88+:}
89+CREATE TABLE "tab" ("a" int NULL, "b" real NULL);
90+-}
91+createTable
92+ :: ( KnownSymbol sch
93+ , KnownSymbol tab
94+ , columns ~ (col ': cols)
95+ , SOP.SListI columns
96+ , SOP.SListI constraints
97+ , Has sch schemas0 schema0
98+ , schemas1 ~ Alter sch (Create tab ('Table (constraints :=> columns)) schema0) schemas0 )
99+ => QualifiedAlias sch tab -- ^ the name of the table to add
100+ -> NP (Aliased (ColumnTypeExpression schemas0)) columns
101+ -- ^ the names and datatype of each column
102+ -> NP (Aliased (TableConstraintExpression sch tab schemas1)) constraints
103+ -- ^ constraints that must hold for the table
104+ -> Definition schemas0 schemas1
105+createTable tab columns constraints = UnsafeDefinition $
106+ "CREATE TABLE" <+> renderCreation tab columns constraints
107+
108+{-| `createTableIfNotExists` creates a table if it doesn't exist, but does not add it to the schema.
109+Instead, the schema already has the table so if the table did not yet exist, the schema was wrong.
110+`createTableIfNotExists` fixes this. Interestingly, this property makes it an idempotent in
111+the `Category` of `Definition`s.
112+
113+>>> :set -XOverloadedLabels -XTypeApplications
114+>>> :{
115+type Table = '[] :=>
116+ '[ "a" ::: 'NoDef :=> 'Null 'PGint4
117+ , "b" ::: 'NoDef :=> 'Null 'PGfloat4 ]
118+:}
119+
120+>>> type Schemas = Public '["tab" ::: 'Table Table]
121+
122+>>> :{
123+let
124+ setup :: Definition Schemas Schemas
125+ setup = createTableIfNotExists #tab
126+ (nullable int `as` #a :* nullable real `as` #b) Nil
127+in printSQL setup
128+:}
129+CREATE TABLE IF NOT EXISTS "tab" ("a" int NULL, "b" real NULL);
130+-}
131+createTableIfNotExists
132+ :: ( KnownSymbol sch
133+ , KnownSymbol tab
134+ , columns ~ (col ': cols)
135+ , SOP.SListI columns
136+ , SOP.SListI constraints
137+ , Has sch schemas0 schema0
138+ , schemas1 ~ Alter sch (CreateIfNotExists tab ('Table (constraints :=> columns)) schema0) schemas0 )
139+ => QualifiedAlias sch tab -- ^ the name of the table to add
140+ -> NP (Aliased (ColumnTypeExpression schemas0)) columns
141+ -- ^ the names and datatype of each column
142+ -> NP (Aliased (TableConstraintExpression sch tab schemas1)) constraints
143+ -- ^ constraints that must hold for the table
144+ -> Definition schemas0 schemas1
145+createTableIfNotExists tab columns constraints = UnsafeDefinition $
146+ "CREATE TABLE IF NOT EXISTS"
147+ <+> renderCreation tab columns constraints
148+
149+-- helper function for `createTable` and `createTableIfNotExists`
150+renderCreation
151+ :: ( KnownSymbol sch
152+ , KnownSymbol tab
153+ , SOP.SListI columns
154+ , SOP.SListI constraints )
155+ => QualifiedAlias sch tab -- ^ the name of the table to add
156+ -> NP (Aliased (ColumnTypeExpression schemas0)) columns
157+ -- ^ the names and datatype of each column
158+ -> NP (Aliased (TableConstraintExpression sch tab schemas1)) constraints
159+ -- ^ constraints that must hold for the table
160+ -> ByteString
161+renderCreation tab columns constraints = renderSQL tab
162+ <+> parenthesized
163+ ( renderCommaSeparated renderColumnDef columns
164+ <> ( case constraints of
165+ Nil -> ""
166+ _ -> ", " <>
167+ renderCommaSeparated renderConstraint constraints ) )
168+ <> ";"
169+ where
170+ renderColumnDef :: Aliased (ColumnTypeExpression schemas) x -> ByteString
171+ renderColumnDef (ty `As` column) =
172+ renderSQL column <+> renderColumnTypeExpression ty
173+ renderConstraint
174+ :: Aliased (TableConstraintExpression sch tab schemas) constraint
175+ -> ByteString
176+ renderConstraint (constraint `As` alias) =
177+ "CONSTRAINT" <+> renderSQL alias <+> renderSQL constraint
178+
179+-- | `dropTable` removes a table from the schema.
180+--
181+-- >>> :{
182+-- let
183+-- definition :: Definition '["public" ::: '["muh_table" ::: 'Table t]] (Public '[])
184+-- definition = dropTable #muh_table
185+-- :}
186+--
187+-- >>> printSQL definition
188+-- DROP TABLE "muh_table";
189+dropTable
190+ :: ( Has sch schemas schema
191+ , KnownSymbol tab )
192+ => QualifiedAlias sch tab -- ^ table to remove
193+ -> Definition schemas (Alter sch (DropSchemum tab 'Table schema) schemas)
194+dropTable tab = UnsafeDefinition $ "DROP TABLE" <+> renderSQL tab <> ";"
195+
196+dropTableIfExists
197+ :: ( Has sch schemas schema
198+ , Has tab schema ('Table table))
199+ => QualifiedAlias sch tab -- ^ table to remove
200+ -> Definition schemas (Alter sch (DropIfExists tab schema) schemas)
201+dropTableIfExists tab = UnsafeDefinition $ "DROP TABLE IF EXISTS" <+> renderSQL tab <> ";"
202+
203+-- | `alterTable` changes the definition of a table from the schema.
204+alterTable
205+ :: (Has sch schemas schema, Has tab schema ('Table table0))
206+ => QualifiedAlias sch tab -- ^ table to alter
207+ -> AlterTable sch tab schemas table1 -- ^ alteration to perform
208+ -> Definition schemas (Alter sch (Alter tab ('Table table1) schema) schemas)
209+alterTable tab alteration = UnsafeDefinition $
210+ "ALTER TABLE"
211+ <+> renderSQL tab
212+ <+> renderAlterTable alteration
213+ <> ";"
214+
215+-- | `alterTableRename` changes the name of a table from the schema.
216+--
217+-- >>> printSQL $ alterTableRename #foo #bar
218+-- ALTER TABLE "foo" RENAME TO "bar";
219+alterTableRename
220+ :: (KnownSymbol table0, KnownSymbol table1)
221+ => Alias table0 -- ^ table to rename
222+ -> Alias table1 -- ^ what to rename it
223+ -> Definition schema (Rename table0 table1 schema)
224+alterTableRename table0 table1 = UnsafeDefinition $
225+ "ALTER TABLE" <+> renderSQL table0
226+ <+> "RENAME TO" <+> renderSQL table1 <> ";"
227+
228+-- | An `AlterTable` describes the alteration to perform on the columns
229+-- of a table.
230+newtype AlterTable
231+ (sch :: Symbol)
232+ (tab :: Symbol)
233+ (schemas :: SchemasType)
234+ (table :: TableType) =
235+ UnsafeAlterTable {renderAlterTable :: ByteString}
236+ deriving (GHC.Generic,Show,Eq,Ord,NFData)
237+
238+-- | An `addConstraint` adds a table constraint.
239+--
240+-- >>> :{
241+-- let
242+-- definition :: Definition
243+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
244+-- '["public" ::: '["tab" ::: 'Table ('["positive" ::: 'Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
245+-- definition = alterTable #tab (addConstraint #positive (check #col (#col .> 0)))
246+-- in printSQL definition
247+-- :}
248+-- ALTER TABLE "tab" ADD CONSTRAINT "positive" CHECK (("col" > 0));
249+addConstraint
250+ :: ( KnownSymbol alias
251+ , Has sch schemas schema
252+ , Has tab schema ('Table table0)
253+ , table0 ~ (constraints :=> columns)
254+ , table1 ~ (Create alias constraint constraints :=> columns) )
255+ => Alias alias
256+ -> TableConstraintExpression sch tab schemas constraint
257+ -- ^ constraint to add
258+ -> AlterTable sch tab schemas table1
259+addConstraint alias constraint = UnsafeAlterTable $
260+ "ADD" <+> "CONSTRAINT" <+> renderSQL alias
261+ <+> renderSQL constraint
262+
263+-- | A `dropConstraint` drops a table constraint.
264+--
265+-- >>> :{
266+-- let
267+-- definition :: Definition
268+-- '["public" ::: '["tab" ::: 'Table ('["positive" ::: Check '["col"]] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
269+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
270+-- definition = alterTable #tab (dropConstraint #positive)
271+-- in printSQL definition
272+-- :}
273+-- ALTER TABLE "tab" DROP CONSTRAINT "positive";
274+dropConstraint
275+ :: ( KnownSymbol constraint
276+ , Has sch schemas schema
277+ , Has tab schema ('Table table0)
278+ , table0 ~ (constraints :=> columns)
279+ , table1 ~ (Drop constraint constraints :=> columns) )
280+ => Alias constraint
281+ -- ^ constraint to drop
282+ -> AlterTable sch tab schemas table1
283+dropConstraint constraint = UnsafeAlterTable $
284+ "DROP" <+> "CONSTRAINT" <+> renderSQL constraint
285+
286+-- | An `AddColumn` is either @NULL@ or has @DEFAULT@.
287+class AddColumn ty where
288+ -- | `addColumn` adds a new column, initially filled with whatever
289+ -- default value is given or with @NULL@.
290+ --
291+ -- >>> :{
292+ -- let
293+ -- definition :: Definition
294+ -- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
295+ -- '["public" ::: '["tab" ::: 'Table ('[] :=>
296+ -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
297+ -- , "col2" ::: 'Def :=> 'Null 'PGtext ])]]
298+ -- definition = alterTable #tab (addColumn #col2 (text & nullable & default_ "foo"))
299+ -- in printSQL definition
300+ -- :}
301+ -- ALTER TABLE "tab" ADD COLUMN "col2" text NULL DEFAULT E'foo';
302+ --
303+ -- >>> :{
304+ -- let
305+ -- definition :: Definition
306+ -- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
307+ -- '["public" ::: '["tab" ::: 'Table ('[] :=>
308+ -- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
309+ -- , "col2" ::: 'NoDef :=> 'Null 'PGtext ])]]
310+ -- definition = alterTable #tab (addColumn #col2 (text & nullable))
311+ -- in printSQL definition
312+ -- :}
313+ -- ALTER TABLE "tab" ADD COLUMN "col2" text NULL;
314+ addColumn
315+ :: ( KnownSymbol column
316+ , Has sch schemas schema
317+ , Has tab schema ('Table table0)
318+ , table0 ~ (constraints :=> columns) )
319+ => Alias column -- ^ column to add
320+ -> ColumnTypeExpression schemas ty -- ^ type of the new column
321+ -> AlterTable sch tab schemas (constraints :=> Create column ty columns)
322+ addColumn column ty = UnsafeAlterTable $
323+ "ADD COLUMN" <+> renderSQL column <+> renderColumnTypeExpression ty
324+instance {-# OVERLAPPING #-} AddColumn ('Def :=> ty)
325+instance {-# OVERLAPPABLE #-} AddColumn ('NoDef :=> 'Null ty)
326+
327+-- | A `dropColumn` removes a column. Whatever data was in the column
328+-- disappears. Table constraints involving the column are dropped, too.
329+-- However, if the column is referenced by a foreign key constraint of
330+-- another table, PostgreSQL will not silently drop that constraint.
331+--
332+-- >>> :{
333+-- let
334+-- definition :: Definition
335+-- '["public" ::: '["tab" ::: 'Table ('[] :=>
336+-- '[ "col1" ::: 'NoDef :=> 'Null 'PGint4
337+-- , "col2" ::: 'NoDef :=> 'Null 'PGtext ])]]
338+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col1" ::: 'NoDef :=> 'Null 'PGint4])]]
339+-- definition = alterTable #tab (dropColumn #col2)
340+-- in printSQL definition
341+-- :}
342+-- ALTER TABLE "tab" DROP COLUMN "col2";
343+dropColumn
344+ :: ( KnownSymbol column
345+ , Has sch schemas schema
346+ , Has tab schema ('Table table0)
347+ , table0 ~ (constraints :=> columns)
348+ , table1 ~ (constraints :=> Drop column columns) )
349+ => Alias column -- ^ column to remove
350+ -> AlterTable sch tab schemas table1
351+dropColumn column = UnsafeAlterTable $
352+ "DROP COLUMN" <+> renderSQL column
353+
354+-- | A `renameColumn` renames a column.
355+--
356+-- >>> :{
357+-- let
358+-- definition :: Definition
359+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["foo" ::: 'NoDef :=> 'Null 'PGint4])]]
360+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["bar" ::: 'NoDef :=> 'Null 'PGint4])]]
361+-- definition = alterTable #tab (renameColumn #foo #bar)
362+-- in printSQL definition
363+-- :}
364+-- ALTER TABLE "tab" RENAME COLUMN "foo" TO "bar";
365+renameColumn
366+ :: ( KnownSymbol column0
367+ , KnownSymbol column1
368+ , Has sch schemas schema
369+ , Has tab schema ('Table table0)
370+ , table0 ~ (constraints :=> columns)
371+ , table1 ~ (constraints :=> Rename column0 column1 columns) )
372+ => Alias column0 -- ^ column to rename
373+ -> Alias column1 -- ^ what to rename the column
374+ -> AlterTable sch tab schemas table1
375+renameColumn column0 column1 = UnsafeAlterTable $
376+ "RENAME COLUMN" <+> renderSQL column0 <+> "TO" <+> renderSQL column1
377+
378+-- | An `alterColumn` alters a single column.
379+alterColumn
380+ :: ( KnownSymbol column
381+ , Has sch schemas schema
382+ , Has tab schema ('Table table0)
383+ , table0 ~ (constraints :=> columns)
384+ , Has column columns ty0
385+ , table1 ~ (constraints :=> Alter column ty1 columns))
386+ => Alias column -- ^ column to alter
387+ -> AlterColumn schemas ty0 ty1 -- ^ alteration to perform
388+ -> AlterTable sch tab schemas table1
389+alterColumn column alteration = UnsafeAlterTable $
390+ "ALTER COLUMN" <+> renderSQL column <+> renderAlterColumn alteration
391+
392+-- | An `AlterColumn` describes the alteration to perform on a single column.
393+newtype AlterColumn (schemas :: SchemasType) (ty0 :: ColumnType) (ty1 :: ColumnType) =
394+ UnsafeAlterColumn {renderAlterColumn :: ByteString}
395+ deriving (GHC.Generic,Show,Eq,Ord,NFData)
396+
397+-- | A `setDefault` sets a new default for a column. Note that this doesn't
398+-- affect any existing rows in the table, it just changes the default for
399+-- future insert and update commands.
400+--
401+-- >>> :{
402+-- let
403+-- definition :: Definition
404+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
405+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'Def :=> 'Null 'PGint4])]]
406+-- definition = alterTable #tab (alterColumn #col (setDefault 5))
407+-- in printSQL definition
408+-- :}
409+-- ALTER TABLE "tab" ALTER COLUMN "col" SET DEFAULT 5;
410+setDefault
411+ :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty -- ^ default value to set
412+ -> AlterColumn schemas (constraint :=> ty) ('Def :=> ty)
413+setDefault expression = UnsafeAlterColumn $
414+ "SET DEFAULT" <+> renderExpression expression
415+
416+-- | A `dropDefault` removes any default value for a column.
417+--
418+-- >>> :{
419+-- let
420+-- definition :: Definition
421+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'Def :=> 'Null 'PGint4])]]
422+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
423+-- definition = alterTable #tab (alterColumn #col dropDefault)
424+-- in printSQL definition
425+-- :}
426+-- ALTER TABLE "tab" ALTER COLUMN "col" DROP DEFAULT;
427+dropDefault :: AlterColumn schemas ('Def :=> ty) ('NoDef :=> ty)
428+dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"
429+
430+-- | A `setNotNull` adds a @NOT NULL@ constraint to a column.
431+-- The constraint will be checked immediately, so the table data must satisfy
432+-- the constraint before it can be added.
433+--
434+-- >>> :{
435+-- let
436+-- definition :: Definition
437+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
438+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
439+-- definition = alterTable #tab (alterColumn #col setNotNull)
440+-- in printSQL definition
441+-- :}
442+-- ALTER TABLE "tab" ALTER COLUMN "col" SET NOT NULL;
443+setNotNull
444+ :: AlterColumn schemas (constraint :=> 'Null ty) (constraint :=> 'NotNull ty)
445+setNotNull = UnsafeAlterColumn $ "SET NOT NULL"
446+
447+-- | A `dropNotNull` drops a @NOT NULL@ constraint from a column.
448+--
449+-- >>> :{
450+-- let
451+-- definition :: Definition
452+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
453+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4])]]
454+-- definition = alterTable #tab (alterColumn #col dropNotNull)
455+-- in printSQL definition
456+-- :}
457+-- ALTER TABLE "tab" ALTER COLUMN "col" DROP NOT NULL;
458+dropNotNull
459+ :: AlterColumn schemas (constraint :=> 'NotNull ty) (constraint :=> 'Null ty)
460+dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"
461+
462+-- | An `alterType` converts a column to a different data type.
463+-- This will succeed only if each existing entry in the column can be
464+-- converted to the new type by an implicit cast.
465+--
466+-- >>> :{
467+-- let
468+-- definition :: Definition
469+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint4])]]
470+-- '["public" ::: '["tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGnumeric])]]
471+-- definition =
472+-- alterTable #tab (alterColumn #col (alterType (numeric & notNullable)))
473+-- in printSQL definition
474+-- :}
475+-- ALTER TABLE "tab" ALTER COLUMN "col" TYPE numeric NOT NULL;
476+alterType :: ColumnTypeExpression schemas ty -> AlterColumn schemas ty0 ty
477+alterType ty = UnsafeAlterColumn $ "TYPE" <+> renderColumnTypeExpression ty
squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table/Column.hsnew file+105
@@ -0,0 +1,105 @@
1+{-|
2+Module: Squeal.PostgreSQL.Definition.Table.Column
3+Description: Column type expressions
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+Column type expressions.
9+-}
10+
11+{-# LANGUAGE
12+ AllowAmbiguousTypes
13+ , ConstraintKinds
14+ , DeriveAnyClass
15+ , DeriveGeneric
16+ , DerivingStrategies
17+ , FlexibleContexts
18+ , FlexibleInstances
19+ , GADTs
20+ , LambdaCase
21+ , MultiParamTypeClasses
22+ , OverloadedLabels
23+ , OverloadedStrings
24+ , RankNTypes
25+ , ScopedTypeVariables
26+ , TypeApplications
27+ , TypeInType
28+ , TypeOperators
29+ , UndecidableSuperClasses
30+#-}
31+
32+module Squeal.PostgreSQL.Definition.Table.Column
33+ ( ColumnTypeExpression (..)
34+ , nullable
35+ , notNullable
36+ , default_
37+ , serial2
38+ , smallserial
39+ , serial4
40+ , serial
41+ , serial8
42+ , bigserial
43+ ) where
44+
45+import Control.DeepSeq
46+import Data.ByteString
47+
48+import qualified GHC.Generics as GHC
49+
50+import Squeal.PostgreSQL.Alias
51+import Squeal.PostgreSQL.Expression
52+import Squeal.PostgreSQL.Expression.Type
53+import Squeal.PostgreSQL.Render
54+import Squeal.PostgreSQL.Schema
55+
56+-- $setup
57+-- >>> import Squeal.PostgreSQL
58+
59+-- | `ColumnTypeExpression`s are used in `createTable` commands.
60+newtype ColumnTypeExpression (schemas :: SchemasType) (ty :: ColumnType)
61+ = UnsafeColumnTypeExpression { renderColumnTypeExpression :: ByteString }
62+ deriving (GHC.Generic,Show,Eq,Ord,NFData)
63+instance RenderSQL (ColumnTypeExpression schemas ty) where
64+ renderSQL = renderColumnTypeExpression
65+
66+-- | used in `createTable` commands as a column constraint to note that
67+-- @NULL@ may be present in a column
68+nullable
69+ :: TypeExpression schemas (nullity ty)
70+ -> ColumnTypeExpression schemas ('NoDef :=> 'Null ty)
71+nullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NULL"
72+
73+-- | used in `createTable` commands as a column constraint to ensure
74+-- @NULL@ is not present in a column
75+notNullable
76+ :: TypeExpression schemas (nullity ty)
77+ -> ColumnTypeExpression schemas ('NoDef :=> 'NotNull ty)
78+notNullable ty = UnsafeColumnTypeExpression $ renderSQL ty <+> "NOT NULL"
79+
80+-- | used in `createTable` commands as a column constraint to give a default
81+default_
82+ :: Expression '[] '[] 'Ungrouped schemas '[] '[] ty
83+ -> ColumnTypeExpression schemas ('NoDef :=> ty)
84+ -> ColumnTypeExpression schemas ('Def :=> ty)
85+default_ x ty = UnsafeColumnTypeExpression $
86+ renderSQL ty <+> "DEFAULT" <+> renderExpression x
87+
88+-- | not a true type, but merely a notational convenience for creating
89+-- unique identifier columns with type `PGint2`
90+serial2, smallserial
91+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint2)
92+serial2 = UnsafeColumnTypeExpression "serial2"
93+smallserial = UnsafeColumnTypeExpression "smallserial"
94+-- | not a true type, but merely a notational convenience for creating
95+-- unique identifier columns with type `PGint4`
96+serial4, serial
97+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint4)
98+serial4 = UnsafeColumnTypeExpression "serial4"
99+serial = UnsafeColumnTypeExpression "serial"
100+-- | not a true type, but merely a notational convenience for creating
101+-- unique identifier columns with type `PGint8`
102+serial8, bigserial
103+ :: ColumnTypeExpression schemas ('Def :=> 'NotNull 'PGint8)
104+serial8 = UnsafeColumnTypeExpression "serial8"
105+bigserial = UnsafeColumnTypeExpression "bigserial"
squeal-postgresql/src/Squeal/PostgreSQL/Definition/Table/Constraint.hsnew file+339
@@ -0,0 +1,339 @@
1+{-|
2+Module: Squeal.PostgreSQL.Definition.Table.Constraint
3+Description: Table constraint expressions
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+Table constraint expressions.
9+-}
10+
11+{-# LANGUAGE
12+ AllowAmbiguousTypes
13+ , ConstraintKinds
14+ , DeriveAnyClass
15+ , DeriveGeneric
16+ , DerivingStrategies
17+ , FlexibleContexts
18+ , FlexibleInstances
19+ , GADTs
20+ , LambdaCase
21+ , MultiParamTypeClasses
22+ , OverloadedLabels
23+ , OverloadedStrings
24+ , RankNTypes
25+ , ScopedTypeVariables
26+ , TypeApplications
27+ , TypeInType
28+ , TypeOperators
29+ , UndecidableSuperClasses
30+#-}
31+
32+module Squeal.PostgreSQL.Definition.Table.Constraint
33+ ( TableConstraintExpression (..)
34+ , check
35+ , unique
36+ , primaryKey
37+ , foreignKey
38+ , ForeignKeyed
39+ , OnDeleteClause (..)
40+ , OnUpdateClause (..)
41+ ) where
42+
43+import Control.DeepSeq
44+import Data.ByteString
45+import GHC.TypeLits
46+
47+import qualified Generics.SOP as SOP
48+import qualified GHC.Generics as GHC
49+
50+import Squeal.PostgreSQL.Alias
51+import Squeal.PostgreSQL.Expression.Logic
52+import Squeal.PostgreSQL.List
53+import Squeal.PostgreSQL.Render
54+import Squeal.PostgreSQL.Schema
55+
56+-- $setup
57+-- >>> import Squeal.PostgreSQL
58+
59+-- | Data types are a way to limit the kind of data that can be stored in a
60+-- table. For many applications, however, the constraint they provide is
61+-- too coarse. For example, a column containing a product price should
62+-- probably only accept positive values. But there is no standard data type
63+-- that accepts only positive numbers. Another issue is that you might want
64+-- to constrain column data with respect to other columns or rows.
65+-- For example, in a table containing product information,
66+-- there should be only one row for each product number.
67+-- `TableConstraint`s give you as much control over the data in your tables
68+-- as you wish. If a user attempts to store data in a column that would
69+-- violate a constraint, an error is raised. This applies
70+-- even if the value came from the default value definition.
71+newtype TableConstraintExpression
72+ (sch :: Symbol)
73+ (tab :: Symbol)
74+ (schemas :: SchemasType)
75+ (constraint :: TableConstraint)
76+ = UnsafeTableConstraintExpression
77+ { renderTableConstraintExpression :: ByteString }
78+ deriving (GHC.Generic,Show,Eq,Ord,NFData)
79+instance RenderSQL
80+ (TableConstraintExpression sch tab schemas constraint) where
81+ renderSQL = renderTableConstraintExpression
82+
83+{-| A `check` constraint is the most generic `TableConstraint` type.
84+It allows you to specify that the value in a certain column must satisfy
85+a Boolean (truth-value) expression.
86+
87+>>> :{
88+type Schema = '[
89+ "tab" ::: 'Table ('[ "inequality" ::: 'Check '["a","b"]] :=> '[
90+ "a" ::: 'NoDef :=> 'NotNull 'PGint4,
91+ "b" ::: 'NoDef :=> 'NotNull 'PGint4
92+ ])]
93+:}
94+
95+>>> :{
96+let
97+ definition :: Definition (Public '[]) (Public Schema)
98+ definition = createTable #tab
99+ ( (int & notNullable) `as` #a :*
100+ (int & notNullable) `as` #b )
101+ ( check (#a :* #b) (#a .> #b) `as` #inequality )
102+:}
103+
104+>>> printSQL definition
105+CREATE TABLE "tab" ("a" int NOT NULL, "b" int NOT NULL, CONSTRAINT "inequality" CHECK (("a" > "b")));
106+-}
107+check
108+ :: ( Has sch schemas schema
109+ , Has tab schema ('Table table)
110+ , HasAll aliases (TableToRow table) subcolumns )
111+ => NP Alias aliases
112+ -- ^ specify the subcolumns which are getting checked
113+ -> (forall t. Condition '[] '[] 'Ungrouped schemas '[] '[t ::: subcolumns])
114+ -- ^ a closed `Condition` on those subcolumns
115+ -> TableConstraintExpression sch tab schemas ('Check aliases)
116+check _cols condition = UnsafeTableConstraintExpression $
117+ "CHECK" <+> parenthesized (renderSQL condition)
118+
119+{-| A `unique` constraint ensure that the data contained in a column,
120+or a group of columns, is unique among all the rows in the table.
121+
122+>>> :{
123+type Schema = '[
124+ "tab" ::: 'Table( '[ "uq_a_b" ::: 'Unique '["a","b"]] :=> '[
125+ "a" ::: 'NoDef :=> 'Null 'PGint4,
126+ "b" ::: 'NoDef :=> 'Null 'PGint4
127+ ])]
128+:}
129+
130+>>> :{
131+let
132+ definition :: Definition (Public '[]) (Public Schema)
133+ definition = createTable #tab
134+ ( (int & nullable) `as` #a :*
135+ (int & nullable) `as` #b )
136+ ( unique (#a :* #b) `as` #uq_a_b )
137+:}
138+
139+>>> printSQL definition
140+CREATE TABLE "tab" ("a" int NULL, "b" int NULL, CONSTRAINT "uq_a_b" UNIQUE ("a", "b"));
141+-}
142+unique
143+ :: ( Has sch schemas schema
144+ , Has tab schema('Table table)
145+ , HasAll aliases (TableToRow table) subcolumns )
146+ => NP Alias aliases
147+ -- ^ specify subcolumns which together are unique for each row
148+ -> TableConstraintExpression sch tab schemas ('Unique aliases)
149+unique columns = UnsafeTableConstraintExpression $
150+ "UNIQUE" <+> parenthesized (renderSQL columns)
151+
152+{-| A `primaryKey` constraint indicates that a column, or group of columns,
153+can be used as a unique identifier for rows in the table.
154+This requires that the values be both unique and not null.
155+
156+>>> :{
157+type Schema = '[
158+ "tab" ::: 'Table ('[ "pk_id" ::: 'PrimaryKey '["id"]] :=> '[
159+ "id" ::: 'Def :=> 'NotNull 'PGint4,
160+ "name" ::: 'NoDef :=> 'NotNull 'PGtext
161+ ])]
162+:}
163+
164+>>> :{
165+let
166+ definition :: Definition (Public '[]) (Public Schema)
167+ definition = createTable #tab
168+ ( serial `as` #id :*
169+ (text & notNullable) `as` #name )
170+ ( primaryKey #id `as` #pk_id )
171+:}
172+
173+>>> printSQL definition
174+CREATE TABLE "tab" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_id" PRIMARY KEY ("id"));
175+-}
176+primaryKey
177+ :: ( Has sch schemas schema
178+ , Has tab schema ('Table table)
179+ , HasAll aliases (TableToColumns table) subcolumns
180+ , AllNotNull subcolumns )
181+ => NP Alias aliases
182+ -- ^ specify the subcolumns which together form a primary key.
183+ -> TableConstraintExpression sch tab schemas ('PrimaryKey aliases)
184+primaryKey columns = UnsafeTableConstraintExpression $
185+ "PRIMARY KEY" <+> parenthesized (renderSQL columns)
186+
187+{-| A `foreignKey` specifies that the values in a column
188+(or a group of columns) must match the values appearing in some row of
189+another table. We say this maintains the referential integrity
190+between two related tables.
191+
192+>>> :{
193+type Schema =
194+ '[ "users" ::: 'Table (
195+ '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>
196+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4
197+ , "name" ::: 'NoDef :=> 'NotNull 'PGtext
198+ ])
199+ , "emails" ::: 'Table (
200+ '[ "pk_emails" ::: 'PrimaryKey '["id"]
201+ , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]
202+ ] :=>
203+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4
204+ , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4
205+ , "email" ::: 'NoDef :=> 'Null 'PGtext
206+ ])
207+ ]
208+:}
209+
210+>>> :{
211+let
212+ setup :: Definition (Public '[]) (Public Schema)
213+ setup =
214+ createTable #users
215+ ( serial `as` #id :*
216+ (text & notNullable) `as` #name )
217+ ( primaryKey #id `as` #pk_users ) >>>
218+ createTable #emails
219+ ( serial `as` #id :*
220+ (int & notNullable) `as` #user_id :*
221+ (text & nullable) `as` #email )
222+ ( primaryKey #id `as` #pk_emails :*
223+ foreignKey #user_id #users #id
224+ OnDeleteCascade OnUpdateCascade `as` #fk_user_id )
225+in printSQL setup
226+:}
227+CREATE TABLE "users" ("id" serial, "name" text NOT NULL, CONSTRAINT "pk_users" PRIMARY KEY ("id"));
228+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);
229+
230+A `foreignKey` can even be a table self-reference.
231+
232+>>> :{
233+type Schema =
234+ '[ "employees" ::: 'Table (
235+ '[ "employees_pk" ::: 'PrimaryKey '["id"]
236+ , "employees_employer_fk" ::: 'ForeignKey '["employer_id"] "employees" '["id"]
237+ ] :=>
238+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4
239+ , "name" ::: 'NoDef :=> 'NotNull 'PGtext
240+ , "employer_id" ::: 'NoDef :=> 'Null 'PGint4
241+ ])
242+ ]
243+:}
244+
245+>>> :{
246+let
247+ setup :: Definition (Public '[]) (Public Schema)
248+ setup =
249+ createTable #employees
250+ ( serial `as` #id :*
251+ (text & notNullable) `as` #name :*
252+ (integer & nullable) `as` #employer_id )
253+ ( primaryKey #id `as` #employees_pk :*
254+ foreignKey #employer_id #employees #id
255+ OnDeleteCascade OnUpdateCascade `as` #employees_employer_fk )
256+in printSQL setup
257+:}
258+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);
259+-}
260+foreignKey
261+ :: (ForeignKeyed schemas sch schema child parent
262+ table reftable
263+ columns refcolumns
264+ constraints cols
265+ reftys tys )
266+ => NP Alias columns
267+ -- ^ column or columns in the table
268+ -> Alias parent
269+ -- ^ reference table
270+ -> NP Alias refcolumns
271+ -- ^ reference column or columns in the reference table
272+ -> OnDeleteClause
273+ -- ^ what to do when reference is deleted
274+ -> OnUpdateClause
275+ -- ^ what to do when reference is updated
276+ -> TableConstraintExpression sch child schemas
277+ ('ForeignKey columns parent refcolumns)
278+foreignKey keys parent refs ondel onupd = UnsafeTableConstraintExpression $
279+ "FOREIGN KEY" <+> parenthesized (renderSQL keys)
280+ <+> "REFERENCES" <+> renderSQL parent
281+ <+> parenthesized (renderSQL refs)
282+ <+> renderSQL ondel
283+ <+> renderSQL onupd
284+
285+-- | A constraint synonym between types involved in a foreign key constraint.
286+type ForeignKeyed schemas
287+ sch
288+ schema
289+ child parent
290+ table reftable
291+ columns refcolumns
292+ constraints cols
293+ reftys tys =
294+ ( Has sch schemas schema
295+ , Has child schema ('Table table)
296+ , Has parent schema ('Table reftable)
297+ , HasAll columns (TableToColumns table) tys
298+ , reftable ~ (constraints :=> cols)
299+ , HasAll refcolumns cols reftys
300+ , SOP.AllZip SamePGType tys reftys
301+ , Uniquely refcolumns constraints )
302+
303+-- | `OnDeleteClause` indicates what to do with rows that reference a deleted row.
304+data OnDeleteClause
305+ = OnDeleteNoAction
306+ -- ^ if any referencing rows still exist when the constraint is checked,
307+ -- an error is raised
308+ | OnDeleteRestrict -- ^ prevents deletion of a referenced row
309+ | OnDeleteCascade
310+ -- ^ specifies that when a referenced row is deleted,
311+ -- row(s) referencing it should be automatically deleted as well
312+ deriving (GHC.Generic,Show,Eq,Ord)
313+instance NFData OnDeleteClause
314+-- | Render `OnDeleteClause`.
315+instance RenderSQL OnDeleteClause where
316+ renderSQL = \case
317+ OnDeleteNoAction -> "ON DELETE NO ACTION"
318+ OnDeleteRestrict -> "ON DELETE RESTRICT"
319+ OnDeleteCascade -> "ON DELETE CASCADE"
320+
321+-- | Analagous to `OnDeleteClause` there is also `OnUpdateClause` which is invoked
322+-- when a referenced column is changed (updated).
323+data OnUpdateClause
324+ = OnUpdateNoAction
325+ -- ^ if any referencing rows has not changed when the constraint is checked,
326+ -- an error is raised
327+ | OnUpdateRestrict -- ^ prevents update of a referenced row
328+ | OnUpdateCascade
329+ -- ^ the updated values of the referenced column(s) should be copied
330+ -- into the referencing row(s)
331+ deriving (GHC.Generic,Show,Eq,Ord)
332+instance NFData OnUpdateClause
333+
334+-- | Render `OnUpdateClause`.
335+instance RenderSQL OnUpdateClause where
336+ renderSQL = \case
337+ OnUpdateNoAction -> "ON UPDATE NO ACTION"
338+ OnUpdateRestrict -> "ON UPDATE RESTRICT"
339+ OnUpdateCascade -> "ON UPDATE CASCADE"
squeal-postgresql/src/Squeal/PostgreSQL/Definition/Type.hsnew file+229
@@ -0,0 +1,229 @@
1+{-|
2+Module: Squeal.PostgreSQL.Definition.Type
3+Description: Create and drop type definitions
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+Create and drop type definitions.
9+-}
10+
11+{-# LANGUAGE
12+ AllowAmbiguousTypes
13+ , ConstraintKinds
14+ , DeriveAnyClass
15+ , DeriveGeneric
16+ , DerivingStrategies
17+ , FlexibleContexts
18+ , FlexibleInstances
19+ , GADTs
20+ , LambdaCase
21+ , MultiParamTypeClasses
22+ , OverloadedLabels
23+ , OverloadedStrings
24+ , RankNTypes
25+ , ScopedTypeVariables
26+ , TypeApplications
27+ , TypeInType
28+ , TypeOperators
29+ , UndecidableSuperClasses
30+#-}
31+
32+module Squeal.PostgreSQL.Definition.Type
33+ ( createTypeEnum
34+ , createTypeEnumFrom
35+ , createTypeComposite
36+ , createTypeCompositeFrom
37+ , createTypeRange
38+ , createDomain
39+ , dropType
40+ , dropTypeIfExists
41+ ) where
42+
43+import Data.ByteString
44+import Data.Monoid
45+import GHC.TypeLits
46+import Prelude hiding ((.), id)
47+
48+import qualified Generics.SOP as SOP
49+
50+import Squeal.PostgreSQL.Alias
51+import Squeal.PostgreSQL.Expression.Logic
52+import Squeal.PostgreSQL.Expression.Type
53+import Squeal.PostgreSQL.Definition
54+import Squeal.PostgreSQL.List
55+import Squeal.PostgreSQL.PG
56+import Squeal.PostgreSQL.Render
57+import Squeal.PostgreSQL.Schema
58+
59+-- $setup
60+-- >>> import Squeal.PostgreSQL
61+-- >>> import qualified GHC.Generics as GHC
62+-- >>> import qualified Generics.SOP as SOP
63+
64+-- | Enumerated types are created using the `createTypeEnum` command, for example
65+--
66+-- >>> printSQL $ (createTypeEnum #mood (label @"sad" :* label @"ok" :* label @"happy") :: Definition (Public '[]) '["public" ::: '["mood" ::: 'Typedef ('PGenum '["sad","ok","happy"])]])
67+-- CREATE TYPE "mood" AS ENUM ('sad', 'ok', 'happy');
68+createTypeEnum
69+ :: (KnownSymbol enum, Has sch schemas schema, SOP.All KnownSymbol labels)
70+ => QualifiedAlias sch enum
71+ -- ^ name of the user defined enumerated type
72+ -> NP PGlabel labels
73+ -- ^ labels of the enumerated type
74+ -> Definition schemas (Alter sch (Create enum ('Typedef ('PGenum labels)) schema) schemas)
75+createTypeEnum enum labels = UnsafeDefinition $
76+ "CREATE" <+> "TYPE" <+> renderSQL enum <+> "AS" <+> "ENUM" <+>
77+ parenthesized (renderSQL labels) <> ";"
78+
79+-- | Enumerated types can also be generated from a Haskell type, for example
80+--
81+-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
82+-- >>> instance SOP.Generic Schwarma
83+-- >>> instance SOP.HasDatatypeInfo Schwarma
84+-- >>> :{
85+-- let
86+-- createSchwarma :: Definition (Public '[]) '["public" ::: '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))]]
87+-- createSchwarma = createTypeEnumFrom @Schwarma #schwarma
88+-- in
89+-- printSQL createSchwarma
90+-- :}
91+-- CREATE TYPE "schwarma" AS ENUM ('Beef', 'Lamb', 'Chicken');
92+createTypeEnumFrom
93+ :: forall hask sch enum schemas schema.
94+ ( SOP.Generic hask
95+ , SOP.All KnownSymbol (LabelsPG hask)
96+ , KnownSymbol enum
97+ , Has sch schemas schema )
98+ => QualifiedAlias sch enum
99+ -- ^ name of the user defined enumerated type
100+ -> Definition schemas (Alter sch (Create enum ('Typedef (PG (Enumerated hask))) schema) schemas)
101+createTypeEnumFrom enum = createTypeEnum enum
102+ (SOP.hpure label :: NP PGlabel (LabelsPG hask))
103+
104+{- | `createTypeComposite` creates a composite type. The composite type is
105+specified by a list of attribute names and data types.
106+
107+>>> :{
108+type PGcomplex = 'PGcomposite
109+ '[ "real" ::: 'NotNull 'PGfloat8
110+ , "imaginary" ::: 'NotNull 'PGfloat8 ]
111+:}
112+
113+>>> :{
114+let
115+ setup :: Definition (Public '[]) '["public" ::: '["complex" ::: 'Typedef PGcomplex]]
116+ setup = createTypeComposite #complex
117+ (float8 `as` #real :* float8 `as` #imaginary)
118+in printSQL setup
119+:}
120+CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
121+-}
122+createTypeComposite
123+ :: (KnownSymbol ty, Has sch schemas schema, SOP.SListI fields)
124+ => QualifiedAlias sch ty
125+ -- ^ name of the user defined composite type
126+ -> NP (Aliased (TypeExpression schemas)) fields
127+ -- ^ list of attribute names and data types
128+ -> Definition schemas (Alter sch (Create ty ('Typedef ('PGcomposite fields)) schema) schemas)
129+createTypeComposite ty fields = UnsafeDefinition $
130+ "CREATE" <+> "TYPE" <+> renderSQL ty <+> "AS" <+> parenthesized
131+ (renderCommaSeparated renderField fields) <> ";"
132+ where
133+ renderField :: Aliased (TypeExpression schemas) x -> ByteString
134+ renderField (typ `As` alias) =
135+ renderSQL alias <+> renderSQL typ
136+
137+-- | Composite types can also be generated from a Haskell type, for example
138+--
139+-- >>> data Complex = Complex {real :: Double, imaginary :: Double} deriving GHC.Generic
140+-- >>> instance SOP.Generic Complex
141+-- >>> instance SOP.HasDatatypeInfo Complex
142+-- >>> type Schema = '["complex" ::: 'Typedef (PG (Composite Complex))]
143+-- >>> :{
144+-- let
145+-- createComplex :: Definition (Public '[]) (Public Schema)
146+-- createComplex = createTypeCompositeFrom @Complex #complex
147+-- in
148+-- printSQL createComplex
149+-- :}
150+-- CREATE TYPE "complex" AS ("real" float8, "imaginary" float8);
151+createTypeCompositeFrom
152+ :: forall hask sch ty schemas schema.
153+ ( SOP.All (FieldTyped schemas) (RowPG hask)
154+ , KnownSymbol ty
155+ , Has sch schemas schema )
156+ => QualifiedAlias sch ty
157+ -- ^ name of the user defined composite type
158+ -> Definition schemas (Alter sch (Create ty ( 'Typedef (PG (Composite hask))) schema) schemas)
159+createTypeCompositeFrom ty = createTypeComposite ty
160+ (SOP.hcpure (SOP.Proxy :: SOP.Proxy (FieldTyped schemas)) fieldtype
161+ :: NP (Aliased (TypeExpression schemas)) (RowPG hask))
162+
163+{-|
164+`createDomain` creates a new domain. A domain is essentially a data type
165+with constraints (restrictions on the allowed set of values).
166+
167+Domains are useful for abstracting common constraints on fields
168+into a single location for maintenance. For example, several tables might
169+contain email address columns, all requiring the same `check` constraint
170+to verify the address syntax. Define a domain rather than setting up
171+each table's constraint individually.
172+
173+>>> :{
174+let
175+ createPositive :: Definition (Public '[]) (Public '["positive" ::: 'Typedef 'PGfloat4])
176+ createPositive = createDomain #positive real (#value .> 0 .&& (#value & isNotNull))
177+in printSQL createPositive
178+:}
179+CREATE DOMAIN "positive" AS real CHECK ((("value" > 0) AND "value" IS NOT NULL));
180+-}
181+createDomain
182+ :: (Has sch schemas schema, KnownSymbol dom)
183+ => QualifiedAlias sch dom
184+ -> (forall null. TypeExpression schemas (null ty))
185+ -> (forall tab. Condition '[] '[] 'Ungrouped schemas '[] '[tab ::: '["value" ::: 'Null ty]])
186+ -> Definition schemas (Alter sch (Create dom ('Typedef ty) schema) schemas)
187+createDomain dom ty condition =
188+ UnsafeDefinition $ "CREATE DOMAIN" <+> renderSQL dom
189+ <+> "AS" <+> renderTypeExpression ty
190+ <+> "CHECK" <+> parenthesized (renderSQL condition) <> ";"
191+
192+{- |
193+>>> :{
194+let
195+ createSmallIntRange :: Definition (Public '[]) (Public '["int2range" ::: 'Typedef ('PGrange 'PGint2)])
196+ createSmallIntRange = createTypeRange #int2range int2
197+in printSQL createSmallIntRange
198+:}
199+CREATE TYPE "int2range" AS RANGE (subtype = int2);
200+-}
201+createTypeRange
202+ :: (Has sch schemas schema, KnownSymbol range)
203+ => QualifiedAlias sch range
204+ -> (forall null. TypeExpression schemas (null ty))
205+ -> Definition schemas (Alter sch (Create range ('Typedef ('PGrange ty)) schema) schemas)
206+createTypeRange range ty = UnsafeDefinition $
207+ "CREATE" <+> "TYPE" <+> renderSQL range <+> "AS" <+> "RANGE" <+>
208+ parenthesized ("subtype" <+> "=" <+> renderTypeExpression ty) <> ";"
209+
210+-- | Drop a type.
211+--
212+-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
213+-- >>> instance SOP.Generic Schwarma
214+-- >>> instance SOP.HasDatatypeInfo Schwarma
215+-- >>> printSQL (dropType #schwarma :: Definition '["public" ::: '["schwarma" ::: 'Typedef (PG (Enumerated Schwarma))]] (Public '[]))
216+-- DROP TYPE "schwarma";
217+dropType
218+ :: (Has sch schemas schema, KnownSymbol td)
219+ => QualifiedAlias sch td
220+ -- ^ name of the user defined type
221+ -> Definition schemas (Alter sch (DropSchemum td 'Typedef schema) schemas)
222+dropType tydef = UnsafeDefinition $ "DROP" <+> "TYPE" <+> renderSQL tydef <> ";"
223+
224+dropTypeIfExists
225+ :: (Has sch schemas schema, KnownSymbol td)
226+ => QualifiedAlias sch td
227+ -- ^ name of the user defined type
228+ -> Definition schemas (Alter sch (DropSchemumIfExists td 'Typedef schema) schemas)
229+dropTypeIfExists tydef = UnsafeDefinition $ "DROP" <+> "TYPE" <+> renderSQL tydef <> ";"
squeal-postgresql/src/Squeal/PostgreSQL/Definition/View.hsnew file+104
@@ -0,0 +1,104 @@
1+{-|
2+Module: Squeal.PostgreSQL.Definition.View
3+Description: Create and drop view definitions
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+Create and drop view definitions.
9+-}
10+
11+{-# LANGUAGE
12+ AllowAmbiguousTypes
13+ , ConstraintKinds
14+ , DeriveAnyClass
15+ , DeriveGeneric
16+ , DerivingStrategies
17+ , FlexibleContexts
18+ , FlexibleInstances
19+ , GADTs
20+ , LambdaCase
21+ , MultiParamTypeClasses
22+ , OverloadedLabels
23+ , OverloadedStrings
24+ , RankNTypes
25+ , ScopedTypeVariables
26+ , TypeApplications
27+ , TypeInType
28+ , TypeOperators
29+ , UndecidableSuperClasses
30+#-}
31+
32+module Squeal.PostgreSQL.Definition.View
33+ ( createView
34+ , createOrReplaceView
35+ , dropView
36+ , dropViewIfExists
37+ ) where
38+
39+import GHC.TypeLits
40+
41+import Squeal.PostgreSQL.Alias
42+import Squeal.PostgreSQL.Definition
43+import Squeal.PostgreSQL.Query
44+import Squeal.PostgreSQL.Render
45+import Squeal.PostgreSQL.Schema
46+
47+-- $setup
48+-- >>> import Squeal.PostgreSQL
49+
50+{- | Create a view.
51+>>> type ABC = '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4]
52+>>> type BC = '["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4]
53+>>> :{
54+let
55+ definition :: Definition
56+ '[ "public" ::: '["abc" ::: 'Table ('[] :=> ABC)]]
57+ '[ "public" ::: '["abc" ::: 'Table ('[] :=> ABC), "bc" ::: 'View BC]]
58+ definition =
59+ createView #bc (select_ (#b :* #c) (from (table #abc)))
60+in printSQL definition
61+:}
62+CREATE VIEW "bc" AS SELECT "b" AS "b", "c" AS "c" FROM "abc" AS "abc";
63+-}
64+createView
65+ :: (Has sch schemas schema, KnownSymbol vw)
66+ => QualifiedAlias sch vw -- ^ the name of the view to add
67+ -> Query '[] '[] schemas '[] view -- ^ query
68+ -> Definition schemas (Alter sch (Create vw ('View view) schema) schemas)
69+createView alias query = UnsafeDefinition $
70+ "CREATE" <+> "VIEW" <+> renderSQL alias <+> "AS"
71+ <+> renderQuery query <> ";"
72+
73+createOrReplaceView
74+ :: (Has sch schemas schema, KnownSymbol vw)
75+ => QualifiedAlias sch vw -- ^ the name of the view to add
76+ -> Query '[] '[] schemas '[] view -- ^ query
77+ -> Definition schemas (Alter sch (CreateOrReplace vw ('View view) schema) schemas)
78+createOrReplaceView alias query = UnsafeDefinition $
79+ "CREATE OR REPLACE VIEW" <+> renderSQL alias <+> "AS"
80+ <+> renderQuery query <> ";"
81+
82+-- | Drop a view.
83+--
84+-- >>> :{
85+-- let
86+-- definition :: Definition
87+-- '[ "public" ::: '["abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])
88+-- , "bc" ::: 'View ('["b" ::: 'Null 'PGint4, "c" ::: 'Null 'PGint4])]]
89+-- '[ "public" ::: '["abc" ::: 'Table ('[] :=> '["a" ::: 'NoDef :=> 'Null 'PGint4, "b" ::: 'NoDef :=> 'Null 'PGint4, "c" ::: 'NoDef :=> 'Null 'PGint4])]]
90+-- definition = dropView #bc
91+-- in printSQL definition
92+-- :}
93+-- DROP VIEW "bc";
94+dropView
95+ :: (Has sch schemas schema, KnownSymbol vw)
96+ => QualifiedAlias sch vw -- ^ view to remove
97+ -> Definition schemas (Alter sch (DropSchemum vw 'View schema) schemas)
98+dropView vw = UnsafeDefinition $ "DROP VIEW" <+> renderSQL vw <> ";"
99+
100+dropViewIfExists
101+ :: (Has sch schemas schema, KnownSymbol vw)
102+ => QualifiedAlias sch vw -- ^ view to remove
103+ -> Definition schemas (Alter sch (DropIfExists vw schema) schemas)
104+dropViewIfExists vw = UnsafeDefinition $ "DROP VIEW IF EXISTS" <+> renderSQL vw <> ";"
squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+10−10
@@ -34,7 +34,7 @@ module Squeal.PostgreSQL.Expression
34 ( -- * Expression
34 ( -- * Expression
35 Expression (..)
35 Expression (..)
36 , Expr
36 , Expr
37− , (:-->)
37+ , type (-->)
38 , FunctionDB
38 , FunctionDB
39 , unsafeFunction
39 , unsafeFunction
40 , function
40 , function
@@ -48,7 +48,7 @@ module Squeal.PostgreSQL.Expression
48 , binaryOp
48 , binaryOp
49 , FunctionVar
49 , FunctionVar
50 , unsafeFunctionVar
50 , unsafeFunctionVar
51− , FunctionN
51+ , type (--->)
52 , FunctionNDB
52 , FunctionNDB
53 , unsafeFunctionN
53 , unsafeFunctionN
54 , functionN
54 , functionN
@@ -159,7 +159,7 @@ type OperatorDB schemas x1 x2 y
159-- This is a subtype of the usual Haskell function type `Prelude.->`,
159-- This is a subtype of the usual Haskell function type `Prelude.->`,
160-- indeed a subcategory as it is closed under the usual
160-- indeed a subcategory as it is closed under the usual
161-- `Prelude..` and `Prelude.id`.
161-- `Prelude..` and `Prelude.id`.
162−type (:-->) x y
162+type (-->) x y
163 = forall outer commons grp schemas params from
163 = forall outer commons grp schemas params from
164 . Expression outer commons grp schemas params from x
164 . Expression outer commons grp schemas params from x
165 -- ^ input
165 -- ^ input
@@ -179,7 +179,7 @@ Use the `*:` operator to end your argument lists, like so.
179>>> printSQL (unsafeFunctionN "fun" (true :* false :* localTime *: true))
179>>> printSQL (unsafeFunctionN "fun" (true :* false :* localTime *: true))
180fun(TRUE, FALSE, LOCALTIME, TRUE)
180fun(TRUE, FALSE, LOCALTIME, TRUE)
181-}
181-}
182−type FunctionN xs y
182+type (--->) xs y
183 = forall outer commons grp schemas params from
183 = forall outer commons grp schemas params from
184 . NP (Expression outer commons grp schemas params from) xs
184 . NP (Expression outer commons grp schemas params from) xs
185 -- ^ inputs
185 -- ^ inputs
@@ -327,7 +327,7 @@ binaryOp = unsafeBinaryOp $ renderSymbol @op
327
327
328-- | >>> printSQL $ unsafeLeftOp "NOT" true
328-- | >>> printSQL $ unsafeLeftOp "NOT" true
329-- (NOT TRUE)
329-- (NOT TRUE)
330−unsafeLeftOp :: ByteString -> x :--> y
330+unsafeLeftOp :: ByteString -> x --> y
331unsafeLeftOp op x = UnsafeExpression $ parenthesized $ op <+> renderSQL x
331unsafeLeftOp op x = UnsafeExpression $ parenthesized $ op <+> renderSQL x
332
332
333leftOp
333leftOp
@@ -339,7 +339,7 @@ leftOp = unsafeLeftOp $ renderSymbol @op
339
339
340-- | >>> printSQL $ true & unsafeRightOp "IS NOT TRUE"
340-- | >>> printSQL $ true & unsafeRightOp "IS NOT TRUE"
341-- (TRUE IS NOT TRUE)
341-- (TRUE IS NOT TRUE)
342−unsafeRightOp :: ByteString -> x :--> y
342+unsafeRightOp :: ByteString -> x --> y
343unsafeRightOp op x = UnsafeExpression $ parenthesized $ renderSQL x <+> op
343unsafeRightOp op x = UnsafeExpression $ parenthesized $ renderSQL x <+> op
344
344
345rightOp
345rightOp
@@ -351,25 +351,25 @@ rightOp = unsafeRightOp $ renderSymbol @op
351
351
352-- | >>> printSQL $ unsafeFunction "f" true
352-- | >>> printSQL $ unsafeFunction "f" true
353-- f(TRUE)
353-- f(TRUE)
354−unsafeFunction :: ByteString -> x :--> y
354+unsafeFunction :: ByteString -> x --> y
355unsafeFunction fun x = UnsafeExpression $
355unsafeFunction fun x = UnsafeExpression $
356 fun <> parenthesized (renderSQL x)
356 fun <> parenthesized (renderSQL x)
357
357
358function
358function
359− :: (Has sch schemas schema, Has fun schema ('Function '[x] ('Returns y)))
359+ :: (Has sch schemas schema, Has fun schema ('Function ('[x] :=> 'Returns y)))
360 => QualifiedAlias sch fun
360 => QualifiedAlias sch fun
361 -> FunctionDB schemas x y
361 -> FunctionDB schemas x y
362function = unsafeFunction . renderSQL
362function = unsafeFunction . renderSQL
363
363
364-- | >>> printSQL $ unsafeFunctionN "f" (currentTime :* localTimestamp :* false *: literal 'a')
364-- | >>> printSQL $ unsafeFunctionN "f" (currentTime :* localTimestamp :* false *: literal 'a')
365-- f(CURRENT_TIME, LOCALTIMESTAMP, FALSE, E'a')
365-- f(CURRENT_TIME, LOCALTIMESTAMP, FALSE, E'a')
366−unsafeFunctionN :: SListI xs => ByteString -> FunctionN xs y
366+unsafeFunctionN :: SListI xs => ByteString -> xs ---> y
367unsafeFunctionN fun xs = UnsafeExpression $
367unsafeFunctionN fun xs = UnsafeExpression $
368 fun <> parenthesized (renderCommaSeparated renderSQL xs)
368 fun <> parenthesized (renderCommaSeparated renderSQL xs)
369
369
370functionN
370functionN
371 :: ( Has sch schemas schema
371 :: ( Has sch schemas schema
372− , Has fun schema ('Function xs ('Returns y))
372+ , Has fun schema ('Function (xs :=> 'Returns y))
373 , SListI xs )
373 , SListI xs )
374 => QualifiedAlias sch fun
374 => QualifiedAlias sch fun
375 -> FunctionNDB schemas xs y
375 -> FunctionNDB schemas xs y
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Collection.hs+5−5
@@ -42,7 +42,7 @@ import qualified Generics.SOP as SOP
42
42
43import Squeal.PostgreSQL.Alias
43import Squeal.PostgreSQL.Alias
44import Squeal.PostgreSQL.Expression
44import Squeal.PostgreSQL.Expression
45−import Squeal.PostgreSQL.Expression.SetOf
45+import Squeal.PostgreSQL.Expression.Set
46import Squeal.PostgreSQL.List
46import Squeal.PostgreSQL.List
47import Squeal.PostgreSQL.Render
47import Squeal.PostgreSQL.Render
48import Squeal.PostgreSQL.Schema
48import Squeal.PostgreSQL.Schema
@@ -111,20 +111,20 @@ array2 xss = UnsafeExpression $ "ARRAY" <>
111
111
112-- | >>> printSQL $ cardinality (array [null_, false, true])
112-- | >>> printSQL $ cardinality (array [null_, false, true])
113-- cardinality(ARRAY[NULL, FALSE, TRUE])
113-- cardinality(ARRAY[NULL, FALSE, TRUE])
114−cardinality :: null ('PGvararray ty) :--> null 'PGint8
114+cardinality :: null ('PGvararray ty) --> null 'PGint8
115cardinality = unsafeFunction "cardinality"
115cardinality = unsafeFunction "cardinality"
116
116
117-- | >>> printSQL $ array [null_, false, true] & index 2
117-- | >>> printSQL $ array [null_, false, true] & index 2
118-- (ARRAY[NULL, FALSE, TRUE])[2]
118-- (ARRAY[NULL, FALSE, TRUE])[2]
119index
119index
120 :: Word64 -- ^ index
120 :: Word64 -- ^ index
121− -> null ('PGvararray ty) :--> NullifyType ty
121+ -> null ('PGvararray ty) --> NullifyType ty
122index n expr = UnsafeExpression $
122index n expr = UnsafeExpression $
123 parenthesized (renderSQL expr) <> "[" <> fromString (show n) <> "]"
123 parenthesized (renderSQL expr) <> "[" <> fromString (show n) <> "]"
124
124
125-- | Expand an array to a set of rows
125-- | Expand an array to a set of rows
126−unnest :: SetOfFunction "unnest" (null ('PGvararray ty)) '["unnest" ::: ty]
126+unnest :: SetFunction "unnest" (null ('PGvararray ty)) '["unnest" ::: ty]
127−unnest = unsafeSetOfFunction
127+unnest = unsafeSetFunction
128
128
129-- | A row constructor is an expression that builds a row value
129-- | A row constructor is an expression that builds a row value
130-- (also called a composite value) using values for its member fields.
130-- (also called a composite value) using values for its member fields.
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Comparison.hs+6−6
@@ -162,7 +162,7 @@ isNotDistinctFrom = unsafeBinaryOp "IS NOT DISTINCT FROM"
162>>> printSQL $ true & isTrue
162>>> printSQL $ true & isTrue
163(TRUE IS TRUE)
163(TRUE IS TRUE)
164-}
164-}
165−isTrue :: null0 'PGbool :--> null1 'PGbool
165+isTrue :: null0 'PGbool --> null1 'PGbool
166isTrue = unsafeRightOp "IS TRUE"
166isTrue = unsafeRightOp "IS TRUE"
167
167
168{- | is false or unknown
168{- | is false or unknown
@@ -170,7 +170,7 @@ isTrue = unsafeRightOp "IS TRUE"
170>>> printSQL $ true & isNotTrue
170>>> printSQL $ true & isNotTrue
171(TRUE IS NOT TRUE)
171(TRUE IS NOT TRUE)
172-}
172-}
173−isNotTrue :: null0 'PGbool :--> null1 'PGbool
173+isNotTrue :: null0 'PGbool --> null1 'PGbool
174isNotTrue = unsafeRightOp "IS NOT TRUE"
174isNotTrue = unsafeRightOp "IS NOT TRUE"
175
175
176{- | is false
176{- | is false
@@ -178,7 +178,7 @@ isNotTrue = unsafeRightOp "IS NOT TRUE"
178>>> printSQL $ true & isFalse
178>>> printSQL $ true & isFalse
179(TRUE IS FALSE)
179(TRUE IS FALSE)
180-}
180-}
181−isFalse :: null0 'PGbool :--> null1 'PGbool
181+isFalse :: null0 'PGbool --> null1 'PGbool
182isFalse = unsafeRightOp "IS FALSE"
182isFalse = unsafeRightOp "IS FALSE"
183
183
184{- | is true or unknown
184{- | is true or unknown
@@ -186,7 +186,7 @@ isFalse = unsafeRightOp "IS FALSE"
186>>> printSQL $ true & isNotFalse
186>>> printSQL $ true & isNotFalse
187(TRUE IS NOT FALSE)
187(TRUE IS NOT FALSE)
188-}
188-}
189−isNotFalse :: null0 'PGbool :--> null1 'PGbool
189+isNotFalse :: null0 'PGbool --> null1 'PGbool
190isNotFalse = unsafeRightOp "IS NOT FALSE"
190isNotFalse = unsafeRightOp "IS NOT FALSE"
191
191
192{- | is unknown
192{- | is unknown
@@ -194,7 +194,7 @@ isNotFalse = unsafeRightOp "IS NOT FALSE"
194>>> printSQL $ true & isUnknown
194>>> printSQL $ true & isUnknown
195(TRUE IS UNKNOWN)
195(TRUE IS UNKNOWN)
196-}
196-}
197−isUnknown :: null0 'PGbool :--> null1 'PGbool
197+isUnknown :: null0 'PGbool --> null1 'PGbool
198isUnknown = unsafeRightOp "IS UNKNOWN"
198isUnknown = unsafeRightOp "IS UNKNOWN"
199
199
200{- | is true or false
200{- | is true or false
@@ -202,5 +202,5 @@ isUnknown = unsafeRightOp "IS UNKNOWN"
202>>> printSQL $ true & isNotUnknown
202>>> printSQL $ true & isNotUnknown
203(TRUE IS NOT UNKNOWN)
203(TRUE IS NOT UNKNOWN)
204-}
204-}
205−isNotUnknown :: null0 'PGbool :--> null1 'PGbool
205+isNotUnknown :: null0 'PGbool --> null1 'PGbool
206isNotUnknown = unsafeRightOp "IS NOT UNKNOWN"
206isNotUnknown = unsafeRightOp "IS NOT UNKNOWN"
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Json.hs+40−47
@@ -81,7 +81,7 @@ import GHC.TypeLits
81
81
82import Squeal.PostgreSQL.Alias
82import Squeal.PostgreSQL.Alias
83import Squeal.PostgreSQL.Expression
83import Squeal.PostgreSQL.Expression
84−import Squeal.PostgreSQL.Expression.SetOf
84+import Squeal.PostgreSQL.Expression.Set
85import Squeal.PostgreSQL.Expression.Type
85import Squeal.PostgreSQL.Expression.Type
86import Squeal.PostgreSQL.List
86import Squeal.PostgreSQL.List
87import Squeal.PostgreSQL.Query
87import Squeal.PostgreSQL.Query
@@ -188,7 +188,7 @@ Table 9.45: JSON creation functions
188-- otherwise, a scalar value is produced. For any scalar type other than a
188-- otherwise, a scalar value is produced. For any scalar type other than a
189-- number, a Boolean, or a null value, the text representation will be used, in
189-- number, a Boolean, or a null value, the text representation will be used, in
190-- such a fashion that it is a valid json value.
190-- such a fashion that it is a valid json value.
191−toJson :: null ty :--> null 'PGjson
191+toJson :: null ty --> null 'PGjson
192toJson = unsafeFunction "to_json"
192toJson = unsafeFunction "to_json"
193
193
194-- | Returns the value as jsonb. Arrays and composites are converted
194-- | Returns the value as jsonb. Arrays and composites are converted
@@ -197,26 +197,26 @@ toJson = unsafeFunction "to_json"
197-- otherwise, a scalar value is produced. For any scalar type other than a
197-- otherwise, a scalar value is produced. For any scalar type other than a
198-- number, a Boolean, or a null value, the text representation will be used, in
198-- number, a Boolean, or a null value, the text representation will be used, in
199-- such a fashion that it is a valid jsonb value.
199-- such a fashion that it is a valid jsonb value.
200−toJsonb :: null ty :--> null 'PGjsonb
200+toJsonb :: null ty --> null 'PGjsonb
201toJsonb = unsafeFunction "to_jsonb"
201toJsonb = unsafeFunction "to_jsonb"
202
202
203-- | Returns the array as a JSON array. A PostgreSQL multidimensional array
203-- | Returns the array as a JSON array. A PostgreSQL multidimensional array
204-- becomes a JSON array of arrays.
204-- becomes a JSON array of arrays.
205−arrayToJson :: null ('PGvararray ty) :--> null 'PGjson
205+arrayToJson :: null ('PGvararray ty) --> null 'PGjson
206arrayToJson = unsafeFunction "array_to_json"
206arrayToJson = unsafeFunction "array_to_json"
207
207
208-- | Returns the row as a JSON object.
208-- | Returns the row as a JSON object.
209−rowToJson :: null ('PGcomposite ty) :--> null 'PGjson
209+rowToJson :: null ('PGcomposite ty) --> null 'PGjson
210rowToJson = unsafeFunction "row_to_json"
210rowToJson = unsafeFunction "row_to_json"
211
211
212-- | Builds a possibly-heterogeneously-typed JSON array out of a variadic
212-- | Builds a possibly-heterogeneously-typed JSON array out of a variadic
213-- argument list.
213-- argument list.
214−jsonBuildArray :: SOP.SListI tuple => FunctionN tuple (null 'PGjson)
214+jsonBuildArray :: SOP.SListI tuple => tuple ---> null 'PGjson
215jsonBuildArray = unsafeFunctionN "json_build_array"
215jsonBuildArray = unsafeFunctionN "json_build_array"
216
216
217-- | Builds a possibly-heterogeneously-typed (binary) JSON array out of a
217-- | Builds a possibly-heterogeneously-typed (binary) JSON array out of a
218-- variadic argument list.
218-- variadic argument list.
219−jsonbBuildArray :: SOP.SListI tuple => FunctionN tuple (null 'PGjsonb)
219+jsonbBuildArray :: SOP.SListI tuple => tuple ---> null 'PGjsonb
220jsonbBuildArray = unsafeFunctionN "jsonb_build_array"
220jsonbBuildArray = unsafeFunctionN "jsonb_build_array"
221
221
222-- | Builds a possibly-heterogeneously-typed JSON object out of a variadic
222-- | Builds a possibly-heterogeneously-typed JSON object out of a variadic
@@ -224,10 +224,10 @@ jsonbBuildArray = unsafeFunctionN "jsonb_build_array"
224-- and values.
224-- and values.
225class SOP.SListI tys => JsonBuildObject tys where
225class SOP.SListI tys => JsonBuildObject tys where
226
226
227− jsonBuildObject :: FunctionN tys (null 'PGjson)
227+ jsonBuildObject :: tys ---> null 'PGjson
228 jsonBuildObject = unsafeFunctionN "json_build_object"
228 jsonBuildObject = unsafeFunctionN "json_build_object"
229
229
230− jsonbBuildObject :: FunctionN tys (null 'PGjsonb)
230+ jsonbBuildObject :: tys ---> null 'PGjsonb
231 jsonbBuildObject = unsafeFunctionN "jsonb_build_object"
231 jsonbBuildObject = unsafeFunctionN "jsonb_build_object"
232
232
233instance JsonBuildObject '[]
233instance JsonBuildObject '[]
@@ -240,7 +240,7 @@ instance (JsonBuildObject tys, key `In` PGJsonKey)
240-- which are taken as a key/value pair.
240-- which are taken as a key/value pair.
241jsonObject
241jsonObject
242 :: null ('PGfixarray '[n,2] ('NotNull 'PGtext))
242 :: null ('PGfixarray '[n,2] ('NotNull 'PGtext))
243− :--> null 'PGjson
243+ --> null 'PGjson
244jsonObject = unsafeFunction "json_object"
244jsonObject = unsafeFunction "json_object"
245
245
246-- | Builds a binary JSON object out of a text array.
246-- | Builds a binary JSON object out of a text array.
@@ -249,24 +249,24 @@ jsonObject = unsafeFunction "json_object"
249-- which are taken as a key/value pair.
249-- which are taken as a key/value pair.
250jsonbObject
250jsonbObject
251 :: null ('PGfixarray '[n,2] ('NotNull 'PGtext))
251 :: null ('PGfixarray '[n,2] ('NotNull 'PGtext))
252− :--> null 'PGjsonb
252+ --> null 'PGjsonb
253jsonbObject = unsafeFunction "jsonb_object"
253jsonbObject = unsafeFunction "jsonb_object"
254
254
255-- | This is an alternate form of 'jsonObject' that takes two arrays; one for
255-- | This is an alternate form of 'jsonObject' that takes two arrays; one for
256-- keys and one for values, that are zipped pairwise to create a JSON object.
256-- keys and one for values, that are zipped pairwise to create a JSON object.
257−jsonZipObject :: FunctionN
257+jsonZipObject ::
258 '[ null ('PGvararray ('NotNull 'PGtext))
258 '[ null ('PGvararray ('NotNull 'PGtext))
259 , null ('PGvararray ('NotNull 'PGtext)) ]
259 , null ('PGvararray ('NotNull 'PGtext)) ]
260− ( null 'PGjson )
260+ ---> null 'PGjson
261jsonZipObject = unsafeFunctionN "json_object"
261jsonZipObject = unsafeFunctionN "json_object"
262
262
263-- | This is an alternate form of 'jsonbObject' that takes two arrays; one for
263-- | This is an alternate form of 'jsonbObject' that takes two arrays; one for
264-- keys and one for values, that are zipped pairwise to create a binary JSON
264-- keys and one for values, that are zipped pairwise to create a binary JSON
265-- object.
265-- object.
266−jsonbZipObject :: FunctionN
266+jsonbZipObject ::
267 '[ null ('PGvararray ('NotNull 'PGtext))
267 '[ null ('PGvararray ('NotNull 'PGtext))
268 , null ('PGvararray ('NotNull 'PGtext)) ]
268 , null ('PGvararray ('NotNull 'PGtext)) ]
269− ( null 'PGjsonb )
269+ ---> null 'PGjsonb
270jsonbZipObject = unsafeFunctionN "jsonb_object"
270jsonbZipObject = unsafeFunctionN "jsonb_object"
271
271
272{-----------------------------------------
272{-----------------------------------------
@@ -274,31 +274,31 @@ Table 9.46: JSON processing functions
274-----------------------------------------}
274-----------------------------------------}
275
275
276-- | Returns the number of elements in the outermost JSON array.
276-- | Returns the number of elements in the outermost JSON array.
277−jsonArrayLength :: null 'PGjson :--> null 'PGint4
277+jsonArrayLength :: null 'PGjson --> null 'PGint4
278jsonArrayLength = unsafeFunction "json_array_length"
278jsonArrayLength = unsafeFunction "json_array_length"
279
279
280-- | Returns the number of elements in the outermost binary JSON array.
280-- | Returns the number of elements in the outermost binary JSON array.
281−jsonbArrayLength :: null 'PGjsonb :--> null 'PGint4
281+jsonbArrayLength :: null 'PGjsonb --> null 'PGint4
282jsonbArrayLength = unsafeFunction "jsonb_array_length"
282jsonbArrayLength = unsafeFunction "jsonb_array_length"
283
283
284-- | Returns the type of the outermost JSON value as a text string. Possible
284-- | Returns the type of the outermost JSON value as a text string. Possible
285-- types are object, array, string, number, boolean, and null.
285-- types are object, array, string, number, boolean, and null.
286−jsonTypeof :: null 'PGjson :--> null 'PGtext
286+jsonTypeof :: null 'PGjson --> null 'PGtext
287jsonTypeof = unsafeFunction "json_typeof"
287jsonTypeof = unsafeFunction "json_typeof"
288
288
289-- | Returns the type of the outermost binary JSON value as a text string.
289-- | Returns the type of the outermost binary JSON value as a text string.
290-- Possible types are object, array, string, number, boolean, and null.
290-- Possible types are object, array, string, number, boolean, and null.
291−jsonbTypeof :: null 'PGjsonb :--> null 'PGtext
291+jsonbTypeof :: null 'PGjsonb --> null 'PGtext
292jsonbTypeof = unsafeFunction "jsonb_typeof"
292jsonbTypeof = unsafeFunction "jsonb_typeof"
293
293
294-- | Returns its argument with all object fields that have null values omitted.
294-- | Returns its argument with all object fields that have null values omitted.
295-- Other null values are untouched.
295-- Other null values are untouched.
296−jsonStripNulls :: null 'PGjson :--> null 'PGjson
296+jsonStripNulls :: null 'PGjson --> null 'PGjson
297jsonStripNulls = unsafeFunction "json_strip_nulls"
297jsonStripNulls = unsafeFunction "json_strip_nulls"
298
298
299-- | Returns its argument with all object fields that have null values omitted.
299-- | Returns its argument with all object fields that have null values omitted.
300-- Other null values are untouched.
300-- Other null values are untouched.
301−jsonbStripNulls :: null 'PGjsonb :--> null 'PGjsonb
301+jsonbStripNulls :: null 'PGjsonb --> null 'PGjsonb
302jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"
302jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"
303
303
304-- | @ jsonbSet target path new_value create_missing @
304-- | @ jsonbSet target path new_value create_missing @
@@ -309,12 +309,9 @@ jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"
309-- item designated by path does not exist. As with the path orientated
309-- item designated by path does not exist. As with the path orientated
310-- operators, negative integers that appear in path count from the end of JSON
310-- operators, negative integers that appear in path count from the end of JSON
311-- arrays.
311-- arrays.
312−jsonbSet
312+jsonbSet ::
313− :: FunctionN
314− '[ null 'PGjsonb
315− , null ('PGvararray ('NotNull 'PGtext))
313+ '[ null 'PGjsonb, null ('PGvararray ('NotNull 'PGtext))
316− , null 'PGjsonb
317− , null 'PGbool ] (null 'PGjsonb)
314+ , null 'PGjsonb, null 'PGbool ] ---> null 'PGjsonb
318jsonbSet = unsafeFunctionN "jsonbSet"
315jsonbSet = unsafeFunctionN "jsonbSet"
319
316
320-- | @ jsonbInsert target path new_value insert_after @
317-- | @ jsonbInsert target path new_value insert_after @
@@ -326,27 +323,23 @@ jsonbSet = unsafeFunctionN "jsonbSet"
326-- path is in JSONB object, @new_value@ will be inserted only if target does not
323-- path is in JSONB object, @new_value@ will be inserted only if target does not
327-- exist. As with the path orientated operators, negative integers that appear
324-- exist. As with the path orientated operators, negative integers that appear
328-- in path count from the end of JSON arrays.
325-- in path count from the end of JSON arrays.
329−jsonbInsert
326+jsonbInsert ::
330− :: FunctionN
331− '[ null 'PGjsonb
332− , null ('PGvararray ('NotNull 'PGtext))
327+ '[ null 'PGjsonb, null ('PGvararray ('NotNull 'PGtext))
333− , null 'PGjsonb
334− , null 'PGbool ] (null 'PGjsonb)
328+ , null 'PGjsonb, null 'PGbool ] ---> null 'PGjsonb
335jsonbInsert = unsafeFunctionN "jsonb_insert"
329jsonbInsert = unsafeFunctionN "jsonb_insert"
336
330
337-- | Returns its argument as indented JSON text.
331-- | Returns its argument as indented JSON text.
338−jsonbPretty :: null 'PGjsonb :--> null 'PGtext
332+jsonbPretty :: null 'PGjsonb --> null 'PGtext
339jsonbPretty = unsafeFunction "jsonb_pretty"
333jsonbPretty = unsafeFunction "jsonb_pretty"
340
334
341−
342{- | Expands the outermost JSON object into a set of key/value pairs.
335{- | Expands the outermost JSON object into a set of key/value pairs.
343
336
344>>> printSQL (select Star (from (jsonEach (literal (Json (object ["a" .= "foo", "b" .= "bar"]))))))
337>>> printSQL (select Star (from (jsonEach (literal (Json (object ["a" .= "foo", "b" .= "bar"]))))))
345SELECT * FROM json_each(('{"a":"foo","b":"bar"}' :: json))
338SELECT * FROM json_each(('{"a":"foo","b":"bar"}' :: json))
346-}
339-}
347−jsonEach :: SetOfFunction "json_each" (null 'PGjson)
340+jsonEach :: SetFunction "json_each" (null 'PGjson)
348 '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGjson]
341 '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGjson]
349−jsonEach = unsafeSetOfFunction
342+jsonEach = unsafeSetFunction
350
343
351{- | Expands the outermost binary JSON object into a set of key/value pairs.
344{- | Expands the outermost binary JSON object into a set of key/value pairs.
352
345
@@ -354,9 +347,9 @@ jsonEach = unsafeSetOfFunction
354SELECT * FROM jsonb_each(('{"a":"foo","b":"bar"}' :: jsonb))
347SELECT * FROM jsonb_each(('{"a":"foo","b":"bar"}' :: jsonb))
355-}
348-}
356jsonbEach
349jsonbEach
357− :: SetOfFunction "jsonb_each" (nullity 'PGjsonb)
350+ :: SetFunction "jsonb_each" (nullity 'PGjsonb)
358 '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGjson]
351 '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGjson]
359−jsonbEach = unsafeSetOfFunction
352+jsonbEach = unsafeSetFunction
360
353
361{- | Expands the outermost JSON object into a set of key/value pairs.
354{- | Expands the outermost JSON object into a set of key/value pairs.
362
355
@@ -364,9 +357,9 @@ jsonbEach = unsafeSetOfFunction
364SELECT * FROM json_each_text(('{"a":"foo","b":"bar"}' :: json))
357SELECT * FROM json_each_text(('{"a":"foo","b":"bar"}' :: json))
365-}
358-}
366jsonEachText
359jsonEachText
367− :: SetOfFunction "json_each_text" (null 'PGjson)
360+ :: SetFunction "json_each_text" (null 'PGjson)
368 '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGtext]
361 '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGtext]
369−jsonEachText = unsafeSetOfFunction
362+jsonEachText = unsafeSetFunction
370
363
371{- | Expands the outermost binary JSON object into a set of key/value pairs.
364{- | Expands the outermost binary JSON object into a set of key/value pairs.
372
365
@@ -374,9 +367,9 @@ jsonEachText = unsafeSetOfFunction
374SELECT * FROM jsonb_each_text(('{"a":"foo","b":"bar"}' :: jsonb))
367SELECT * FROM jsonb_each_text(('{"a":"foo","b":"bar"}' :: jsonb))
375-}
368-}
376jsonbEachText
369jsonbEachText
377− :: SetOfFunction "jsonb_each_text" (null 'PGjsonb)
370+ :: SetFunction "jsonb_each_text" (null 'PGjsonb)
378 '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGtext]
371 '["key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull 'PGtext]
379−jsonbEachText = unsafeSetOfFunction
372+jsonbEachText = unsafeSetFunction
380
373
381{- | Returns set of keys in the outermost JSON object.
374{- | Returns set of keys in the outermost JSON object.
382
375
@@ -384,9 +377,9 @@ jsonbEachText = unsafeSetOfFunction
384json_object_keys(('{"a":"foo","b":"bar"}' :: json))
377json_object_keys(('{"a":"foo","b":"bar"}' :: json))
385-}
378-}
386jsonObjectKeys
379jsonObjectKeys
387− :: SetOfFunction "json_object_keys" (nullity 'PGjson)
380+ :: SetFunction "json_object_keys" (nullity 'PGjson)
388 '["json_object_keys" ::: 'NotNull 'PGtext]
381 '["json_object_keys" ::: 'NotNull 'PGtext]
389−jsonObjectKeys = unsafeSetOfFunction
382+jsonObjectKeys = unsafeSetFunction
390
383
391{- | Returns set of keys in the outermost JSON object.
384{- | Returns set of keys in the outermost JSON object.
392
385
@@ -394,9 +387,9 @@ jsonObjectKeys = unsafeSetOfFunction
394jsonb_object_keys(('{"a":"foo","b":"bar"}' :: jsonb))
387jsonb_object_keys(('{"a":"foo","b":"bar"}' :: jsonb))
395-}
388-}
396jsonbObjectKeys
389jsonbObjectKeys
397− :: SetOfFunction "jsonb_object_keys" (null 'PGjsonb)
390+ :: SetFunction "jsonb_object_keys" (null 'PGjsonb)
398 '["jsonb_object_keys" ::: 'NotNull 'PGtext]
391 '["jsonb_object_keys" ::: 'NotNull 'PGtext]
399−jsonbObjectKeys = unsafeSetOfFunction
392+jsonbObjectKeys = unsafeSetFunction
400
393
401-- | Build rows from Json types.
394-- | Build rows from Json types.
402type JsonPopulateFunction fun json
395type JsonPopulateFunction fun json
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Logic.hs+1−1
@@ -47,7 +47,7 @@ false = UnsafeExpression "FALSE"
47
47
48-- | >>> printSQL $ not_ true
48-- | >>> printSQL $ not_ true
49-- (NOT TRUE)
49-- (NOT TRUE)
50−not_ :: null 'PGbool :--> null 'PGbool
50+not_ :: null 'PGbool --> null 'PGbool
51not_ = unsafeLeftOp "NOT"
51not_ = unsafeLeftOp "NOT"
52
52
53-- | >>> printSQL $ true .&& false
53-- | >>> printSQL $ true .&& false
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Math.hs+4−6
@@ -37,9 +37,7 @@ import Squeal.PostgreSQL.Schema
37-- in printSQL expression
37-- in printSQL expression
38-- :}
38-- :}
39-- atan2(pi(), 2)
39-- atan2(pi(), 2)
40−atan2_
41− :: float `In` PGFloating
42− => FunctionN '[ null float, null float] (null float)
40+atan2_ :: float `In` PGFloating => '[ null float, null float] ---> null float
43atan2_ = unsafeFunctionN "atan2"
41atan2_ = unsafeFunctionN "atan2"
44
42
45
43
@@ -78,7 +76,7 @@ rem_ = unsafeBinaryOp "%"
78-- in printSQL expression
76-- in printSQL expression
79-- :}
77-- :}
80-- trunc(pi())
78-- trunc(pi())
81−trunc :: frac `In` PGFloating => null frac :--> null frac
79+trunc :: frac `In` PGFloating => null frac --> null frac
82trunc = unsafeFunction "trunc"
80trunc = unsafeFunction "trunc"
83
81
84-- | >>> :{
82-- | >>> :{
@@ -88,7 +86,7 @@ trunc = unsafeFunction "trunc"
88-- in printSQL expression
86-- in printSQL expression
89-- :}
87-- :}
90-- round(pi())
88-- round(pi())
91−round_ :: frac `In` PGFloating => null frac :--> null frac
89+round_ :: frac `In` PGFloating => null frac --> null frac
92round_ = unsafeFunction "round"
90round_ = unsafeFunction "round"
93
91
94-- | >>> :{
92-- | >>> :{
@@ -98,5 +96,5 @@ round_ = unsafeFunction "round"
98-- in printSQL expression
96-- in printSQL expression
99-- :}
97-- :}
100-- ceiling(pi())
98-- ceiling(pi())
101−ceiling_ :: frac `In` PGFloating => null frac :--> null frac
99+ceiling_ :: frac `In` PGFloating => null frac --> null frac
102ceiling_ = unsafeFunction "ceiling"
100ceiling_ = unsafeFunction "ceiling"
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Null.hs+4−4
@@ -44,7 +44,7 @@ null_ = UnsafeExpression "NULL"
44--
44--
45-- >>> printSQL $ notNull true
45-- >>> printSQL $ notNull true
46-- TRUE
46-- TRUE
47−notNull :: 'NotNull ty :--> 'Null ty
47+notNull :: 'NotNull ty --> 'Null ty
48notNull = UnsafeExpression . renderSQL
48notNull = UnsafeExpression . renderSQL
49
49
50-- | return the leftmost value which is not NULL
50-- | return the leftmost value which is not NULL
@@ -69,12 +69,12 @@ fromNull notNullx nullx = coalesce [nullx] notNullx
69
69
70-- | >>> printSQL $ null_ & isNull
70-- | >>> printSQL $ null_ & isNull
71-- NULL IS NULL
71-- NULL IS NULL
72−isNull :: 'Null ty :--> null 'PGbool
72+isNull :: 'Null ty --> null 'PGbool
73isNull x = UnsafeExpression $ renderSQL x <+> "IS NULL"
73isNull x = UnsafeExpression $ renderSQL x <+> "IS NULL"
74
74
75-- | >>> printSQL $ null_ & isNotNull
75-- | >>> printSQL $ null_ & isNotNull
76-- NULL IS NOT NULL
76-- NULL IS NOT NULL
77−isNotNull :: 'Null ty :--> null 'PGbool
77+isNotNull :: 'Null ty --> null 'PGbool
78isNotNull x = UnsafeExpression $ renderSQL x <+> "IS NOT NULL"
78isNotNull x = UnsafeExpression $ renderSQL x <+> "IS NOT NULL"
79
79
80-- | analagous to `maybe` using @IS NULL@
80-- | analagous to `maybe` using @IS NULL@
@@ -100,5 +100,5 @@ matchNull y f x = ifThenElse (isNull x) y
100>>> printSQL expr
100>>> printSQL expr
101NULLIF(FALSE, ($1 :: bool))
101NULLIF(FALSE, ($1 :: bool))
102-}
102-}
103−nullIf :: FunctionN '[ 'NotNull ty, 'NotNull ty] ('Null ty)
103+nullIf :: '[ 'NotNull ty, 'NotNull ty] ---> 'Null ty
104nullIf = unsafeFunctionN "NULLIF"
104nullIf = unsafeFunctionN "NULLIF"
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Range.hs+8−9
@@ -205,27 +205,26 @@ whole = NonEmpty Infinite Infinite
205(@-) :: Operator (null ('PGrange ty)) (null ('PGrange ty)) (null ('PGrange ty))
205(@-) :: Operator (null ('PGrange ty)) (null ('PGrange ty)) (null ('PGrange ty))
206(@-) = unsafeBinaryOp "-"
206(@-) = unsafeBinaryOp "-"
207
207
208−lowerBound :: null ('PGrange ty) :--> 'Null ty
208+lowerBound :: null ('PGrange ty) --> 'Null ty
209lowerBound = unsafeFunction "lower"
209lowerBound = unsafeFunction "lower"
210
210
211−upperBound :: null ('PGrange ty) :--> 'Null ty
211+upperBound :: null ('PGrange ty) --> 'Null ty
212upperBound = unsafeFunction "upper"
212upperBound = unsafeFunction "upper"
213
213
214−isEmpty :: null ('PGrange ty) :--> 'Null 'PGbool
214+isEmpty :: null ('PGrange ty) --> 'Null 'PGbool
215isEmpty = unsafeFunction "isempty"
215isEmpty = unsafeFunction "isempty"
216
216
217−lowerInc :: null ('PGrange ty) :--> 'Null 'PGbool
217+lowerInc :: null ('PGrange ty) --> 'Null 'PGbool
218lowerInc = unsafeFunction "lower_inc"
218lowerInc = unsafeFunction "lower_inc"
219
219
220−lowerInf :: null ('PGrange ty) :--> 'Null 'PGbool
220+lowerInf :: null ('PGrange ty) --> 'Null 'PGbool
221lowerInf = unsafeFunction "lower_inf"
221lowerInf = unsafeFunction "lower_inf"
222
222
223−upperInc :: null ('PGrange ty) :--> 'Null 'PGbool
223+upperInc :: null ('PGrange ty) --> 'Null 'PGbool
224upperInc = unsafeFunction "upper_inc"
224upperInc = unsafeFunction "upper_inc"
225
225
226−upperInf :: null ('PGrange ty) :--> 'Null 'PGbool
226+upperInf :: null ('PGrange ty) --> 'Null 'PGbool
227upperInf = unsafeFunction "upper_inf"
227upperInf = unsafeFunction "upper_inf"
228
228
229−rangeMerge :: FunctionN
230− '[ null ('PGrange ty), null ('PGrange ty)] (null ('PGrange ty))
229+rangeMerge :: '[null ('PGrange ty), null ('PGrange ty)] ---> null ('PGrange ty)
231rangeMerge = unsafeFunctionN "range_merge"
230rangeMerge = unsafeFunctionN "range_merge"
squeal-postgresql/src/Squeal/PostgreSQL/Expression/SetOf.hs → squeal-postgresql/src/Squeal/PostgreSQL/Expression/Set.hsrenamed+52−40
@@ -1,5 +1,5 @@
1{-|
1{-|
2−Module: Squeal.PostgreSQL.Expression.SetOf
2+Module: Squeal.PostgreSQL.Expression.Set
3Description: Set returning functions
3Description: Set returning functions
4Copyright: (c) Eitan Chatav, 2019
4Copyright: (c) Eitan Chatav, 2019
5Maintainer: eitan@morphism.tech
5Maintainer: eitan@morphism.tech
@@ -20,16 +20,18 @@ Set returning functions
20 , TypeOperators
20 , TypeOperators
21#-}
21#-}
22
22
23−module Squeal.PostgreSQL.Expression.SetOf
23+module Squeal.PostgreSQL.Expression.Set
24 ( generateSeries
24 ( generateSeries
25 , generateSeriesStep
25 , generateSeriesStep
26 , generateSeriesTimestamp
26 , generateSeriesTimestamp
27− , SetOfFunction
27+ , SetFunction
28− , unsafeSetOfFunction
28+ , unsafeSetFunction
29− , setOfFunction
29+ , SetFunctionDB
30− , SetOfFunctionN
30+ , setFunction
31− , unsafeSetOfFunctionN
31+ , SetFunctionN
32− , setOfFunctionN
32+ , unsafeSetFunctionN
33+ , SetFunctionNDB
34+ , setFunctionN
33 ) where
35 ) where
34
36
35import GHC.TypeLits
37import GHC.TypeLits
@@ -46,55 +48,65 @@ import Squeal.PostgreSQL.Schema
46{- |
48{- |
47A @RankNType@ for set returning functions with 1 argument.
49A @RankNType@ for set returning functions with 1 argument.
48-}
50-}
49−type SetOfFunction fun ty setof
51+type SetFunction fun ty row
50 = forall outer commons schemas params
52 = forall outer commons schemas params
51 . Expression outer commons 'Ungrouped schemas params '[] ty
53 . Expression outer commons 'Ungrouped schemas params '[] ty
52 -- ^ input
54 -- ^ input
53− -> FromClause outer commons schemas params '[fun ::: setof]
55+ -> FromClause outer commons schemas params '[fun ::: row]
56+ -- ^ output
57+
58+type SetFunctionDB fun schemas ty row
59+ = forall outer commons params
60+ . Expression outer commons 'Ungrouped schemas params '[] ty
61+ -- ^ input
62+ -> FromClause outer commons schemas params '[fun ::: row]
54 -- ^ output
63 -- ^ output
55
64
56-- | Escape hatch for a set returning function with 1 argument.
65-- | Escape hatch for a set returning function with 1 argument.
57−unsafeSetOfFunction
66+unsafeSetFunction
58− :: forall fun ty setof. KnownSymbol fun
67+ :: forall fun ty row. KnownSymbol fun
59− => SetOfFunction fun ty setof -- ^ set returning function
68+ => SetFunction fun ty row -- ^ set returning function
60−unsafeSetOfFunction x = UnsafeFromClause $
69+unsafeSetFunction x = UnsafeFromClause $
61 renderSymbol @fun <> parenthesized (renderSQL x)
70 renderSymbol @fun <> parenthesized (renderSQL x)
62
71
63−setOfFunction
72+setFunction
64 :: ( Has sch schemas schema
73 :: ( Has sch schemas schema
65− , Has fun schema ('Function '[ty] ('ReturnsTable setof)) )
74+ , Has fun schema ('Function ('[ty] :=> 'ReturnsTable row)) )
66− => Alias fun
75+ => QualifiedAlias sch fun
67− -> ( forall outer commons params
76+ -> SetFunctionDB fun schemas ty row
68− . Expression outer commons 'Ungrouped schemas params '[] ty
77+setFunction _ = unsafeSetFunction
69− -> FromClause outer commons schemas params '[fun ::: setof] )
70−setOfFunction _ = unsafeSetOfFunction
71
78
72{- |
79{- |
73A @RankNType@ for set returning functions with multiple argument.
80A @RankNType@ for set returning functions with multiple argument.
74-}
81-}
75−type SetOfFunctionN fun tys setof
82+type SetFunctionN fun tys row
76 = forall outer commons schemas params
83 = forall outer commons schemas params
77 . NP (Expression outer commons 'Ungrouped schemas params '[]) tys
84 . NP (Expression outer commons 'Ungrouped schemas params '[]) tys
78 -- ^ inputs
85 -- ^ inputs
79− -> FromClause outer commons schemas params '[fun ::: setof]
86+ -> FromClause outer commons schemas params '[fun ::: row]
80 -- ^ output
87 -- ^ output
81
88
82-- | Escape hatch for a set returning function with multiple argument.
89-- | Escape hatch for a set returning function with multiple argument.
83−unsafeSetOfFunctionN
90+unsafeSetFunctionN
84− :: forall fun tys setof. (SOP.SListI tys, KnownSymbol fun)
91+ :: forall fun tys row. (SOP.SListI tys, KnownSymbol fun)
85− => SetOfFunctionN fun tys setof -- ^ set returning function
92+ => SetFunctionN fun tys row -- ^ set returning function
86−unsafeSetOfFunctionN xs = UnsafeFromClause $
93+unsafeSetFunctionN xs = UnsafeFromClause $
87 renderSymbol @fun <> parenthesized (renderCommaSeparated renderSQL xs)
94 renderSymbol @fun <> parenthesized (renderCommaSeparated renderSQL xs)
88
95
89−setOfFunctionN
96+type SetFunctionNDB fun schemas tys row
97+ = forall outer commons params
98+ . NP (Expression outer commons 'Ungrouped schemas params '[]) tys
99+ -- ^ inputs
100+ -> FromClause outer commons schemas params '[fun ::: row]
101+ -- ^ output
102+
103+setFunctionN
90 :: ( Has sch schemas schema
104 :: ( Has sch schemas schema
91− , Has fun schema ('Function tys ('ReturnsTable setof))
105+ , Has fun schema ('Function (tys :=> 'ReturnsTable row))
92 , SOP.SListI tys )
106 , SOP.SListI tys )
93− => Alias fun
107+ => QualifiedAlias sch fun
94− -> ( forall outer commons params
108+ -> SetFunctionNDB fun schemas tys row
95− . NP (Expression outer commons 'Ungrouped schemas params '[]) tys
109+setFunctionN _ = unsafeSetFunctionN
96− -> FromClause outer commons schemas params '[fun ::: setof] )
97−setOfFunctionN _ = unsafeSetOfFunctionN
98
110
99{- | @generateSeries (start *: stop)@
111{- | @generateSeries (start *: stop)@
100
112
@@ -102,9 +114,9 @@ Generate a series of values, from @start@ to @stop@ with a step size of one
102-}
114-}
103generateSeries
115generateSeries
104 :: ty `In` '[ 'PGint4, 'PGint8, 'PGnumeric]
116 :: ty `In` '[ 'PGint4, 'PGint8, 'PGnumeric]
105− => SetOfFunctionN "generate_series" '[ null ty, null ty]
117+ => SetFunctionN "generate_series" '[ null ty, null ty]
106 '["generate_series" ::: null ty] -- ^ set returning function
118 '["generate_series" ::: null ty] -- ^ set returning function
107−generateSeries = unsafeSetOfFunctionN
119+generateSeries = unsafeSetFunctionN
108
120
109{- | @generateSeries (start :* stop *: step)@
121{- | @generateSeries (start :* stop *: step)@
110
122
@@ -112,9 +124,9 @@ Generate a series of values, from @start@ to @stop@ with a step size of @step@
112-}
124-}
113generateSeriesStep
125generateSeriesStep
114 :: ty `In` '[ 'PGint4, 'PGint8, 'PGnumeric]
126 :: ty `In` '[ 'PGint4, 'PGint8, 'PGnumeric]
115− => SetOfFunctionN "generate_series" '[null ty, null ty, null ty]
127+ => SetFunctionN "generate_series" '[null ty, null ty, null ty]
116 '["generate_series" ::: null ty] -- ^ set returning function
128 '["generate_series" ::: null ty] -- ^ set returning function
117−generateSeriesStep = unsafeSetOfFunctionN
129+generateSeriesStep = unsafeSetFunctionN
118
130
119{- | @generateSeries (start :* stop *: step)@
131{- | @generateSeries (start :* stop *: step)@
120
132
@@ -122,6 +134,6 @@ Generate a series of values, from @start@ to @stop@ with a step size of @step@
122-}
134-}
123generateSeriesTimestamp
135generateSeriesTimestamp
124 :: ty `In` '[ 'PGtimestamp, 'PGtimestamptz]
136 :: ty `In` '[ 'PGtimestamp, 'PGtimestamptz]
125− => SetOfFunctionN "generate_series" '[null ty, null ty, null 'PGinterval]
137+ => SetFunctionN "generate_series" '[null ty, null ty, null 'PGinterval]
126 '["generate_series" ::: null ty] -- ^ set returning function
138 '["generate_series" ::: null ty] -- ^ set returning function
127−generateSeriesTimestamp = unsafeSetOfFunctionN
139+generateSeriesTimestamp = unsafeSetFunctionN
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Text.hs+3−3
@@ -30,17 +30,17 @@ import Squeal.PostgreSQL.Schema
30
30
31-- | >>> printSQL $ lower "ARRRGGG"
31-- | >>> printSQL $ lower "ARRRGGG"
32-- lower(E'ARRRGGG')
32-- lower(E'ARRRGGG')
33−lower :: null 'PGtext :--> null 'PGtext
33+lower :: null 'PGtext --> null 'PGtext
34lower = unsafeFunction "lower"
34lower = unsafeFunction "lower"
35
35
36-- | >>> printSQL $ upper "eeee"
36-- | >>> printSQL $ upper "eeee"
37-- upper(E'eeee')
37-- upper(E'eeee')
38−upper :: null 'PGtext :--> null 'PGtext
38+upper :: null 'PGtext --> null 'PGtext
39upper = unsafeFunction "upper"
39upper = unsafeFunction "upper"
40
40
41-- | >>> printSQL $ charLength "four"
41-- | >>> printSQL $ charLength "four"
42-- char_length(E'four')
42-- char_length(E'four')
43−charLength :: null 'PGtext :--> null 'PGint4
43+charLength :: null 'PGtext --> null 'PGint4
44charLength = unsafeFunction "char_length"
44charLength = unsafeFunction "char_length"
45
45
46-- | The `like` expression returns true if the @string@ matches
46-- | The `like` expression returns true if the @string@ matches
squeal-postgresql/src/Squeal/PostgreSQL/Expression/TextSearch.hs+19−20
@@ -55,7 +55,7 @@ import Squeal.PostgreSQL.Schema
55(.|) = unsafeBinaryOp "||"
55(.|) = unsafeBinaryOp "||"
56
56
57-- | negate a `Squeal.PostgreSQL.Expression.Type.tsquery`
57-- | negate a `Squeal.PostgreSQL.Expression.Type.tsquery`
58−(.!) :: null 'PGtsquery :--> null 'PGtsquery
58+(.!) :: null 'PGtsquery --> null 'PGtsquery
59(.!) = unsafeLeftOp "!!"
59(.!) = unsafeLeftOp "!!"
60
60
61-- | `Squeal.PostgreSQL.Expression.Type.tsquery` followed by
61-- | `Squeal.PostgreSQL.Expression.Type.tsquery` followed by
@@ -66,51 +66,50 @@ import Squeal.PostgreSQL.Schema
66-- | convert array of lexemes to `Squeal.PostgreSQL.Expression.Type.tsvector`
66-- | convert array of lexemes to `Squeal.PostgreSQL.Expression.Type.tsvector`
67arrayToTSvector
67arrayToTSvector
68 :: null ('PGvararray ('NotNull 'PGtext))
68 :: null ('PGvararray ('NotNull 'PGtext))
69− :--> null 'PGtsvector
69+ --> null 'PGtsvector
70arrayToTSvector = unsafeFunction "array_to_tsvector"
70arrayToTSvector = unsafeFunction "array_to_tsvector"
71
71
72-- | number of lexemes in `Squeal.PostgreSQL.Expression.Type.tsvector`
72-- | number of lexemes in `Squeal.PostgreSQL.Expression.Type.tsvector`
73−tsvectorLength :: null 'PGtsvector :--> null 'PGint4
73+tsvectorLength :: null 'PGtsvector --> null 'PGint4
74tsvectorLength = unsafeFunction "length"
74tsvectorLength = unsafeFunction "length"
75
75
76-- | number of lexemes plus operators in `Squeal.PostgreSQL.Expression.Type.tsquery`
76-- | number of lexemes plus operators in `Squeal.PostgreSQL.Expression.Type.tsquery`
77−numnode :: null 'PGtsquery :--> null 'PGint4
77+numnode :: null 'PGtsquery --> null 'PGint4
78numnode = unsafeFunction "numnode"
78numnode = unsafeFunction "numnode"
79
79
80-- | produce `Squeal.PostgreSQL.Expression.Type.tsquery` ignoring punctuation
80-- | produce `Squeal.PostgreSQL.Expression.Type.tsquery` ignoring punctuation
81−plainToTSquery :: null 'PGtext :--> null 'PGtsquery
81+plainToTSquery :: null 'PGtext --> null 'PGtsquery
82plainToTSquery = unsafeFunction "plainto_tsquery"
82plainToTSquery = unsafeFunction "plainto_tsquery"
83
83
84-- | produce `Squeal.PostgreSQL.Expression.Type.tsquery` that searches for a phrase,
84-- | produce `Squeal.PostgreSQL.Expression.Type.tsquery` that searches for a phrase,
85-- ignoring punctuation
85-- ignoring punctuation
86−phraseToTSquery :: null 'PGtext :--> null 'PGtsquery
86+phraseToTSquery :: null 'PGtext --> null 'PGtsquery
87phraseToTSquery = unsafeFunction "phraseto_tsquery"
87phraseToTSquery = unsafeFunction "phraseto_tsquery"
88
88
89-- | produce `Squeal.PostgreSQL.Expression.Type.tsquery` from a web search style query
89-- | produce `Squeal.PostgreSQL.Expression.Type.tsquery` from a web search style query
90−websearchToTSquery :: null 'PGtext :--> null 'PGtsquery
90+websearchToTSquery :: null 'PGtext --> null 'PGtsquery
91websearchToTSquery = unsafeFunction "websearch_to_tsquery"
91websearchToTSquery = unsafeFunction "websearch_to_tsquery"
92
92
93-- | get indexable part of a `Squeal.PostgreSQL.Expression.Type.tsquery`
93-- | get indexable part of a `Squeal.PostgreSQL.Expression.Type.tsquery`
94−queryTree :: null 'PGtsquery :--> null 'PGtext
94+queryTree :: null 'PGtsquery --> null 'PGtext
95queryTree = unsafeFunction "query_tree"
95queryTree = unsafeFunction "query_tree"
96
96
97-- | normalize words and convert to `Squeal.PostgreSQL.Expression.Type.tsquery`
97-- | normalize words and convert to `Squeal.PostgreSQL.Expression.Type.tsquery`
98−toTSquery :: null 'PGtext :--> null 'PGtsquery
98+toTSquery :: null 'PGtext --> null 'PGtsquery
99toTSquery = unsafeFunction "to_tsquery"
99toTSquery = unsafeFunction "to_tsquery"
100
100
101-- | reduce document text to `Squeal.PostgreSQL.Expression.Type.tsvector`
101-- | reduce document text to `Squeal.PostgreSQL.Expression.Type.tsvector`
102toTSvector
102toTSvector
103 :: ty `In` '[ 'PGtext, 'PGjson, 'PGjsonb]
103 :: ty `In` '[ 'PGtext, 'PGjson, 'PGjsonb]
104− => null ty :--> null 'PGtsvector
104+ => null ty --> null 'PGtsvector
105toTSvector = unsafeFunction "to_tsvector"
105toTSvector = unsafeFunction "to_tsvector"
106
106
107-- | assign weight to each element of `Squeal.PostgreSQL.Expression.Type.tsvector`
107-- | assign weight to each element of `Squeal.PostgreSQL.Expression.Type.tsvector`
108−setWeight
109− :: FunctionN '[null 'PGtsvector, null ('PGchar 1)] (null 'PGtsvector)
108+setWeight :: '[null 'PGtsvector, null ('PGchar 1)] ---> null 'PGtsvector
110setWeight = unsafeFunctionN "set_weight"
109setWeight = unsafeFunctionN "set_weight"
111
110
112-- | remove positions and weights from `Squeal.PostgreSQL.Expression.Type.tsvector`
111-- | remove positions and weights from `Squeal.PostgreSQL.Expression.Type.tsvector`
113−strip :: null 'PGtsvector :--> null 'PGtsvector
112+strip :: null 'PGtsvector --> null 'PGtsvector
114strip = unsafeFunction "strip"
113strip = unsafeFunction "strip"
115
114
116-- | @jsonToTSvector (document *: filter)@
115-- | @jsonToTSvector (document *: filter)@
@@ -123,7 +122,7 @@ strip = unsafeFunction "strip"
123-- "boolean" (to include all Boolean values in the string format "true"/"false"),
122-- "boolean" (to include all Boolean values in the string format "true"/"false"),
124-- "key" (to include all keys) or "all" (to include all above).
123-- "key" (to include all keys) or "all" (to include all above).
125-- These values can be combined together to include, e.g. all string and numeric values.
124-- These values can be combined together to include, e.g. all string and numeric values.
126−jsonToTSvector :: FunctionN '[null 'PGjson, null 'PGjson] (null 'PGtsvector)
125+jsonToTSvector :: '[null 'PGjson, null 'PGjson] ---> null 'PGtsvector
127jsonToTSvector = unsafeFunctionN "json_to_tsvector"
126jsonToTSvector = unsafeFunctionN "json_to_tsvector"
128
127
129-- | @jsonbToTSvector (document *: filter)@
128-- | @jsonbToTSvector (document *: filter)@
@@ -136,23 +135,23 @@ jsonToTSvector = unsafeFunctionN "json_to_tsvector"
136-- "boolean" (to include all Boolean values in the string format "true"/"false"),
135-- "boolean" (to include all Boolean values in the string format "true"/"false"),
137-- "key" (to include all keys) or "all" (to include all above).
136-- "key" (to include all keys) or "all" (to include all above).
138-- These values can be combined together to include, e.g. all string and numeric values.
137-- These values can be combined together to include, e.g. all string and numeric values.
139−jsonbToTSvector :: FunctionN '[null 'PGjsonb, null 'PGjsonb] (null 'PGtsvector)
138+jsonbToTSvector :: '[null 'PGjsonb, null 'PGjsonb] ---> null 'PGtsvector
140jsonbToTSvector = unsafeFunctionN "jsonb_to_tsvector"
139jsonbToTSvector = unsafeFunctionN "jsonb_to_tsvector"
141
140
142-- | remove given lexeme from `Squeal.PostgreSQL.Expression.Type.tsvector`
141-- | remove given lexeme from `Squeal.PostgreSQL.Expression.Type.tsvector`
143−tsDelete :: FunctionN
142+tsDelete ::
144 '[null 'PGtsvector, null ('PGvararray ('NotNull 'PGtext))]
143 '[null 'PGtsvector, null ('PGvararray ('NotNull 'PGtext))]
145− (null 'PGtsvector)
144+ ---> null 'PGtsvector
146tsDelete = unsafeFunctionN "ts_delete"
145tsDelete = unsafeFunctionN "ts_delete"
147
146
148-- | select only elements with given weights from `Squeal.PostgreSQL.Expression.Type.tsvector`
147-- | select only elements with given weights from `Squeal.PostgreSQL.Expression.Type.tsvector`
149−tsFilter :: FunctionN
148+tsFilter ::
150 '[null 'PGtsvector, null ('PGvararray ('NotNull ('PGchar 1)))]
149 '[null 'PGtsvector, null ('PGvararray ('NotNull ('PGchar 1)))]
151− (null 'PGtsvector)
150+ ---> null 'PGtsvector
152tsFilter = unsafeFunctionN "ts_filter"
151tsFilter = unsafeFunctionN "ts_filter"
153
152
154-- | display a `Squeal.PostgreSQL.Expression.Type.tsquery` match
153-- | display a `Squeal.PostgreSQL.Expression.Type.tsquery` match
155tsHeadline
154tsHeadline
156 :: document `In` '[ 'PGtext, 'PGjson, 'PGjsonb]
155 :: document `In` '[ 'PGtext, 'PGjson, 'PGjsonb]
157− => FunctionN '[null document, null 'PGtsquery] (null 'PGtext)
156+ => '[null document, null 'PGtsquery] ---> null 'PGtext
158tsHeadline = unsafeFunctionN "ts_headline"
157tsHeadline = unsafeFunctionN "ts_headline"
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Time.hs+7−12
@@ -17,6 +17,7 @@ Date/Time functions and operators
17 , OverloadedStrings
17 , OverloadedStrings
18 , PolyKinds
18 , PolyKinds
19 , RankNTypes
19 , RankNTypes
20+ , TypeOperators
20#-}
21#-}
21
22
22module Squeal.PostgreSQL.Expression.Time
23module Squeal.PostgreSQL.Expression.Time
@@ -85,9 +86,7 @@ Create date from year, month and day fields
85>>> printSQL (makeDate (1984 :* 7 *: 3))
86>>> printSQL (makeDate (1984 :* 7 *: 3))
86make_date(1984, 7, 3)
87make_date(1984, 7, 3)
87-}
88-}
88−makeDate :: FunctionN
89− '[ null 'PGint4, null 'PGint4, null 'PGint4 ]
89+makeDate :: '[ null 'PGint4, null 'PGint4, null 'PGint4 ] ---> null 'PGdate
90− ( null 'PGdate )
91makeDate = unsafeFunctionN "make_date"
90makeDate = unsafeFunctionN "make_date"
92
91
93{-|
92{-|
@@ -96,9 +95,7 @@ Create time from hour, minute and seconds fields
96>>> printSQL (makeTime (8 :* 15 *: 23.5))
95>>> printSQL (makeTime (8 :* 15 *: 23.5))
97make_time(8, 15, 23.5)
96make_time(8, 15, 23.5)
98-}
97-}
99−makeTime :: FunctionN
100− '[ null 'PGint4, null 'PGint4, null 'PGfloat8 ]
98+makeTime :: '[ null 'PGint4, null 'PGint4, null 'PGfloat8 ] ---> null 'PGtime
101− ( null 'PGtime )
102makeTime = unsafeFunctionN "make_time"
99makeTime = unsafeFunctionN "make_time"
103
100
104{-|
101{-|
@@ -107,10 +104,9 @@ Create timestamp from year, month, day, hour, minute and seconds fields
107>>> printSQL (makeTimestamp (2013 :* 7 :* 15 :* 8 :* 15 *: 23.5))
104>>> printSQL (makeTimestamp (2013 :* 7 :* 15 :* 8 :* 15 *: 23.5))
108make_timestamp(2013, 7, 15, 8, 15, 23.5)
105make_timestamp(2013, 7, 15, 8, 15, 23.5)
109-}
106-}
110−makeTimestamp :: FunctionN
107+makeTimestamp ::
111 '[ null 'PGint4, null 'PGint4, null 'PGint4
108 '[ null 'PGint4, null 'PGint4, null 'PGint4
112− , null 'PGint4, null 'PGint4, null 'PGfloat8 ]
109+ , null 'PGint4, null 'PGint4, null 'PGfloat8 ] ---> null 'PGtimestamp
113− ( null 'PGtimestamp )
114makeTimestamp = unsafeFunctionN "make_timestamp"
110makeTimestamp = unsafeFunctionN "make_timestamp"
115
111
116{-|
112{-|
@@ -121,10 +117,9 @@ the current time zone is used
121>>> printSQL (makeTimestamptz (2013 :* 7 :* 15 :* 8 :* 15 *: 23.5))
117>>> printSQL (makeTimestamptz (2013 :* 7 :* 15 :* 8 :* 15 *: 23.5))
122make_timestamptz(2013, 7, 15, 8, 15, 23.5)
118make_timestamptz(2013, 7, 15, 8, 15, 23.5)
123-}
119-}
124−makeTimestamptz :: FunctionN
120+makeTimestamptz ::
125 '[ null 'PGint4, null 'PGint4, null 'PGint4
121 '[ null 'PGint4, null 'PGint4, null 'PGint4
126− , null 'PGint4, null 'PGint4, null 'PGfloat8 ]
122+ , null 'PGint4, null 'PGint4, null 'PGfloat8 ] ---> null 'PGtimestamptz
127− ( null 'PGtimestamptz )
128makeTimestamptz = unsafeFunctionN "make_timestamptz"
123makeTimestamptz = unsafeFunctionN "make_timestamptz"
129
124
130{-|
125{-|
squeal-postgresql/src/Squeal/PostgreSQL/Expression/Type.hs+8
@@ -31,6 +31,7 @@ module Squeal.PostgreSQL.Expression.Type
31 , astype
31 , astype
32 , inferredtype
32 , inferredtype
33 , PGTyped (..)
33 , PGTyped (..)
34+ , FieldTyped (..)
34 , typedef
35 , typedef
35 , typetable
36 , typetable
36 , typeview
37 , typeview
@@ -339,3 +340,10 @@ instance (SOP.All KnownNat dims, PGTyped schemas ty)
339instance PGTyped schemas (null 'PGtsvector) where pgtype = tsvector
340instance PGTyped schemas (null 'PGtsvector) where pgtype = tsvector
340instance PGTyped schemas (null 'PGtsquery) where pgtype = tsquery
341instance PGTyped schemas (null 'PGtsquery) where pgtype = tsquery
341instance PGTyped schemas (null 'PGoid) where pgtype = oid
342instance PGTyped schemas (null 'PGoid) where pgtype = oid
343+
344+-- | Lift `PGTyped` to a field
345+class FieldTyped schemas ty where
346+ fieldtype :: Aliased (TypeExpression schemas) ty
347+instance (KnownSymbol alias, PGTyped schemas ty)
348+ => FieldTyped schemas (alias ::: ty) where
349+ fieldtype = pgtype `As` Alias
squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+3
@@ -167,6 +167,9 @@ import qualified GHC.Generics as GHC
167import Squeal.PostgreSQL.Alias
167import Squeal.PostgreSQL.Alias
168import Squeal.PostgreSQL.Binary
168import Squeal.PostgreSQL.Binary
169import Squeal.PostgreSQL.Definition
169import Squeal.PostgreSQL.Definition
170+import Squeal.PostgreSQL.Definition.Table
171+import Squeal.PostgreSQL.Definition.Table.Column
172+import Squeal.PostgreSQL.Definition.Table.Constraint
170import Squeal.PostgreSQL.Expression.Comparison
173import Squeal.PostgreSQL.Expression.Comparison
171import Squeal.PostgreSQL.Expression.Parameter
174import Squeal.PostgreSQL.Expression.Parameter
172import Squeal.PostgreSQL.Expression.Time
175import Squeal.PostgreSQL.Expression.Time
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+74−4
@@ -44,6 +44,8 @@ module Squeal.PostgreSQL.Schema
44 , ColumnsType
44 , ColumnsType
45 , TableType
45 , TableType
46 , SchemumType (..)
46 , SchemumType (..)
47+ , IndexType (..)
48+ , FunctionType
47 , OperatorType (..)
49 , OperatorType (..)
48 , ReturnsType (..)
50 , ReturnsType (..)
49 , SchemaType
51 , SchemaType
@@ -60,7 +62,12 @@ module Squeal.PostgreSQL.Schema
60 , PGlabel (..)
62 , PGlabel (..)
61 -- * Data Definitions
63 -- * Data Definitions
62 , Create
64 , Create
65+ , CreateIfNotExists
66+ , CreateOrReplace
63 , Drop
67 , Drop
68+ , DropSchemum
69+ , DropIfExists
70+ , DropSchemumIfExists
64 , Alter
71 , Alter
65 , Rename
72 , Rename
66 , ConstraintInvolves
73 , ConstraintInvolves
@@ -322,16 +329,69 @@ type family Create alias x xs where
322 Create alias x (alias ::: y ': xs) = TypeError
329 Create alias x (alias ::: y ': xs) = TypeError
323 ('Text "Create: alias "
330 ('Text "Create: alias "
324 ':<>: 'ShowType alias
331 ':<>: 'ShowType alias
325− ':<>: 'Text "already in use")
332+ ':<>: 'Text "already exists")
326 Create alias y (x ': xs) = x ': Create alias y xs
333 Create alias y (x ': xs) = x ': Create alias y xs
327
334
335+type family CreateIfNotExists alias x xs where
336+ CreateIfNotExists alias x '[] = '[alias ::: x]
337+ CreateIfNotExists alias x (alias ::: y ': xs) = alias ::: y ': xs
338+ CreateIfNotExists alias y (x ': xs) = x ': CreateIfNotExists alias y xs
339+
340+type family CreateOrReplace alias x xs where
341+ CreateOrReplace alias x '[] = '[alias ::: x]
342+ CreateOrReplace alias x (alias ::: x ': xs) = alias ::: x ': xs
343+ CreateOrReplace alias x (alias ::: y ': xs) = TypeError
344+ ('Text "CreateOrReplace: expected type "
345+ ':<>: 'ShowType x
346+ ':<>: 'Text " but alias "
347+ ':<>: 'ShowType alias
348+ ':<>: 'Text " has type "
349+ ':<>: 'ShowType y)
350+ CreateOrReplace alias y (x ': xs) = x ': CreateOrReplace alias y xs
351+
328-- | @Drop alias xs@ removes the type associated with @alias@ in @xs@
352-- | @Drop alias xs@ removes the type associated with @alias@ in @xs@
329-- and is used in `Squeal.PostgreSQL.Definition.dropTable` statements
353-- and is used in `Squeal.PostgreSQL.Definition.dropTable` statements
330-- and in @ALTER TABLE@ `Squeal.PostgreSQL.Definition.dropColumn` statements.
354-- and in @ALTER TABLE@ `Squeal.PostgreSQL.Definition.dropColumn` statements.
331type family Drop alias xs where
355type family Drop alias xs where
356+ Drop alias '[] = TypeError
357+ ('Text "Drop: alias "
358+ ':<>: 'ShowType alias
359+ ':<>: 'Text " does not exist" )
332− Drop alias ((alias ::: x) ': xs) = xs
360+ Drop alias (alias ::: x ': xs) = xs
333 Drop alias (x ': xs) = x ': Drop alias xs
361 Drop alias (x ': xs) = x ': Drop alias xs
334
362
363+type family DropSchemum alias sch xs where
364+ DropSchemum alias sch '[] = TypeError
365+ ('Text "DropSchemum: alias "
366+ ':<>: 'ShowType alias
367+ ':<>: 'Text " does not exist" )
368+ DropSchemum alias sch (alias ::: sch x ': xs) = xs
369+ DropSchemum alias sch0 (alias ::: sch1 x ': xs) = TypeError
370+ ('Text "DropSchemum: expected schemum "
371+ ':<>: 'ShowType sch0
372+ ':<>: 'Text " but alias "
373+ ':<>: 'ShowType alias
374+ ':<>: 'Text " has schemum "
375+ ':<>: 'ShowType sch1)
376+ DropSchemum alias sch (x ': xs) = x ': DropSchemum alias sch xs
377+
378+type family DropIfExists alias xs where
379+ DropIfExists alias '[] = '[]
380+ DropIfExists alias (alias ::: x ': xs) = xs
381+ DropIfExists alias (x ': xs) = x ': DropIfExists alias xs
382+
383+type family DropSchemumIfExists alias sch xs where
384+ DropSchemumIfExists alias sch '[] = '[]
385+ DropSchemumIfExists alias sch (alias ::: sch x ': xs) = xs
386+ DropSchemumIfExists alias sch0 (alias ::: sch1 x ': xs) = TypeError
387+ ('Text "DropSchemumIfExists: expected schemum "
388+ ':<>: 'ShowType sch1
389+ ':<>: 'Text " but alias "
390+ ':<>: 'ShowType alias
391+ ':<>: 'Text " has schemum "
392+ ':<>: 'ShowType sch0)
393+ DropSchemumIfExists alias sch (x ': xs) = x ': DropSchemumIfExists alias sch xs
394+
335-- | @Alter alias x xs@ replaces the type associated with an @alias@ in @xs@
395-- | @Alter alias x xs@ replaces the type associated with an @alias@ in @xs@
336-- with the type @x@ and is used in `Squeal.PostgreSQL.Definition.alterTable`
396-- with the type @x@ and is used in `Squeal.PostgreSQL.Definition.alterTable`
337-- and `Squeal.PostgreSQL.Definition.alterColumn`.
397-- and `Squeal.PostgreSQL.Definition.alterColumn`.
@@ -368,11 +428,21 @@ data SchemumType
368 = Table TableType
428 = Table TableType
369 | View RowType
429 | View RowType
370 | Typedef PGType
430 | Typedef PGType
371− | Index
431+ | Index IndexType
372− | Function [NullityType] ReturnsType
432+ | Function FunctionType
373 | Operator OperatorType
433 | Operator OperatorType
374 | UnsafeSchemum Symbol
434 | UnsafeSchemum Symbol
375
435
436+type FunctionType = ([NullityType], ReturnsType)
437+
438+data IndexType
439+ = Btree
440+ | Hash
441+ | Gist
442+ | Spgist
443+ | Gin
444+ | Brin
445+
376data ReturnsType
446data ReturnsType
377 = Returns NullityType
447 = Returns NullityType
378 | ReturnsTable RowType
448 | ReturnsTable RowType