hpqtypes-extras-1.16.3.0: Extra utilities for hpqtypes library
Safe HaskellSafe-Inferred
LanguageHaskell2010

Database.PostgreSQL.PQTypes.SQL.Builder

Description

Module Database.PostgreSQL.PQTypes.SQL.Builder offers a nice monadic DSL for building SQL statements on the fly. Some examples:

>>> :{
sqlSelect "documents" $ do
  sqlResult "id"
  sqlResult "title"
  sqlResult "mtime"
  sqlOrderBy "documents.mtime DESC"
  sqlWhereILike "documents.title" "%pattern%"
:}
SQL " SELECT  id, title, mtime FROM documents WHERE (documents.title ILIKE <\"%pattern%\">)    ORDER BY documents.mtime DESC  "

SQL.Builder supports SELECT as sqlSelect and data manipulation using sqlInsert, sqlInsertSelect, sqlDelete and sqlUpdate.

>>> import Data.Time
>>> let title = "title" :: String
>>> let ctime  = read "2020-01-01 00:00:00 UTC" :: UTCTime
>>> :{
sqlInsert "documents" $ do
  sqlSet "title" title
  sqlSet "ctime" ctime
  sqlResult "id"
:}
SQL " INSERT INTO documents (title, ctime) VALUES (<\"title\">, <2020-01-01 00:00:00 UTC>)  RETURNING id"

The sqlInsertSelect is particulary interesting as it supports INSERT of values taken from a SELECT clause from same or even different tables.

There is a possibility to do multiple inserts at once. Data given by sqlSetList will be inserted multiple times, data given by sqlSet will be multiplied as many times as needed to cover all inserted rows (it is common to all rows). If you use multiple sqlSetList then lists will be made equal in length by appending DEFAULT as fill element.

>>> :{
sqlInsert "documents" $ do
  sqlSet "ctime" ctime
  sqlSetList "title" ["title1", "title2", "title3"]
  sqlResult "id"
:}
SQL " INSERT INTO documents (ctime, title) VALUES (<2020-01-01 00:00:00 UTC>, <\"title1\">) , (<2020-01-01 00:00:00 UTC>, <\"title2\">) , (<2020-01-01 00:00:00 UTC>, <\"title3\">)  RETURNING id"

The above will insert 3 new documents.

SQL.Builder provides quite a lot of SQL magic, including ORDER BY as sqlOrderBy, GROUP BY as sqlGroupBy.

>>> :{
sqlSelect "documents" $ do
  sqlResult "id"
  sqlResult "title"
  sqlResult "mtime"
  sqlOrderBy "documents.mtime DESC"
  sqlOrderBy "documents.title"
  sqlGroupBy "documents.status"
  sqlJoinOn "users" "documents.user_id = users.id"
  sqlWhere $ mkSQL "documents.title ILIKE" <?> "%pattern%"
:}
SQL " SELECT  id, title, mtime FROM documents  JOIN  users  ON  documents.user_id = users.id WHERE (documents.title ILIKE <\"%pattern%\">)  GROUP BY documents.status  ORDER BY documents.mtime DESC, documents.title  "

Joins are done by sqlJoinOn, sqlLeftJoinOn, sqlRightJoinOn, sqlJoinOn, sqlFullJoinOn. If everything fails use sqlJoin and sqlFrom to set join clause as string. Support for a join grammars as some kind of abstract syntax data type is lacking.

>>> :{
sqlDelete "mails" $ do
  sqlWhere "id > 67"
:}
SQL " DELETE FROM mails  WHERE (id > 67) "
>>> :{
sqlUpdate "document_tags" $ do
  sqlSet "value" (123 :: Int)
  sqlWhere "name = 'abc'"
:}
SQL " UPDATE document_tags SET value=<123>  WHERE (name = 'abc') "
Synopsis

Documentation

sqlWhere :: (MonadState v m, SqlWhere v) => SQL -> m () Source #

The WHERE part of an SQL query. See above for a usage example. See also SqlCondition.

sqlWhereEq :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> a -> m () Source #

sqlWhereEqSql :: (MonadState v m, SqlWhere v, Sqlable sql) => SQL -> sql -> m () Source #

sqlWhereNotEq :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> a -> m () Source #

sqlWhereEqualsAny :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> [a] -> m () Source #

Similar to sqlWhereIn, but uses ANY instead of SELECT UNNEST.

sqlWhereIn :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> [a] -> m () Source #

sqlWhereInSql :: (MonadState v m, Sqlable a, SqlWhere v) => SQL -> a -> m () Source #

sqlWhereNotIn :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> [a] -> m () Source #

sqlWhereNotInSql :: (MonadState v m, Sqlable a, SqlWhere v) => SQL -> a -> m () Source #

sqlWhereLike :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> a -> m () Source #

sqlWhereILike :: (MonadState v m, SqlWhere v, Show a, ToSQL a) => SQL -> a -> m () Source #

sqlWhereIsNULL :: (MonadState v m, SqlWhere v) => SQL -> m () Source #

sqlFrom :: (MonadState v m, SqlFrom v) => SQL -> m () Source #

sqlJoin :: (MonadState v m, SqlFrom v) => SQL -> m () Source #

sqlJoinOn :: (MonadState v m, SqlFrom v) => SQL -> SQL -> m () Source #

sqlLeftJoinOn :: (MonadState v m, SqlFrom v) => SQL -> SQL -> m () Source #

sqlRightJoinOn :: (MonadState v m, SqlFrom v) => SQL -> SQL -> m () Source #

sqlFullJoinOn :: (MonadState v m, SqlFrom v) => SQL -> SQL -> m () Source #

sqlOnConflictDoNothing :: (MonadState v m, SqlOnConflict v) => m () Source #

