| Copyright | (c) Eitan Chatav 2017 |
|---|---|
| Maintainer | eitan@morphism.tech |
| Stability | experimental |
| Safe Haskell | None |
| Language | Haskell2010 |
Squeal.PostgreSQL.Manipulation
Contents
Description
Squeal data manipulation language.
- newtype Manipulation (schema :: TablesType) (params :: [ColumnType]) (columns :: ColumnsType) = UnsafeManipulation {}
- queryStatement :: Query schema params columns -> Manipulation schema params columns
- insertInto :: (SListI columns, SListI results, HasTable table schema columns) => Alias table -> ValuesClause schema params columns -> ConflictClause columns params -> ReturningClause columns params results -> Manipulation schema params results
- data ValuesClause (schema :: TablesType) (params :: [ColumnType]) (columns :: ColumnsType)
- = Values (NP (Aliased (Expression '[] Ungrouped params)) columns) [NP (Aliased (Expression '[] Ungrouped params)) columns]
- | ValuesQuery (Query schema params columns)
- renderValuesClause :: SListI columns => ValuesClause schema params columns -> ByteString
- data ReturningClause (columns :: ColumnsType) (params :: [ColumnType]) (results :: ColumnsType) where
- ReturningStar :: ReturningClause columns params columns
- Returning :: NP (Aliased (Expression '[table ::: columns] Ungrouped params)) results -> ReturningClause columns params results
- renderReturningClause :: SListI results => ReturningClause params columns results -> ByteString
- data ConflictClause columns params where
- OnConflictDoRaise :: ConflictClause columns params
- OnConflictDoNothing :: ConflictClause columns params
- OnConflictDoUpdate :: NP (Aliased (UpdateExpression columns params)) columns -> Maybe (Condition '[table ::: columns] Ungrouped params) -> ConflictClause columns params
- renderConflictClause :: SListI columns => ConflictClause columns params -> ByteString
- update :: (HasTable table schema columns, SListI columns, SListI results) => Alias table -> NP (Aliased (UpdateExpression columns params)) columns -> Condition '[tab ::: columns] Ungrouped params -> ReturningClause columns params results -> Manipulation schema params results
- data UpdateExpression columns params ty
- = Same
- | Set (forall table. Expression '[table ::: columns] Ungrouped params ty)
- renderUpdateExpression :: Aliased (UpdateExpression params columns) column -> Maybe ByteString
- deleteFrom :: (SListI results, HasTable table schema columns) => Alias table -> Condition '[table ::: columns] Ungrouped params -> ReturningClause columns params results -> Manipulation schema params results
Manipulation
newtype Manipulation (schema :: TablesType) (params :: [ColumnType]) (columns :: ColumnsType) Source #
A Manipulation is a statement which may modify data in the database,
but does not alter the schema. Examples are insertInto, update and
deleteFrom. A Query is also considered a Manipulation even though
it does not modify data.
Constructors
| UnsafeManipulation | |
Fields | |
Instances
| Eq (Manipulation schema params columns) Source # | |
| Ord (Manipulation schema params columns) Source # | |
| Show (Manipulation schema params columns) Source # | |
| Generic (Manipulation schema params columns) Source # | |
| NFData (Manipulation schema params columns) Source # | |
| type Rep (Manipulation schema params columns) Source # | |
queryStatement :: Query schema params columns -> Manipulation schema params columns Source #
Convert a Query into a Manipulation.
Insert
Arguments
| :: (SListI columns, SListI results, HasTable table schema columns) | |
| => Alias table | table to insert into |
| -> ValuesClause schema params columns | values to insert |
| -> ConflictClause columns params | what to do in case of constraint conflict |
| -> ReturningClause columns params results | results to return |
| -> Manipulation schema params results |
When a table is created, it contains no data. The first thing to do before a database can be of much use is to insert data. Data is conceptually inserted one row at a time. Of course you can also insert more than one row, but there is no way to insert less than one row. Even if you know only some column values, a complete row must be created.
simple insert:
>>>:{let manipulation :: Manipulation '[ "tab" ::: '[ "col1" ::: 'Required ('NotNull 'PGint4) , "col2" ::: 'Required ('NotNull 'PGint4) ]] '[] '[] manipulation = insertInto #tab (Values (2 `As` #col1 :* 4 `As` #col2 :* Nil) []) OnConflictDoRaise (Returning Nil) in renderManipulation manipulation :} "INSERT INTO tab (col1, col2) VALUES (2, 4);"
parameterized insert:
>>>:{let manipulation :: Manipulation '[ "tab" ::: '[ "col1" ::: 'Required ('NotNull 'PGint4) , "col2" ::: 'Required ('NotNull 'PGint4) ]] '[ 'Required ('NotNull 'PGint4) , 'Required ('NotNull 'PGint4) ] '[] manipulation = insertInto #tab (Values (param @1 `As` #col1 :* param @2 `As` #col2 :* Nil) []) OnConflictDoRaise (Returning Nil) in renderManipulation manipulation :} "INSERT INTO tab (col1, col2) VALUES (($1 :: int4), ($2 :: int4));"
returning insert:
>>>:{let manipulation :: Manipulation '[ "tab" ::: '[ "col1" ::: 'Required ('NotNull 'PGint4) , "col2" ::: 'Required ('NotNull 'PGint4) ]] '[] '["fromOnly" ::: 'Required ('NotNull 'PGint4)] manipulation = insertInto #tab (Values (2 `As` #col1 :* 4 `As` #col2 :* Nil) []) OnConflictDoRaise (Returning (#col1 `As` #fromOnly :* Nil)) in renderManipulation manipulation :} "INSERT INTO tab (col1, col2) VALUES (2, 4) RETURNING col1 AS fromOnly;"
query insert:
>>>:{let manipulation :: Manipulation '[ "tab" ::: '[ "col1" ::: 'Required ('NotNull 'PGint4) , "col2" ::: 'Required ('NotNull 'PGint4) ] , "other_tab" ::: '[ "col1" ::: 'Required ('NotNull 'PGint4) , "col2" ::: 'Required ('NotNull 'PGint4) ] ] '[] '[] manipulation = insertInto #tab ( ValuesQuery $ selectStar (from (Table (#other_tab `As` #t))) ) OnConflictDoRaise (Returning Nil) in renderManipulation manipulation :} "INSERT INTO tab SELECT * FROM other_tab AS t;"
upsert:
>>>:{let manipulation :: Manipulation '[ "tab" ::: '[ "col1" ::: 'Required ('NotNull 'PGint4) , "col2" ::: 'Required ('NotNull 'PGint4) ]] '[] '[ "sum" ::: 'Required ('NotNull 'PGint4)] manipulation = insertInto #tab (Values (2 `As` #col1 :* 4 `As` #col2 :* Nil) [6 `As` #col1 :* 8 `As` #col2 :* Nil]) (OnConflictDoUpdate (Set 2 `As` #col1 :* Same `As` #col2 :* Nil) (Just (#col1 .== #col2))) (Returning $ (#col1 + #col2) `As` #sum :* Nil) in renderManipulation manipulation :} "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;"
data ValuesClause (schema :: TablesType) (params :: [ColumnType]) (columns :: ColumnsType) Source #
A ValuesClause lets you insert either values, free Expressions,
or the result of a Query.
Constructors
| Values (NP (Aliased (Expression '[] Ungrouped params)) columns) [NP (Aliased (Expression '[] Ungrouped params)) columns] | at least one row of values |
| ValuesQuery (Query schema params columns) |
renderValuesClause :: SListI columns => ValuesClause schema params columns -> ByteString Source #
Render a ValuesClause.
data ReturningClause (columns :: ColumnsType) (params :: [ColumnType]) (results :: ColumnsType) where Source #
A ReturningClause computes and return value(s) based
on each row actually inserted, updated or deleted. This is primarily
useful for obtaining values that were supplied by defaults, such as a
serial sequence number. However, any expression using the table's columns
is allowed. Only rows that were successfully inserted or updated or
deleted will be returned. For example, if a row was locked
but not updated because an OnConflictDoUpdate condition was not satisfied,
the row will not be returned. ReturningStar will return all columns
in the row. Use `Returning Nil` in the common case where no return
values are desired.
Constructors
| ReturningStar :: ReturningClause columns params columns | |
| Returning :: NP (Aliased (Expression '[table ::: columns] Ungrouped params)) results -> ReturningClause columns params results |
renderReturningClause :: SListI results => ReturningClause params columns results -> ByteString Source #
Render a ReturningClause.
data ConflictClause columns params where Source #
A ConflictClause specifies an action to perform upon a constraint
violation. OnConflictDoRaise will raise an error.
OnConflictDoNothing simply avoids inserting a row.
OnConflictDoUpdate updates the existing row that conflicts with the row
proposed for insertion.
Constructors
| OnConflictDoRaise :: ConflictClause columns params | |
| OnConflictDoNothing :: ConflictClause columns params | |
| OnConflictDoUpdate :: NP (Aliased (UpdateExpression columns params)) columns -> Maybe (Condition '[table ::: columns] Ungrouped params) -> ConflictClause columns params |
renderConflictClause :: SListI columns => ConflictClause columns params -> ByteString Source #
Render a ConflictClause.
Update
Arguments
| :: (HasTable table schema columns, SListI columns, SListI results) | |
| => Alias table | table to update |
| -> NP (Aliased (UpdateExpression columns params)) columns | modified values to replace old values |
| -> Condition '[tab ::: columns] Ungrouped params | condition under which to perform update on a row |
| -> ReturningClause columns params results | results to return |
| -> Manipulation schema params results |
An update command changes the values of the specified columns
in all rows that satisfy the condition.
>>>:{let manipulation :: Manipulation '[ "tab" ::: '[ "col1" ::: 'Required ('NotNull 'PGint4) , "col2" ::: 'Required ('NotNull 'PGint4) ]] '[] '[] manipulation = update #tab (Set 2 `As` #col1 :* Same `As` #col2 :* Nil) (#col1 ./= #col2) (Returning Nil) in renderManipulation manipulation :} "UPDATE tab SET col1 = 2 WHERE (col1 <> col2);"
data UpdateExpression columns params ty Source #
Columns to be updated are mentioned with Set; columns which are to
remain the same are mentioned with Same.
Constructors
| Same | column to remain the same upon update |
| Set (forall table. Expression '[table ::: columns] Ungrouped params ty) | column to be updated |
Instances
| Eq (UpdateExpression columns params ty) Source # | |
| Ord (UpdateExpression columns params ty) Source # | |
| Show (UpdateExpression columns params ty) Source # | |
renderUpdateExpression :: Aliased (UpdateExpression params columns) column -> Maybe ByteString Source #
Render an UpdateExpression.
Arguments
| :: (SListI results, HasTable table schema columns) | |
| => Alias table | table to delete from |
| -> Condition '[table ::: columns] Ungrouped params | condition under which to delete a row |
| -> ReturningClause columns params results | results to return |
| -> Manipulation schema params results |
Delete rows of a table.
>>>:{let manipulation :: Manipulation '[ "tab" ::: '[ "col1" ::: 'Required ('NotNull 'PGint4) , "col2" ::: 'Required ('NotNull 'PGint4) ]] '[] '[ "col1" ::: 'Required ('NotNull 'PGint4) , "col2" ::: 'Required ('NotNull 'PGint4) ] manipulation = deleteFrom #tab (#col1 .== #col2) ReturningStar in renderManipulation manipulation :} "DELETE FROM tab WHERE (col1 = col2) RETURNING *;"