| Copyright | (c) Eitan Chatav 2017 |
|---|---|
| Maintainer | eitan@morphism.tech |
| Stability | experimental |
| Safe Haskell | None |
| Language | Haskell2010 |
Squeal.PostgreSQL.Query
Description
Squeal queries.
- newtype Query (schema :: TablesType) (params :: [NullityType]) (columns :: RelationType) = UnsafeQuery {}
- union :: Query schema params columns -> Query schema params columns -> Query schema params columns
- unionAll :: Query schema params columns -> Query schema params columns -> Query schema params columns
- intersect :: Query schema params columns -> Query schema params columns -> Query schema params columns
- intersectAll :: Query schema params columns -> Query schema params columns -> Query schema params columns
- except :: Query schema params columns -> Query schema params columns -> Query schema params columns
- exceptAll :: Query schema params columns -> Query schema params columns -> Query schema params columns
- select :: SListI columns => NP (Aliased (Expression relations grouping params)) (column ': columns) -> TableExpression schema params relations grouping -> Query schema params (column ': columns)
- selectDistinct :: SListI columns => NP (Aliased (Expression relations Ungrouped params)) (column ': columns) -> TableExpression schema params relations Ungrouped -> Query schema params (column ': columns)
- selectStar :: HasUnique relation relations columns => TableExpression schema params relations Ungrouped -> Query schema params columns
- selectDistinctStar :: HasUnique relation relations columns => TableExpression schema params relations Ungrouped -> Query schema params columns
- selectDotStar :: Has relation relations columns => Alias relation -> TableExpression schema params relations Ungrouped -> Query schema params columns
- selectDistinctDotStar :: Has relation relations columns => Alias relation -> TableExpression schema params relations Ungrouped -> Query schema params columns
- data TableExpression (schema :: TablesType) (params :: [NullityType]) (relations :: RelationsType) (grouping :: Grouping) = TableExpression {
- fromClause :: FromClause schema params relations
- whereClause :: [Condition relations Ungrouped params]
- groupByClause :: GroupByClause relations grouping
- havingClause :: HavingClause relations grouping params
- orderByClause :: [SortExpression relations grouping params]
- limitClause :: [Word64]
- offsetClause :: [Word64]
- renderTableExpression :: TableExpression schema params relations grouping -> ByteString
- from :: FromClause schema params relations -> TableExpression schema params relations Ungrouped
- where_ :: Condition relations Ungrouped params -> TableExpression schema params relations grouping -> TableExpression schema params relations grouping
- group :: SListI bys => NP (By relations) bys -> TableExpression schema params relations Ungrouped -> TableExpression schema params relations (Grouped bys)
- having :: Condition relations (Grouped bys) params -> TableExpression schema params relations (Grouped bys) -> TableExpression schema params relations (Grouped bys)
- orderBy :: [SortExpression relations grouping params] -> TableExpression schema params relations grouping -> TableExpression schema params relations grouping
- limit :: Word64 -> TableExpression schema params relations grouping -> TableExpression schema params relations grouping
- offset :: Word64 -> TableExpression schema params relations grouping -> TableExpression schema params relations grouping
- newtype FromClause schema params relations = UnsafeFromClause {}
- table :: Aliased (Table schema) table -> FromClause schema params '[table]
- subquery :: Aliased (Query schema params) table -> FromClause schema params '[table]
- crossJoin :: FromClause schema params right -> FromClause schema params left -> FromClause schema params (Join left right)
- innerJoin :: FromClause schema params right -> Condition (Join left right) Ungrouped params -> FromClause schema params left -> FromClause schema params (Join left right)
- leftOuterJoin :: FromClause schema params right -> Condition (Join left right) Ungrouped params -> FromClause schema params left -> FromClause schema params (Join left (NullifyRelations right))
- rightOuterJoin :: FromClause schema params right -> Condition (Join left right) Ungrouped params -> FromClause schema params left -> FromClause schema params (Join (NullifyRelations left) right)
- fullOuterJoin :: FromClause schema params right -> Condition (Join left right) Ungrouped params -> FromClause schema params left -> FromClause schema params (Join (NullifyRelations left) (NullifyRelations right))
- data By (relations :: RelationsType) (by :: (Symbol, Symbol)) where
- renderBy :: By relations by -> ByteString
- data GroupByClause relations grouping where
- NoGroups :: GroupByClause relations Ungrouped
- Group :: SListI bys => NP (By relations) bys -> GroupByClause relations (Grouped bys)
- renderGroupByClause :: GroupByClause relations grouping -> ByteString
- data HavingClause relations grouping params where
- NoHaving :: HavingClause relations Ungrouped params
- Having :: [Condition relations (Grouped bys) params] -> HavingClause relations (Grouped bys) params
- renderHavingClause :: HavingClause relations grouping params -> ByteString
- data SortExpression relations grouping params where
- Asc :: Expression relations grouping params (NotNull ty) -> SortExpression relations grouping params
- Desc :: Expression relations grouping params (NotNull ty) -> SortExpression relations grouping params
- AscNullsFirst :: Expression relations grouping params (Null ty) -> SortExpression relations grouping params
- AscNullsLast :: Expression relations grouping params (Null ty) -> SortExpression relations grouping params
- DescNullsFirst :: Expression relations grouping params (Null ty) -> SortExpression relations grouping params
- DescNullsLast :: Expression relations grouping params (Null ty) -> SortExpression relations grouping params
- renderSortExpression :: SortExpression relations grouping params -> ByteString
Queries
newtype Query (schema :: TablesType) (params :: [NullityType]) (columns :: RelationType) Source #
The process of retrieving or the command to retrieve data from a database
is called a Query. The select, selectStar, selectDotStar,
selectDistinct, selectDistinctStar and selectDistinctDotStar commands
are used to specify queries.
simple query:
>>>:{let query :: Query '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]] '[] '["col" ::: 'Null 'PGint4] query = selectStar (from (table (#tab `As` #t))) in renderQuery query :} "SELECT * FROM tab AS t"
restricted query:
>>>:{let query :: Query '[ "tab" ::: '[] :=> '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4 , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ]] '[] '[ "sum" ::: 'NotNull 'PGint4 , "col1" ::: 'NotNull 'PGint4 ] query = select ((#col1 + #col2) `As` #sum :* #col1 `As` #col1 :* Nil) ( from (table (#tab `As` #t)) & where_ (#col1 .> #col2) & where_ (#col2 .> 0) ) in renderQuery query :} "SELECT (col1 + col2) AS sum, col1 AS col1 FROM tab AS t WHERE ((col1 > col2) AND (col2 > 0))"
subquery:
>>>:{let query :: Query '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]] '[] '["col" ::: 'Null 'PGint4] query = selectStar (from (subquery (selectStar (from (table (#tab `As` #t))) `As` #sub))) in renderQuery query :} "SELECT * FROM (SELECT * FROM tab AS t) AS sub"
limits and offsets:
>>>:{let query :: Query '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]] '[] '["col" ::: 'Null 'PGint4] query = selectStar (from (table (#tab `As` #t)) & limit 100 & offset 2 & limit 50 & offset 2) in renderQuery query :} "SELECT * FROM tab AS t LIMIT 50 OFFSET 4"
parameterized query:
>>>:{let query :: Query '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGfloat8]] '[ 'NotNull 'PGfloat8] '["col" ::: 'NotNull 'PGfloat8] query = selectStar (from (table (#tab `As` #t)) & where_ (#col .> param @1)) in renderQuery query :} "SELECT * FROM tab AS t WHERE (col > ($1 :: float8))"
aggregation query:
>>>:{let query :: Query '[ "tab" ::: '[] :=> '[ "col1" ::: 'NoDef :=> 'NotNull 'PGint4 , "col2" ::: 'NoDef :=> 'NotNull 'PGint4 ]] '[] '[ "sum" ::: 'NotNull 'PGint4 , "col1" ::: 'NotNull 'PGint4 ] query = select (sum_ #col2 `As` #sum :* #col1 `As` #col1 :* Nil) ( from (table (#tab `As` #table1)) & group (By #col1 :* Nil) & having (#col1 + sum_ #col2 .> 1) ) in renderQuery query :} "SELECT sum(col2) AS sum, col1 AS col1 FROM tab AS table1 GROUP BY col1 HAVING ((col1 + sum(col2)) > 1)"
sorted query:
>>>:{let query :: Query '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]] '[] '["col" ::: 'Null 'PGint4] query = selectStar (from (table (#tab `As` #t)) & orderBy [#col & AscNullsFirst]) in renderQuery query :} "SELECT * FROM tab AS t ORDER BY col ASC NULLS FIRST"
joins:
>>>:set -XFlexibleContexts>>>:{let query :: Query '[ "orders" ::: '["pk_orders" ::: PrimaryKey '["id"] ,"fk_customers" ::: ForeignKey '["customer_id"] "customers" '["id"] ,"fk_shippers" ::: ForeignKey '["shipper_id"] "shippers" '["id"]] :=> '[ "id" ::: 'NoDef :=> 'NotNull 'PGint4 , "price" ::: 'NoDef :=> 'NotNull 'PGfloat4 , "customer_id" ::: 'NoDef :=> 'NotNull 'PGint4 , "shipper_id" ::: 'NoDef :=> 'NotNull 'PGint4 ] , "customers" ::: '["pk_customers" ::: PrimaryKey '["id"]] :=> '[ "id" ::: 'NoDef :=> 'NotNull 'PGint4 , "name" ::: 'NoDef :=> 'NotNull 'PGtext ] , "shippers" ::: '["pk_shippers" ::: PrimaryKey '["id"]] :=> '[ "id" ::: 'NoDef :=> 'NotNull 'PGint4 , "name" ::: 'NoDef :=> 'NotNull 'PGtext ] ] '[] '[ "order_price" ::: 'NotNull 'PGfloat4 , "customer_name" ::: 'NotNull 'PGtext , "shipper_name" ::: 'NotNull 'PGtext ] query = select ( #o ! #price `As` #order_price :* #c ! #name `As` #customer_name :* #s ! #name `As` #shipper_name :* Nil ) ( from (table (#orders `As` #o) & innerJoin (table (#customers `As` #c)) (#o ! #customer_id .== #c ! #id) & innerJoin (table (#shippers `As` #s)) (#o ! #shipper_id .== #s ! #id)) ) in renderQuery query :} "SELECT o.price AS order_price, c.name AS customer_name, s.name AS shipper_name FROM orders AS o INNER JOIN customers AS c ON (o.customer_id = c.id) INNER JOIN shippers AS s ON (o.shipper_id = s.id)"
self-join:
>>>:{let query :: Query '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]] '[] '["col" ::: 'Null 'PGint4] query = selectDotStar #t1 (from (table (#tab `As` #t1) & crossJoin (table (#tab `As` #t2)))) in renderQuery query :} "SELECT t1.* FROM tab AS t1 CROSS JOIN tab AS t2"
set operations:
>>>:{let query :: Query '["tab" ::: '[] :=> '["col" ::: 'NoDef :=> 'Null 'PGint4]] '[] '["col" ::: 'Null 'PGint4] query = selectStar (from (table (#tab `As` #t))) `unionAll` selectStar (from (table (#tab `As` #t))) in renderQuery query :} "(SELECT * FROM tab AS t) UNION ALL (SELECT * FROM tab AS t)"
Constructors
| UnsafeQuery | |
Fields | |
union :: Query schema params columns -> Query schema params columns -> Query schema params columns Source #
The results of two queries can be combined using the set operation
union. Duplicate rows are eliminated.
unionAll :: Query schema params columns -> Query schema params columns -> Query schema params columns Source #
The results of two queries can be combined using the set operation
unionAll, the disjoint union. Duplicate rows are retained.
intersect :: Query schema params columns -> Query schema params columns -> Query schema params columns Source #
The results of two queries can be combined using the set operation
intersect, the intersection. Duplicate rows are eliminated.
intersectAll :: Query schema params columns -> Query schema params columns -> Query schema params columns Source #
The results of two queries can be combined using the set operation
intersectAll, the intersection. Duplicate rows are retained.
except :: Query schema params columns -> Query schema params columns -> Query schema params columns Source #
The results of two queries can be combined using the set operation
except, the set difference. Duplicate rows are eliminated.
exceptAll :: Query schema params columns -> Query schema params columns -> Query schema params columns Source #
The results of two queries can be combined using the set operation
exceptAll, the set difference. Duplicate rows are retained.
Select
Arguments
| :: SListI columns | |
| => NP (Aliased (Expression relations grouping params)) (column ': columns) | select list |
| -> TableExpression schema params relations grouping | intermediate virtual table |
| -> Query schema params (column ': columns) |
the TableExpression in the select command constructs an intermediate
virtual table by possibly combining tables, views, eliminating rows,
grouping, etc. This table is finally passed on to processing by
the select list. The select list determines which columns of
the intermediate table are actually output.
Arguments
| :: SListI columns | |
| => NP (Aliased (Expression relations Ungrouped params)) (column ': columns) | select list |
| -> TableExpression schema params relations Ungrouped | intermediate virtual table |
| -> Query schema params (column ': columns) |
After the select list has been processed, the result table can
be subject to the elimination of duplicate rows using selectDistinct.
Arguments
| :: HasUnique relation relations columns | |
| => TableExpression schema params relations Ungrouped | intermediate virtual table |
| -> Query schema params columns |
The simplest kind of query is selectStar which emits all columns
that the table expression produces.
Arguments
| :: HasUnique relation relations columns | |
| => TableExpression schema params relations Ungrouped | intermediate virtual table |
| -> Query schema params columns |
A selectDistinctStar emits all columns that the table expression
produces and eliminates duplicate rows.
Arguments
| :: Has relation relations columns | |
| => Alias relation | particular virtual subtable |
| -> TableExpression schema params relations Ungrouped | intermediate virtual table |
| -> Query schema params columns |
When working with multiple tables, it can also be useful to ask
for all the columns of a particular table, using selectDotStar.
selectDistinctDotStar Source #
Arguments
| :: Has relation relations columns | |
| => Alias relation | particular virtual table |
| -> TableExpression schema params relations Ungrouped | intermediate virtual table |
| -> Query schema params columns |
A selectDistinctDotStar asks for all the columns of a particular table,
and eliminates duplicate rows.
Table Expressions
data TableExpression (schema :: TablesType) (params :: [NullityType]) (relations :: RelationsType) (grouping :: Grouping) Source #
A TableExpression computes a table. The table expression contains
a fromClause that is optionally followed by a whereClause,
groupByClause, havingClause, orderByClause, limitClause
and offsetClauses. Trivial table expressions simply refer
to a table on disk, a so-called base table, but more complex expressions
can be used to modify or combine base tables in various ways.
Constructors
| TableExpression | |
Fields
| |
renderTableExpression :: TableExpression schema params relations grouping -> ByteString Source #
Render a TableExpression
Arguments
| :: FromClause schema params relations | table reference |
| -> TableExpression schema params relations Ungrouped |
A from generates a TableExpression from a table reference that can be
a table name, or a derived table such as a subquery, a JOIN construct,
or complex combinations of these. A from may be transformed by where_,
group, having, orderBy, limit and offset, using the & operator
to match the left-to-right sequencing of their placement in SQL.
Arguments
| :: Condition relations Ungrouped params | filtering condition |
| -> TableExpression schema params relations grouping | |
| -> TableExpression schema params relations grouping |
A where_ is an endomorphism of TableExpressions which adds a
search condition to the whereClause.
Arguments
| :: SListI bys | |
| => NP (By relations) bys | grouped columns |
| -> TableExpression schema params relations Ungrouped | |
| -> TableExpression schema params relations (Grouped bys) |
A group is a transformation of TableExpressions which switches
its Grouping from Ungrouped to Grouped. Use group Nil to perform
a "grand total" aggregation query.
Arguments
| :: Condition relations (Grouped bys) params | having condition |
| -> TableExpression schema params relations (Grouped bys) | |
| -> TableExpression schema params relations (Grouped bys) |
A having is an endomorphism of TableExpressions which adds a
search condition to the havingClause.
Arguments
| :: [SortExpression relations grouping params] | sort expressions |
| -> TableExpression schema params relations grouping | |
| -> TableExpression schema params relations grouping |
An orderBy is an endomorphism of TableExpressions which appends an
ordering to the right of the orderByClause.
Arguments
| :: Word64 | limit parameter |
| -> TableExpression schema params relations grouping | |
| -> TableExpression schema params relations grouping |
A limit is an endomorphism of TableExpressions which adds to the
limitClause.
Arguments
| :: Word64 | offset parameter |
| -> TableExpression schema params relations grouping | |
| -> TableExpression schema params relations grouping |
An offset is an endomorphism of TableExpressions which adds to the
offsetClause.
From
newtype FromClause schema params relations Source #
A FromClause can be a table name, or a derived table such
as a subquery, a JOIN construct, or complex combinations of these.
Constructors
| UnsafeFromClause | |
Fields | |
Instances
| Eq (FromClause k1 k2 k3 schema params relations) Source # | |
| Ord (FromClause k1 k2 k3 schema params relations) Source # | |
| Show (FromClause k1 k2 k3 schema params relations) Source # | |
| Generic (FromClause k1 k2 k3 schema params relations) Source # | |
| NFData (FromClause k1 k2 k3 schema params relations) Source # | |
| type Rep (FromClause k1 k2 k3 schema params relations) Source # | |
table :: Aliased (Table schema) table -> FromClause schema params '[table] Source #
A real table is a table from the schema.
Arguments
| :: FromClause schema params right | right |
| -> FromClause schema params left | left |
| -> FromClause schema params (Join left right) |
left & crossJoin right. For every possible combination of rows from
left and right (i.e., a Cartesian product), the joined table will contain
a row consisting of all columns in left followed by all columns in right.
If the tables have n and m rows respectively, the joined table will
have n * m rows.
Arguments
| :: FromClause schema params right | right |
| -> Condition (Join left right) Ungrouped params |
|
| -> FromClause schema params left | left |
| -> FromClause schema params (Join left right) |
left & innerJoin right on. The joined table is filtered by
the on condition.
Arguments
| :: FromClause schema params right | right |
| -> Condition (Join left right) Ungrouped params |
|
| -> FromClause schema params left | left |
| -> FromClause schema params (Join left (NullifyRelations right)) |
left & leftOuterJoin right on. First, an inner join is performed.
Then, for each row in left that does not satisfy the on condition with
any row in right, a joined row is added with null values in columns of right.
Thus, the joined table always has at least one row for each row in left.
Arguments
| :: FromClause schema params right | right |
| -> Condition (Join left right) Ungrouped params |
|
| -> FromClause schema params left | left |
| -> FromClause schema params (Join (NullifyRelations left) right) |
left & rightOuterJoin right on. First, an inner join is performed.
Then, for each row in right that does not satisfy the on condition with
any row in left, a joined row is added with null values in columns of left.
This is the converse of a left join: the result table will always
have a row for each row in right.
Arguments
| :: FromClause schema params right | right |
| -> Condition (Join left right) Ungrouped params |
|
| -> FromClause schema params left | left |
| -> FromClause schema params (Join (NullifyRelations left) (NullifyRelations right)) |
left & fullOuterJoin right on. First, an inner join is performed.
Then, for each row in left that does not satisfy the on condition with
any row in right, a joined row is added with null values in columns of right.
Also, for each row of right that does not satisfy the join condition
with any row in left, a joined row with null values in the columns of left
is added.
Grouping
data By (relations :: RelationsType) (by :: (Symbol, Symbol)) where Source #
Bys are used in group to reference a list of columns which are then
used to group together those rows in a table that have the same values
in all the columns listed. By #col will reference an unambiguous
column col; otherwise By2 (#tab ! #col) will reference a table
qualified column tab.col.
data GroupByClause relations grouping where Source #
A GroupByClause indicates the Grouping of a TableExpression.
A NoGroups indicates Ungrouped while a Group indicates Grouped.
NoGroups is distinguised from Group Nil since no aggregation can be
done on NoGroups while all output Expressions must be aggregated
in Group Nil. In general, all output Expressions in the
complement of bys must be aggregated in Group bys.
Constructors
| NoGroups :: GroupByClause relations Ungrouped | |
| Group :: SListI bys => NP (By relations) bys -> GroupByClause relations (Grouped bys) |
renderGroupByClause :: GroupByClause relations grouping -> ByteString Source #
Renders a GroupByClause.
data HavingClause relations grouping params where Source #
A HavingClause is used to eliminate groups that are not of interest.
An Ungrouped TableExpression may only use NoHaving while a Grouped
TableExpression must use Having whose conditions are combined with
.&&.
Constructors
| NoHaving :: HavingClause relations Ungrouped params | |
| Having :: [Condition relations (Grouped bys) params] -> HavingClause relations (Grouped bys) params |
Instances
| Eq (HavingClause relations grouping params) Source # | |
| Ord (HavingClause relations grouping params) Source # | |
| Show (HavingClause relations grouping params) Source # | |
renderHavingClause :: HavingClause relations grouping params -> ByteString Source #
Render a HavingClause.
Sorting
data SortExpression relations grouping params where Source #
SortExpressions are used by sortBy to optionally sort the results
of a Query. Asc or Desc set the sort direction of a NotNull result
column to ascending or descending. Ascending order puts smaller values
first, where "smaller" is defined in terms of the .< operator. Similarly,
descending order is determined with the .> operator. AscNullsFirst,
AscNullsLast, DescNullsFirst and DescNullsLast options are used to
determine whether nulls appear before or after non-null values in the sort
ordering of a Null result column.
Constructors
| Asc :: Expression relations grouping params (NotNull ty) -> SortExpression relations grouping params | |
| Desc :: Expression relations grouping params (NotNull ty) -> SortExpression relations grouping params | |
| AscNullsFirst :: Expression relations grouping params (Null ty) -> SortExpression relations grouping params | |
| AscNullsLast :: Expression relations grouping params (Null ty) -> SortExpression relations grouping params | |
| DescNullsFirst :: Expression relations grouping params (Null ty) -> SortExpression relations grouping params | |
| DescNullsLast :: Expression relations grouping params (Null ty) -> SortExpression relations grouping params |
Instances
| Show (SortExpression relations grouping params) Source # | |
renderSortExpression :: SortExpression relations grouping params -> ByteString Source #
Render a SortExpression.