@@ -28,6 +28,9 @@ module Squeal.PostgreSQL.Manipulation
2828 ( -- * Manipulation
2929 Manipulation (UnsafeManipulation, renderManipulation)
3030 , queryStatement
31+ , ColumnValue (..)
32+ , ReturningClause (ReturningStar, Returning)
33+ , ConflictClause (OnConflictDoRaise, OnConflictDoNothing, OnConflictDoUpdate)
3134 -- * Insert
3235 , insertRows
3336 , insertRow
@@ -35,22 +38,23 @@ module Squeal.PostgreSQL.Manipulation
3538 , insertRow_
3639 , insertQuery
3740 , insertQuery_
38− , ReturningClause (ReturningStar, Returning)
3941 , renderReturningClause
40− , ConflictClause (OnConflictDoRaise, OnConflictDoNothing, OnConflictDoUpdate)
4142 , renderConflictClause
4243 -- * Update
4344 , update
4445 , update_
46+ -- * Delete
4547 , deleteFrom
4648 , deleteFrom_
47− , ColumnValue (..)
49+ -- * With
50+ , with
4851 ) where
4952
5053import Control.DeepSeq
5154import Data.ByteString hiding (foldr)
5255import Data.Monoid
5356
57+import qualified Data.ByteString as ByteString
5458import qualified Generics.SOP as SOP
5559import qualified GHC.Generics as GHC
5660
@@ -59,33 +63,10 @@ import Squeal.PostgreSQL.Prettyprint
5963import Squeal.PostgreSQL.Query
6064import Squeal.PostgreSQL.Schema
6165
62−-- | A `Manipulation` is a statement which may modify data in the database,
63−-- but does not alter the schema. Examples are `insertInto`, `update` and
64−-- `deleteFrom`. A `Query` is also considered a `Manipulation` even though
65−-- it does not modify data.
66−newtype Manipulation
67− (schema :: TablesType)
68− (params :: [NullityType])
69− (columns :: RelationType)
70− = UnsafeManipulation { renderManipulation :: ByteString }
71− deriving (GHC.Generic,Show,Eq,Ord,NFData)
72−
73−-- | Convert a `Query` into a `Manipulation`.
74−queryStatement
75− :: Query schema params columns
76− -> Manipulation schema params columns
77−queryStatement q = UnsafeManipulation $ renderQuery q <> ";"
78−
79−{-----------------------------------------
80−INSERT statements
81−-----------------------------------------}
82−
8366{- |
84−When a table is created, it contains no data. The first thing to do
85−before a database can be of much use is to insert data. Data is
86−conceptually inserted one row at a time. Of course you can also insert
87−more than one row, but there is no way to insert less than one row.
88−Even if you know only some column values, a complete row must be created.
67+A `Manipulation` is a statement which may modify data in the database,
68+but does not alter the schema. Examples are inserts, updates and deletes.
69+A `Query` is also considered a `Manipulation` even though it does not modify data.
8970
9071simple insert:
9172
@@ -153,15 +134,90 @@ let
153134in renderManipulation manipulation
154135:}
155136"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;"
137+
138+query insert:
139+
140+>>> :{
141+let
142+ manipulation :: Manipulation
143+ '[ "tab" ::: '[] :=>
144+ '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
145+ , "col2" ::: 'NoDef :=> 'NotNull 'PGint4
146+ ]
147+ , "other_tab" ::: '[] :=>
148+ '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
149+ , "col2" ::: 'NoDef :=> 'NotNull 'PGint4
150+ ]
151+ ] '[] '[]
152+ manipulation =
153+ insertQuery_ #tab
154+ (selectStar (from (table (#other_tab `As` #t))))
155+in renderManipulation manipulation
156+:}
157+"INSERT INTO tab SELECT * FROM other_tab AS t;"
158+
159+update:
160+
161+>>> :{
162+let
163+ manipulation :: Manipulation
164+ '[ "tab" ::: '[] :=>
165+ '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
166+ , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ]] '[] '[]
167+ manipulation =
168+ update_ #tab (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
169+ (#col1 ./= #col2)
170+in renderManipulation manipulation
171+:}
172+"UPDATE tab SET col1 = 2 WHERE (col1 <> col2);"
173+
174+delete:
175+
176+>>> :{
177+let
178+ manipulation :: Manipulation
179+ '[ "tab" ::: '[] :=>
180+ '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
181+ , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ]] '[]
182+ '[ "col1" ::: 'NotNull 'PGint4
183+ , "col2" ::: 'NotNull 'PGint4 ]
184+ manipulation = deleteFrom #tab (#col1 .== #col2) ReturningStar
185+in renderManipulation manipulation
186+:}
187+"DELETE FROM tab WHERE (col1 = col2) RETURNING *;"
156188-}
189+newtype Manipulation
190+ (schema :: TablesType)
191+ (params :: [NullityType])
192+ (columns :: RelationType)
193+ = UnsafeManipulation { renderManipulation :: ByteString }
194+ deriving (GHC.Generic,Show,Eq,Ord,NFData)
195+
196+-- | Convert a `Query` into a `Manipulation`.
197+queryStatement
198+ :: Query schema params columns
199+ -> Manipulation schema params columns
200+queryStatement q = UnsafeManipulation $ renderQuery q <> ";"
201+
202+{-----------------------------------------
203+INSERT statements
204+-----------------------------------------}
205+
206+-- | Insert multiple rows.
207+--
208+-- When a table is created, it contains no data. The first thing to do
209+-- before a database can be of much use is to insert data. Data is
210+-- conceptually inserted one row at a time. Of course you can also insert
211+-- more than one row, but there is no way to insert less than one row.
212+-- Even if you know only some column values, a complete row must be created.
157213insertRows
158214 :: ( SOP.SListI columns
159215 , SOP.SListI results
160216 , Has tab schema table
161217 , columns ~ TableToColumns table )
162218 => Alias tab -- ^ table to insert into
163− -> NP (Aliased (ColumnValue '[] params)) columns
164− -> [NP (Aliased (ColumnValue '[] params)) columns]
219+ -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert
220+ -> [NP (Aliased (ColumnValue '[] params)) columns] -- ^ more rows to insert
165221 -> ConflictClause columns params
166222 -- ^ what to do in case of constraint conflict
167223 -> ReturningClause columns params results -- ^ results to return
@@ -190,7 +246,7 @@ insertRow
190246 , Has tab schema table
191247 , columns ~ TableToColumns table )
192248 => Alias tab -- ^ table to insert into
193− -> NP (Aliased (ColumnValue '[] params)) columns
249+ -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert
194250 -> ConflictClause columns params
195251 -- ^ what to do in case of constraint conflict
196252 -> ReturningClause columns params results -- ^ results to return
@@ -203,8 +259,8 @@ insertRows_
203259 , Has tab schema table
204260 , columns ~ TableToColumns table )
205261 => Alias tab -- ^ table to insert into
206− -> NP (Aliased (ColumnValue '[] params)) columns
207− -> [NP (Aliased (ColumnValue '[] params)) columns]
262+ -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert
263+ -> [NP (Aliased (ColumnValue '[] params)) columns] -- ^ more rows to insert
208264 -> Manipulation schema params '[]
209265insertRows_ tab row rows =
210266 insertRows tab row rows OnConflictDoRaise (Returning Nil)
@@ -215,31 +271,11 @@ insertRow_
215271 , Has tab schema table
216272 , columns ~ TableToColumns table )
217273 => Alias tab -- ^ table to insert into
218− -> NP (Aliased (ColumnValue '[] params)) columns
274+ -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert
219275 -> Manipulation schema params '[]
220276insertRow_ tab row = insertRow tab row OnConflictDoRaise (Returning Nil)
221277
222−{- | Insert a query.
223−
224−>>> :{
225−let
226− manipulation :: Manipulation
227− '[ "tab" ::: '[] :=>
228− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
229− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4
230− ]
231− , "other_tab" ::: '[] :=>
232− '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
233− , "col2" ::: 'NoDef :=> 'NotNull 'PGint4
234− ]
235− ] '[] '[]
236− manipulation =
237− insertQuery_ #tab
238− (selectStar (from (table (#other_tab `As` #t))))
239−in renderManipulation manipulation
240−:}
241−"INSERT INTO tab SELECT * FROM other_tab AS t;"
242−-}
278+-- | Insert a `Query`.
243279insertQuery
244280 :: ( SOP.SListI columns
245281 , SOP.SListI results
@@ -257,7 +293,7 @@ insertQuery tab query conflict returning = UnsafeManipulation $
257293 <> renderConflictClause conflict
258294 <> renderReturningClause returning
259295
260−-- | Insert a query returning `Nil` and raising an error on conflicts.
296+-- | Insert a `Query` returning `Nil` and raising an error on conflicts.
261297insertQuery_
262298 :: ( SOP.SListI columns
263299 , Has tab schema table
@@ -292,7 +328,7 @@ data ColumnValue
292328-- deleted will be returned. For example, if a row was locked
293329-- but not updated because an `OnConflictDoUpdate` condition was not satisfied,
294330-- the row will not be returned. `ReturningStar` will return all columns
295−-- in the row. Use `Returning Nil` in the common case where no return
331+-- in the row. Use @Returning Nil@ in the common case where no return
296332-- values are desired.
297333data ReturningClause
298334 (columns :: ColumnsType)
@@ -362,7 +398,6 @@ UPDATE statements
362398
363399-- | An `update` command changes the values of the specified columns
364400-- in all rows that satisfy the condition.
365−--
366401update
367402 :: ( SOP.SListI columns
368403 , SOP.SListI results
@@ -394,18 +429,6 @@ update tab columns wh returning = UnsafeManipulation $
394429 renderAlias column <+> "=" <+> renderExpression expression
395430
396431-- | Update a row returning `Nil`.
397−-- >>> :{
398−-- let
399−-- manipulation :: Manipulation
400−-- '[ "tab" ::: '[] :=>
401−-- '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
402−-- , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ]] '[] '[]
403−-- manipulation =
404−-- update_ #tab (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
405−-- (#col1 ./= #col2)
406−-- in renderManipulation manipulation
407−-- :}
408−-- "UPDATE tab SET col1 = 2 WHERE (col1 <> col2);"
409432update_
410433 :: ( SOP.SListI columns
411434 , Has tab schema table
@@ -423,19 +446,6 @@ DELETE statements
423446-----------------------------------------}
424447
425448-- | Delete rows of a table.
426−--
427−-- >>> :{
428−-- let
429−-- manipulation :: Manipulation
430−-- '[ "tab" ::: '[] :=>
431−-- '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4
432−-- , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ]] '[]
433−-- '[ "col1" ::: 'NotNull 'PGint4
434−-- , "col2" ::: 'NotNull 'PGint4 ]
435−-- manipulation = deleteFrom #tab (#col1 .== #col2) ReturningStar
436−-- in renderManipulation manipulation
437−-- :}
438−-- "DELETE FROM tab WHERE (col1 = col2) RETURNING *;"
439449deleteFrom
440450 :: ( SOP.SListI results
441451 , Has tab schema table
@@ -459,3 +469,44 @@ deleteFrom_
459469 -- ^ condition under which to delete a row
460470 -> Manipulation schema params '[]
461471deleteFrom_ tab wh = deleteFrom tab wh (Returning Nil)
472+
473+{-----------------------------------------
474+WITH statements
475+-----------------------------------------}
476+
477+-- | `with` provides a way to write auxiliary statements for use in a larger statement.
478+-- These statements, which are often referred to as Common Table Expressions or CTEs,
479+-- can be thought of as defining temporary tables that exist just for one statement.
480+--
481+-- >>> type ProductsTable = '[] :=> '["product" ::: 'NoDef :=> 'NotNull 'PGtext, "date" ::: 'Def :=> 'NotNull 'PGdate]
482+--
483+-- >>> :{
484+-- let
485+-- manipulation :: Manipulation '["products" ::: ProductsTable, "products_deleted" ::: ProductsTable] '[ 'NotNull 'PGdate] '[]
486+-- manipulation = with
487+-- (deleteFrom #products (#date .< param @1) ReturningStar `As` #deleted_rows :* Nil)
488+-- (insertQuery_ #products_deleted (selectStar (from (table (#deleted_rows `As` #t)))))
489+-- in renderManipulation manipulation
490+-- :}
491+-- "WITH deleted_rows AS (DELETE FROM products WHERE (date < ($1 :: date)) RETURNING *) INSERT INTO products_deleted SELECT * FROM deleted_rows AS t;"
492+with
493+ :: SOP.SListI commons
494+ => NP (Aliased (Manipulation schema params)) commons
495+ -- ^ common table expressions
496+ -> Manipulation (Join (RelationsToTables commons) schema) params results
497+ -> Manipulation schema params results
498+with commons manipulation = UnsafeManipulation $
499+ "WITH" <+> renderCommaSeparated renderCommon commons
500+ <+> renderManipulation manipulation
501+ where
502+ renderCommon
503+ :: Aliased (Manipulation schema params) common
504+ -> ByteString
505+ renderCommon (common `As` alias) =
506+ renderAlias alias <+> "AS" <+>
507+ let
508+ str = renderManipulation common
509+ len = ByteString.length str
510+ str' = ByteString.take (len - 1) str -- remove ';'
511+ in
512+ parenthesized str'