Safe Haskell | None |
---|---|
Language | Haskell2010 |
Perform aggregation on Select
s. To aggregate a Select
you
should construct an Aggregator
encoding how you want the
aggregation to proceed, then call aggregate
on it. The
Aggregator
should be constructed from the basic Aggregator
s
below by using the combining operations from
Data.Profunctor.Product.
Synopsis
- aggregate :: Aggregator a b -> Select a -> Select b
- aggregateOrdered :: Order a -> Aggregator a b -> Select a -> Select b
- distinctAggregator :: Aggregator a b -> Aggregator a b
- data Aggregator a b
- groupBy :: Aggregator (Column a) (Column a)
- sum :: Aggregator (Column a) (Column a)
- sumInt4 :: Aggregator (Column SqlInt4) (Column SqlInt8)
- sumInt8 :: Aggregator (Column SqlInt8) (Column SqlNumeric)
- count :: Aggregator (Column a) (Column SqlInt8)
- countStar :: Aggregator a (Column SqlInt8)
- avg :: Aggregator (Column SqlFloat8) (Column SqlFloat8)
- max :: SqlOrd a => Aggregator (Column a) (Column a)
- min :: SqlOrd a => Aggregator (Column a) (Column a)
- boolOr :: Aggregator (Column SqlBool) (Column SqlBool)
- boolAnd :: Aggregator (Column SqlBool) (Column SqlBool)
- arrayAgg :: Aggregator (Column a) (Column (SqlArray a))
- jsonAgg :: Aggregator (Column a) (Column SqlJson)
- stringAgg :: Column SqlText -> Aggregator (Column SqlText) (Column SqlText)
- countRows :: Select a -> Select (Column SqlInt8)
Aggregation
aggregate :: Aggregator a b -> Select a -> Select b Source #
Given a Select
producing rows of type a
and an Aggregator
accepting rows of
type a
, apply the aggregator to the select.
If you simply want to count the number of rows in a query you might
find the countRows
function more convenient.
If you want to use aggregate
with SelectArr
s then you should
compose it with laterally
:
laterally
.aggregate
::Aggregator
a b ->SelectArr
a b ->SelectArr
a b
Please note that when aggregating an empty query with no GROUP BY
clause, Opaleye's behaviour differs from Postgres's behaviour.
Postgres returns a single row whereas Opaleye returns zero rows.
Opaleye's behaviour is consistent with the meaning of aggregating
over groups of rows and Postgres's behaviour is inconsistent. When a
query has zero rows it has zero groups, and thus zero rows in the
result of an aggregation.
aggregateOrdered :: Order a -> Aggregator a b -> Select a -> Select b Source #
Order the values within each aggregation in Aggregator
using
the given ordering. This is only relevant for aggregations that
depend on the order they get their elements, like arrayAgg
and
stringAgg
.
Note that this orders all aggregations with the same ordering. If
you need different orderings for different aggregations, use
orderAggregate
.
distinctAggregator :: Aggregator a b -> Aggregator a b Source #
Aggregate only distinct values
data Aggregator a b Source #
An Aggregator
takes a collection of rows of type a
, groups
them, and transforms each group into a single row of type b
. This
corresponds to aggregators using GROUP BY
in SQL.
You should combine basic Aggregator
s into Aggregator
s on compound
types by using the operations in Data.Profunctor.Product.
An Aggregator
corresponds closely to a Fold
from the
foldl
package. Whereas an Aggregator
a
b
takes each group of
type a
to a single row of type b
, a Fold
a
b
takes a list of a
and returns a single value of type b
.
Instances
Basic Aggregator
s
groupBy :: Aggregator (Column a) (Column a) Source #
Group the aggregation by equality on the input to groupBy
.
sumInt8 :: Aggregator (Column SqlInt8) (Column SqlNumeric) Source #
count :: Aggregator (Column a) (Column SqlInt8) Source #
Count the number of non-null rows in a group.
countStar :: Aggregator a (Column SqlInt8) Source #
Count the number of rows in a group. This Aggregator
is named
countStar
after SQL's COUNT(*)
aggregation function.
jsonAgg :: Aggregator (Column a) (Column SqlJson) Source #
Aggregates values, including nulls, as a JSON array
An example usage:
import qualified Opaleye as O O.aggregate O.jsonAgg $ do (firstCol, secondCol) <- O.selectTable table6 return . O.jsonBuildObject $ O.jsonBuildObjectField "summary" firstCol <> O.jsonBuildObjectField "details" secondCol
The above query, when executed, will return JSON of the following form from postgres:
"[{\"summary\" : \"xy\", \"details\" : \"a\"}, {\"summary\" : \"z\", \"details\" : \"a\"}, {\"summary\" : \"more text\", \"details\" : \"a\"}]"