Copyright | (c) Eitan Chatav 2017 |
---|---|
Maintainer | [email protected] |
Stability | experimental |
Safe Haskell | None |
Language | Haskell2010 |
Squeal.PostgreSQL.Manipulation
Contents
Description
Squeal data manipulation language.
Synopsis
- newtype Manipulation (schema :: SchemaType) (params :: [NullityType]) (columns :: RowType) = UnsafeManipulation {}
- queryStatement :: Query schema params columns -> Manipulation schema params columns
- data ColumnValue (schema :: SchemaType) (columns :: RowType) (params :: [NullityType]) (ty :: ColumnType) where
- Same :: ColumnValue schema (column ': columns) params ty
- Default :: ColumnValue schema columns params (Def :=> ty)
- Set :: (forall table. Expression schema '[table ::: columns] Ungrouped params ty) -> ColumnValue schema columns params (constraint :=> ty)
- data ReturningClause (schema :: SchemaType) (params :: [NullityType]) (row0 :: RowType) (row1 :: RowType) where
- ReturningStar :: ReturningClause schema params row row
- Returning :: NP (Aliased (Expression schema '[table ::: row0] Ungrouped params)) row1 -> ReturningClause schema params row0 row1
- data ConflictClause (schema :: SchemaType) (table :: TableType) (params :: [NullityType]) where
- OnConflictDoRaise :: ConflictClause schema table params
- OnConflictDoNothing :: ConflictClause schema table params
- OnConflictDoUpdate :: (row ~ TableToRow table, columns ~ TableToColumns table) => NP (Aliased (ColumnValue schema row params)) columns -> [Condition schema '[t ::: row] Ungrouped params] -> ConflictClause schema table params
- insertRows :: (SListI columns, SListI results, Has tab schema (Table table), row ~ TableToRow table, columns ~ TableToColumns table) => Alias tab -> NP (Aliased (ColumnValue schema '[] params)) columns -> [NP (Aliased (ColumnValue schema '[] params)) columns] -> ConflictClause schema table params -> ReturningClause schema params row results -> Manipulation schema params results
- insertRow :: (SListI columns, SListI results, Has tab schema (Table table), row ~ TableToRow table, columns ~ TableToColumns table) => Alias tab -> NP (Aliased (ColumnValue schema '[] params)) columns -> ConflictClause schema table params -> ReturningClause schema params row results -> Manipulation schema params results
- insertRows_ :: (SListI columns, Has tab schema (Table table), columns ~ TableToColumns table) => Alias tab -> NP (Aliased (ColumnValue schema '[] params)) columns -> [NP (Aliased (ColumnValue schema '[] params)) columns] -> Manipulation schema params '[]
- insertRow_ :: (SListI columns, Has tab schema (Table table), columns ~ TableToColumns table) => Alias tab -> NP (Aliased (ColumnValue schema '[] params)) columns -> Manipulation schema params '[]
- insertQuery :: (SListI columns, SListI results, Has tab schema (Table table), row ~ TableToRow table, columns ~ TableToColumns table) => Alias tab -> Query schema params (TableToRow table) -> ConflictClause schema table params -> ReturningClause schema params row results -> Manipulation schema params results
- insertQuery_ :: (SListI columns, Has tab schema (Table table), columns ~ TableToColumns table) => Alias tab -> Query schema params (TableToRow table) -> Manipulation schema params '[]
- renderReturningClause :: SListI results => ReturningClause schema params columns results -> ByteString
- renderConflictClause :: SListI (TableToColumns table) => ConflictClause schema table params -> ByteString
- update :: (SListI columns, SListI results, Has tab schema (Table table), row ~ TableToRow table, columns ~ TableToColumns table) => Alias tab -> NP (Aliased (ColumnValue schema row params)) columns -> (forall t. Condition schema '[t ::: row] Ungrouped params) -> ReturningClause schema params row results -> Manipulation schema params results
- update_ :: (SListI columns, Has tab schema (Table table), row ~ TableToRow table, columns ~ TableToColumns table) => Alias tab -> NP (Aliased (ColumnValue schema row params)) columns -> (forall t. Condition schema '[t ::: row] Ungrouped params) -> Manipulation schema params '[]
- deleteFrom :: (SListI results, Has tab schema (Table table), row ~ TableToRow table, columns ~ TableToColumns table) => Alias tab -> Condition schema '[tab ::: row] Ungrouped params -> ReturningClause schema params row results -> Manipulation schema params results
- deleteFrom_ :: (Has tab schema (Table table), row ~ TableToRow table, columns ~ TableToColumns table) => Alias tab -> (forall t. Condition schema '[t ::: row] Ungrouped params) -> Manipulation schema params '[]
Manipulation
newtype Manipulation (schema :: SchemaType) (params :: [NullityType]) (columns :: RowType) Source #
A Manipulation
is a statement which may modify data in the database,
but does not alter the schema. Examples are inserts, updates and deletes.
A Query
is also considered a Manipulation
even though it does not modify data.
simple insert:
>>>
:{
let manipulation :: Manipulation '[ "tab" ::: 'Table ('[] :=> '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4 , "col2" ::: 'Def :=> 'NotNull 'PGint4 ])] '[] '[] manipulation = insertRow_ #tab (Set 2 `as` #col1 :* Default `as` #col2) in printSQL manipulation :} INSERT INTO "tab" ("col1", "col2") VALUES (2, DEFAULT)
parameterized insert:
>>>
:{
let manipulation :: Manipulation '[ "tab" ::: 'Table ('[] :=> '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4 , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])] '[ 'NotNull 'PGint4, 'NotNull 'PGint4 ] '[] manipulation = insertRow_ #tab (Set (param @1) `as` #col1 :* Set (param @2) `as` #col2) in printSQL manipulation :} INSERT INTO "tab" ("col1", "col2") VALUES (($1 :: int4), ($2 :: int4))
returning insert:
>>>
:{
let manipulation :: Manipulation '[ "tab" ::: 'Table ('[] :=> '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4 , "col2" ::: 'Def :=> 'NotNull 'PGint4 ])] '[] '["fromOnly" ::: 'NotNull 'PGint4] manipulation = insertRow #tab (Set 2 `as` #col1 :* Default `as` #col2) OnConflictDoRaise (Returning (#col1 `as` #fromOnly)) in printSQL manipulation :} INSERT INTO "tab" ("col1", "col2") VALUES (2, DEFAULT) RETURNING "col1" AS "fromOnly"
upsert:
>>>
:{
let manipulation :: Manipulation '[ "tab" ::: 'Table ('[] :=> '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4 , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])] '[] '[ "sum" ::: 'NotNull 'PGint4] manipulation = insertRows #tab (Set 2 `as` #col1 :* Set 4 `as` #col2) [Set 6 `as` #col1 :* Set 8 `as` #col2] (OnConflictDoUpdate (Set 2 `as` #col1 :* Same `as` #col2) [#col1 .== #col2]) (Returning $ (#col1 + #col2) `as` #sum) in printSQL 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"
query insert:
>>>
:{
let manipulation :: Manipulation '[ "tab" ::: 'Table ('[] :=> '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4 , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ]) , "other_tab" ::: 'Table ('[] :=> '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4 , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ]) ] '[] '[] manipulation = insertQuery_ #tab (selectStar (from (table (#other_tab `as` #t)))) in printSQL manipulation :} INSERT INTO "tab" SELECT * FROM "other_tab" AS "t"
update:
>>>
:{
let manipulation :: Manipulation '[ "tab" ::: 'Table ('[] :=> '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4 , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])] '[] '[] manipulation = update_ #tab (Set 2 `as` #col1 :* Same `as` #col2) (#col1 ./= #col2) in printSQL manipulation :} UPDATE "tab" SET "col1" = 2 WHERE ("col1" <> "col2")
delete:
>>>
:{
let manipulation :: Manipulation '[ "tab" ::: 'Table ('[] :=> '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4 , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ])] '[] '[ "col1" ::: 'NotNull 'PGint4 , "col2" ::: 'NotNull 'PGint4 ] manipulation = deleteFrom #tab (#col1 .== #col2) ReturningStar in printSQL manipulation :} DELETE FROM "tab" WHERE ("col1" = "col2") RETURNING *
with manipulation:
>>>
type ProductsTable = '[] :=> '["product" ::: 'NoDef :=> 'NotNull 'PGtext, "date" ::: 'Def :=> 'NotNull 'PGdate]
>>>
:{
let manipulation :: Manipulation '[ "products" ::: 'Table ProductsTable , "products_deleted" ::: 'Table ProductsTable ] '[ 'NotNull 'PGdate] '[] manipulation = with (deleteFrom #products (#date .< param @1) ReturningStar `as` #deleted_rows) (insertQuery_ #products_deleted (selectStar (from (view (#deleted_rows `as` #t))))) in printSQL manipulation :} WITH "deleted_rows" AS (DELETE FROM "products" WHERE ("date" < ($1 :: date)) RETURNING *) INSERT INTO "products_deleted" SELECT * FROM "deleted_rows" AS "t"
Constructors
UnsafeManipulation | |
Fields |
Instances
With Manipulation Source # | |
Defined in Squeal.PostgreSQL.Manipulation Methods with :: AlignedList (CommonTableExpression Manipulation params) schema0 schema1 -> Manipulation schema1 params row -> Manipulation schema0 params row Source # | |
Eq (Manipulation schema params columns) Source # | |
Defined in Squeal.PostgreSQL.Manipulation Methods (==) :: Manipulation schema params columns -> Manipulation schema params columns -> Bool # (/=) :: Manipulation schema params columns -> Manipulation schema params columns -> Bool # | |
Ord (Manipulation schema params columns) Source # | |
Defined in Squeal.PostgreSQL.Manipulation Methods compare :: Manipulation schema params columns -> Manipulation schema params columns -> Ordering # (<) :: Manipulation schema params columns -> Manipulation schema params columns -> Bool # (<=) :: Manipulation schema params columns -> Manipulation schema params columns -> Bool # (>) :: Manipulation schema params columns -> Manipulation schema params columns -> Bool # (>=) :: Manipulation schema params columns -> Manipulation schema params columns -> Bool # max :: Manipulation schema params columns -> Manipulation schema params columns -> Manipulation schema params columns # min :: Manipulation schema params columns -> Manipulation schema params columns -> Manipulation schema params columns # | |
Show (Manipulation schema params columns) Source # | |
Defined in Squeal.PostgreSQL.Manipulation Methods showsPrec :: Int -> Manipulation schema params columns -> ShowS # show :: Manipulation schema params columns -> String # showList :: [Manipulation schema params columns] -> ShowS # | |
Generic (Manipulation schema params columns) Source # | |
Defined in Squeal.PostgreSQL.Manipulation Associated Types type Rep (Manipulation schema params columns) :: * -> * # Methods from :: Manipulation schema params columns -> Rep (Manipulation schema params columns) x # to :: Rep (Manipulation schema params columns) x -> Manipulation schema params columns # | |
NFData (Manipulation schema params columns) Source # | |
Defined in Squeal.PostgreSQL.Manipulation Methods rnf :: Manipulation schema params columns -> () # | |
RenderSQL (Manipulation schema params columns) Source # | |
Defined in Squeal.PostgreSQL.Manipulation Methods renderSQL :: Manipulation schema params columns -> ByteString Source # | |
type Rep (Manipulation schema params columns) Source # | |
Defined in Squeal.PostgreSQL.Manipulation type Rep (Manipulation schema params columns) = D1 (MetaData "Manipulation" "Squeal.PostgreSQL.Manipulation" "squeal-postgresql-0.4.0.0-GuxxUOwtUmZB6qL3MLEXvb" True) (C1 (MetaCons "UnsafeManipulation" PrefixI True) (S1 (MetaSel (Just "renderManipulation") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 ByteString))) |
queryStatement :: Query schema params columns -> Manipulation schema params columns Source #
Convert a Query
into a Manipulation
.
data ColumnValue (schema :: SchemaType) (columns :: RowType) (params :: [NullityType]) (ty :: ColumnType) where Source #
ColumnValue
s are values to insert or update in a row.
Same
updates with the same value.
Default
inserts or updates with the DEFAULT
value.
Set
sets a value to be an Expression
, which can refer to
existing value in the row for an update.
Constructors
Same :: ColumnValue schema (column ': columns) params ty | |
Default :: ColumnValue schema columns params (Def :=> ty) | |
Set :: (forall table. Expression schema '[table ::: columns] Ungrouped params ty) -> ColumnValue schema columns params (constraint :=> ty) |
data ReturningClause (schema :: SchemaType) (params :: [NullityType]) (row0 :: RowType) (row1 :: RowType) 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 schema params row row | |
Returning :: NP (Aliased (Expression schema '[table ::: row0] Ungrouped params)) row1 -> ReturningClause schema params row0 row1 |
data ConflictClause (schema :: SchemaType) (table :: TableType) (params :: [NullityType]) 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 schema table params | |
OnConflictDoNothing :: ConflictClause schema table params | |
OnConflictDoUpdate :: (row ~ TableToRow table, columns ~ TableToColumns table) => NP (Aliased (ColumnValue schema row params)) columns -> [Condition schema '[t ::: row] Ungrouped params] -> ConflictClause schema table params |
Insert
Arguments
:: (SListI columns, SListI results, Has tab schema (Table table), row ~ TableToRow table, columns ~ TableToColumns table) | |
=> Alias tab | table to insert into |
-> NP (Aliased (ColumnValue schema '[] params)) columns | row to insert |
-> [NP (Aliased (ColumnValue schema '[] params)) columns] | more rows to insert |
-> ConflictClause schema table params | what to do in case of constraint conflict |
-> ReturningClause schema params row results | results to return |
-> Manipulation schema params results |
Insert multiple rows.
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.
Arguments
:: (SListI columns, SListI results, Has tab schema (Table table), row ~ TableToRow table, columns ~ TableToColumns table) | |
=> Alias tab | table to insert into |
-> NP (Aliased (ColumnValue schema '[] params)) columns | row to insert |
-> ConflictClause schema table params | what to do in case of constraint conflict |
-> ReturningClause schema params row results | results to return |
-> Manipulation schema params results |
Insert a single row.
Arguments
:: (SListI columns, Has tab schema (Table table), columns ~ TableToColumns table) | |
=> Alias tab | table to insert into |
-> NP (Aliased (ColumnValue schema '[] params)) columns | row to insert |
-> [NP (Aliased (ColumnValue schema '[] params)) columns] | more rows to insert |
-> Manipulation schema params '[] |
Insert multiple rows returning Nil
and raising an error on conflicts.
Arguments
:: (SListI columns, Has tab schema (Table table), columns ~ TableToColumns table) | |
=> Alias tab | table to insert into |
-> NP (Aliased (ColumnValue schema '[] params)) columns | row to insert |
-> Manipulation schema params '[] |
Insert a single row returning Nil
and raising an error on conflicts.
Arguments
:: (SListI columns, SListI results, Has tab schema (Table table), row ~ TableToRow table, columns ~ TableToColumns table) | |
=> Alias tab | table to insert into |
-> Query schema params (TableToRow table) | |
-> ConflictClause schema table params | what to do in case of constraint conflict |
-> ReturningClause schema params row results | results to return |
-> Manipulation schema params results |
Insert a Query
.
Arguments
:: (SListI columns, Has tab schema (Table table), columns ~ TableToColumns table) | |
=> Alias tab | table to insert into |
-> Query schema params (TableToRow table) | |
-> Manipulation schema params '[] |
renderReturningClause :: SListI results => ReturningClause schema params columns results -> ByteString Source #
Render a ReturningClause
.
renderConflictClause :: SListI (TableToColumns table) => ConflictClause schema table params -> ByteString Source #
Render a ConflictClause
.
Update
Arguments
:: (SListI columns, SListI results, Has tab schema (Table table), row ~ TableToRow table, columns ~ TableToColumns table) | |
=> Alias tab | table to update |
-> NP (Aliased (ColumnValue schema row params)) columns | modified values to replace old values |
-> (forall t. Condition schema '[t ::: row] Ungrouped params) | condition under which to perform update on a row |
-> ReturningClause schema params row 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.
Arguments
:: (SListI columns, Has tab schema (Table table), row ~ TableToRow table, columns ~ TableToColumns table) | |
=> Alias tab | table to update |
-> NP (Aliased (ColumnValue schema row params)) columns | modified values to replace old values |
-> (forall t. Condition schema '[t ::: row] Ungrouped params) | condition under which to perform update on a row |
-> Manipulation schema params '[] |
Update a row returning Nil
.
Delete
Arguments
:: (SListI results, Has tab schema (Table table), row ~ TableToRow table, columns ~ TableToColumns table) | |
=> Alias tab | table to delete from |
-> Condition schema '[tab ::: row] Ungrouped params | condition under which to delete a row |
-> ReturningClause schema params row results | results to return |
-> Manipulation schema params results |
Delete rows of a table.
Arguments
:: (Has tab schema (Table table), row ~ TableToRow table, columns ~ TableToColumns table) | |
=> Alias tab | table to delete from |
-> (forall t. Condition schema '[t ::: row] Ungrouped params) | condition under which to delete a row |
-> Manipulation schema params '[] |
Delete rows returning Nil
.