sqlOnConflictOnColumns :: (MonadState v m, SqlOnConflict v, Sqlable sql) => [SQL] -> sql -> m () Source #

sqlOnConflictOnColumnsDoNothing :: (MonadState v m, SqlOnConflict v) => [SQL] -> m () Source #

sqlSet :: (MonadState v m, SqlSet v, Show a, ToSQL a) => SQL -> a -> m () Source #

sqlSetInc :: (MonadState v m, SqlSet v) => SQL -> m () Source #

sqlSetList :: (MonadState SqlInsert m, Show a, ToSQL a) => SQL -> [a] -> m () Source #

sqlSetCmd :: (MonadState v m, SqlSet v) => SQL -> SQL -> m () Source #

sqlCopyColumn :: (MonadState v m, SqlSet v) => SQL -> m () Source #

sqlResult :: (MonadState v m, SqlResult v) => SQL -> m () Source #

sqlOrderBy :: (MonadState v m, SqlOrderBy v) => SQL -> m () Source #

sqlOffset :: (MonadState v m, SqlOffsetLimit v, Integral int) => int -> m () Source #

sqlLimit :: (MonadState v m, SqlOffsetLimit v, Integral int) => int -> m () Source #

sqlWith :: (MonadState v m, SqlWith v, Sqlable s) => SQL -> s -> m () Source #

sqlWithMaterialized :: (MonadState v m, SqlWith v, Sqlable s) => SQL -> s -> m () Source #

sqlUnion :: (MonadState SqlSelect m, Sqlable sql) => [sql] -> m () Source #

Note: WHERE clause of the main SELECT is treated specially, i.e. it only applies to the main SELECT, not the whole union.

data SqlSelect Source #

Instances

Instances details
Show SqlSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

IsSQL SqlSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

Methods

withSQL :: SqlSelect -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r #

SqlDistinct SqlSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

SqlFrom SqlSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

SqlGroupByHaving SqlSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

SqlOffsetLimit SqlSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

SqlOrderBy SqlSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

SqlResult SqlSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

SqlWhere SqlSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

SqlWith SqlSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

Methods

sqlWith1 :: SqlSelect -> SQL -> SQL -> Materialized -> SqlSelect

Sqlable SqlSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

data SqlInsert Source #

Constructors

SqlInsert 

Fields

data SqlInsertSelect Source #

Instances

Instances details
Show SqlInsertSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

IsSQL SqlInsertSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

Methods

withSQL :: SqlInsertSelect -> ParamAllocator -> (Ptr PGparam -> CString -> IO r) -> IO r #

SqlDistinct SqlInsertSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

SqlFrom SqlInsertSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

SqlGroupByHaving SqlInsertSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

SqlOffsetLimit SqlInsertSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

SqlOrderBy SqlInsertSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

SqlResult SqlInsertSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

SqlSet SqlInsertSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

SqlWhere SqlInsertSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

SqlWith SqlInsertSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

Methods

sqlWith1 :: SqlInsertSelect -> SQL -> SQL -> Materialized -> SqlInsertSelect

Sqlable SqlInsertSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

data SqlUpdate Source #

Constructors

SqlUpdate 

sqlWhereAny :: (MonadState v m, SqlWhere v) => [State SqlAll ()] -> m () Source #

Add a condition in the WHERE statement that holds if any of the given condition holds.

class SqlSet a Source #

Minimal complete definition

sqlSet1

Instances

Instances details
SqlSet SqlInsert Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

Methods

sqlSet1 :: SqlInsert -> SQL -> SQL -> SqlInsert

SqlSet SqlInsertSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

SqlSet SqlUpdate Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

Methods

sqlSet1 :: SqlUpdate -> SQL -> SQL -> SqlUpdate

class SqlFrom a Source #

Minimal complete definition

sqlFrom1

class SqlWith a Source #

Minimal complete definition

sqlWith1

Instances

Instances details
SqlWith SqlDelete Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

Methods

sqlWith1 :: SqlDelete -> SQL -> SQL -> Materialized -> SqlDelete

SqlWith SqlInsertSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

Methods

sqlWith1 :: SqlInsertSelect -> SQL -> SQL -> Materialized -> SqlInsertSelect

SqlWith SqlSelect Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

Methods

sqlWith1 :: SqlSelect -> SQL -> SQL -> Materialized -> SqlSelect

SqlWith SqlUpdate Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

Methods

sqlWith1 :: SqlUpdate -> SQL -> SQL -> Materialized -> SqlUpdate

class SqlOrderBy a Source #

Minimal complete definition

sqlOrderBy1

class SqlGroupByHaving a Source #

Minimal complete definition

sqlGroupBy1, sqlHaving1

class SqlDistinct a Source #

Minimal complete definition

sqlDistinct1

data SqlCondition Source #

SqlCondition are clauses that are part of the WHERE block in SQL statements. Each statement has a list of conditions, all of them must be fulfilled. Sometimes we need to inspect internal structure of a condition. For now it seems that the only interesting case is EXISTS (SELECT ...), because that internal SELECT can have explainable clauses.

sqlOR :: SQL -> SQL -> SQL Source #

data AscDesc a Source #

AscDesc marks ORDER BY order as ascending or descending. Conversion to SQL adds DESC marker to descending and no marker to ascending order.

Constructors

Asc a 
Desc a 

Instances

Instances details
Show a => Show (AscDesc a) Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

Methods

showsPrec :: Int -> AscDesc a -> ShowS #

show :: AscDesc a -> String #

showList :: [AscDesc a] -> ShowS #

Eq a => Eq (AscDesc a) Source # 
Instance details

Defined in Database.PostgreSQL.PQTypes.SQL.Builder

Methods

(==) :: AscDesc a -> AscDesc a -> Bool #

(/=) :: AscDesc a -> AscDesc a -> Bool #