@@ -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,19 +24,21 @@
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
@@ -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,51 @@ queryStatement q = UnsafeManipulation $ renderQuery q <> ";"
5875INSERT statements
5976-----------------------------------------}
6077
78+-- | When a table is created, it contains no data. The first thing to do
79+-- before a database can be of much use is to insert data. Data is
80+-- conceptually inserted one row at a time. Of course you can also insert
81+-- more than one row, but there is no way to insert less than one row.
82+-- Even if you know only some column values, a complete row must be created.
83+--
84+-- >>> :{
85+-- let
86+-- manipulation :: Manipulation
87+-- '[ "tab" :::
88+-- '[ "col1" ::: 'Required ('NotNull 'PGint4)
89+-- , "col2" ::: 'Required ('NotNull 'PGint4) ]] '[] '[]
90+-- manipulation =
91+-- insertInto #tab (Values (2 `As` #col1 :* 4 `As` #col2 :* Nil) [])
92+-- OnConflictDoRaise (Returning Nil)
93+-- in renderManipulation manipulation
94+-- :}
95+-- "INSERT INTO tab (col1, col2) VALUES (2, 4);"
96+--
97+-- >>> :{
98+-- let
99+-- manipulation :: Manipulation
100+-- '[ "tab" :::
101+-- '[ "col1" ::: 'Required ('NotNull 'PGint4)
102+-- , "col2" ::: 'Required ('NotNull 'PGint4) ]]
103+-- '[] '[ "sum" ::: 'Required ('NotNull 'PGint4)]
104+-- manipulation =
105+-- insertInto #tab
106+-- (Values
107+-- (2 `As` #col1 :* 4 `As` #col2 :* Nil)
108+-- [6 `As` #col1 :* 8 `As` #col2 :* Nil])
109+-- (OnConflictDoUpdate
110+-- (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
111+-- (Just (#col1 .== #col2)))
112+-- (Returning $ (#col1 + #col2) `As` #sum :* Nil)
113+-- in renderManipulation manipulation
114+-- :}
115+-- "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;"
61116insertInto
62117 :: (SListI columns, SListI results, HasTable table schema columns)
63− => Alias table
64− -> ValuesClause schema params columns
118+ => Alias table -- ^ table to insert into
119+ -> ValuesClause schema params columns -- ^ values to insert
65120 -> ConflictClause columns params
66− -> ReturningClause columns params results
121+ -- ^ what to do in case of constraint conflict
122+ -> ReturningClause columns params results -- ^ results to return
67123 -> Manipulation schema params results
68124insertInto table insert conflict returning = UnsafeManipulation $
69125 "INSERT" <+> "INTO" <+> renderAlias table
@@ -71,6 +127,8 @@ insertInto table insert conflict returning = UnsafeManipulation $
71127 <> renderConflictClause conflict
72128 <> renderReturningClause returning
73129
130+-- | A `ValuesClause` lets you insert either values, free `Expression`s,
131+-- or the result of a `Query`.
74132data ValuesClause
75133 (schema :: TablesType)
76134 (params :: [ColumnType])
@@ -78,8 +136,10 @@ data ValuesClause
78136 = Values
79137 (NP (Aliased (Expression '[] 'Ungrouped params)) columns)
80138 [NP (Aliased (Expression '[] 'Ungrouped params)) columns]
139+ -- ^ at least one row of values
81140 | ValuesQuery (Query schema params columns)
82141
142+-- | Render a `ValuesClause`.
83143renderValuesClause
84144 :: SListI columns
85145 => ValuesClause schema params columns
@@ -97,6 +157,16 @@ renderValuesClause = \case
97157 renderValuePart (value `As` _) = renderExpression value
98158 ValuesQuery q -> renderQuery q
99159
160+-- | A `ReturningClause` computes and return value(s) based
161+-- on each row actually inserted, updated or deleted. This is primarily
162+-- useful for obtaining values that were supplied by defaults, such as a
163+-- serial sequence number. However, any expression using the table's columns
164+-- is allowed. Only rows that were successfully inserted or updated or
165+-- deleted will be returned. For example, if a row was locked
166+-- but not updated because an `OnConflictDoUpdate` condition was not satisfied,
167+-- the row will not be returned. `ReturningStar` will return all columns
168+-- in the row. Use `Returning Nil` in the common case where no return
169+-- values are desired.
100170data ReturningClause
101171 (columns :: ColumnsType)
102172 (params :: [ColumnType])
@@ -109,6 +179,7 @@ data ReturningClause
109179 results
110180 -> ReturningClause columns params results
111181
182+-- | Render a `ReturningClause`.
112183renderReturningClause
113184 :: SListI results
114185 => ReturningClause params columns results
@@ -119,20 +190,26 @@ renderReturningClause = \case
119190 Returning results -> " RETURNING"
120191 <+> renderCommaSeparated (renderAliased renderExpression) results <> ";"
121192
193+-- | A `ConflictClause` specifies an action to perform upon a constraint
194+-- violation. `OnConflictDoRaise` will raise an error.
195+-- `OnConflictDoNothing` simply avoids inserting a row.
196+-- `OnConflictDoUpdate` updates the existing row that conflicts with the row
197+-- proposed for insertion.
122198data ConflictClause columns params where
123− Conflict :: ConflictClause columns params
199+ OnConflictDoRaise :: ConflictClause columns params
124200 OnConflictDoNothing :: ConflictClause columns params
125201 OnConflictDoUpdate
126202 :: NP (Aliased (UpdateExpression columns params)) columns
127203 -> Maybe (Condition '[table ::: columns] 'Ungrouped params)
128204 -> ConflictClause columns params
129205
206+-- | Render a `ConflictClause`.
130207renderConflictClause
131208 :: SListI columns
132209 => ConflictClause columns params
133210 -> ByteString
134211renderConflictClause = \case
135− Conflict -> ""
212+ OnConflictDoRaise -> ""
136213 OnConflictDoNothing -> " ON CONFLICT DO NOTHING"
137214 OnConflictDoUpdate updates whMaybe
138215 -> " ON CONFLICT DO UPDATE SET"
@@ -145,13 +222,50 @@ renderConflictClause = \case
145222UPDATE statements
146223-----------------------------------------}
147224
225+-- | An `update` command changes the values of the specified columns
226+-- in all rows that satisfy the condition.
227+--
228+-- >>> :{
229+-- let
230+-- manipulation :: Manipulation
231+-- '[ "tab" :::
232+-- '[ "col1" ::: 'Required ('NotNull 'PGint4)
233+-- , "col2" ::: 'Required ('NotNull 'PGint4) ]] '[] '[]
234+-- manipulation =
235+-- update #tab (Set 2 `As` #col1 :* Same `As` #col2 :* Nil)
236+-- (#col1 ./= #col2) (Returning Nil)
237+-- in renderManipulation manipulation
238+-- :}
239+-- "UPDATE tab SET col1 = 2 WHERE (col1 <> col2);"
240+update
241+ :: (HasTable table schema columns, SListI columns, SListI results)
242+ => Alias table -- ^ table to update
243+ -> NP (Aliased (UpdateExpression columns params)) columns
244+ -- ^ modified values to replace old values
245+ -> Condition '[tab ::: columns] 'Ungrouped params
246+ -- ^ condition under which to perform update on a row
247+ -> ReturningClause columns params results -- ^ results to return
248+ -> Manipulation schema params results
249+update table columns wh returning = UnsafeManipulation $
250+ "UPDATE"
251+ <+> renderAlias table
252+ <+> "SET"
253+ <+> renderCommaSeparatedMaybe renderUpdateExpression columns
254+ <+> "WHERE" <+> renderExpression wh
255+ <> renderReturningClause returning
256+
257+-- | Columns to be updated are mentioned with `Set`; columns which are to
258+-- remain the same are mentioned with `Same`.
148259data UpdateExpression columns params ty
149260 = Same
261+ -- ^ column to remain the same upon update
150262 | Set (forall table. Expression '[table ::: columns] 'Ungrouped params ty)
263+ -- ^ column to be updated
151264deriving instance Show (UpdateExpression columns params ty)
152265deriving instance Eq (UpdateExpression columns params ty)
153266deriving instance Ord (UpdateExpression columns params ty)
154267
268+-- | Render an `UpdateExpression`.
155269renderUpdateExpression
156270 :: Aliased (UpdateExpression params columns) column
157271 -> Maybe ByteString
@@ -160,30 +274,32 @@ renderUpdateExpression = \case
160274 Set expression `As` column -> Just $
161275 renderAlias column <+> "=" <+> renderExpression expression
162276
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−
178277{-----------------------------------------
179278DELETE statements
180279-----------------------------------------}
181280
281+-- | Delete rows of a table.
282+--
283+-- >>> :{
284+-- let
285+-- manipulation :: Manipulation
286+-- '[ "tab" :::
287+-- '[ "col1" ::: 'Required ('NotNull 'PGint4)
288+-- , "col2" ::: 'Required ('NotNull 'PGint4) ]] '[]
289+-- '[ "col1" ::: 'Required ('NotNull 'PGint4)
290+-- , "col2" ::: 'Required ('NotNull 'PGint4) ]
291+-- manipulation = deleteFrom #tab (#col1 .== #col2) ReturningStar
292+-- in renderManipulation manipulation
293+-- :}
294+-- "DELETE FROM tab WHERE (col1 = col2) RETURNING *;"
182295deleteFrom
183− :: HasTable table schema columns
184− => Alias table
296+ :: (SListI results, HasTable table schema columns)
297+ => Alias table -- ^ table to delete from
185298 -> Condition '[table ::: columns] 'Ungrouped params
186− -> Manipulation schema params '[]
187−deleteFrom table wh = UnsafeManipulation $
299+ -- ^ condition under which to delete a row
300+ -> ReturningClause columns params results -- ^ results to return
301+ -> Manipulation schema params results
302+deleteFrom table wh returning = UnsafeManipulation $
188303 "DELETE FROM" <+> renderAlias table
189− <+> "WHERE" <+> renderExpression wh <> ";"
304+ <+> "WHERE" <+> renderExpression wh
305+ <> renderReturningClause returning