git.iko.soy/squeal
on dev help sign in
Merge pull request #45 from echatav/docs

Docs

commitc31bdbe01c5417070c7bf6a81512356a3ee64a53 authorEitan Chatav <eitan.chatav@gmail.com> dateFri 25 Aug 2017, 15:59 (9 years ago) parent535318202ad26e
11 files changed+1642−379
compare with dev
unifiedsplit
squeal-postgresql/exe/Example.hs+2−2 squeal-postgresql/src/Squeal/PostgreSQL.hs+10 squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+3−3 squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+360−63 squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+343−108 squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+212−33 squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+227−90 squeal-postgresql/src/Squeal/PostgreSQL/Prettyprint.hs+17 squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+456−70 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+9−7 squeal-postgresql/test/Squeal/PostgreSQL/ManipulationSpec.hs+3−3
squeal-postgresql/exe/Example.hs+2−2
@@ -59,12 +59,12 @@ main = do
5959 ( Values
6060 (param @1 `As` #col1 :* param @2 `As` #col2 :* Nil)
6161 [param @3 `As` #col1 :* param @4 `As` #col2 :* Nil]
62− ) Conflict (Returning Nil)
62+ ) OnConflictDoNothing (Returning Nil)
6363 liftBase $ Char8.putStrLn "manipulating"
6464 _insertResult <- manipulateParams insert
6565 (1::Int32,2::Int32,3::Int32,4::Int32)
6666 liftBase $ Char8.putStrLn "querying"
67− result <- query $
67+ result <- runQuery $
6868 selectStar (from (Table (#table1 `As` #table1)))
6969 value00 <- getValue (RowNumber 0) (columnNumber @0) result
7070 value01 <- getValue (RowNumber 0) (columnNumber @1) result
squeal-postgresql/src/Squeal/PostgreSQL.hs+10
@@ -1,3 +1,13 @@
1+{-|
2+Module: Squeal.PostgreSQL
3+Description: Squeel export module
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+`Squeal.PostgreSQL` re-exports @squeel-postgresql@'s main modules.
9+-}
10+
111module Squeal.PostgreSQL
212 ( module Squeal.PostgreSQL.Binary
313 , module Squeal.PostgreSQL.Definition
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+3−3
@@ -249,10 +249,10 @@ instance
249249-- >>> toParams @(Only (Maybe Text)) @'[ 'Required ('Null 'PGtext)] (Only (Just "foo"))
250250-- K (Just "foo") :* Nil
251251--
252−-- >>> type PGShortRow = '["only" ::: 'Required ('Null 'PGtext)]
252+-- >>> type PGShortRow = '["fromOnly" ::: 'Required ('Null 'PGtext)]
253253-- >>> fromRow @PGShortRow @(Only (Maybe Text)) (K (Just "bar") :* Nil)
254−-- Only {only = Just "bar"}
255−newtype Only x = Only { only :: x }
254+-- Only {fromOnly = Just "bar"}
255+newtype Only x = Only { fromOnly :: x }
256256 deriving (Functor,Foldable,Traversable,Eq,Ord,Read,Show,GHC.Generic)
257257instance Generic (Only x)
258258instance HasDatatypeInfo (Only x)
squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+360−63
@@ -1,3 +1,13 @@
1+{-|
2+Module: Squeal.PostgreSQL.Definition
3+Description: Squeal data definition language
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+Squeal data definition language.
9+-}
10+
111{-# LANGUAGE
212 DataKinds
313 , DeriveDataTypeable
@@ -14,25 +24,30 @@
1424#-}
1525
1626module Squeal.PostgreSQL.Definition
17− ( -- * Data Definition Language
27+ ( -- * Definition
1828 Definition (UnsafeDefinition, renderDefinition)
29+ -- * Create
1930 , createTable
2031 , TableConstraint (UnsafeTableConstraint, renderTableConstraint)
2132 , check
2233 , unique
2334 , primaryKey
2435 , foreignKey
25− , OnDelete (OnDeleteNoAction, OnDeleteRestrict, OnDeleteCascade)
26− , renderOnDelete
27− , OnUpdate (OnUpdateNoAction, OnUpdateRestrict, OnUpdateCascade)
28− , renderOnUpdate
36+ , OnDeleteClause (OnDeleteNoAction, OnDeleteRestrict, OnDeleteCascade)
37+ , renderOnDeleteClause
38+ , OnUpdateClause (OnUpdateNoAction, OnUpdateRestrict, OnUpdateCascade)
39+ , renderOnUpdateClause
40+ -- * Drop
2941 , dropTable
42+ -- * Alter
3043 , alterTable
3144 , alterTableRename
32− , AlterTable (UnsafeAlterTable, renderAlterTable)
45+ , alterTableAddConstraint
46+ , AlterColumns (UnsafeAlterColumns, renderAlterColumns)
3347 , addColumnDefault
3448 , addColumnNull
3549 , dropColumn
50+ , dropColumnCascade
3651 , renameColumn
3752 , alterColumn
3853 , AlterColumn (UnsafeAlterColumn, renderAlterColumn)
@@ -47,10 +62,10 @@ import Control.Category
4762import Control.DeepSeq
4863import Data.ByteString
4964import Data.Monoid
50−import Generics.SOP
5165import GHC.TypeLits
5266import Prelude hiding ((.), id)
5367
68+import qualified Generics.SOP as SOP
5469import qualified GHC.Generics as GHC
5570
5671import Squeal.PostgreSQL.Expression
@@ -61,6 +76,9 @@ import Squeal.PostgreSQL.Schema
6176statements
6277-----------------------------------------}
6378
79+-- | A `Definition` is a statement that changes the schema of the
80+-- database, like a `createTable`, `dropTable`, or `alterTable` command.
81+-- `Definition`s may be composed using the `>>>` operator.
6482newtype Definition
6583 (schema0 :: TablesType)
6684 (schema1 :: TablesType)
@@ -76,11 +94,21 @@ instance Category Definition where
7694CREATE statements
7795-----------------------------------------}
7896
97+-- | `createTable` adds a table to the schema.
98+--
99+-- >>> :set -XOverloadedLabels
100+-- >>> :{
101+-- renderDefinition $
102+-- createTable #tab (int `As` #a :* real `As` #b :* Nil) []
103+-- :}
104+-- "CREATE TABLE tab (a int, b real);"
79105createTable
80− :: (KnownSymbol table, SListI columns)
81− => Alias table
106+ :: (KnownSymbol table, SOP.SListI columns)
107+ => Alias table -- ^ the name of the table to add
82108 -> NP (Aliased TypeExpression) (column ': columns)
109+ -- ^ the names and datatype of each column
83110 -> [TableConstraint schema (column ': columns)]
111+ -- ^ constraints that must hold for the table
84112 -> Definition schema (Create table (column ': columns) schema)
85113createTable table columns constraints = UnsafeDefinition $
86114 "CREATE TABLE" <+> renderAlias table
@@ -97,74 +125,175 @@ createTable table columns constraints = UnsafeDefinition $
97125 [] -> ""
98126 _ -> ", " <> commaSeparated (renderTableConstraint <$> constraints)
99127
128+-- | Data types are a way to limit the kind of data that can be stored in a
129+-- table. For many applications, however, the constraint they provide is
130+-- too coarse. For example, a column containing a product price should
131+-- probably only accept positive values. But there is no standard data type
132+-- that accepts only positive numbers. Another issue is that you might want
133+-- to constrain column data with respect to other columns or rows.
134+-- For example, in a table containing product information,
135+-- there should be only one row for each product number.
136+-- `TableConstraint`s give you as much control over the data in your tables
137+-- as you wish. If a user attempts to store data in a column that would
138+-- violate a constraint, an error is raised. This applies
139+-- even if the value came from the default value definition.
100140newtype TableConstraint
101141 (schema :: TablesType)
102142 (columns :: ColumnsType)
103143 = UnsafeTableConstraint { renderTableConstraint :: ByteString }
104144 deriving (GHC.Generic,Show,Eq,Ord,NFData)
105145
146+-- | A `check` constraint is the most generic `TableConstraint` type.
147+-- It allows you to specify that the value in a certain column must satisfy
148+-- a Boolean (truth-value) expression.
149+--
150+-- >>> :{
151+-- renderDefinition $
152+-- createTable #tab
153+-- ( (int & notNull) `As` #a :*
154+-- (int & notNull) `As` #b :* Nil )
155+-- [ check (#a .> #b) ]
156+-- :}
157+-- "CREATE TABLE tab (a int NOT NULL, b int NOT NULL, CHECK ((a > b)));"
106158check
107159 :: Condition '[table ::: columns] 'Ungrouped '[]
160+ -- ^ condition to check
108161 -> TableConstraint schema columns
109162check condition = UnsafeTableConstraint $
110163 "CHECK" <+> parenthesized (renderExpression condition)
111164
165+-- | A `unique` constraint ensure that the data contained in a column,
166+-- or a group of columns, is unique among all the rows in the table.
167+--
168+-- >>> :{
169+-- renderDefinition $
170+-- createTable #tab
171+-- ( int `As` #a :*
172+-- int `As` #b :* Nil )
173+-- [ unique (Column #a :* Column #b :* Nil) ]
174+-- :}
175+-- "CREATE TABLE tab (a int, b int, UNIQUE (a, b));"
112176unique
113− :: SListI subcolumns
177+ :: SOP.SListI subcolumns
114178 => NP (Column columns) subcolumns
179+ -- ^ unique column or group of columns
115180 -> TableConstraint schema columns
116181unique columns = UnsafeTableConstraint $
117182 "UNIQUE" <+> parenthesized (renderCommaSeparated renderColumn columns)
118183
184+-- | A `primaryKey` constraint indicates that a column, or group of columns,
185+-- can be used as a unique identifier for rows in the table.
186+-- This requires that the values be both unique and not null.
187+--
188+-- >>> :{
189+-- renderDefinition $
190+-- createTable #tab
191+-- ( serial `As` #id :*
192+-- (text & notNull) `As` #name :* Nil )
193+-- [ primaryKey (Column #id :* Nil) ]
194+-- :}
195+-- "CREATE TABLE tab (id serial, name text NOT NULL, PRIMARY KEY (id));"
119196primaryKey
120− :: (SListI subcolumns, AllNotNull subcolumns)
197+ :: (SOP.SListI subcolumns, AllNotNull subcolumns)
121198 => NP (Column columns) subcolumns
199+ -- ^ identifying column or group of columns
122200 -> TableConstraint schema columns
123201primaryKey columns = UnsafeTableConstraint $
124202 "PRIMARY KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)
125203
204+-- | A `foreignKey` specifies that the values in a column
205+-- (or a group of columns) must match the values appearing in some row of
206+-- another table. We say this maintains the referential integrity
207+-- between two related tables.
208+--
209+-- >>> :{
210+-- let
211+-- definition :: Definition '[]
212+-- '[ "users" :::
213+-- '[ "id" ::: 'Optional ('NotNull 'PGint4)
214+-- , "username" ::: 'Required ('NotNull 'PGtext)
215+-- ]
216+-- , "emails" :::
217+-- '[ "id" ::: 'Optional ('NotNull 'PGint4)
218+-- , "userid" ::: 'Required ('NotNull 'PGint4)
219+-- , "email" ::: 'Required ('NotNull 'PGtext)
220+-- ]
221+-- ]
222+-- definition =
223+-- createTable #users
224+-- (serial `As` #id :* (text & notNull) `As` #username :* Nil)
225+-- [primaryKey (Column #id :* Nil)] >>>
226+-- createTable #emails
227+-- ( serial `As` #id :*
228+-- (integer & notNull) `As` #userid :*
229+-- (text & notNull) `As` #email :* Nil )
230+-- [ primaryKey (Column #id :* Nil)
231+-- , foreignKey (Column #userid :* Nil) #users (Column #id :* Nil)
232+-- OnDeleteCascade OnUpdateRestrict
233+-- ]
234+-- in renderDefinition definition
235+-- :}
236+-- "CREATE TABLE users (id serial, username text NOT NULL, PRIMARY KEY (id)); CREATE TABLE emails (id serial, userid integer NOT NULL, email text NOT NULL, PRIMARY KEY (id), FOREIGN KEY (userid) REFERENCES users (id) ON DELETE CASCADE ON UPDATE RESTRICT);"
126237foreignKey
127238 :: ( HasTable reftable schema refcolumns
128239 , SameTypes subcolumns refsubcolumns
129240 , NotAllNull subcolumns
130− , SListI subcolumns
131− , SListI refsubcolumns)
241+ , SOP.SListI subcolumns
242+ , SOP.SListI refsubcolumns)
132243 => NP (Column columns) subcolumns
244+ -- ^ column or columns in the table
133245 -> Alias reftable
246+ -- ^ reference table
134247 -> NP (Column refcolumns) refsubcolumns
135− -> OnDelete
136− -> OnUpdate
248+ -- ^ reference column or columns in the reference table
249+ -> OnDeleteClause
250+ -- ^ what to do when reference is deleted
251+ -> OnUpdateClause
252+ -- ^ what to do when reference is updated
137253 -> TableConstraint schema columns
138254foreignKey columns reftable refcolumns onDelete onUpdate =
139255 UnsafeTableConstraint $
140256 "FOREIGN KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)
141257 <+> "REFERENCES" <+> renderAlias reftable
142258 <+> parenthesized (renderCommaSeparated renderColumn refcolumns)
143− <+> renderOnDelete onDelete
144− <+> renderOnUpdate onUpdate
259+ <+> renderOnDeleteClause onDelete
260+ <+> renderOnUpdateClause onUpdate
145261
146−data OnDelete
262+-- | `OnDelete` indicates what to do with rows that reference a deleted row.
263+data OnDeleteClause
147264 = OnDeleteNoAction
148− | OnDeleteRestrict
265+ -- ^ if any referencing rows still exist when the constraint is checked,
266+ -- an error is raised
267+ | OnDeleteRestrict -- ^ prevents deletion of a referenced row
149268 | OnDeleteCascade
269+ -- ^ specifies that when a referenced row is deleted,
270+ -- row(s) referencing it should be automatically deleted as well
150271 deriving (GHC.Generic,Show,Eq,Ord)
151−instance NFData OnDelete
272+instance NFData OnDeleteClause
152273
153−renderOnDelete :: OnDelete -> ByteString
154−renderOnDelete = \case
274+-- | Render `OnDeleteClause`.
275+renderOnDeleteClause :: OnDeleteClause -> ByteString
276+renderOnDeleteClause = \case
155277 OnDeleteNoAction -> "ON DELETE NO ACTION"
156278 OnDeleteRestrict -> "ON DELETE RESTRICT"
157279 OnDeleteCascade -> "ON DELETE CASCADE"
158280
159−data OnUpdate
281+-- | Analagous to `OnDelete` there is also `OnUpdate` which is invoked
282+-- when a referenced column is changed (updated).
283+data OnUpdateClause
160284 = OnUpdateNoAction
161− | OnUpdateRestrict
285+ -- ^ if any referencing rows has not changed when the constraint is checked,
286+ -- an error is raised
287+ | OnUpdateRestrict -- ^ prevents update of a referenced row
162288 | OnUpdateCascade
289+ -- ^ the updated values of the referenced column(s) should be copied
290+ -- into the referencing row(s)
163291 deriving (GHC.Generic,Show,Eq,Ord)
164−instance NFData OnUpdate
292+instance NFData OnUpdateClause
165293
166−renderOnUpdate :: OnUpdate -> ByteString
167−renderOnUpdate = \case
294+-- | Render `OnUpdateClause`.
295+renderOnUpdateClause :: OnUpdateClause -> ByteString
296+renderOnUpdateClause = \case
168297 OnUpdateNoAction -> "ON UPDATE NO ACTION"
169298 OnUpdateRestrict -> "ON UPDATE RESTRICT"
170299 OnUpdateCascade -> "ON UPDATE CASCADE"
@@ -173,9 +302,13 @@ renderOnUpdate = \case
173302DROP statements
174303-----------------------------------------}
175304
305+-- | `dropTable` removes a table from the schema.
306+--
307+-- >>> renderDefinition $ dropTable #muh_table
308+-- "DROP TABLE muh_table;"
176309dropTable
177310 :: KnownSymbol table
178− => Alias table
311+ => Alias table -- ^ table to remove
179312 -> Definition schema (Drop table schema)
180313dropTable table = UnsafeDefinition $ "DROP TABLE" <+> renderAlias table <> ";"
181314
@@ -183,93 +316,257 @@ dropTable table = UnsafeDefinition $ "DROP TABLE" <+> renderAlias table <> ";"
183316ALTER statements
184317-----------------------------------------}
185318
319+-- | `alterTable` changes the definition of a table from the schema.
186320alterTable
187321 :: HasTable table schema columns0
188− => Alias table
189− -> AlterTable columns0 columns1
322+ => Alias table -- ^ table to alter
323+ -> AlterColumns columns0 columns1 -- ^ alteration to perform
190324 -> Definition schema (Alter table schema columns1)
191325alterTable table alteration = UnsafeDefinition $
192326 "ALTER TABLE"
193327 <+> renderAlias table
194− <+> renderAlterTable alteration
328+ <+> renderAlterColumns alteration
195329 <> ";"
196330
331+-- | `alterTableRename` changes the name of a table from the schema.
332+--
333+-- >>> renderDefinition $ alterTableRename #foo #bar
334+-- "ALTER TABLE foo RENAME TO bar;"
197335alterTableRename
198336 :: (KnownSymbol table0, KnownSymbol table1)
199− => Alias table0
200− -> Alias table1
337+ => Alias table0 -- ^ table to rename
338+ -> Alias table1 -- ^ what to rename it
201339 -> Definition schema (Rename table0 table1 schema)
202340alterTableRename table0 table1 = UnsafeDefinition $
203341 "ALTER TABLE" <+> renderAlias table0
204342 <+> "RENAME TO" <+> renderAlias table1 <> ";"
205343
206−newtype AlterTable
344+-- | An `alterTableAddConstraint` adds a table constraint.
345+--
346+-- >>> :{
347+-- let
348+-- definition :: Definition
349+-- '["tab" ::: '["col" ::: 'Required ('NotNull 'PGint4)]]
350+-- '["tab" ::: '["col" ::: 'Required ('NotNull 'PGint4)]]
351+-- definition = alterTableAddConstraint #tab (check (#col .> 0))
352+-- in renderDefinition definition
353+-- :}
354+-- "ALTER TABLE tab ADD CHECK ((col > 0));"
355+alterTableAddConstraint
356+ :: HasTable table schema columns
357+ => Alias table -- ^ table to constrain
358+ -> TableConstraint schema columns -- ^ what constraint to add
359+ -> Definition schema schema
360+alterTableAddConstraint table constraint = UnsafeDefinition $
361+ "ALTER TABLE" <+> renderAlias table
362+ <+> "ADD" <+> renderTableConstraint constraint <> ";"
363+
364+-- | An `AlterColumns` describes the alteration to perform on the columns
365+-- of a table.
366+newtype AlterColumns
207367 (columns0 :: ColumnsType)
208368 (columns1 :: ColumnsType) =
209− UnsafeAlterTable {renderAlterTable :: ByteString}
369+ UnsafeAlterColumns {renderAlterColumns :: ByteString}
210370 deriving (GHC.Generic,Show,Eq,Ord,NFData)
211371
372+-- | An `addColumnDefault` adds a new `Optional` column. The new column is
373+-- initially filled with whatever default value is given.
374+--
375+-- >>> :{
376+-- let
377+-- definition :: Definition
378+-- '["tab" ::: '["col1" ::: 'Required ('Null 'PGint4)]]
379+-- '["tab" :::
380+-- '[ "col1" ::: 'Required ('Null 'PGint4)
381+-- , "col2" ::: 'Optional ('Null 'PGtext) ]]
382+-- definition = alterTable #tab
383+-- (addColumnDefault #col2 (text & default_ "foo"))
384+-- in renderDefinition definition
385+-- :}
386+-- "ALTER TABLE tab ADD COLUMN col2 text DEFAULT E'foo';"
212387addColumnDefault
213388 :: KnownSymbol column
214− => Alias column
215− -> TypeExpression ('Optional ty)
216− -> AlterTable columns (Create column ('Optional ty) columns)
217−addColumnDefault column ty = UnsafeAlterTable $
389+ => Alias column -- ^ column to add
390+ -> TypeExpression ('Optional ty) -- ^ type of the new column
391+ -> AlterColumns columns (Create column ('Optional ty) columns)
392+addColumnDefault column ty = UnsafeAlterColumns $
218393 "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty
219394
395+-- | An `addColumnDefault` adds a new `Null` column. The new column is
396+-- initially filled with %NULL%s.
397+--
398+-- >>> :{
399+-- let
400+-- definition :: Definition
401+-- '["tab" ::: '["col1" ::: 'Required ('Null 'PGint4)]]
402+-- '["tab" :::
403+-- '[ "col1" ::: 'Required ('Null 'PGint4)
404+-- , "col2" ::: 'Required ('Null 'PGtext) ]]
405+-- definition = alterTable #tab (addColumnNull #col2 text)
406+-- in renderDefinition definition
407+-- :}
408+-- "ALTER TABLE tab ADD COLUMN col2 text;"
220409addColumnNull
221410 :: KnownSymbol column
222− => Alias column
223− -> TypeExpression ('Required ('Null ty))
224− -> AlterTable columns (Create column ('Required ('Null ty)) columns)
225−addColumnNull column ty = UnsafeAlterTable $
411+ => Alias column -- ^ column to add
412+ -> TypeExpression ('Required ('Null ty)) -- ^ type of the new column
413+ -> AlterColumns columns (Create column ('Required ('Null ty)) columns)
414+addColumnNull column ty = UnsafeAlterColumns $
226415 "ADD COLUMN" <+> renderAlias column <+> renderTypeExpression ty
227416
417+-- | A `dropColumn` removes a column. Whatever data was in the column
418+-- disappears. Table constraints involving the column are dropped, too.
419+-- However, if the column is referenced by a foreign key constraint of
420+-- another table, PostgreSQL will not silently drop that constraint.
421+--
422+-- >>> :{
423+-- let
424+-- definition :: Definition
425+-- '["tab" :::
426+-- '[ "col1" ::: 'Required ('Null 'PGint4)
427+-- , "col2" ::: 'Required ('Null 'PGtext) ]]
428+-- '["tab" ::: '["col1" ::: 'Required ('Null 'PGint4)]]
429+-- definition = alterTable #tab (dropColumn #col2)
430+-- in renderDefinition definition
431+-- :}
432+-- "ALTER TABLE tab DROP COLUMN col2;"
228433dropColumn
229434 :: KnownSymbol column
230− => Alias column
231− -> AlterTable columns (Drop column columns)
232−dropColumn column = UnsafeAlterTable $
435+ => Alias column -- ^ column to remove
436+ -> AlterColumns columns (Drop column columns)
437+dropColumn column = UnsafeAlterColumns $
233438 "DROP COLUMN" <+> renderAlias column
234439
440+-- | Like `dropColumn` but authorizes dropping everything that depends
441+-- on the column.
442+--
443+-- >>> :{
444+-- let
445+-- definition :: Definition
446+-- '["tab" :::
447+-- '[ "col1" ::: 'Required ('Null 'PGint4)
448+-- , "col2" ::: 'Required ('Null 'PGtext) ]]
449+-- '["tab" ::: '["col1" ::: 'Required ('Null 'PGint4)]]
450+-- definition = alterTable #tab (dropColumnCascade #col2)
451+-- in renderDefinition definition
452+-- :}
453+-- "ALTER TABLE tab DROP COLUMN col2 CASCADE;"
454+dropColumnCascade
455+ :: KnownSymbol column
456+ => Alias column -- ^ column to remove
457+ -> AlterColumns columns (Drop column columns)
458+dropColumnCascade column = UnsafeAlterColumns $
459+ "DROP COLUMN" <+> renderAlias column <+> "CASCADE"
460+
461+-- | A `renameColumn` renames a column.
462+--
463+-- >>> :{
464+-- let
465+-- definition :: Definition
466+-- '["tab" ::: '["foo" ::: 'Required ('Null 'PGint4)]]
467+-- '["tab" ::: '["bar" ::: 'Required ('Null 'PGint4)]]
468+-- definition = alterTable #tab (renameColumn #foo #bar)
469+-- in renderDefinition definition
470+-- :}
471+-- "ALTER TABLE tab RENAME COLUMN foo TO bar;"
235472renameColumn
236473 :: (KnownSymbol column0, KnownSymbol column1)
237474 => Alias column0
238475 -> Alias column1
239− -> AlterTable columns (Rename column0 column1 columns)
240−renameColumn column0 column1 = UnsafeAlterTable $
476+ -> AlterColumns columns (Rename column0 column1 columns)
477+renameColumn column0 column1 = UnsafeAlterColumns $
241478 "RENAME COLUMN" <+> renderAlias column0 <+> "TO" <+> renderAlias column1
242479
480+-- | An `alterColumn` alters a single column.
243481alterColumn
244482 :: (KnownSymbol column, HasColumn column columns ty0)
245− => Alias column
246− -> AlterColumn ty0 ty1
247− -> AlterTable columns (Alter column columns ty1)
248−alterColumn column alteration = UnsafeAlterTable $
483+ => Alias column -- ^ column to alter
484+ -> AlterColumn ty0 ty1 -- ^ alteration to perform
485+ -> AlterColumns columns (Alter column columns ty1)
486+alterColumn column alteration = UnsafeAlterColumns $
249487 "ALTER COLUMN" <+> renderAlias column <+> renderAlterColumn alteration
250488
489+-- | An `AlterColumn` describes the alteration to perform on a single column.
251490newtype AlterColumn (ty0 :: ColumnType) (ty1 :: ColumnType) =
252491 UnsafeAlterColumn {renderAlterColumn :: ByteString}
253492 deriving (GHC.Generic,Show,Eq,Ord,NFData)
254493
494+-- | A `setDefault` sets a new default for a column. Note that this doesn't
495+-- affect any existing rows in the table, it just changes the default for
496+-- future `insertTable` and `updateTable` commands.
497+--
498+-- >>> :{
499+-- let
500+-- definition :: Definition
501+-- '["tab" ::: '["col" ::: 'Required ('Null 'PGint4)]]
502+-- '["tab" ::: '["col" ::: 'Optional ('Null 'PGint4)]]
503+-- definition = alterTable #tab (alterColumn #col (setDefault 5))
504+-- in renderDefinition definition
505+-- :}
506+-- "ALTER TABLE tab ALTER COLUMN col SET DEFAULT 5;"
255507setDefault
256− :: Expression '[] 'Ungrouped '[] ('Required ty)
257− -> AlterColumn ('Required ty) ('Optional ty)
508+ :: Expression '[] 'Ungrouped '[] ('Required ty) -- ^ default value to set
509+ -> AlterColumn (optionality ty) ('Optional ty)
258510setDefault expression = UnsafeAlterColumn $
259511 "SET DEFAULT" <+> renderExpression expression
260512
261−dropDefault :: AlterColumn ('Optional ty) ('Required ty)
513+-- | A `dropDefault` removes any default value for a column.
514+--
515+-- >>> :{
516+-- let
517+-- definition :: Definition
518+-- '["tab" ::: '["col" ::: 'Optional ('Null 'PGint4)]]
519+-- '["tab" ::: '["col" ::: 'Required ('Null 'PGint4)]]
520+-- definition = alterTable #tab (alterColumn #col dropDefault)
521+-- in renderDefinition definition
522+-- :}
523+-- "ALTER TABLE tab ALTER COLUMN col DROP DEFAULT;"
524+dropDefault :: AlterColumn (optionality ty) ('Required ty)
262525dropDefault = UnsafeAlterColumn $ "DROP DEFAULT"
263526
264−setNotNull
265− :: AlterColumn (optionality ('Null ty)) (optionality ('NotNull ty))
527+-- | A `setNotNull` adds a @NOT NULL@ constraint to a column.
528+-- The constraint will be checked immediately, so the table data must satisfy
529+-- the constraint before it can be added.
530+--
531+-- >>> :{
532+-- let
533+-- definition :: Definition
534+-- '["tab" ::: '["col" ::: 'Required ('Null 'PGint4)]]
535+-- '["tab" ::: '["col" ::: 'Required ('NotNull 'PGint4)]]
536+-- definition = alterTable #tab (alterColumn #col setNotNull)
537+-- in renderDefinition definition
538+-- :}
539+-- "ALTER TABLE tab ALTER COLUMN col SET NOT NULL;"
540+setNotNull :: AlterColumn (optionality ('Null ty)) (optionality ('NotNull ty))
266541setNotNull = UnsafeAlterColumn $ "SET NOT NULL"
267542
268−dropNotNull
269− :: AlterColumn (optionality ('NotNull ty)) (optionality ('Null ty))
543+-- | A `dropNotNull` drops a @NOT NULL@ constraint from a column.
544+--
545+-- >>> :{
546+-- let
547+-- definition :: Definition
548+-- '["tab" ::: '["col" ::: 'Required ('NotNull 'PGint4)]]
549+-- '["tab" ::: '["col" ::: 'Required ('Null 'PGint4)]]
550+-- definition = alterTable #tab (alterColumn #col dropNotNull)
551+-- in renderDefinition definition
552+-- :}
553+-- "ALTER TABLE tab ALTER COLUMN col DROP NOT NULL;"
554+dropNotNull :: AlterColumn (optionality ('NotNull ty)) (optionality ('Null ty))
270555dropNotNull = UnsafeAlterColumn $ "DROP NOT NULL"
271556
272−alterType
273− :: TypeExpression (optionality (nullity ty1))
274− -> AlterColumn (optionality (nullity ty0)) (optionality (nullity ty1))
275−alterType ty = UnsafeAlterColumn $ "TYPE " <> renderTypeExpression ty
557+-- | An `alterType` converts a column to a different data type.
558+-- This will succeed only if each existing entry in the column can be
559+-- converted to the new type by an implicit cast.
560+--
561+-- >>> :{
562+-- let
563+-- definition :: Definition
564+-- '["tab" ::: '["col" ::: 'Required ('NotNull 'PGint4)]]
565+-- '["tab" ::: '["col" ::: 'Required ('NotNull 'PGnumeric)]]
566+-- definition =
567+-- alterTable #tab (alterColumn #col (alterType (numeric & notNull)))
568+-- in renderDefinition definition
569+-- :}
570+-- "ALTER TABLE tab ALTER COLUMN col TYPE numeric NOT NULL;"
571+alterType :: TypeExpression ty -> AlterColumn ty0 ty1
572+alterType ty = UnsafeAlterColumn $ "TYPE" <+> renderTypeExpression ty
squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+343−108
@@ -1,3 +1,13 @@
1+{-|
2+Module: Squeal.PostgreSQL.Query
3+Description: Squeal expressions
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+Squeal expressions are the atoms used to build statements.
9+-}
10+
111{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
212{-# LANGUAGE
313 AllowAmbiguousTypes
@@ -24,7 +34,7 @@
2434#-}
2535
2636module Squeal.PostgreSQL.Expression
27− ( -- * Column Expressions
37+ ( -- * Expression
2838 Expression (UnsafeExpression, renderExpression)
2939 , HasParameter (param)
3040 , HasColumn (getColumn)
@@ -49,8 +59,8 @@ module Squeal.PostgreSQL.Expression
4959 , unsafeFunction
5060 , atan2_
5161 , cast
52− , div_
53− , mod_
62+ , quot_
63+ , rem_
5464 , trunc
5565 , round_
5666 , ceiling_
@@ -83,25 +93,15 @@ module Squeal.PostgreSQL.Expression
8393 , charLength
8494 , like
8595 -- ** Aggregation
86− , unsafeAggregate
87− , unsafeAggregateDistinct
88− , sum_
89− , sumDistinct
96+ , unsafeAggregate, unsafeAggregateDistinct
97+ , sum_, sumDistinct
9098 , PGAvg (avg, avgDistinct)
91− , bitAnd
92− , bitOr
93− , boolAnd
94− , boolOr
99+ , bitAnd, bitOr, boolAnd, boolOr
100+ , bitAndDistinct, bitOrDistinct, boolAndDistinct, boolOrDistinct
95101 , countStar
96− , countDistinctStar
97− , count
98− , every
99− , jsonAgg
100− , jsonbAgg
101− , jsonObjectAgg
102− , jsonbObjectAgg
103− , max_
104− , min_
102+ , count, countDistinct
103+ , every, everyDistinct
104+ , max_, maxDistinct, min_, minDistinct
105105 -- * Tables
106106 , Table (UnsafeTable, renderTable)
107107 , HasTable (getTable)
@@ -140,6 +140,7 @@ module Squeal.PostgreSQL.Expression
140140 , timeWithTimeZone
141141 , interval
142142 , uuid
143+ , inet
143144 , json
144145 , jsonb
145146 , notNull
@@ -233,6 +234,10 @@ instance (HasTable table tables columns, HasColumn column columns ty)
233234 table ! column = UnsafeExpression $
234235 renderAlias table <> "." <> renderAlias column
235236
237+-- | A `Column` is a witness to a `HasColumn` constraint. It's used
238+-- in `Squeel.PostgreSQL.Definition.unique` and other
239+-- `Squeel.PostgreSQL.Definition.TableConstraint`s to witness a
240+-- subcolumns relationship.
236241data Column
237242 (columns :: ColumnsType)
238243 (columnty :: (Symbol,ColumnType))
@@ -245,9 +250,14 @@ deriving instance Show (Column columns columnty)
245250deriving instance Eq (Column columns columnty)
246251deriving instance Ord (Column columns columnty)
247252
253+-- | Render a `Column`.
248254renderColumn :: Column columns columnty -> ByteString
249255renderColumn (Column column) = renderAlias column
250256
257+{- | A `GroupedBy` constraint indicates that a table qualified column is
258+a member of the auxiliary namespace created by @GROUP BY@ clauses and thus,
259+may be called in an output `Expression` without aggregating.
260+-}
251261class (KnownSymbol table, KnownSymbol column)
252262 => GroupedBy table column bys where
253263 getGroup1
@@ -294,6 +304,7 @@ def = UnsafeExpression "DEFAULT"
294304-- "FALSE"
295305unDef
296306 :: Expression '[] 'Ungrouped params ('Required (nullity ty))
307+ -- ^ not @DEFAULT@
297308 -> Expression '[] 'Ungrouped params ('Optional (nullity ty))
298309unDef = UnsafeExpression . renderExpression
299310
@@ -310,6 +321,7 @@ null_ = UnsafeExpression "NULL"
310321-- "TRUE"
311322unNull
312323 :: Expression tables grouping params (optionality ('NotNull ty))
324+ -- ^ not @NULL@
313325 -> Expression tables grouping params (optionality ('Null ty))
314326unNull = UnsafeExpression . renderExpression
315327
@@ -319,7 +331,9 @@ unNull = UnsafeExpression . renderExpression
319331-- "COALESCE(NULL, TRUE, FALSE)"
320332coalesce
321333 :: [Expression tables grouping params ('Required ('Null ty))]
334+ -- ^ @NULL@s may be present
322335 -> Expression tables grouping params ('Required ('NotNull ty))
336+ -- ^ @NULL@ is absent
323337 -> Expression tables grouping params ('Required ('NotNull ty))
324338coalesce nullxs notNullx = UnsafeExpression $
325339 "COALESCE" <> parenthesized (commaSeparated
@@ -331,6 +345,7 @@ coalesce nullxs notNullx = UnsafeExpression $
331345-- "COALESCE(NULL, TRUE)"
332346fromNull
333347 :: Expression tables grouping params ('Required ('NotNull ty))
348+ -- ^ what to convert @NULL@ to
334349 -> Expression tables grouping params ('Required ('Null ty))
335350 -> Expression tables grouping params ('Required ('NotNull ty))
336351fromNull notNullx nullx = coalesce [nullx] notNullx
@@ -339,6 +354,7 @@ fromNull notNullx nullx = coalesce [nullx] notNullx
339354-- "NULL IS NULL"
340355isNull
341356 :: Expression tables grouping params ('Required ('Null ty))
357+ -- ^ possibly @NULL@
342358 -> Condition tables grouping params
343359isNull x = UnsafeExpression $ renderExpression x <+> "IS NULL"
344360
@@ -346,6 +362,7 @@ isNull x = UnsafeExpression $ renderExpression x <+> "IS NULL"
346362-- "NULL IS NOT NULL"
347363isn'tNull
348364 :: Expression tables grouping params ('Required ('Null ty))
365+ -- ^ possibly @NULL@
349366 -> Condition tables grouping params
350367isn'tNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"
351368
@@ -355,21 +372,26 @@ isn'tNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"
355372-- "CASE WHEN NULL IS NULL THEN TRUE ELSE (NOT NULL) END"
356373matchNull
357374 :: Expression tables grouping params ('Required nullty)
375+ -- ^ what to convert @NULL@ to
358376 -> ( Expression tables grouping params ('Required ('NotNull ty))
359377 -> Expression tables grouping params ('Required nullty) )
378+ -- ^ function to perform when @NULL@ is absent
360379 -> Expression tables grouping params ('Required ('Null ty))
361380 -> Expression tables grouping params ('Required nullty)
362381matchNull y f x = ifThenElse (isNull x) y
363382 (f (UnsafeExpression (renderExpression x)))
364383
365−-- | right inverse to `fromNull`
384+-- | right inverse to `fromNull`, if its arguments are equal then
385+-- `nullIf` gives @NULL@.
366386--
367387-- >>> :set -XTypeApplications -XDataKinds
368388-- >>> renderExpression @_ @_ @'[_] $ fromNull false (nullIf false (param @1))
369389-- "COALESCE(NULL IF (FALSE, ($1 :: bool)), FALSE)"
370390nullIf
371391 :: Expression tables grouping params ('Required ('NotNull ty))
392+ -- ^ @NULL@ is absent
372393 -> Expression tables grouping params ('Required ('NotNull ty))
394+ -- ^ @NULL@ is absent
373395 -> Expression tables grouping params ('Required ('Null ty))
374396nullIf x y = UnsafeExpression $ "NULL IF" <+> parenthesized
375397 (renderExpression x <> ", " <> renderExpression y)
@@ -378,7 +400,9 @@ nullIf x y = UnsafeExpression $ "NULL IF" <+> parenthesized
378400-- "GREATEST(CURRENT_TIMESTAMP, ($1 :: timestamp with time zone))"
379401greatest
380402 :: Expression tables grouping params ('Required nullty)
403+ -- ^ needs at least 1 argument
381404 -> [Expression tables grouping params ('Required nullty)]
405+ -- ^ or more
382406 -> Expression tables grouping params ('Required nullty)
383407greatest x xs = UnsafeExpression $ "GREATEST("
384408 <> commaSeparated (renderExpression <$> (x:xs)) <> ")"
@@ -387,28 +411,39 @@ greatest x xs = UnsafeExpression $ "GREATEST("
387411-- "LEAST(CURRENT_TIMESTAMP, NULL)"
388412least
389413 :: Expression tables grouping params ('Required nullty)
414+ -- ^ needs at least 1 argument
390415 -> [Expression tables grouping params ('Required nullty)]
416+ -- ^ or more
391417 -> Expression tables grouping params ('Required nullty)
392418least x xs = UnsafeExpression $ "LEAST("
393419 <> commaSeparated (renderExpression <$> (x:xs)) <> ")"
394420
421+-- | >>> renderExpression $ unsafeBinaryOp "OR" true false
422+-- "(TRUE OR FALSE)"
395423unsafeBinaryOp
396424 :: ByteString
425+ -- ^ operator
397426 -> Expression tables grouping params ('Required ty0)
398427 -> Expression tables grouping params ('Required ty1)
399428 -> Expression tables grouping params ('Required ty2)
400429unsafeBinaryOp op x y = UnsafeExpression $ parenthesized $
401430 renderExpression x <+> op <+> renderExpression y
402431
432+-- | >>> renderExpression $ unsafeUnaryOp "NOT" true
433+-- "(NOT TRUE)"
403434unsafeUnaryOp
404435 :: ByteString
436+ -- ^ operator
405437 -> Expression tables grouping params ('Required ty0)
406438 -> Expression tables grouping params ('Required ty1)
407439unsafeUnaryOp op x = UnsafeExpression $ parenthesized $
408440 op <+> renderExpression x
409441
442+-- | >>> renderExpression $ unsafeFunction "f" true
443+-- "f(TRUE)"
410444unsafeFunction
411445 :: ByteString
446+ -- ^ function
412447 -> Expression tables grouping params ('Required xty)
413448 -> Expression tables grouping params ('Required yty)
414449unsafeFunction fun x = UnsafeExpression $
@@ -453,79 +488,128 @@ instance (PGNum ty, PGFloating ty) => Floating
453488 acosh x = log (x + sqrt (x*x - 1))
454489 atanh x = log ((1 + x) / (1 - x)) / 2
455490
491+-- | >>> renderExpression @_ @_ @_ @(_ (_ 'PGfloat4)) $ atan2_ pi 2
492+-- "atan2(pi(), 2)"
456493atan2_
457494 :: PGFloating float
458495 => Expression tables grouping params ('Required (nullity float))
496+ -- ^ numerator
459497 -> Expression tables grouping params ('Required (nullity float))
498+ -- ^ denominator
460499 -> Expression tables grouping params ('Required (nullity float))
461500atan2_ y x = UnsafeExpression $
462501 "atan2(" <> renderExpression y <> ", " <> renderExpression x <> ")"
463502
503+-- When a `cast` is applied to an `Expression` of a known type, it
504+-- represents a run-time type conversion. The cast will succeed only if a
505+-- suitable type conversion operation has been defined.
506+--
507+-- | >>> renderExpression $ true & cast int4
508+-- "(TRUE :: int4)"
464509cast
465510 :: TypeExpression ('Required ('Null ty1))
511+ -- ^ type to cast as
466512 -> Expression tables grouping params ('Required (nullity ty0))
513+ -- ^ value to convert
467514 -> Expression tables grouping params ('Required (nullity ty1))
468515cast ty x = UnsafeExpression $ parenthesized $
469516 renderExpression x <+> "::" <+> renderTypeExpression ty
470517
471−div_
518+-- | integer division, truncates the result
519+--
520+-- >>> renderExpression @_ @_ @_ @(_(_ 'PGint2)) $ 5 `quot_` 2
521+-- "(5 / 2)"
522+quot_
472523 :: PGIntegral int
473524 => Expression tables grouping params ('Required (nullity int))
525+ -- ^ numerator
474526 -> Expression tables grouping params ('Required (nullity int))
527+ -- ^ denominator
475528 -> Expression tables grouping params ('Required (nullity int))
476−div_ = unsafeBinaryOp "/"
529+quot_ = unsafeBinaryOp "/"
477530
478−mod_
531+-- | remainder upon integer division
532+--
533+-- >>> renderExpression @_ @_ @_ @(_ (_ 'PGint2)) $ 5 `rem_` 2
534+-- "(5 % 2)"
535+rem_
479536 :: PGIntegral int
480537 => Expression tables grouping params ('Required (nullity int))
538+ -- ^ numerator
481539 -> Expression tables grouping params ('Required (nullity int))
540+ -- ^ denominator
482541 -> Expression tables grouping params ('Required (nullity int))
483−mod_ = unsafeBinaryOp "%"
542+rem_ = unsafeBinaryOp "%"
484543
544+-- | >>> renderExpression @_ @_ @_ @(_ (_ 'PGfloat4)) $ trunc pi
545+-- "trunc(pi())"
485546trunc
486547 :: PGFloating frac
487548 => Expression tables grouping params ('Required (nullity frac))
549+ -- ^ fractional number
488550 -> Expression tables grouping params ('Required (nullity frac))
489551trunc = unsafeFunction "trunc"
490552
553+-- | >>> renderExpression @_ @_ @_ @(_ (_ 'PGfloat4)) $ round_ pi
554+-- "round(pi())"
491555round_
492556 :: PGFloating frac
493557 => Expression tables grouping params ('Required (nullity frac))
558+ -- ^ fractional number
494559 -> Expression tables grouping params ('Required (nullity frac))
495560round_ = unsafeFunction "round"
496561
562+-- | >>> renderExpression @_ @_ @_ @(_ (_ 'PGfloat4)) $ ceiling_ pi
563+-- "ceiling(pi())"
497564ceiling_
498565 :: PGFloating frac
499566 => Expression tables grouping params ('Required (nullity frac))
567+ -- ^ fractional number
500568 -> Expression tables grouping params ('Required (nullity frac))
501569ceiling_ = unsafeFunction "ceiling"
502570
571+-- | A `Condition` is a boolean valued `Expression`. While SQL allows
572+-- conditions to have @NULL@, squeal instead chooses to disallow @NULL@,
573+-- forcing one to handle the case of @NULL@ explicitly to produce
574+-- a `Condition`.
503575type Condition tables grouping params =
504576 Expression tables grouping params ('Required ('NotNull 'PGbool))
505577
578+-- | >>> renderExpression true
579+-- "TRUE"
506580true :: Condition tables grouping params
507581true = UnsafeExpression "TRUE"
508582
583+-- | >>> renderExpression false
584+-- "FALSE"
509585false :: Condition tables grouping params
510586false = UnsafeExpression "FALSE"
511587
588+-- | >>> renderExpression $ not_ true
589+-- "(NOT TRUE)"
512590not_
513591 :: Condition tables grouping params
514592 -> Condition tables grouping params
515593not_ = unsafeUnaryOp "NOT"
516594
595+-- | >>> renderExpression $ true .&& false
596+-- "(TRUE AND FALSE)"
517597(.&&)
518598 :: Condition tables grouping params
519599 -> Condition tables grouping params
520600 -> Condition tables grouping params
521601(.&&) = unsafeBinaryOp "AND"
522602
603+-- | >>> renderExpression $ true .|| false
604+-- "(TRUE OR FALSE)"
523605(.||)
524606 :: Condition tables grouping params
525607 -> Condition tables grouping params
526608 -> Condition tables grouping params
527609(.||) = unsafeBinaryOp "OR"
528610
611+-- | >>> renderExpression @_ @_ @_ @(_ (_ 'PGint2)) $ caseWhenThenElse [(true, 1), (false, 2)] 3
612+-- "CASE WHEN TRUE THEN 1 WHEN FALSE THEN 2 ELSE 3 END"
529613caseWhenThenElse
530614 :: [ ( Condition tables grouping params
531615 , Expression tables grouping params ('Required ty)
@@ -545,6 +629,8 @@ caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat
545629 , " END"
546630 ]
547631
632+-- | >>> renderExpression @_ @_ @_ @(_ (_ 'PGint2)) $ ifThenElse true 1 0
633+-- "CASE WHEN TRUE THEN 1 ELSE 0 END"
548634ifThenElse
549635 :: Condition tables grouping params
550636 -> Expression tables grouping params ('Required ty)
@@ -552,64 +638,89 @@ ifThenElse
552638 -> Expression tables grouping params ('Required ty)
553639ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_
554640
641+-- | Comparison operations like `.==`, `./=`, `.>`, `.>=`, `.<` and `.<=`
642+-- will produce @NULL@s if one of their arguments is @NULL@.
643+--
644+-- >>> renderExpression $ unNull true .== null_
645+-- "(TRUE = NULL)"
555646(.==)
556− :: Expression tables grouping params ('Required (nullity ty))
557− -> Expression tables grouping params ('Required (nullity ty))
647+ :: Expression tables grouping params ('Required (nullity ty)) -- ^ lhs
648+ -> Expression tables grouping params ('Required (nullity ty)) -- ^ rhs
558649 -> Expression tables grouping params ('Required (nullity 'PGbool))
559650(.==) = unsafeBinaryOp "="
560651infix 4 .==
561652
653+-- | >>> renderExpression $ unNull true ./= null_
654+-- "(TRUE <> NULL)"
562655(./=)
563− :: Expression tables grouping params ('Required (nullity ty))
564− -> Expression tables grouping params ('Required (nullity ty))
656+ :: Expression tables grouping params ('Required (nullity ty)) -- ^ lhs
657+ -> Expression tables grouping params ('Required (nullity ty)) -- ^ rhs
565658 -> Expression tables grouping params ('Required (nullity 'PGbool))
566659(./=) = unsafeBinaryOp "<>"
567660infix 4 ./=
568661
662+-- | >>> renderExpression $ unNull true .>= null_
663+-- "(TRUE >= NULL)"
569664(.>=)
570− :: Expression tables grouping params ('Required (nullity ty))
571− -> Expression tables grouping params ('Required (nullity ty))
665+ :: Expression tables grouping params ('Required (nullity ty)) -- ^ lhs
666+ -> Expression tables grouping params ('Required (nullity ty)) -- ^ rhs
572667 -> Expression tables grouping params ('Required (nullity 'PGbool))
573668(.>=) = unsafeBinaryOp ">="
574669infix 4 .>=
575670
671+-- | >>> renderExpression $ unNull true .< null_
672+-- "(TRUE < NULL)"
576673(.<)
577− :: Expression tables grouping params ('Required (nullity ty))
578− -> Expression tables grouping params ('Required (nullity ty))
674+ :: Expression tables grouping params ('Required (nullity ty)) -- ^ lhs
675+ -> Expression tables grouping params ('Required (nullity ty)) -- ^ rhs
579676 -> Expression tables grouping params ('Required (nullity 'PGbool))
580677(.<) = unsafeBinaryOp "<"
581678infix 4 .<
582679
680+-- | >>> renderExpression $ unNull true .<= null_
681+-- "(TRUE <= NULL)"
583682(.<=)
584− :: Expression tables grouping params ('Required (nullity ty))
585− -> Expression tables grouping params ('Required (nullity ty))
683+ :: Expression tables grouping params ('Required (nullity ty)) -- ^ lhs
684+ -> Expression tables grouping params ('Required (nullity ty)) -- ^ rhs
586685 -> Expression tables grouping params ('Required (nullity 'PGbool))
587686(.<=) = unsafeBinaryOp "<="
588687infix 4 .<=
589688
689+-- | >>> renderExpression $ unNull true .> null_
690+-- "(TRUE > NULL)"
590691(.>)
591− :: Expression tables grouping params ('Required (nullity ty))
592− -> Expression tables grouping params ('Required (nullity ty))
692+ :: Expression tables grouping params ('Required (nullity ty)) -- ^ lhs
693+ -> Expression tables grouping params ('Required (nullity ty)) -- ^ rhs
593694 -> Expression tables grouping params ('Required (nullity 'PGbool))
594695(.>) = unsafeBinaryOp ">"
595696infix 4 .>
596697
698+-- | >>> renderExpression $ currentDate
699+-- "CURRENT_DATE"
597700currentDate
598701 :: Expression tables grouping params ('Required (nullity 'PGdate))
599702currentDate = UnsafeExpression "CURRENT_DATE"
600703
704+-- | >>> renderExpression $ currentTime
705+-- "CURRENT_TIME"
601706currentTime
602707 :: Expression tables grouping params ('Required (nullity 'PGtimetz))
603708currentTime = UnsafeExpression "CURRENT_TIME"
604709
710+-- | >>> renderExpression $ currentTimestamp
711+-- "CURRENT_TIMESTAMP"
605712currentTimestamp
606713 :: Expression tables grouping params ('Required (nullity 'PGtimestamptz))
607714currentTimestamp = UnsafeExpression "CURRENT_TIMESTAMP"
608715
716+-- | >>> renderExpression $ localTime
717+-- "LOCALTIME"
609718localTime
610719 :: Expression tables grouping params ('Required (nullity 'PGtime))
611720localTime = UnsafeExpression "LOCALTIME"
612721
722+-- | >>> renderExpression $ localTimestamp
723+-- "LOCALTIMESTAMP"
613724localTimestamp
614725 :: Expression tables grouping params ('Required (nullity 'PGtimestamp))
615726localTimestamp = UnsafeExpression "LOCALTIMESTAMP"
@@ -639,24 +750,44 @@ instance Monoid
639750 mempty = fromString ""
640751 mappend = unsafeBinaryOp "||"
641752
753+-- | >>> renderExpression $ lower "ARRRGGG"
754+-- "lower(E'ARRRGGG')"
642755lower
643756 :: Expression tables grouping params ('Required (nullity 'PGtext))
757+ -- ^ string to lower case
644758 -> Expression tables grouping params ('Required (nullity 'PGtext))
645759lower = unsafeFunction "lower"
646760
761+-- | >>> renderExpression $ upper "eeee"
762+-- "upper(E'eeee')"
647763upper
648764 :: Expression tables grouping params ('Required (nullity 'PGtext))
765+ -- ^ string to upper case
649766 -> Expression tables grouping params ('Required (nullity 'PGtext))
650767upper = unsafeFunction "upper"
651768
769+-- | >>> renderExpression $ charLength "four"
770+-- "char_length(E'four')"
652771charLength
653772 :: Expression tables grouping params ('Required (nullity 'PGtext))
773+ -- ^ string to measure
654774 -> Expression tables grouping params ('Required (nullity 'PGint4))
655775charLength = unsafeFunction "char_length"
656776
777+-- | The `like` expression returns true if the @string@ matches
778+-- the supplied @pattern@. If @pattern@ does not contain percent signs
779+-- or underscores, then the pattern only represents the string itself;
780+-- in that case `like` acts like the equals operator. An underscore (_)
781+-- in pattern stands for (matches) any single character; a percent sign (%)
782+-- matches any sequence of zero or more characters.
783+--
784+-- >>> renderExpression $ "abc" `like` "a%"
785+-- "(E'abc' LIKE E'a%')"
657786like
658787 :: Expression tables grouping params ('Required (nullity 'PGtext))
788+ -- ^ string
659789 -> Expression tables grouping params ('Required (nullity 'PGtext))
790+ -- ^ pattern
660791 -> Expression tables grouping params ('Required (nullity 'PGbool))
661792like = unsafeBinaryOp "LIKE"
662793
@@ -664,25 +795,46 @@ like = unsafeBinaryOp "LIKE"
664795aggregation
665796-----------------------------------------}
666797
667−unsafeAggregate, unsafeAggregateDistinct
668− :: ByteString
798+-- | escape hatch to define aggregate functions
799+unsafeAggregate
800+ :: ByteString -- ^ aggregate function
669801 -> Expression tables 'Ungrouped params ('Required xty)
670802 -> Expression tables ('Grouped bys) params ('Required yty)
671803unsafeAggregate fun x = UnsafeExpression $ mconcat
672804 [fun, "(", renderExpression x, ")"]
805+
806+-- | escape hatch to define aggregate functions over distinct values
807+unsafeAggregateDistinct
808+ :: ByteString -- ^ aggregate function
809+ -> Expression tables 'Ungrouped params ('Required xty)
810+ -> Expression tables ('Grouped bys) params ('Required yty)
673811unsafeAggregateDistinct fun x = UnsafeExpression $ mconcat
674812 [fun, "(DISTINCT ", renderExpression x, ")"]
675813
676−sum_, sumDistinct
814+-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGnumeric)]] $ sum_ #col
815+-- "sum(col)"
816+sum_
677817 :: PGNum ty
678818 => Expression tables 'Ungrouped params ('Required (nullity ty))
819+ -- ^ what to sum
679820 -> Expression tables ('Grouped bys) params ('Required (nullity ty))
680821sum_ = unsafeAggregate "sum"
822+
823+-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGnumeric)]] $ sumDistinct #col
824+-- "sum(DISTINCT col)"
825+sumDistinct
826+ :: PGNum ty
827+ => Expression tables 'Ungrouped params ('Required (nullity ty))
828+ -- ^ what to sum
829+ -> Expression tables ('Grouped bys) params ('Required (nullity ty))
681830sumDistinct = unsafeAggregateDistinct "sum"
682831
832+-- | A constraint for `PGType`s that you can take averages of and the resulting
833+-- `PGType`.
683834class PGAvg ty avg | ty -> avg where
684835 avg, avgDistinct
685836 :: Expression tables 'Ungrouped params ('Required (nullity ty))
837+ -- ^ what to average
686838 -> Expression tables ('Grouped bys) params ('Required (nullity avg))
687839 avg = unsafeAggregate "avg"
688840 avgDistinct = unsafeAggregateDistinct "avg"
@@ -694,76 +846,141 @@ instance PGAvg 'PGfloat4 'PGfloat8
694846instance PGAvg 'PGfloat8 'PGfloat8
695847instance PGAvg 'PGinterval 'PGinterval
696848
697−bitAnd, bitOr
849+-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGint4)]] $ bitAnd #col
850+-- "bit_and(col)"
851+bitAnd
698852 :: PGIntegral int
699853 => Expression tables 'Ungrouped params ('Required (nullity int))
854+ -- ^ what to aggregate
700855 -> Expression tables ('Grouped bys) params ('Required (nullity int))
701856bitAnd = unsafeAggregate "bit_and"
857+
858+-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGint4)]] $ bitOr #col
859+-- "bit_or(col)"
860+bitOr
861+ :: PGIntegral int
862+ => Expression tables 'Ungrouped params ('Required (nullity int))
863+ -- ^ what to aggregate
864+ -> Expression tables ('Grouped bys) params ('Required (nullity int))
702865bitOr = unsafeAggregate "bit_or"
703866
704−boolAnd, boolOr
867+-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGint4)]] $ bitAndDistinct #col
868+-- "bit_and(DISTINCT col)"
869+bitAndDistinct
870+ :: PGIntegral int
871+ => Expression tables 'Ungrouped params ('Required (nullity int))
872+ -- ^ what to aggregate
873+ -> Expression tables ('Grouped bys) params ('Required (nullity int))
874+bitAndDistinct = unsafeAggregateDistinct "bit_and"
875+
876+-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGint4)]] $ bitOrDistinct #col
877+-- "bit_or(DISTINCT col)"
878+bitOrDistinct
879+ :: PGIntegral int
880+ => Expression tables 'Ungrouped params ('Required (nullity int))
881+ -- ^ what to aggregate
882+ -> Expression tables ('Grouped bys) params ('Required (nullity int))
883+bitOrDistinct = unsafeAggregateDistinct "bit_or"
884+
885+-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGbool)]] $ boolAnd #col
886+-- "bool_and(col)"
887+boolAnd
705888 :: Expression tables 'Ungrouped params ('Required (nullity 'PGbool))
889+ -- ^ what to aggregate
706890 -> Expression tables ('Grouped bys) params ('Required (nullity 'PGbool))
707891boolAnd = unsafeAggregate "bool_and"
892+
893+-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGbool)]] $ boolOr #col
894+-- "bool_or(col)"
895+boolOr
896+ :: Expression tables 'Ungrouped params ('Required (nullity 'PGbool))
897+ -- ^ what to aggregate
898+ -> Expression tables ('Grouped bys) params ('Required (nullity 'PGbool))
708899boolOr = unsafeAggregate "bool_or"
709900
710−countStar, countDistinctStar
901+-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGbool)]] $ boolAndDistinct #col
902+-- "bool_and(DISTINCT col)"
903+boolAndDistinct
904+ :: Expression tables 'Ungrouped params ('Required (nullity 'PGbool))
905+ -- ^ what to aggregate
906+ -> Expression tables ('Grouped bys) params ('Required (nullity 'PGbool))
907+boolAndDistinct = unsafeAggregateDistinct "bool_and"
908+
909+-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGbool)]] $ boolOrDistinct #col
910+-- "bool_or(DISTINCT col)"
911+boolOrDistinct
912+ :: Expression tables 'Ungrouped params ('Required (nullity 'PGbool))
913+ -- ^ what to aggregate
914+ -> Expression tables ('Grouped bys) params ('Required (nullity 'PGbool))
915+boolOrDistinct = unsafeAggregateDistinct "bool_or"
916+
917+-- | A special aggregation that does not require an input
918+--
919+-- >>> renderExpression countStar
920+-- "count(*)"
921+countStar
711922 :: Expression tables ('Grouped bys) params ('Required ('NotNull 'PGint8))
712923countStar = UnsafeExpression $ "count(*)"
713−countDistinctStar = UnsafeExpression $ "count(DISTINCT *)"
714924
925+-- | >>> renderExpression @'[_ ::: '["col" ::: 'Optional _]] $ count #col
926+-- "count(col)"
715927count
716928 :: Expression tables 'Ungrouped params ('Required ty)
929+ -- ^ what to count
717930 -> Expression tables ('Grouped bys) params ('Required ('NotNull 'PGint8))
718931count = unsafeAggregate "count"
719−
932+
933+-- | >>> renderExpression @'[_ ::: '["col" ::: 'Required _]] $ countDistinct #col
934+-- "count(DISTINCT col)"
935+countDistinct
936+ :: Expression tables 'Ungrouped params ('Required ty)
937+ -- ^ what to count
938+ -> Expression tables ('Grouped bys) params ('Required ('NotNull 'PGint8))
939+countDistinct = unsafeAggregateDistinct "count"
940+
941+-- | synonym for `boolAnd`
942+--
943+-- >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGbool)]] $ every #col
944+-- "every(col)"
720945every
721946 :: Expression tables 'Ungrouped params ('Required (nullity 'PGbool))
947+ -- ^ what to aggregate
722948 -> Expression tables ('Grouped bys) params ('Required (nullity 'PGbool))
723949every = unsafeAggregate "every"
724950
725−jsonAgg
726− :: Expression tables 'Ungrouped params ('Required ty)
727− -> Expression tables ('Grouped bys) params ('Required ('NotNull 'PGjson))
728−jsonAgg = unsafeAggregate "json_agg"
951+-- | synonym for `boolAndDistinct`
952+--
953+-- >>> renderExpression @'[_ ::: '["col" ::: 'Required (_ 'PGbool)]] $ everyDistinct #col
954+-- "every(DISTINCT col)"
955+everyDistinct
956+ :: Expression tables 'Ungrouped params ('Required (nullity 'PGbool))
957+ -- ^ what to aggregate
958+ -> Expression tables ('Grouped bys) params ('Required (nullity 'PGbool))
959+everyDistinct = unsafeAggregateDistinct "every"
729960
730−jsonbAgg
731− :: Expression tables 'Ungrouped params ('Required ty)
732− -> Expression tables ('Grouped bys) params ('Required ('NotNull 'PGjsonb))
733−jsonbAgg = unsafeAggregate "jsonb_agg"
734−
735−jsonObjectAgg
736− :: Expression tables 'Ungrouped params ('Required ('NotNull keyty))
737− -> Expression tables 'Ungrouped params ('Required valty)
738− -> Expression tables ('Grouped bys) params ('Required ('NotNull 'PGjson))
739−jsonObjectAgg k v = UnsafeExpression $
740− "json_object_agg(" <> renderExpression k
741− <> ", " <> renderExpression v <> ")"
742−
743−jsonbObjectAgg
744− :: Expression tables 'Ungrouped params ('Required ('NotNull keyty))
745− -> Expression tables 'Ungrouped params ('Required valty)
746− -> Expression tables ('Grouped bys) params ('Required ('NotNull 'PGjsonb))
747−jsonbObjectAgg k v = UnsafeExpression $
748− "jsonb_object_agg("
749− <> renderExpression k <> ", " <> renderExpression v <> ")"
750−
751−max_, min_
961+-- | minimum and maximum aggregation
962+max_, min_, maxDistinct, minDistinct
752963 :: Expression tables 'Ungrouped params ('Required (nullity ty))
964+ -- ^ what to aggregate
753965 -> Expression tables ('Grouped bys) params ('Required (nullity ty))
754966max_ = unsafeAggregate "max"
755967min_ = unsafeAggregate "min"
968+maxDistinct = unsafeAggregateDistinct "max"
969+minDistinct = unsafeAggregateDistinct "min"
756970
757971{-----------------------------------------
758972tables
759973-----------------------------------------}
760974
975+-- | A `Table` from a schema without its alias with an `IsLabel` instance
976+-- to call a table reference by its alias.
761977newtype Table
762978 (schema :: TablesType)
763979 (columns :: ColumnsType)
764980 = UnsafeTable { renderTable :: ByteString }
765981 deriving (GHC.Generic,Show,Eq,Ord,NFData)
766982
983+-- | A `HasTable` constraint indicates a table reference.
767984class KnownSymbol table => HasTable table tables columns
768985 | table tables -> columns where
769986 getTable :: Alias table -> Table tables columns
@@ -782,96 +999,113 @@ instance HasTable table schema columns
782999type expressions
7831000-----------------------------------------}
7841001
1002+-- | `TypeExpression`s are used in `cast`s and `createTable` commands.
7851003newtype TypeExpression (ty :: ColumnType)
7861004 = UnsafeTypeExpression { renderTypeExpression :: ByteString }
7871005 deriving (GHC.Generic,Show,Eq,Ord,NFData)
7881006
1007+-- | logical Boolean (true/false)
7891008bool :: TypeExpression ('Required ('Null 'PGbool))
7901009bool = UnsafeTypeExpression "bool"
791−int2 :: TypeExpression ('Required ('Null 'PGint2))
1010+-- | signed two-byte integer
1011+int2, smallint :: TypeExpression ('Required ('Null 'PGint2))
7921012int2 = UnsafeTypeExpression "int2"
793−smallint :: TypeExpression ('Required ('Null 'PGint2))
7941013smallint = UnsafeTypeExpression "smallint"
795−int4 :: TypeExpression ('Required ('Null 'PGint4))
1014+-- | signed four-byte integer
1015+int4, int, integer :: TypeExpression ('Required ('Null 'PGint4))
7961016int4 = UnsafeTypeExpression "int4"
797−int :: TypeExpression ('Required ('Null 'PGint4))
7981017int = UnsafeTypeExpression "int"
799−integer :: TypeExpression ('Required ('Null 'PGint4))
8001018integer = UnsafeTypeExpression "integer"
801−int8 :: TypeExpression ('Required ('Null 'PGint8))
1019+-- | signed eight-byte integer
1020+int8, bigint :: TypeExpression ('Required ('Null 'PGint8))
8021021int8 = UnsafeTypeExpression "int8"
803−bigint :: TypeExpression ('Required ('Null 'PGint8))
8041022bigint = UnsafeTypeExpression "bigint"
1023+-- | arbitrary precision numeric type
8051024numeric :: TypeExpression ('Required ('Null 'PGnumeric))
8061025numeric = UnsafeTypeExpression "numeric"
807−float4 :: TypeExpression ('Required ('Null 'PGfloat4))
1026+-- | single precision floating-point number (4 bytes)
1027+float4, real :: TypeExpression ('Required ('Null 'PGfloat4))
8081028float4 = UnsafeTypeExpression "float4"
809−real :: TypeExpression ('Required ('Null 'PGfloat4))
8101029real = UnsafeTypeExpression "real"
811−float8 :: TypeExpression ('Required ('Null 'PGfloat8))
1030+-- | double precision floating-point number (8 bytes)
1031+float8, doublePrecision :: TypeExpression ('Required ('Null 'PGfloat8))
8121032float8 = UnsafeTypeExpression "float8"
813−doublePrecision :: TypeExpression ('Required ('Null 'PGfloat8))
8141033doublePrecision = UnsafeTypeExpression "double precision"
815−serial2 :: TypeExpression ('Optional ('NotNull 'PGint2))
1034+-- | not a true type, but merely a notational convenience for creating
1035+-- unique identifier columns with type `'PGint2`
1036+serial2, smallserial :: TypeExpression ('Optional ('NotNull 'PGint2))
8161037serial2 = UnsafeTypeExpression "serial2"
817−smallserial :: TypeExpression ('Optional ('NotNull 'PGint2))
8181038smallserial = UnsafeTypeExpression "smallserial"
819−serial4 :: TypeExpression ('Optional ('NotNull 'PGint4))
1039+-- | not a true type, but merely a notational convenience for creating
1040+-- unique identifier columns with type `'PGint4`
1041+serial4, serial :: TypeExpression ('Optional ('NotNull 'PGint4))
8201042serial4 = UnsafeTypeExpression "serial4"
821−serial :: TypeExpression ('Optional ('NotNull 'PGint4))
8221043serial = UnsafeTypeExpression "serial"
823−serial8 :: TypeExpression ('Optional ('NotNull 'PGint8))
1044+-- | not a true type, but merely a notational convenience for creating
1045+-- unique identifier columns with type `'PGint8`
1046+serial8, bigserial :: TypeExpression ('Optional ('NotNull 'PGint8))
8241047serial8 = UnsafeTypeExpression "serial8"
825−bigserial :: TypeExpression ('Optional ('NotNull 'PGint8))
8261048bigserial = UnsafeTypeExpression "bigserial"
1049+-- | variable-length character string
8271050text :: TypeExpression ('Required ('Null 'PGtext))
8281051text = UnsafeTypeExpression "text"
829−char
1052+-- | fixed-length character string
1053+char, character
8301054 :: (KnownNat n, 1 <= n)
8311055 => proxy n
8321056 -> TypeExpression ('Required ('Null ('PGchar n)))
8331057char p = UnsafeTypeExpression $ "char(" <> renderNat p <> ")"
834−character
835− :: (KnownNat n, 1 <= n)
836− => proxy n
837− -> TypeExpression ('Required ('Null ('PGchar n)))
8381058character p = UnsafeTypeExpression $ "character(" <> renderNat p <> ")"
839−varchar
1059+-- | variable-length character string
1060+varchar, characterVarying
8401061 :: (KnownNat n, 1 <= n)
8411062 => proxy n
8421063 -> TypeExpression ('Required ('Null ('PGvarchar n)))
8431064varchar p = UnsafeTypeExpression $ "varchar(" <> renderNat p <> ")"
844−characterVarying
845− :: (KnownNat n, 1 <= n)
846− => proxy n
847− -> TypeExpression ('Required ('Null ('PGvarchar n)))
8481065characterVarying p = UnsafeTypeExpression $
8491066 "character varying(" <> renderNat p <> ")"
850−bytea :: TypeExpression ('Required ('Null ('PGbytea)))
1067+-- | binary data ("byte array")
1068+bytea :: TypeExpression ('Required ('Null 'PGbytea))
8511069bytea = UnsafeTypeExpression "bytea"
852−timestamp :: TypeExpression ('Required ('Null ('PGtimestamp)))
1070+-- | date and time (no time zone)
1071+timestamp :: TypeExpression ('Required ('Null 'PGtimestamp))
8531072timestamp = UnsafeTypeExpression "timestamp"
854−timestampWithTimeZone :: TypeExpression ('Required ('Null ('PGtimestamptz)))
1073+-- | date and time, including time zone
1074+timestampWithTimeZone :: TypeExpression ('Required ('Null 'PGtimestamptz))
8551075timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"
856−date :: TypeExpression ('Required ('Null ('PGdate)))
1076+-- | calendar date (year, month, day)
1077+date :: TypeExpression ('Required ('Null 'PGdate))
8571078date = UnsafeTypeExpression "date"
858−time :: TypeExpression ('Required ('Null ('PGtime)))
1079+-- | time of day (no time zone)
1080+time :: TypeExpression ('Required ('Null 'PGtime))
8591081time = UnsafeTypeExpression "time"
860−timeWithTimeZone :: TypeExpression ('Required ('Null ('PGtimetz)))
1082+-- | time of day, including time zone
1083+timeWithTimeZone :: TypeExpression ('Required ('Null 'PGtimetz))
8611084timeWithTimeZone = UnsafeTypeExpression "time with time zone"
862−interval :: TypeExpression ('Required ('Null ('PGinterval)))
1085+-- | time span
1086+interval :: TypeExpression ('Required ('Null 'PGinterval))
8631087interval = UnsafeTypeExpression "interval"
864−uuid :: TypeExpression ('Required ('Null ('PGuuid)))
1088+-- | universally unique identifier
1089+uuid :: TypeExpression ('Required ('Null 'PGuuid))
8651090uuid = UnsafeTypeExpression "uuid"
866−json :: TypeExpression ('Required ('Null ('PGjson)))
1091+-- | IPv4 or IPv6 host address
1092+inet :: TypeExpression ('Required ('Null 'PGinet))
1093+inet = UnsafeTypeExpression "inet"
1094+-- | textual JSON data
1095+json :: TypeExpression ('Required ('Null 'PGjson))
8671096json = UnsafeTypeExpression "json"
868−jsonb :: TypeExpression ('Required ('Null ('PGjsonb)))
1097+-- | binary JSON data, decomposed
1098+jsonb :: TypeExpression ('Required ('Null 'PGjsonb))
8691099jsonb = UnsafeTypeExpression "jsonb"
8701100
1101+-- | used in `createTable` commands as a column constraint to ensure
1102+-- @NULL@ is not present
8711103notNull
8721104 :: TypeExpression (optionality ('Null ty))
8731105 -> TypeExpression (optionality ('NotNull ty))
8741106notNull ty = UnsafeTypeExpression $ renderTypeExpression ty <+> "NOT NULL"
1107+
1108+-- | used in `createTable` commands as a column constraint to give a default
8751109default_
8761110 :: Expression '[] 'Ungrouped '[] ('Required ty)
8771111 -> TypeExpression ('Required ty)
@@ -879,6 +1113,7 @@ default_
8791113default_ x ty = UnsafeTypeExpression $
8801114 renderTypeExpression ty <+> "DEFAULT" <+> renderExpression x
8811115
1116+-- | `pgtype` is a demoted version of a `PGType`
8821117class PGTyped (ty :: PGType) where
8831118 pgtype :: TypeExpression ('Required ('Null ty))
8841119instance PGTyped 'PGbool where pgtype = bool
squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+212−33
@@ -1,3 +1,13 @@
1+{-|
2+Module: Squeal.PostgreSQL.Manipulation
3+Description: Squeal data manipulation language
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+Squeal data manipulation language.
9+-}
10+
111{-# LANGUAGE
212 DataKinds
313 , DeriveDataTypeable
@@ -14,27 +24,29 @@
1424#-}
1525
1626module Squeal.PostgreSQL.Manipulation
17− ( -- * Data Manipulation Language
27+ ( -- * Manipulation
1828 Manipulation (UnsafeManipulation, renderManipulation)
1929 , queryStatement
30+ -- * Insert
2031 , insertInto
2132 , ValuesClause (Values, ValuesQuery)
2233 , renderValuesClause
2334 , ReturningClause (ReturningStar, Returning)
2435 , renderReturningClause
25− , ConflictClause (Conflict, OnConflictDoNothing, OnConflictDoUpdate)
36+ , ConflictClause (OnConflictDoRaise, OnConflictDoNothing, OnConflictDoUpdate)
2637 , renderConflictClause
38+ -- * Update
39+ , update
2740 , UpdateExpression (Same, Set)
2841 , renderUpdateExpression
29− , update
3042 , deleteFrom
3143 ) where
3244
3345import Control.DeepSeq
3446import Data.ByteString
3547import Data.Monoid
36−import Generics.SOP
3748
49+import qualified Generics.SOP as SOP
3850import qualified GHC.Generics as GHC
3951
4052import Squeal.PostgreSQL.Expression
@@ -42,6 +54,10 @@ import Squeal.PostgreSQL.Prettyprint
4254import Squeal.PostgreSQL.Query
4355import Squeal.PostgreSQL.Schema
4456
57+-- | A `Manipulation` is a statement which may modify data in the database,
58+-- but does not alter the schema. Examples are `insertInto`, `update` and
59+-- `deleteFrom`. A `Query` is also considered a `Manipulation` even though
60+-- it does not modify data.
4561newtype Manipulation
4662 (schema :: TablesType)
4763 (params :: [ColumnType])
@@ -49,6 +65,7 @@ newtype Manipulation
4965 = UnsafeManipulation { renderManipulation :: ByteString }
5066 deriving (GHC.Generic,Show,Eq,Ord,NFData)
5167
68+-- | Convert a `Query` into a `Manipulation`.
5269queryStatement
5370 :: Query schema params columns
5471 -> Manipulation schema params columns
@@ -58,12 +75,114 @@ queryStatement q = UnsafeManipulation $ renderQuery q <> ";"
5875INSERT statements
5976-----------------------------------------}
6077
78+{- |
79+When a table is created, it contains no data. The first thing to do
80+before a database can be of much use is to insert data. Data is
81+conceptually inserted one row at a time. Of course you can also insert
82+more than one row, but there is no way to insert less than one row.
83+Even if you know only some column values, a complete row must be created.
84+
85+simple insert:
86+
87+>>> :{
88+let
89+ manipulation :: Manipulation
90+ '[ "tab" :::
91+ '[ "col1" ::: 'Required ('NotNull 'PGint4)
92+ , "col2" ::: 'Required ('NotNull 'PGint4) ]] '[] '[]
93+ manipulation =
94+ insertInto #tab (Values (2 `As` #col1 :* 4 `As` #col2 :* Nil) [])
95+ OnConflictDoRaise (Returning Nil)
96+in renderManipulation manipulation
97+:}
98+"INSERT INTO tab (col1, col2) VALUES (2, 4);"
99+
100+parameterized insert:
101+
102+>>> :{
103+let
104+ manipulation :: Manipulation
105+ '[ "tab" :::
106+ '[ "col1" ::: 'Required ('NotNull 'PGint4)
107+ , "col2" ::: 'Required ('NotNull 'PGint4) ]]
108+ '[ 'Required ('NotNull 'PGint4)
109+ , 'Required ('NotNull 'PGint4) ] '[]
110+ manipulation =
111+ insertInto #tab
112+ (Values (param @1 `As` #col1 :* param @2 `As` #col2 :* Nil) [])
113+ OnConflictDoRaise (Returning Nil)
114+in renderManipulation manipulation
115+:}
116+"INSERT INTO tab (col1, col2) VALUES (($1 :: int4), ($2 :: int4));"
117+
118+returning insert:
119+
120+>>> :{
121+let
122+ manipulation :: Manipulation
123+ '[ "tab" :::
124+ '[ "col1" ::: 'Required ('NotNull 'PGint4)
125+ , "col2" ::: 'Required ('NotNull 'PGint4) ]] '[]
126+ '["fromOnly" ::: 'Required ('NotNull 'PGint4)]
127+ manipulation =
128+ insertInto #tab (Values (2 `As` #col1 :* 4 `As` #col2 :* Nil) [])
129+ OnConflictDoRaise (Returning (#col1 `As` #fromOnly :* Nil))
130+in renderManipulation manipulation
131+:}
132+"INSERT INTO tab (col1, col2) VALUES (2, 4) RETURNING col1 AS fromOnly;"
133+
134+query insert:
135+
136+>>> :{
137+let
138+ manipulation :: Manipulation
139+ '[ "tab" :::
140+ '[ "col1" ::: 'Required ('NotNull 'PGint4)
141+ , "col2" ::: 'Required ('NotNull 'PGint4)
142+ ]
143+ , "other_tab" :::
144+ '[ "col1" ::: 'Required ('NotNull 'PGint4)
145+ , "col2" ::: 'Required ('NotNull 'PGint4)
146+ ]
147+ ] '[] '[]
148+ manipulation =
149+ insertInto #tab
150+ ( ValuesQuery $
151+ selectStar (from (Table (#other_tab `As` #t))) )
152+ OnConflictDoRaise (Returning Nil)
153+in renderManipulation manipulation
154+:}
155+"INSERT INTO tab SELECT * FROM other_tab AS t;"
156+
157+upsert:
158+
159+>>> :{
160+let
161+ manipulation :: Manipulation
162+ '[ "tab" :::
163+ '[ "col1" ::: 'Required ('NotNull 'PGint4)
164+ , "col2" ::: 'Required ('NotNull 'PGint4) ]]
165+ '[] '[ "sum" ::: 'Required ('NotNull 'PGint4)]
166+ manipulation =
167+ insertInto #tab
168+ (Values
169+ (2 `As` #col1 :* 4 `As` #col2 :* Nil)
170+ [6 `As` #col1 :* 8 `As` #col2 :* Nil])
171+ (OnConflictDoUpdate
172+ (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
173+ (Just (#col1 .== #col2)))
174+ (Returning $ (#col1 + #col2) `As` #sum :* Nil)
175+in renderManipulation manipulation
176+:}
177+"INSERT INTO tab (col1, col2) VALUES (2, 4), (6, 8) ON CONFLICT DO UPDATE SET col1 = 2 WHERE (col1 = col2) RETURNING (col1 + col2) AS sum;"
178+-}
61179insertInto
62− :: (SListI columns, SListI results, HasTable table schema columns)
63− => Alias table
64− -> ValuesClause schema params columns
180+ :: (SOP.SListI columns, SOP.SListI results, HasTable table schema columns)
181+ => Alias table -- ^ table to insert into
182+ -> ValuesClause schema params columns -- ^ values to insert
65183 -> ConflictClause columns params
66− -> ReturningClause columns params results
184+ -- ^ what to do in case of constraint conflict
185+ -> ReturningClause columns params results -- ^ results to return
67186 -> Manipulation schema params results
68187insertInto table insert conflict returning = UnsafeManipulation $
69188 "INSERT" <+> "INTO" <+> renderAlias table
@@ -71,6 +190,8 @@ insertInto table insert conflict returning = UnsafeManipulation $
71190 <> renderConflictClause conflict
72191 <> renderReturningClause returning
73192
193+-- | A `ValuesClause` lets you insert either values, free `Expression`s,
194+-- or the result of a `Query`.
74195data ValuesClause
75196 (schema :: TablesType)
76197 (params :: [ColumnType])
@@ -78,10 +199,12 @@ data ValuesClause
78199 = Values
79200 (NP (Aliased (Expression '[] 'Ungrouped params)) columns)
80201 [NP (Aliased (Expression '[] 'Ungrouped params)) columns]
202+ -- ^ at least one row of values
81203 | ValuesQuery (Query schema params columns)
82204
205+-- | Render a `ValuesClause`.
83206renderValuesClause
84− :: SListI columns
207+ :: SOP.SListI columns
85208 => ValuesClause schema params columns
86209 -> ByteString
87210renderValuesClause = \case
@@ -97,6 +220,16 @@ renderValuesClause = \case
97220 renderValuePart (value `As` _) = renderExpression value
98221 ValuesQuery q -> renderQuery q
99222
223+-- | A `ReturningClause` computes and return value(s) based
224+-- on each row actually inserted, updated or deleted. This is primarily
225+-- useful for obtaining values that were supplied by defaults, such as a
226+-- serial sequence number. However, any expression using the table's columns
227+-- is allowed. Only rows that were successfully inserted or updated or
228+-- deleted will be returned. For example, if a row was locked
229+-- but not updated because an `OnConflictDoUpdate` condition was not satisfied,
230+-- the row will not be returned. `ReturningStar` will return all columns
231+-- in the row. Use `Returning Nil` in the common case where no return
232+-- values are desired.
100233data ReturningClause
101234 (columns :: ColumnsType)
102235 (params :: [ColumnType])
@@ -109,8 +242,9 @@ data ReturningClause
109242 results
110243 -> ReturningClause columns params results
111244
245+-- | Render a `ReturningClause`.
112246renderReturningClause
113− :: SListI results
247+ :: SOP.SListI results
114248 => ReturningClause params columns results
115249 -> ByteString
116250renderReturningClause = \case
@@ -119,20 +253,26 @@ renderReturningClause = \case
119253 Returning results -> " RETURNING"
120254 <+> renderCommaSeparated (renderAliased renderExpression) results <> ";"
121255
256+-- | A `ConflictClause` specifies an action to perform upon a constraint
257+-- violation. `OnConflictDoRaise` will raise an error.
258+-- `OnConflictDoNothing` simply avoids inserting a row.
259+-- `OnConflictDoUpdate` updates the existing row that conflicts with the row
260+-- proposed for insertion.
122261data ConflictClause columns params where
123− Conflict :: ConflictClause columns params
262+ OnConflictDoRaise :: ConflictClause columns params
124263 OnConflictDoNothing :: ConflictClause columns params
125264 OnConflictDoUpdate
126265 :: NP (Aliased (UpdateExpression columns params)) columns
127266 -> Maybe (Condition '[table ::: columns] 'Ungrouped params)
128267 -> ConflictClause columns params
129268
269+-- | Render a `ConflictClause`.
130270renderConflictClause
131− :: SListI columns
271+ :: SOP.SListI columns
132272 => ConflictClause columns params
133273 -> ByteString
134274renderConflictClause = \case
135− Conflict -> ""
275+ OnConflictDoRaise -> ""
136276 OnConflictDoNothing -> " ON CONFLICT DO NOTHING"
137277 OnConflictDoUpdate updates whMaybe
138278 -> " ON CONFLICT DO UPDATE SET"
@@ -145,13 +285,50 @@ renderConflictClause = \case
145285UPDATE statements
146286-----------------------------------------}
147287
288+-- | An `update` command changes the values of the specified columns
289+-- in all rows that satisfy the condition.
290+--
291+-- >>> :{
292+-- let
293+-- manipulation :: Manipulation
294+-- '[ "tab" :::
295+-- '[ "col1" ::: 'Required ('NotNull 'PGint4)
296+-- , "col2" ::: 'Required ('NotNull 'PGint4) ]] '[] '[]
297+-- manipulation =
298+-- update #tab (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
299+-- (#col1 ./= #col2) (Returning Nil)
300+-- in renderManipulation manipulation
301+-- :}
302+-- "UPDATE tab SET col1 = 2 WHERE (col1 <> col2);"
303+update
304+ :: (HasTable table schema columns, SOP.SListI columns, SOP.SListI results)
305+ => Alias table -- ^ table to update
306+ -> NP (Aliased (UpdateExpression columns params)) columns
307+ -- ^ modified values to replace old values
308+ -> Condition '[tab ::: columns] 'Ungrouped params
309+ -- ^ condition under which to perform update on a row
310+ -> ReturningClause columns params results -- ^ results to return
311+ -> Manipulation schema params results
312+update table columns wh returning = UnsafeManipulation $
313+ "UPDATE"
314+ <+> renderAlias table
315+ <+> "SET"
316+ <+> renderCommaSeparatedMaybe renderUpdateExpression columns
317+ <+> "WHERE" <+> renderExpression wh
318+ <> renderReturningClause returning
319+
320+-- | Columns to be updated are mentioned with `Set`; columns which are to
321+-- remain the same are mentioned with `Same`.
148322data UpdateExpression columns params ty
149323 = Same
324+ -- ^ column to remain the same upon update
150325 | Set (forall table. Expression '[table ::: columns] 'Ungrouped params ty)
326+ -- ^ column to be updated
151327deriving instance Show (UpdateExpression columns params ty)
152328deriving instance Eq (UpdateExpression columns params ty)
153329deriving instance Ord (UpdateExpression columns params ty)
154330
331+-- | Render an `UpdateExpression`.
155332renderUpdateExpression
156333 :: Aliased (UpdateExpression params columns) column
157334 -> Maybe ByteString
@@ -160,30 +337,32 @@ renderUpdateExpression = \case
160337 Set expression `As` column -> Just $
161338 renderAlias column <+> "=" <+> renderExpression expression
162339
163−update
164− :: (HasTable table schema columns, SListI columns, SListI results)
165− => Alias table
166− -> NP (Aliased (UpdateExpression columns params)) columns
167− -> Condition '[tab ::: columns] 'Ungrouped params
168− -> ReturningClause columns params results
169− -> Manipulation schema params results
170−update table columns wh returning = UnsafeManipulation $
171− "UPDATE"
172− <+> renderAlias table
173− <+> "SET"
174− <+> renderCommaSeparatedMaybe renderUpdateExpression columns
175− <+> "WHERE" <+> renderExpression wh
176− <> renderReturningClause returning
177−
178340{-----------------------------------------
179341DELETE statements
180342-----------------------------------------}
181343
344+-- | Delete rows of a table.
345+--
346+-- >>> :{
347+-- let
348+-- manipulation :: Manipulation
349+-- '[ "tab" :::
350+-- '[ "col1" ::: 'Required ('NotNull 'PGint4)
351+-- , "col2" ::: 'Required ('NotNull 'PGint4) ]] '[]
352+-- '[ "col1" ::: 'Required ('NotNull 'PGint4)
353+-- , "col2" ::: 'Required ('NotNull 'PGint4) ]
354+-- manipulation = deleteFrom #tab (#col1 .== #col2) ReturningStar
355+-- in renderManipulation manipulation
356+-- :}
357+-- "DELETE FROM tab WHERE (col1 = col2) RETURNING *;"
182358deleteFrom
183− :: HasTable table schema columns
184− => Alias table
359+ :: (SOP.SListI results, HasTable table schema columns)
360+ => Alias table -- ^ table to delete from
185361 -> Condition '[table ::: columns] 'Ungrouped params
186− -> Manipulation schema params '[]
187−deleteFrom table wh = UnsafeManipulation $
362+ -- ^ condition under which to delete a row
363+ -> ReturningClause columns params results -- ^ results to return
364+ -> Manipulation schema params results
365+deleteFrom table wh returning = UnsafeManipulation $
188366 "DELETE FROM" <+> renderAlias table
189− <+> "WHERE" <+> renderExpression wh <> ";"
367+ <+> "WHERE" <+> renderExpression wh
368+ <> renderReturningClause returning
squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+227−90
@@ -1,3 +1,15 @@
1+{-|
2+Module: Squeal.PostgreSQL.PQ
3+Description: PQ monad
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+`Squeal.PostgreSQL.PQ` is where Squeal statements come to actually get run by
9+`LibPQ`. It contains a `PQ` indexed monad transformer to run `Definition`s and
10+a `MonadPQ` constraint for running a `Manipulation` or `Query`.
11+-}
12+
113{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
214{-# LANGUAGE
315 DataKinds
@@ -19,7 +31,36 @@
1931 , UndecidableInstances
2032#-}
2133
22−module Squeal.PostgreSQL.PQ where
34+module Squeal.PostgreSQL.PQ
35+ ( -- * Connection
36+ Connection (unConnection)
37+ , connectdb
38+ , finish
39+ , withConnection
40+ -- * PQ
41+ , PQ (runPQ)
42+ , execPQ
43+ , pqAp
44+ , pqBind
45+ , pqThen
46+ , define
47+ , thenDefine
48+ -- * MonadPQ
49+ , MonadPQ (..)
50+ , PQRun
51+ , pqliftWith
52+ -- * Result
53+ , Result (Result, unResult)
54+ , RowNumber (RowNumber, unRowNumber)
55+ , ColumnNumber (UnsafeColumnNumber, getColumnNumber)
56+ , HasColumnNumber (columnNumber)
57+ , getValue
58+ , getRow
59+ , getRows
60+ , nextRow
61+ , firstRow
62+ , liftResult
63+ ) where
2364
2465import Control.Exception.Lifted
2566import Control.Monad.Base
@@ -43,11 +84,52 @@ import Squeal.PostgreSQL.Manipulation
4384import Squeal.PostgreSQL.Query
4485import Squeal.PostgreSQL.Schema
4586
46−-- | A `Connection` consists of a `Database.PastgreSQL.LibPQ.Connection`
47−-- and a phantom `Squeal.PostgreSQL.TablesType`
87+-- | A `Connection` consists of a `Database.PostgreSQL.LibPQ`
88+-- `Database.PastgreSQL.LibPQ.Connection` and a phantom `TablesType`
4889newtype Connection (schema :: TablesType) =
4990 Connection { unConnection :: LibPQ.Connection }
5091
92+{- | Makes a new connection to the database server.
93+
94+This function opens a new database connection using the parameters taken
95+from the string conninfo.
96+
97+The passed string can be empty to use all default parameters, or it can
98+contain one or more parameter settings separated by whitespace.
99+Each parameter setting is in the form keyword = value. Spaces around the equal
100+sign are optional. To write an empty value or a value containing spaces,
101+surround it with single quotes, e.g., keyword = 'a value'. Single quotes and
102+backslashes within the value must be escaped with a backslash, i.e., ' and \.
103+
104+To specify the schema you wish to connect with, use type application.
105+
106+>>> :set -XTypeApplication
107+>>> conn <- connectdb @MySchema "host=localhost port=5432 dbname=exampledb"
108+
109+Note that, for now, squeal doesn't offer any protection from connecting
110+with the wrong schema!
111+-}
112+connectdb
113+ :: forall schema io
114+ . MonadBase IO io
115+ => ByteString -- ^ conninfo
116+ -> io (Connection schema)
117+connectdb = fmap Connection . liftBase . LibPQ.connectdb
118+
119+-- | Closes the connection to the server.
120+finish :: MonadBase IO io => Connection schema -> io ()
121+finish = liftBase . LibPQ.finish . unConnection
122+
123+-- | Do `connectdb` and `finish` before and after a computation.
124+withConnection
125+ :: forall schema io x
126+ . MonadBaseControl IO io
127+ => ByteString
128+ -> (Connection schema -> io x)
129+ -> io x
130+withConnection connString = bracket (connectdb connString) finish
131+
132+
51133-- | We keep track of the schema via an Atkey indexed state monad transformer,
52134-- `PQ`.
53135newtype PQ
@@ -58,9 +140,7 @@ newtype PQ
58140 PQ { runPQ :: Connection schema0 -> m (x, Connection schema1) }
59141 deriving Functor
60142
61−evalPQ :: Functor m => PQ schema0 schema1 m x -> Connection schema0 -> m x
62−evalPQ (PQ pq) = fmap fst . pq
63−
143+-- | Run a `PQ` and discard the result but keep the `Connection`.
64144execPQ
65145 :: Functor m
66146 => PQ schema0 schema1 m x
@@ -89,7 +169,7 @@ pqBind f (PQ x) = PQ $ \ conn -> do
89169 (x', conn') <- x conn
90170 runPQ (f x') conn'
91171
92−-- | indexed analog of `>>`
172+-- | indexed analog of flipped `>>`
93173pqThen
94174 :: Monad m
95175 => PQ schema1 schema2 m y
@@ -99,7 +179,7 @@ pqThen pq2 pq1 = pq1 & pqBind (\ _ -> pq2)
99179
100180-- | Run a `Definition` with `LibPQ.exec`, we expect that libpq obeys the law
101181--
102−-- prop> then (define statement2) statement1 = define (statement2 . statement1)
182+-- prop> pqThen (define statement2) statement1 = define (statement2 . statement1)
103183define
104184 :: MonadBase IO io
105185 => Definition schema0 schema1
@@ -111,41 +191,82 @@ define (UnsafeDefinition q) = PQ $ \ (Connection conn) -> do
111191 "define: LibPQ.exec returned no results"
112192 Just result -> return (Result result, Connection conn)
113193
114−pqThenDefine
194+-- | Chain together `define` actions.
195+thenDefine
115196 :: MonadBase IO io
116197 => Definition schema1 schema2
117198 -> PQ schema0 schema1 io x
118199 -> PQ schema0 schema2 io (Result '[])
119−pqThenDefine = pqThen . define
200+thenDefine = pqThen . define
201+
202+{- | `MonadPQ` is an `mtl` style constraint, similar to
203+`Control.Monad.State.Class.MonadState`, for using `LibPQ` to
204+
205+* `manipulateParams` runs a `Manipulation` with params from a type
206+ with a `ToParams` constraint. It calls `LibPQ.execParams` and
207+ doesn't afraid of anything.
208+
209+* `manipulate` is like `manipulateParams` for a parameter-free statement.
210+
211+* `runQueryParams` is like `manipulateParams` for query statements.
212+
213+* `traversePrepared` has the same type signature as a composition of
214+ `traverse` and `manipulateParams` but provides an optimization by
215+ preparing the statement with `LibPQ.prepare` and then traversing a
216+ `Traversable` container with `LibPQ.execPrepared`. The temporary prepared
217+ statement is then deallocated.
218+
219+* `forPrepared` is a flipped `traversePrepared`
120220
121−-- | `MonadPQ` is an `mtl` style constraint, similar to `MonadState`.
221+* `traversePrepared_` is like `traversePrepared` but works on `Foldable`
222+ containers and returns unit.
223+
224+* `forPrepared_` is a flipped `traversePrepared_`.
225+
226+* `liftPQ` lets you lift actions from `LibPQ` that require a connection
227+ into your monad.
228+
229+To define an instance, you can minimally define only `manipulateParams`,
230+`traversePrepared`, `traversePrepared_` and `liftPQ`. Monad transformers get
231+a default instance.
232+
233+-}
122234class Monad pq => MonadPQ schema pq | pq -> schema where
123− -- | `manipulateParams` runs a `Manipulation` with params from a type
124− -- with a `ToParams` constraint
125235 manipulateParams
126236 :: ToParams x params
127− => Manipulation schema params ys -> x -> pq (Result ys)
237+ => Manipulation schema params ys
238+ -- ^ `insertInto`, `update` or `deleteFrom`
239+ -> x -> pq (Result ys)
128240 default manipulateParams
129241 :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)
130242 => ToParams x params
131− => Manipulation schema params ys -> x -> pq (Result ys)
243+ => Manipulation schema params ys
244+ -- ^ `insertInto`, `update` or `deleteFrom`
245+ -> x -> pq (Result ys)
132246 manipulateParams manipulation params = lift $
133247 manipulateParams manipulation params
134248
135249 manipulate :: Manipulation schema '[] ys -> pq (Result ys)
136250 manipulate statement = manipulateParams statement ()
137251
138− queryParams
252+ runQueryParams
139253 :: ToParams x params
140− => Query schema params ys -> x -> pq (Result ys)
141− queryParams = manipulateParams . queryStatement
254+ => Query schema params ys
255+ -- ^ `select` and friends
256+ -> x -> pq (Result ys)
257+ runQueryParams = manipulateParams . queryStatement
142258
143− query :: Query schema '[] ys -> pq (Result ys)
144− query q = queryParams q ()
259+ runQuery
260+ :: Query schema '[] ys
261+ -- ^ `select` and friends
262+ -> pq (Result ys)
263+ runQuery q = runQueryParams q ()
145264
146265 traversePrepared
147266 :: (ToParams x params, Traversable list)
148− => Manipulation schema params ys -> list x -> pq (list (Result ys))
267+ => Manipulation schema params ys
268+ -- ^ `insertInto`, `update` or `deleteFrom`
269+ -> list x -> pq (list (Result ys))
149270 default traversePrepared
150271 :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)
151272 => (ToParams x params, Traversable list)
@@ -155,22 +276,32 @@ class Monad pq => MonadPQ schema pq | pq -> schema where
155276
156277 forPrepared
157278 :: (ToParams x params, Traversable list)
158− => list x -> Manipulation schema params ys -> pq (list (Result ys))
279+ => list x
280+ -> Manipulation schema params ys
281+ -- ^ `insertInto`, `update` or `deleteFrom`
282+ -> pq (list (Result ys))
159283 forPrepared = flip traversePrepared
160284
161285 traversePrepared_
162286 :: (ToParams x params, Foldable list)
163− => Manipulation schema params ys -> list x -> pq ()
287+ => Manipulation schema params ys
288+ -- ^ `insertInto`, `update` or `deleteFrom`
289+ -> list x -> pq ()
164290 default traversePrepared_
165291 :: (MonadTrans t, MonadPQ schema pq1, pq ~ t pq1)
166292 => (ToParams x params, Foldable list)
167− => Manipulation schema params ys -> list x -> pq ()
293+ => Manipulation schema params ys
294+ -- ^ `insertInto`, `update` or `deleteFrom`
295+ -> list x -> pq ()
168296 traversePrepared_ manipulation params = lift $
169297 traversePrepared_ manipulation params
170298
171299 forPrepared_
172300 :: (ToParams x params, Traversable list)
173− => list x -> Manipulation schema params ys -> pq ()
301+ => list x
302+ -> Manipulation schema params ys
303+ -- ^ `insertInto`, `update` or `deleteFrom`
304+ -> pq ()
174305 forPrepared_ = flip traversePrepared_
175306
176307 liftPQ :: (LibPQ.Connection -> IO a) -> pq a
@@ -195,58 +326,64 @@ instance MonadBase IO io => MonadPQ schema (PQ schema schema io) where
195326
196327 traversePrepared
197328 (UnsafeManipulation q :: Manipulation schema xs ys) (list :: list x) =
198− PQ $ \ (Connection conn) -> do
329+ PQ $ \ (Connection conn) -> liftBase $ do
199330 let temp = "temporary_statement"
200− prepResultMaybe <- liftBase $ LibPQ.prepare conn temp q Nothing
331+ prepResultMaybe <- LibPQ.prepare conn temp q Nothing
201332 case prepResultMaybe of
202333 Nothing -> error
203334 "traversePrepared: LibPQ.prepare returned no results"
204− Just _prepResult -> return () -- todo: check status of prepResult
335+ Just prepResult -> do
336+ status <- LibPQ.resultStatus prepResult
337+ unless (status == LibPQ.CommandOk) . error $
338+ "traversePrepared: LibPQ.prepare status " <> show status
205339 results <- for list $ \ params -> do
206340 let
207341 toParam' bytes = (bytes,LibPQ.Binary)
208342 params' = fmap (fmap toParam') (hcollapse (toParams @x @xs params))
209− resultMaybe <- liftBase $
210− LibPQ.execPrepared conn temp params' LibPQ.Binary
343+ resultMaybe <- LibPQ.execPrepared conn temp params' LibPQ.Binary
211344 case resultMaybe of
212345 Nothing -> error
213346 "traversePrepared: LibPQ.execParams returned no results"
214347 Just result -> return $ Result result
215− deallocResultMaybe <- liftBase $
216− LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")
348+ deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")
217349 case deallocResultMaybe of
218350 Nothing -> error
219351 "traversePrepared: LibPQ.exec DEALLOCATE returned no results"
220− Just _deallocResult -> return ()
221− -- todo: check status of deallocResult
352+ Just deallocResult -> do
353+ status <- LibPQ.resultStatus deallocResult
354+ unless (status == LibPQ.CommandOk) . error $
355+ "traversePrepared: DEALLOCATE status " <> show status
222356 return (results, Connection conn)
223357
224358 traversePrepared_
225359 (UnsafeManipulation q :: Manipulation schema xs ys) (list :: list x) =
226− PQ $ \ (Connection conn) -> do
360+ PQ $ \ (Connection conn) -> liftBase $ do
227361 let temp = "temporary_statement"
228− prepResultMaybe <- liftBase $ LibPQ.prepare conn temp q Nothing
362+ prepResultMaybe <- LibPQ.prepare conn temp q Nothing
229363 case prepResultMaybe of
230364 Nothing -> error
231365 "traversePrepared_: LibPQ.prepare returned no results"
232− Just _prepResult -> return () -- todo: check status of prepResult
366+ Just prepResult -> do
367+ status <- LibPQ.resultStatus prepResult
368+ unless (status == LibPQ.CommandOk) . error $
369+ "traversePrepared: LibPQ.prepare status " <> show status
233370 for_ list $ \ params -> do
234371 let
235372 toParam' bytes = (bytes,LibPQ.Binary)
236373 params' = fmap (fmap toParam') (hcollapse (toParams @x @xs params))
237− resultMaybe <- liftBase $
238− LibPQ.execPrepared conn temp params' LibPQ.Binary
374+ resultMaybe <- LibPQ.execPrepared conn temp params' LibPQ.Binary
239375 case resultMaybe of
240376 Nothing -> error
241377 "traversePrepared_: LibPQ.execParams returned no results"
242378 Just _result -> return ()
243− deallocResultMaybe <- liftBase $
244− LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")
379+ deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")
245380 case deallocResultMaybe of
246381 Nothing -> error
247382 "traversePrepared: LibPQ.exec DEALLOCATE returned no results"
248− Just _deallocResult -> return ()
249− -- todo: check status of deallocResult
383+ Just deallocResult -> do
384+ status <- LibPQ.resultStatus deallocResult
385+ unless (status == LibPQ.CommandOk) . error $
386+ "traversePrepared: DEALLOCATE status " <> show status
250387 return ((), Connection conn)
251388
252389 liftPQ pq = PQ $ \ (Connection conn) -> do
@@ -269,9 +406,11 @@ instance MonadTrans (PQ schema schema) where
269406instance MonadBase b m => MonadBase b (PQ schema schema m) where
270407 liftBase = lift . liftBase
271408
409+-- | A snapshot of the state of a `PQ` computation.
272410type PQRun schema =
273411 forall m x. Monad m => PQ schema schema m x -> m (x, Connection schema)
274412
413+-- | Helper function in defining `MonadBaseControl` instance for `PQ`.
275414pqliftWith :: Functor m => (PQRun schema -> m a) -> PQ schema schema m a
276415pqliftWith f = PQ $ \ conn ->
277416 fmap (\ x -> (x, conn)) (f $ \ pq -> runPQ pq conn)
@@ -282,28 +421,22 @@ instance MonadBaseControl b m => MonadBaseControl b (PQ schema schema m) where
282421 pqliftWith $ \ run -> liftBaseWith $ \ runInBase -> f $ runInBase . run
283422 restoreM = PQ . const . restoreM
284423
285−connectdb :: MonadBase IO io => ByteString -> io (Connection schema)
286−connectdb = fmap Connection . liftBase . LibPQ.connectdb
287−
288−finish :: MonadBase IO io => Connection schema -> io ()
289−finish = liftBase . LibPQ.finish . unConnection
290−
291−withConnection
292− :: forall schema io x
293− . MonadBaseControl IO io
294− => ByteString
295− -> (Connection schema -> io x)
296− -> io x
297−withConnection connString = bracket (connectdb connString) finish
298−
299−newtype Result (xs :: ColumnsType)
424+-- | Encapsulates the result of a squeal command run by @LibPQ@.
425+-- `Result`s are parameterized by a `ColumnsType` describing the column names
426+-- and their types.
427+newtype Result (columns :: ColumnsType)
300428 = Result { unResult :: LibPQ.Result }
301429
430+-- | Just newtypes around a `CInt`
302431newtype RowNumber = RowNumber { unRowNumber :: LibPQ.Row }
303432
304−newtype ColumnNumber n cs c =
433+-- | In addition to being newtypes around a `CInt`, a `ColumnNumber` is
434+-- parameterized by a `Nat`ural number and acts as an index into a row.
435+newtype ColumnNumber (n :: Nat) (cs :: [k]) (c :: k) =
305436 UnsafeColumnNumber { getColumnNumber :: LibPQ.Column }
306437
438+-- | >>> getColumnNumber (columnNumber @5)
439+-- 5
307440class KnownNat n => HasColumnNumber n columns column
308441 | n columns -> column where
309442 columnNumber :: ColumnNumber n columns column
@@ -314,11 +447,13 @@ instance {-# OVERLAPPABLE #-}
314447 (KnownNat n, HasColumnNumber (n-1) columns column)
315448 => HasColumnNumber n (column' : columns) column
316449
450+-- | Get a single value corresponding to a given row and column number
451+-- from a `Result`.
317452getValue
318453 :: (FromColumnValue colty y, MonadBase IO io)
319− => RowNumber
320− -> ColumnNumber n columns colty
321− -> Result columns
454+ => RowNumber -- ^ row
455+ -> ColumnNumber n columns colty -- ^ col
456+ -> Result columns -- ^ result
322457 -> io y
323458getValue
324459 (RowNumber r)
@@ -331,47 +466,50 @@ getValue
331466 <> show numRows
332467 LibPQ.getvalue result r c
333468
469+-- | Get a row corresponding to a given row number from a `Result`.
334470getRow
335471 :: (FromRow columns y, MonadBase IO io)
336− => RowNumber -> Result columns -> io y
472+ => RowNumber
473+ -- ^ row
474+ -> Result columns
475+ -- ^ result
476+ -> io y
337477getRow (RowNumber r) (Result result :: Result columns) = liftBase $do
338478 numRows <- LibPQ.ntuples result
339479 when (numRows < r) $ error $
340480 "getRow: expected at least " <> show r <> "rows but only saw "
341481 <> show numRows
342482 let len = fromIntegral (lengthSList (Proxy @columns))
343− numCols <- LibPQ.nfields result
344− when (numCols /= len) $ error $
345− "getRow: expected at least " <> show len <> "columns but only saw "
346− <> show numCols
347483 row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]
348484 case fromList row' of
349485 Nothing -> error "getRow: found unexpected length"
350486 Just row -> return $ fromRow @columns row
351487
488+-- | Intended to be used for unfolding in streaming libraries, `nextRow`
489+-- takes a total number of rows (which can be found with `LibPQ.ntuples`)
490+-- and a `Result` and given a row number if it's too large returns `Nothing`,
491+-- otherwise returning the row along with the next row number.
352492nextRow
353493 :: (FromRow columns y, MonadBase IO io)
354− => Result columns -> RowNumber -> io (Maybe (RowNumber,y))
355−nextRow (Result result :: Result columns) (RowNumber r) = liftBase $ do
356− numRows <- LibPQ.ntuples result -- todo: cache this
357− if numRows < r then return Nothing else do
494+ => RowNumber -- ^ total number of rows
495+ -> Result columns -- ^ result
496+ -> RowNumber -- ^ row number
497+ -> io (Maybe (RowNumber,y))
498+nextRow (RowNumber total) (Result result :: Result columns) (RowNumber r)
499+ = liftBase $ if r >= total then return Nothing else do
358500 let len = fromIntegral (lengthSList (Proxy @columns))
359− numCols <- LibPQ.nfields result -- todo: cache this
360− when (numCols /= len) $ error $
361− "nextRow: expected at least " <> show len <> "columns but only saw "
362− <> show numCols
363501 row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]
364502 case fromList row' of
365503 Nothing -> error "nextRow: found unexpected length"
366504 Just row -> return $ Just (RowNumber (r+1), fromRow @columns row)
367505
368−getRows :: (FromRow columns y, MonadBase IO io) => Result columns -> io [y]
506+-- | Get all rows from a `Result`.
507+getRows
508+ :: (FromRow columns y, MonadBase IO io)
509+ => Result columns -- ^ result
510+ -> io [y]
369511getRows (Result result :: Result columns) = liftBase $ do
370512 let len = fromIntegral (lengthSList (Proxy @columns))
371− numCols <- LibPQ.nfields result
372− when (numCols /= len) $ error $
373− "getRow: expected at least " <> show len <> "columns but only saw "
374− <> show numCols
375513 numRows <- LibPQ.ntuples result
376514 for [0 .. numRows - 1] $ \ r -> do
377515 row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]
@@ -379,22 +517,21 @@ getRows (Result result :: Result columns) = liftBase $ do
379517 Nothing -> error "getRows: found unexpected length"
380518 Just row -> return $ fromRow @columns row
381519
382−getRowMaybe
520+-- | Get the first row if possible from a `Result`.
521+firstRow
383522 :: (FromRow columns y, MonadBase IO io)
384− => RowNumber -> Result columns -> io (Maybe y)
385−getRowMaybe (RowNumber r) (Result result :: Result columns) = liftBase $do
523+ => Result columns -- ^ result
524+ -> io (Maybe y)
525+firstRow (Result result :: Result columns) = liftBase $ do
386526 numRows <- LibPQ.ntuples result
387− if numRows < r then return Nothing else do
527+ if numRows <= 0 then return Nothing else do
388528 let len = fromIntegral (lengthSList (Proxy @columns))
389− numCols <- LibPQ.nfields result
390− when (numCols /= len) $ error $
391− "getRow: expected at least " <> show len <> "columns but only saw "
392− <> show numCols
393− row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]
529+ row' <- traverse (LibPQ.getvalue result 0) [0 .. len - 1]
394530 case fromList row' of
395− Nothing -> error "getRow: found unexpected length"
531+ Nothing -> error "firstRow: found unexpected length"
396532 Just row -> return . Just $ fromRow @columns row
397533
534+-- | Lifts actions on results from `LibPQ`.
398535liftResult
399536 :: MonadBase IO io
400537 => (LibPQ.Result -> IO x)
squeal-postgresql/src/Squeal/PostgreSQL/Prettyprint.hs+17
@@ -1,3 +1,13 @@
1+{-|
2+Module: Squeal.PostgreSQL.PrettyPrint
3+Description: Pretty print helper functions
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+Pretty print helper functions.
9+-}
10+
111{-# LANGUAGE
212 MagicHash
313 , OverloadedStrings
@@ -18,15 +28,19 @@ import GHC.TypeLits
1828
1929import qualified Data.ByteString as ByteString
2030
31+-- | Parenthesize a `ByteString`.
2132parenthesized :: ByteString -> ByteString
2233parenthesized str = "(" <> str <> ")"
2334
35+-- | Concatenate two `ByteString`s with a space between.
2436(<+>) :: ByteString -> ByteString -> ByteString
2537str1 <+> str2 = str1 <> " " <> str2
2638
39+-- | Comma separate a list of `ByteString`s.
2740commaSeparated :: [ByteString] -> ByteString
2841commaSeparated = ByteString.intercalate ", "
2942
43+-- | Comma separate the renderings of a heterogeneous list.
3044renderCommaSeparated
3145 :: SListI xs
3246 => (forall x. expression x -> ByteString)
@@ -36,6 +50,8 @@ renderCommaSeparated render
3650 . hcollapse
3751 . hmap (K . render)
3852
53+-- | Comma separate the `Maybe` renderings of a heterogeneous list, dropping
54+-- `Nothing`s.
3955renderCommaSeparatedMaybe
4056 :: SListI xs
4157 => (forall x. expression x -> Maybe ByteString)
@@ -46,5 +62,6 @@ renderCommaSeparatedMaybe render
4662 . hcollapse
4763 . hmap (K . render)
4864
65+-- | Render a promoted `Nat`.
4966renderNat :: KnownNat n => proxy n -> ByteString
5067renderNat (_ :: proxy n) = fromString (show (natVal' (proxy# :: Proxy# n)))
squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+456−70
@@ -1,3 +1,13 @@
1+{-|
2+Module: Squeal.PostgreSQL.Query
3+Description: Squeal queries
4+Copyright: (c) Eitan Chatav, 2017
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+Squeal queries.
9+-}
10+
111{-# LANGUAGE
212 DataKinds
313 , DeriveDataTypeable
@@ -26,16 +36,13 @@ module Squeal.PostgreSQL.Query
2636 , intersectAll
2737 , except
2838 , exceptAll
29− -- * SELECT queries
39+ -- * Select
3040 , select
3141 , selectDistinct
3242 , selectStar
3343 , selectDistinctStar
3444 , selectDotStar
3545 , selectDistinctDotStar
36− -- * FROM clauses
37− , FromClause (..)
38− , renderFromClause
3946 -- * Table Expressions
4047 , TableExpression (..)
4148 , renderTableExpression
@@ -46,6 +53,9 @@ module Squeal.PostgreSQL.Query
4653 , orderBy
4754 , limit
4855 , offset
56+ -- * From
57+ , FromClause (..)
58+ , renderFromClause
4959 -- * Grouping
5060 , By (By, By2)
5161 , renderBy
@@ -53,7 +63,6 @@ module Squeal.PostgreSQL.Query
5363 , renderGroupByClause
5464 , HavingClause (NoHaving, Having)
5565 , renderHavingClause
56− , GroupedBy (getGroup1, getGroup2)
5766 -- * Sorting
5867 , SortExpression (..)
5968 , renderSortExpression
@@ -73,6 +82,184 @@ import Squeal.PostgreSQL.Expression
7382import Squeal.PostgreSQL.Prettyprint
7483import Squeal.PostgreSQL.Schema
7584
85+{- |
86+The process of retrieving or the command to retrieve data from a database
87+is called a `Query`. The `select`, `selectStar`, `selectDotStar`,
88+`selectDistinct`, `selectDistinctStar` and `selectDistinctDotStar` commands
89+are used to specify queries.
90+
91+simple query:
92+
93+>>> :{
94+let
95+ query :: Query '["tab" ::: '["col" ::: 'Required ('Null 'PGint4)]] '[]
96+ '["col" ::: 'Required ('Null 'PGint4)]
97+ query = selectStar (from (Table (#tab `As` #t)))
98+in renderQuery query
99+:}
100+"SELECT * FROM tab AS t"
101+
102+restricted query:
103+
104+>>> :{
105+let
106+ query :: Query
107+ '[ "tab" :::
108+ '[ "col1" ::: 'Required ('NotNull 'PGint4)
109+ , "col2" ::: 'Required ('NotNull 'PGint4) ]]
110+ '[]
111+ '[ "sum" ::: 'Required ('NotNull 'PGint4)
112+ , "col1" ::: 'Required ('NotNull 'PGint4) ]
113+ query =
114+ select
115+ ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
116+ ( from (Table (#tab `As` #t))
117+ & where_ (#col1 .> #col2)
118+ & where_ (#col2 .> 0) )
119+in renderQuery query
120+:}
121+"SELECT (col1 + col2) AS sum, col1 AS col1 FROM tab AS t WHERE ((col1 > col2) AND (col2 > 0))"
122+
123+subquery:
124+
125+>>> :{
126+let
127+ query :: Query '["tab" ::: '["col" ::: 'Required ('Null 'PGint4)]] '[]
128+ '["col" ::: 'Required ('Null 'PGint4)]
129+ query =
130+ selectStar
131+ (from (Subquery (selectStar (from (Table (#tab `As` #t))) `As` #sub)))
132+in renderQuery query
133+:}
134+"SELECT * FROM (SELECT * FROM tab AS t) AS sub"
135+
136+limits and offsets:
137+
138+>>> :{
139+let
140+ query :: Query '["tab" ::: '["col" ::: 'Required ('Null 'PGint4)]] '[]
141+ '["col" ::: 'Required ('Null 'PGint4)]
142+ query = selectStar
143+ ( from (Table (#tab `As` #t))
144+ & limit 100
145+ & offset 2
146+ & limit 50
147+ & offset 2 )
148+in renderQuery query
149+:}
150+"SELECT * FROM tab AS t LIMIT 50 OFFSET 4"
151+
152+parameterized query:
153+
154+>>> :{
155+let
156+ query :: Query '["tab" ::: '["col" ::: 'Required ('Null 'PGint4)]]
157+ '[ 'Required ('NotNull 'PGbool)]
158+ '["col" ::: 'Required ('Null 'PGint4)]
159+ query = selectStar
160+ (from (Table (#tab `As` #t)) & where_ (param @1))
161+in renderQuery query
162+:}
163+"SELECT * FROM tab AS t WHERE ($1 :: bool)"
164+
165+aggregation query:
166+
167+>>> :{
168+let
169+ query :: Query
170+ '[ "tab" :::
171+ '[ "col1" ::: 'Required ('NotNull 'PGint4)
172+ , "col2" ::: 'Required ('NotNull 'PGint4) ]]
173+ '[]
174+ '[ "sum" ::: 'Required ('NotNull 'PGint4)
175+ , "col1" ::: 'Required ('NotNull 'PGint4) ]
176+ query =
177+ select (sum_ #col2 `As` #sum :* #col1 `As` #col1 :* Nil)
178+ ( from (Table (#tab `As` #table1))
179+ & group (By #col1 :* Nil)
180+ & having (#col1 + sum_ #col2 .> 1) )
181+in renderQuery query
182+:}
183+"SELECT sum(col2) AS sum, col1 AS col1 FROM tab AS table1 GROUP BY col1 HAVING ((col1 + sum(col2)) > 1)"
184+
185+sorted query:
186+
187+>>> :{
188+let
189+ query :: Query '["tab" ::: '["col" ::: 'Required ('Null 'PGint4)]] '[]
190+ '["col" ::: 'Required ('Null 'PGint4)]
191+ query = selectStar
192+ (from (Table (#tab `As` #t)) & orderBy [#col & AscNullsFirst])
193+in renderQuery query
194+:}
195+"SELECT * FROM tab AS t ORDER BY col ASC NULLS FIRST"
196+
197+joins:
198+
199+>>> :set -XFlexibleContexts
200+>>> :{
201+let
202+ query :: Query
203+ '[ "orders" :::
204+ '[ "id" ::: 'Required ('NotNull 'PGint4)
205+ , "order_price" ::: 'Required ('NotNull 'PGfloat4)
206+ , "customer_id" ::: 'Required ('NotNull 'PGint4)
207+ , "shipper_id" ::: 'Required ('NotNull 'PGint4)
208+ ]
209+ , "customers" :::
210+ '[ "id" ::: 'Required ('NotNull 'PGint4)
211+ , "name" ::: 'Required ('NotNull 'PGtext)
212+ ]
213+ , "shippers" :::
214+ '[ "id" ::: 'Required ('NotNull 'PGint4)
215+ , "name" ::: 'Required ('NotNull 'PGtext)
216+ ]
217+ ]
218+ '[]
219+ '[ "order_price" ::: 'Required ('NotNull 'PGfloat4)
220+ , "customer_name" ::: 'Required ('NotNull 'PGtext)
221+ , "shipper_name" ::: 'Required ('NotNull 'PGtext)
222+ ]
223+ query = select
224+ ( #o ! #order_price `As` #order_price :*
225+ #c ! #name `As` #customer_name :*
226+ #s ! #name `As` #shipper_name :* Nil )
227+ ( from (Table (#orders `As` #o)
228+ & InnerJoin (Table (#customers `As` #c))
229+ (#o ! #customer_id .== #c ! #id)
230+ & InnerJoin (Table (#shippers `As` #s))
231+ (#o ! #shipper_id .== #s ! #id)) )
232+in renderQuery query
233+:}
234+"SELECT o.order_price AS order_price, c.name AS customer_name, s.name AS shipper_name FROM orders AS o INNER JOIN customers AS c ON (o.customer_id = c.id) INNER JOIN shippers AS s ON (o.shipper_id = s.id)"
235+
236+self-join:
237+
238+>>> :{
239+let
240+ query :: Query '["tab" ::: '["col" ::: 'Required ('Null 'PGint4)]] '[]
241+ '["col" ::: 'Required ('Null 'PGint4)]
242+ query = selectDotStar #t1
243+ (from (Table (#tab `As` #t1) & CrossJoin (Table (#tab `As` #t2))))
244+in renderQuery query
245+:}
246+"SELECT t1.* FROM tab AS t1 CROSS JOIN tab AS t2"
247+
248+set operations:
249+
250+>>> :{
251+let
252+ query :: Query '["tab" ::: '["col" ::: 'Required ('Null 'PGint4)]] '[]
253+ '["col" ::: 'Required ('Null 'PGint4)]
254+ query =
255+ selectStar (from (Table (#tab `As` #t)))
256+ `unionAll`
257+ selectStar (from (Table (#tab `As` #t)))
258+in renderQuery query
259+:}
260+"(SELECT * FROM tab AS t) UNION ALL (SELECT * FROM tab AS t)"
261+-}
262+
76263newtype Query
77264 (schema :: TablesType)
78265 (params :: [ColumnType])
@@ -80,7 +267,9 @@ newtype Query
80267 = UnsafeQuery { renderQuery :: ByteString }
81268 deriving (GHC.Generic,Show,Eq,Ord,NFData)
82269
83−union, unionAll, intersect, intersectAll, except, exceptAll
270+-- | The results of two queries can be combined using the set operation
271+-- `union`. Duplicate rows are eliminated.
272+union
84273 :: Query schema params columns
85274 -> Query schema params columns
86275 -> Query schema params columns
@@ -88,22 +277,57 @@ q1 `union` q2 = UnsafeQuery $
88277 parenthesized (renderQuery q1)
89278 <+> "UNION"
90279 <+> parenthesized (renderQuery q2)
280+
281+-- | The results of two queries can be combined using the set operation
282+-- `unionAll`, the disjoint union. Duplicate rows are retained.
283+unionAll
284+ :: Query schema params columns
285+ -> Query schema params columns
286+ -> Query schema params columns
91287q1 `unionAll` q2 = UnsafeQuery $
92288 parenthesized (renderQuery q1)
93289 <+> "UNION" <+> "ALL"
94290 <+> parenthesized (renderQuery q2)
291+
292+-- | The results of two queries can be combined using the set operation
293+-- `intersect`, the intersection. Duplicate rows are eliminated.
294+intersect
295+ :: Query schema params columns
296+ -> Query schema params columns
297+ -> Query schema params columns
95298q1 `intersect` q2 = UnsafeQuery $
96299 parenthesized (renderQuery q1)
97300 <+> "INTERSECT"
98301 <+> parenthesized (renderQuery q2)
302+
303+-- | The results of two queries can be combined using the set operation
304+-- `intersectAll`, the intersection. Duplicate rows are retained.
305+intersectAll
306+ :: Query schema params columns
307+ -> Query schema params columns
308+ -> Query schema params columns
99309q1 `intersectAll` q2 = UnsafeQuery $
100310 parenthesized (renderQuery q1)
101311 <+> "INTERSECT" <+> "ALL"
102312 <+> parenthesized (renderQuery q2)
313+
314+-- | The results of two queries can be combined using the set operation
315+-- `except`, the set difference. Duplicate rows are eliminated.
316+except
317+ :: Query schema params columns
318+ -> Query schema params columns
319+ -> Query schema params columns
103320q1 `except` q2 = UnsafeQuery $
104321 parenthesized (renderQuery q1)
105322 <+> "EXCEPT"
106323 <+> parenthesized (renderQuery q2)
324+
325+-- | The results of two queries can be combined using the set operation
326+-- `exceptAll`, the set difference. Duplicate rows are retained.
327+exceptAll
328+ :: Query schema params columns
329+ -> Query schema params columns
330+ -> Query schema params columns
107331q1 `exceptAll` q2 = UnsafeQuery $
108332 parenthesized (renderQuery q1)
109333 <+> "EXCEPT" <+> "ALL"
@@ -113,101 +337,91 @@ q1 `exceptAll` q2 = UnsafeQuery $
113337SELECT queries
114338-----------------------------------------}
115339
340+-- | the `TableExpression` in the `select` command constructs an intermediate
341+-- virtual table by possibly combining tables, views, eliminating rows,
342+-- grouping, etc. This table is finally passed on to processing by
343+-- the select list. The select list determines which columns of
344+-- the intermediate table are actually output.
116345select
117346 :: SListI columns
118347 => NP (Aliased (Expression tables grouping params)) (column ': columns)
348+ -- ^ select list
119349 -> TableExpression schema params tables grouping
350+ -- ^ intermediate virtual table
120351 -> Query schema params (column ': columns)
121352select list tabs = UnsafeQuery $
122353 "SELECT"
123354 <+> renderCommaSeparated (renderAliased renderExpression) list
124355 <+> renderTableExpression tabs
125356
357+-- | After the select list has been processed, the result table can
358+-- be subject to the elimination of duplicate rows using `selectDistinct`.
126359selectDistinct
127360 :: SListI columns
128361 => NP (Aliased (Expression tables 'Ungrouped params)) (column ': columns)
362+ -- ^ select list
129363 -> TableExpression schema params tables 'Ungrouped
364+ -- ^ intermediate virtual table
130365 -> Query schema params (column ': columns)
131366selectDistinct list tabs = UnsafeQuery $
132367 "SELECT DISTINCT"
133368 <+> renderCommaSeparated (renderAliased renderExpression) list
134369 <+> renderTableExpression tabs
135370
136−selectStar, selectDistinctStar
371+-- | The simplest kind of query is `selectStar` which emits all columns
372+-- that the table expression produces.
373+selectStar
137374 :: HasUnique table tables columns
138375 => TableExpression schema params tables 'Ungrouped
376+ -- ^ intermediate virtual table
139377 -> Query schema params columns
140378selectStar tabs = UnsafeQuery $ "SELECT" <+> "*" <+> renderTableExpression tabs
379+
380+-- | A `selectDistinctStar` emits all columns that the table expression
381+-- produces and eliminates duplicate rows.
382+selectDistinctStar
383+ :: HasUnique table tables columns
384+ => TableExpression schema params tables 'Ungrouped
385+ -- ^ intermediate virtual table
386+ -> Query schema params columns
141387selectDistinctStar tabs = UnsafeQuery $
142388 "SELECT DISTINCT" <+> "*" <+> renderTableExpression tabs
143389
144−selectDotStar, selectDistinctDotStar
390+-- | When working with multiple tables, it can also be useful to ask
391+-- for all the columns of a particular table, using `selectDotStar`.
392+selectDotStar
145393 :: HasTable table tables columns
146394 => Alias table
395+ -- ^ particular virtual subtable
147396 -> TableExpression schema params tables 'Ungrouped
397+ -- ^ intermediate virtual table
148398 -> Query schema params columns
149399selectDotStar table tables = UnsafeQuery $
150400 "SELECT" <+> renderAlias table <> ".*" <+> renderTableExpression tables
401+
402+-- | A `selectDistinctDotStar` asks for all the columns of a particular table,
403+-- and eliminates duplicate rows.
404+selectDistinctDotStar
405+ :: HasTable table tables columns
406+ => Alias table
407+ -- ^ particular virtual subtable
408+ -> TableExpression schema params tables 'Ungrouped
409+ -- ^ intermediate virtual table
410+ -> Query schema params columns
151411selectDistinctDotStar table tables = UnsafeQuery $
152412 "SELECT DISTINCT" <+> renderAlias table <> ".*"
153413 <+> renderTableExpression tables
154414
155−{-----------------------------------------
156−FROM clauses
157−-----------------------------------------}
158−
159−data FromClause schema params tables where
160− Table
161− :: Aliased (Table schema) table
162− -> FromClause schema params '[table]
163− Subquery
164− :: Aliased (Query schema params) table
165− -> FromClause schema params '[table]
166− CrossJoin
167− :: FromClause schema params right
168− -> FromClause schema params left
169− -> FromClause schema params (Join left right)
170− InnerJoin
171− :: FromClause schema params right
172− -> Condition (Join left right) 'Ungrouped params
173− -> FromClause schema params left
174− -> FromClause schema params (Join left right)
175− LeftOuterJoin
176− :: FromClause schema params right
177− -> Condition (Join left right) 'Ungrouped params
178− -> FromClause schema params left
179− -> FromClause schema params (Join left (NullifyTables right))
180− RightOuterJoin
181− :: FromClause schema params right
182− -> Condition (Join left right) 'Ungrouped params
183− -> FromClause schema params left
184− -> FromClause schema params (Join (NullifyTables left) right)
185− FullOuterJoin
186− :: FromClause schema params right
187− -> Condition (Join left right) 'Ungrouped params
188− -> FromClause schema params left
189− -> FromClause schema params
190− (Join (NullifyTables left) (NullifyTables right))
191−
192−renderFromClause :: FromClause schema params tables -> ByteString
193−renderFromClause = \case
194− Table table -> renderAliased renderTable table
195− Subquery selection -> renderAliased (parenthesized . renderQuery) selection
196− CrossJoin right left ->
197− renderFromClause left <+> "CROSS JOIN" <+> renderFromClause right
198− InnerJoin right on left -> renderJoin "INNER JOIN" right on left
199− LeftOuterJoin right on left -> renderJoin "LEFT OUTER JOIN" right on left
200− RightOuterJoin right on left -> renderJoin "RIGHT OUTER JOIN" right on left
201− FullOuterJoin right on left -> renderJoin "FULL OUTER JOIN" right on left
202− where
203− renderJoin op right on left =
204− renderFromClause left <+> op <+> renderFromClause right
205− <+> "ON" <+> renderExpression on
206−
207415{-----------------------------------------
208416Table Expressions
209417-----------------------------------------}
210418
419+-- | A `TableExpression` computes a table. The table expression contains
420+-- a `fromClause` that is optionally followed by a `whereClause`,
421+-- `groupByClause`, `havingClause`, `orderByClause`, `limitClause`
422+-- and `offsetClause`s. Trivial table expressions simply refer
423+-- to a table on disk, a so-called base table, but more complex expressions
424+-- can be used to modify or combine base tables in various ways.
211425data TableExpression
212426 (schema :: TablesType)
213427 (params :: [ColumnType])
@@ -215,14 +429,47 @@ data TableExpression
215429 (grouping :: Grouping)
216430 = TableExpression
217431 { fromClause :: FromClause schema params tables
432+ -- ^ A table reference that can be a table name, or a derived table such
433+ -- as a subquery, a @JOIN@ construct, or complex combinations of these.
218434 , whereClause :: [Condition tables 'Ungrouped params]
435+ -- ^ optional search coditions, combined with `.&&`. After the processing
436+ -- of the `fromClause` is done, each row of the derived virtual table
437+ -- is checked against the search condition. If the result of the
438+ -- condition is true, the row is kept in the output table,
439+ -- otherwise it is discarded. The search condition typically references
440+ -- at least one column of the table generated in the `fromClause`;
441+ -- this is not required, but otherwise the WHERE clause will
442+ -- be fairly useless.
219443 , groupByClause :: GroupByClause tables grouping
444+ -- ^ The `groupByClause` is used to group together those rows in a table
445+ -- that have the same values in all the columns listed. The order in which
446+ -- the columns are listed does not matter. The effect is to combine each
447+ -- set of rows having common values into one group row that represents all
448+ -- rows in the group. This is done to eliminate redundancy in the output
449+ -- and/or compute aggregates that apply to these groups.
220450 , havingClause :: HavingClause tables grouping params
451+ -- ^ If a table has been grouped using `groupBy`, but only certain groups
452+ -- are of interest, the `havingClause` can be used, much like a
453+ -- `whereClause`, to eliminate groups from the result. Expressions in the
454+ -- `havingClause` can refer both to grouped expressions and to ungrouped
455+ -- expressions (which necessarily involve an aggregate function).
221456 , orderByClause :: [SortExpression tables grouping params]
457+ -- ^ The `orderByClause` is for optional sorting. When more than one
458+ -- `SortExpression` is specified, the later (right) values are used to sort
459+ -- rows that are equal according to the earlier (left) values.
222460 , limitClause :: [Word64]
461+ -- ^ The `limitClause` is combined with `min` to give a limit count
462+ -- if nonempty. If a limit count is given, no more than that many rows
463+ -- will be returned (but possibly fewer, if the query itself yields
464+ -- fewer rows).
223465 , offsetClause :: [Word64]
466+ -- ^ The `offsetClause` is combined with `+` to give an offset count
467+ -- if nonempty. The offset count says to skip that many rows before
468+ -- beginning to return rows. The rows are skipped before the limit count
469+ -- is applied.
224470 }
225471
472+-- | Render a `TableExpression`
226473renderTableExpression
227474 :: TableExpression schema params tables grouping
228475 -> ByteString
@@ -232,7 +479,7 @@ renderTableExpression
232479 , renderWheres whs'
233480 , renderGroupByClause grps'
234481 , renderHavingClause hvs'
235− , renderSorts srts'
482+ , renderOrderByClause srts'
236483 , renderLimits lims'
237484 , renderOffsets offs'
238485 ]
@@ -241,9 +488,9 @@ renderTableExpression
241488 [] -> ""
242489 wh:[] -> " WHERE" <+> renderExpression wh
243490 wh:whs -> " WHERE" <+> renderExpression (foldr (.&&) wh whs)
244− renderSorts = \case
491+ renderOrderByClause = \case
245492 [] -> ""
246− srts -> " SORT BY"
493+ srts -> " ORDER BY"
247494 <+> commaSeparated (renderSortExpression <$> srts)
248495 renderLimits = \case
249496 [] -> ""
@@ -252,17 +499,27 @@ renderTableExpression
252499 [] -> ""
253500 offs -> " OFFSET" <+> fromString (show (sum offs))
254501
502+-- | A `from` generates a `TableExpression` from a table reference that can be
503+-- a table name, or a derived table such as a subquery, a JOIN construct,
504+-- or complex combinations of these. A `from` may be transformed by `where_`,
505+-- `group`, `having`, `orderBy`, `limit` and `offset`, using the `&` operator
506+-- to match the left-to-right sequencing of their placement in SQL.
255507from
256− :: FromClause schema params tables
508+ :: FromClause schema params tables -- ^ table reference
257509 -> TableExpression schema params tables 'Ungrouped
258510from tables = TableExpression tables [] NoGroups NoHaving [] [] []
259511
512+-- | A `where_` is an endomorphism of `TableExpression`s which adds a
513+-- search condition to the `whereClause`.
260514where_
261515 :: Condition tables 'Ungrouped params
262516 -> TableExpression schema params tables grouping
263517 -> TableExpression schema params tables grouping
264518where_ wh tables = tables {whereClause = wh : whereClause tables}
265519
520+-- | A `group` is a transformation of `TableExpression`s which switches
521+-- its `Grouping` from `Ungrouped` to `Grouped`. Use @group Nil@ to perform
522+-- a "grand total" aggregation query.
266523group
267524 :: SListI bys
268525 => NP (By tables) bys
@@ -278,6 +535,8 @@ group bys tables = TableExpression
278535 , offsetClause = offsetClause tables
279536 }
280537
538+-- | A `having` is an endomorphism of `TableExpression`s which adds a
539+-- search condition to the `havingClause`.
281540having
282541 :: Condition tables ('Grouped bys) params
283542 -> TableExpression schema params tables ('Grouped bys)
@@ -285,28 +544,134 @@ having
285544having hv tables = tables
286545 { havingClause = case havingClause tables of Having hvs -> Having (hv:hvs) }
287546
547+-- | An `orderBy` is an endomorphism of `TableExpression`s which appends an
548+-- ordering to the right of the `orderByClause`.
288549orderBy
289550 :: [SortExpression tables grouping params]
290551 -> TableExpression schema params tables grouping
291552 -> TableExpression schema params tables grouping
292553orderBy srts tables = tables {orderByClause = orderByClause tables ++ srts}
293554
555+-- | A `limit` is an endomorphism of `TableExpression`s which adds to the
556+-- `limitClause`.
294557limit
295558 :: Word64
296559 -> TableExpression schema params tables grouping
297560 -> TableExpression schema params tables grouping
298561limit lim tables = tables {limitClause = lim : limitClause tables}
299562
563+-- | An `offset` is an endomorphism of `TableExpression`s which adds to the
564+-- `offsetClause`.
300565offset
301566 :: Word64
302567 -> TableExpression schema params tables grouping
303568 -> TableExpression schema params tables grouping
304569offset off tables = tables {offsetClause = off : offsetClause tables}
305570
571+{-----------------------------------------
572+FROM clauses
573+-----------------------------------------}
574+
575+{- |
576+A `FromClause` can be a table name, or a derived table such
577+as a subquery, a @JOIN@ construct, or complex combinations of these.
578+
579+* A real `Table` is a table from the schema.
580+
581+* `Subquery` derives a table from a `Query`.
582+
583+* A joined table is a table derived from two other (real or derived) tables
584+according to the rules of the particular join type. `CrossJoin`, `InnerJoin`,
585+`LeftOuterJoin`, `RightOuterJoin` and `FullOuterJoin` are available and can
586+be nested using the `&` operator to match the left-to-right sequencing of
587+their placement in SQL.
588+
589+ * @t1 & CrossJoin t2@. For every possible combination of rows from
590+ @t1@ and @t2@ (i.e., a Cartesian product), the joined table will contain
591+ a row consisting of all columns in @t1@ followed by all columns in @t2@.
592+ If the tables have @n@ and @m@ rows respectively, the joined table will
593+ have @n * m@ rows.
594+
595+ * @t1 & InnerJoin t2 on@. For each row @r1@ of @t1@, the joined
596+ table has a row for each row in @t2@ that satisfies the @on@ condition
597+ with @r1@
598+
599+ * @t1 & LeftOuterJoin t2 on@. First, an inner join is performed.
600+ Then, for each row in @t1@ that does not satisfy the @on@ condition with
601+ any row in @t2@, a joined row is added with null values in columns of @t2@.
602+ Thus, the joined table always has at least one row for each row in @t1@.
603+
604+ * @t1 & RightOuterJoin t2 on@. First, an inner join is performed.
605+ Then, for each row in @t2@ that does not satisfy the @on@ condition with
606+ any row in @t1@, a joined row is added with null values in columns of @t1@.
607+ This is the converse of a left join: the result table will always
608+ have a row for each row in @t2@.
609+
610+ * @t1 & FullOuterJoin t2 on@. First, an inner join is performed.
611+ Then, for each row in @t1@ that does not satisfy the @on@ condition with
612+ any row in @t2@, a joined row is added with null values in columns of @t2@.
613+ Also, for each row of @t2@ that does not satisfy the join condition
614+ with any row in @t1@, a joined row with null values in the columns of @t1@
615+ is added.
616+-}
617+data FromClause schema params tables where
618+ Table
619+ :: Aliased (Table schema) table
620+ -> FromClause schema params '[table]
621+ Subquery
622+ :: Aliased (Query schema params) table
623+ -> FromClause schema params '[table]
624+ CrossJoin
625+ :: FromClause schema params right
626+ -> FromClause schema params left
627+ -> FromClause schema params (Join left right)
628+ InnerJoin
629+ :: FromClause schema params right
630+ -> Condition (Join left right) 'Ungrouped params
631+ -> FromClause schema params left
632+ -> FromClause schema params (Join left right)
633+ LeftOuterJoin
634+ :: FromClause schema params right
635+ -> Condition (Join left right) 'Ungrouped params
636+ -> FromClause schema params left
637+ -> FromClause schema params (Join left (NullifyTables right))
638+ RightOuterJoin
639+ :: FromClause schema params right
640+ -> Condition (Join left right) 'Ungrouped params
641+ -> FromClause schema params left
642+ -> FromClause schema params (Join (NullifyTables left) right)
643+ FullOuterJoin
644+ :: FromClause schema params right
645+ -> Condition (Join left right) 'Ungrouped params
646+ -> FromClause schema params left
647+ -> FromClause schema params
648+ (Join (NullifyTables left) (NullifyTables right))
649+
650+-- | Renders a `FromClause`.
651+renderFromClause :: FromClause schema params tables -> ByteString
652+renderFromClause = \case
653+ Table table -> renderAliased renderTable table
654+ Subquery selection -> renderAliased (parenthesized . renderQuery) selection
655+ CrossJoin right left ->
656+ renderFromClause left <+> "CROSS JOIN" <+> renderFromClause right
657+ InnerJoin right on left -> renderJoin "INNER JOIN" right on left
658+ LeftOuterJoin right on left -> renderJoin "LEFT OUTER JOIN" right on left
659+ RightOuterJoin right on left -> renderJoin "RIGHT OUTER JOIN" right on left
660+ FullOuterJoin right on left -> renderJoin "FULL OUTER JOIN" right on left
661+ where
662+ renderJoin op right on left =
663+ renderFromClause left <+> op <+> renderFromClause right
664+ <+> "ON" <+> renderExpression on
665+
306666{-----------------------------------------
307667Grouping
308668-----------------------------------------}
309669
670+-- | `By`s are used in `group` to reference a list of columns which are then
671+-- used to group together those rows in a table that have the same values
672+-- in all the columns listed. @By \#col@ will reference an unambiguous
673+-- column @col@; otherwise @By2 (\#tab \! \#col)@ will reference a table
674+-- qualified column @tab.col@.
310675data By
311676 (tables :: TablesType)
312677 (by :: (Symbol,Symbol)) where
@@ -321,25 +686,36 @@ data By
321686deriving instance Show (By tables by)
322687deriving instance Eq (By tables by)
323688deriving instance Ord (By tables by)
324−
689+
690+-- | Renders a `By`.
325691renderBy :: By tables tabcolty -> ByteString
326692renderBy = \case
327693 By column -> renderAlias column
328694 By2 (table, column) -> renderAlias table <> "." <> renderAlias column
329−
695+
696+-- | A `GroupByClause` indicates the `Grouping` of a `TableExpression`.
697+-- A `NoGroups` indicates `Ungrouped` while a `Group` indicates `Grouped`.
698+-- @NoGroups@ is distinguised from @Group Nil@ since no aggregation can be
699+-- done on @NoGroups@ while all output `Expression`s must be aggregated
700+-- in @Group Nil@.
330701data GroupByClause tables grouping where
331702 NoGroups :: GroupByClause tables 'Ungrouped
332703 Group
333704 :: SListI bys
334705 => NP (By tables) bys
335706 -> GroupByClause tables ('Grouped bys)
336−
707+
708+-- | Renders a `GroupByClause`.
337709renderGroupByClause :: GroupByClause tables grouping -> ByteString
338710renderGroupByClause = \case
339711 NoGroups -> ""
340712 Group Nil -> ""
341713 Group bys -> " GROUP BY" <+> renderCommaSeparated renderBy bys
342−
714+
715+-- | A `HavingClause` is used to eliminate groups that are not of interest.
716+-- An `Ungrouped` `TableExpression` may only use `NoHaving` while a `Grouped`
717+-- `TableExpression` must use `Having` whose conditions are combined with
718+-- `.&&`.
343719data HavingClause tables grouping params where
344720 NoHaving :: HavingClause tables 'Ungrouped params
345721 Having
@@ -348,7 +724,8 @@ data HavingClause tables grouping params where
348724deriving instance Show (HavingClause tables grouping params)
349725deriving instance Eq (HavingClause tables grouping params)
350726deriving instance Ord (HavingClause tables grouping params)
351−
727+
728+-- | Render a `HavingClause`.
352729renderHavingClause :: HavingClause tables grouping params -> ByteString
353730renderHavingClause = \case
354731 NoHaving -> ""
@@ -360,6 +737,14 @@ renderHavingClause = \case
360737Sorting
361738-----------------------------------------}
362739
740+-- | `SortExpression`s are used by `sortBy` to optionally sort the results
741+-- of a `Query`. `Asc` or `Desc` set the sort direction of a `NotNull` result
742+-- column to ascending or descending. Ascending order puts smaller values
743+-- first, where "smaller" is defined in terms of the `.<` operator. Similarly,
744+-- descending order is determined with the `.>` operator. `AscNullsFirst`,
745+-- `AscNullsLast`, `DescNullsFirst` and `DescNullsLast` options are used to
746+-- determine whether nulls appear before or after non-null values in the sort
747+-- ordering of a `Null` result column.
363748data SortExpression tables grouping params where
364749 Asc
365750 :: Expression tables grouping params ('Required ('NotNull ty))
@@ -380,7 +765,8 @@ data SortExpression tables grouping params where
380765 :: Expression tables grouping params ('Required ('Null ty))
381766 -> SortExpression tables grouping params
382767deriving instance Show (SortExpression tables grouping params)
383−
768+
769+-- | Render a `SortExpression`.
384770renderSortExpression :: SortExpression tables grouping params -> ByteString
385771renderSortExpression = \case
386772 Asc expression -> renderExpression expression <+> "ASC"
squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+9−7
@@ -105,6 +105,7 @@ data PGType
105105 | PGinet -- ^ IPv4 or IPv6 host address
106106 | PGjson -- ^ textual JSON data
107107 | PGjsonb -- ^ binary JSON data, decomposed
108+ | UnsafePGType Symbol -- ^ an escape hatch for unsupported PostgreSQL types
108109
109110-- | `NullityType` encodes the potential presence or definite absence of a
110111-- @NULL@ allowing operations which are sensitive to such to be well typed.
@@ -128,7 +129,8 @@ type ColumnsType = [(Symbol,ColumnType)]
128129
129130-- | `TablesType` is a kind synonym for a row of `ColumnsType`s.
130131-- It is used as a kind for both a schema, a disjoint union of tables,
131−-- and a joined table `Squeal.Query.FromClause`, a product of tables.
132+-- and a joined table `Squeal.PostgreSQL.Query.FromClause`,
133+-- a product of tables.
132134type TablesType = [(Symbol,ColumnsType)]
133135
134136-- | `Grouping` is an auxiliary namespace, created by
@@ -154,7 +156,7 @@ type PGFloating ty = In ty '[ 'PGfloat4, 'PGfloat8, 'PGnumeric]
154156-- `Squeal.PostgreSQL.Expression.mod_` functions.
155157type PGIntegral ty = In ty '[ 'PGint2, 'PGint4, 'PGint8]
156158
157−-- | `:::` is the promoted version of `As`, a type level pair between
159+-- | `:::` is like a promoted version of `As`, a type level pair between
158160-- an alias and some type, usually a column alias and a `ColumnType` or
159161-- a table alias and a `ColumnsType`.
160162type (:::) (alias :: Symbol) (ty :: polykind) = '(alias,ty)
@@ -175,7 +177,7 @@ instance alias1 ~ alias2 => IsLabel alias1 (Alias alias2) where
175177renderAlias :: KnownSymbol alias => Alias alias -> ByteString
176178renderAlias = fromString . symbolVal
177179
178−-- | The `As` operator is used to name an expression. `As` is the demoted
180+-- | The `As` operator is used to name an expression. `As` is like a demoted
179181-- version of `:::`.
180182--
181183-- >>> Just "hello" `As` #hi :: Aliased Maybe ("hi" ::: String)
@@ -211,13 +213,13 @@ class IsTableColumn table column expression where
211213 infixl 9 !
212214instance IsTableColumn table column (Alias table, Alias column) where (!) = (,)
213215
214−-- | `In x xs` is a constraint that proves that `x` is in `xs.
216+-- | @In x xs@ is a constraint that proves that @x@ is in @xs@.
215217type family In x xs :: Constraint where
216218 In x (x ': xs) = ()
217219 In x (y ': xs) = In x xs
218220
219−-- | `HasUnique alias xs x` is a constraint that proves that xs is a singleton
220−-- of `alias ::: x`.
221+-- | @HasUnique alias xs x@ is a constraint that proves that @xs@ is a singleton
222+-- of @alias ::: x@.
221223type HasUnique alias xs x = xs ~ '[alias ::: x]
222224
223225-- | `BaseType` forgets about @NULL@ and @DEFAULT@
@@ -259,7 +261,7 @@ type family NullifyColumns (columns :: ColumnsType) :: ColumnsType where
259261
260262-- | `NullifyTables` is an idempotent that nullifies a `TablesType`
261263-- used to nullify the left or right hand side of an outer join
262−-- in a `Squeal.PostgreSQL.Query.FromClause`
264+-- in a `Squeal.PostgreSQL.Query.FromClause`.
263265type family NullifyTables (tables :: TablesType) :: TablesType where
264266 NullifyTables '[] = '[]
265267 NullifyTables ((table ::: columns) ': tables) =
squeal-postgresql/test/Squeal/PostgreSQL/ManipulationSpec.hs+3−3
@@ -24,7 +24,7 @@ spec = do
2424 statement :: Manipulation Tables '[] SumAndCol1
2525 statement =
2626 insertInto #table1 (Values (2 `As` #col1 :* 4 `As` #col2 :* Nil) [])
27− Conflict
27+ OnConflictDoRaise
2828 (Returning $ (#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil)
2929 statement `manipulationRenders`
3030 "INSERT INTO table1 (col1, col2) VALUES (2, 4)\
@@ -79,7 +79,7 @@ spec = do
7979 it "correctly renders DELETEs" $ do
8080 let
8181 statement :: Manipulation Tables '[] '[]
82− statement = deleteFrom #table1 (#col1 .== #col2)
82+ statement = deleteFrom #table1 (#col1 .== #col2) (Returning Nil)
8383 statement `manipulationRenders`
8484 "DELETE FROM table1 WHERE (col1 = col2);"
8585 it "should be safe against SQL injection in literal text" $ do
@@ -87,7 +87,7 @@ spec = do
8787 statement :: Manipulation StudentsTable '[] '[]
8888 statement = insertInto #students
8989 (Values ("Robert'); DROP TABLE students;" `As` #name :* Nil) [])
90− Conflict (Returning Nil)
90+ OnConflictDoRaise (Returning Nil)
9191 statement `manipulationRenders`
9292 "INSERT INTO students (name) VALUES (E'Robert''); DROP TABLE students;');"
9393