{-# LANGUAGE
DataKinds
, DeriveGeneric
, FlexibleContexts
, FlexibleInstances
, FunctionalDependencies
, LambdaCase
, MultiParamTypeClasses
, OverloadedStrings
, PatternSynonyms
, PolyKinds
, StandaloneDeriving
, TypeFamilies
, TypeOperators
, UndecidableInstances
#-}
module Squeal.PostgreSQL.Expression.Aggregate
(
Aggregate (..)
, AggregateArg (..)
, pattern All
, pattern Alls
, allNotNull
, pattern Distinct
, pattern Distincts
, distinctNotNull
, FilterWhere (..)
, PGSum
, PGAvg
) where
import Data.ByteString (ByteString)
import GHC.TypeLits
import qualified Generics.SOP as SOP
import Squeal.PostgreSQL.Type.Alias
import Squeal.PostgreSQL.Expression
import Squeal.PostgreSQL.Expression.Logic
import Squeal.PostgreSQL.Expression.Null
import Squeal.PostgreSQL.Expression.Sort
import Squeal.PostgreSQL.Type.List
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Type.Schema
class Aggregate arg expr | expr -> arg where
countStar :: expr lat with db params from ('NotNull 'PGint8)
count
:: arg '[ty] lat with db params from
-> expr lat with db params from ('NotNull 'PGint8)
sum_
:: arg '[null ty] lat with db params from
-> expr lat with db params from ('Null (PGSum ty))
arrayAgg
:: arg '[ty] lat with db params from
-> expr lat with db params from ('Null ('PGvararray ty))
jsonAgg
:: arg '[ty] lat with db params from
-> expr lat with db params from ('Null 'PGjson)
jsonbAgg
:: arg '[ty] lat with db params from
-> expr lat with db params from ('Null 'PGjsonb)
bitAnd
:: int `In` PGIntegral
=> arg '[null int] lat with db params from
-> expr lat with db params from ('Null int)
bitOr
:: int `In` PGIntegral
=> arg '[null int] lat with db params from
-> expr lat with db params from ('Null int)
boolAnd
:: arg '[null 'PGbool] lat with db params from
-> expr lat with db params from ('Null 'PGbool)
boolOr
:: arg '[null 'PGbool] lat with db params from
-> expr lat with db params from ('Null 'PGbool)
every
:: arg '[null 'PGbool] lat with db params from
-> expr lat with db params from ('Null 'PGbool)
max_
:: arg '[null ty] lat with db params from
-> expr lat with db params from ('Null ty)
min_
:: arg '[null ty] lat with db params from
-> expr lat with db params from ('Null ty)
avg
:: arg '[null ty] lat with db params from
-> expr lat with db params from ('Null (PGAvg ty))
corr
:: arg '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> expr lat with db params from ('Null 'PGfloat8)
covarPop
:: arg '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> expr lat with db params from ('Null 'PGfloat8)
covarSamp
:: arg '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> expr lat with db params from ('Null 'PGfloat8)
regrAvgX
:: arg '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> expr lat with db params from ('Null 'PGfloat8)
regrAvgY
:: arg '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> expr lat with db params from ('Null 'PGfloat8)
regrCount
:: arg '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> expr lat with db params from ('Null 'PGint8)
regrIntercept
:: arg '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> expr lat with db params from ('Null 'PGfloat8)
regrR2
:: arg '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> expr lat with db params from ('Null 'PGfloat8)
regrSlope
:: arg '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> expr lat with db params from ('Null 'PGfloat8)
regrSxx
:: arg '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> expr lat with db params from ('Null 'PGfloat8)
regrSxy
:: arg '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> expr lat with db params from ('Null 'PGfloat8)
regrSyy
:: arg '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> expr lat with db params from ('Null 'PGfloat8)
stddev
:: arg '[null ty] lat with db params from
-> expr lat with db params from ('Null (PGAvg ty))
stddevPop
:: arg '[null ty] lat with db params from
-> expr lat with db params from ('Null (PGAvg ty))
stddevSamp
:: arg '[null ty] lat with db params from
-> expr lat with db params from ('Null (PGAvg ty))
variance
:: arg '[null ty] lat with db params from
-> expr lat with db params from ('Null (PGAvg ty))
varPop
:: arg '[null ty] lat with db params from
-> expr lat with db params from ('Null (PGAvg ty))
varSamp
:: arg '[null ty] lat with db params from
-> expr lat with db params from ('Null (PGAvg ty))
data AggregateArg
(xs :: [NullType])
(lat :: FromType)
(with :: FromType)
(db :: SchemasType)
(params :: [NullType])
(from :: FromType)
= AggregateAll
{ aggregateArgs :: NP (Expression 'Ungrouped lat with db params from) xs
, aggregateOrder :: [SortExpression 'Ungrouped lat with db params from]
, aggregateFilter :: [Condition 'Ungrouped lat with db params from] }
| AggregateDistinct
{ aggregateArgs :: NP (Expression 'Ungrouped lat with db params from) xs
, aggregateOrder :: [SortExpression 'Ungrouped lat with db params from]
, aggregateFilter :: [Condition 'Ungrouped lat with db params from] }
instance SOP.SListI xs => RenderSQL (AggregateArg xs lat with db params from) where
renderSQL = \case
AggregateAll args sorts filters ->
parenthesized
("ALL" <+> renderCommaSeparated renderSQL args<> renderSQL sorts)
<> renderFilters filters
AggregateDistinct args sorts filters ->
parenthesized
("DISTINCT" <+> renderCommaSeparated renderSQL args <> renderSQL sorts)
<> renderFilters filters
where
renderFilter wh = "FILTER" <+> parenthesized ("WHERE" <+> wh)
renderFilters = \case
[] -> ""
wh:whs -> " " <> renderFilter (renderSQL (foldr (.&&) wh whs))
instance OrderBy (AggregateArg xs) 'Ungrouped where
orderBy sorts1 = \case
AggregateAll xs sorts0 whs -> AggregateAll xs (sorts0 ++ sorts1) whs
AggregateDistinct xs sorts0 whs -> AggregateDistinct xs (sorts0 ++ sorts1) whs
pattern All
:: Expression 'Ungrouped lat with db params from x
-> AggregateArg '[x] lat with db params from
pattern All x = Alls (x :* Nil)
pattern Alls
:: NP (Expression 'Ungrouped lat with db params from) xs
-> AggregateArg xs lat with db params from
pattern Alls xs = AggregateAll xs [] []
allNotNull
:: Expression 'Ungrouped lat with db params from ('Null x)
-> AggregateArg '[ 'NotNull x] lat with db params from
allNotNull x = All (unsafeNotNull x) & filterWhere (not_ (isNull x))
pattern Distinct
:: Expression 'Ungrouped lat with db params from x
-> AggregateArg '[x] lat with db params from
pattern Distinct x = Distincts (x :* Nil)
pattern Distincts
:: NP (Expression 'Ungrouped lat with db params from) xs
-> AggregateArg xs lat with db params from
pattern Distincts xs = AggregateDistinct xs [] []
distinctNotNull
:: Expression 'Ungrouped lat with db params from ('Null x)
-> AggregateArg '[ 'NotNull x] lat with db params from
distinctNotNull x = Distinct (unsafeNotNull x) & filterWhere (not_ (isNull x))
class FilterWhere arg grp | arg -> grp where
filterWhere
:: Condition grp lat with db params from
-> arg xs lat with db params from
-> arg xs lat with db params from
instance FilterWhere AggregateArg 'Ungrouped where
filterWhere wh = \case
AggregateAll xs sorts whs -> AggregateAll xs sorts (wh : whs)
AggregateDistinct xs sorts whs -> AggregateDistinct xs sorts (wh : whs)
instance Aggregate AggregateArg (Expression ('Grouped bys)) where
countStar = UnsafeExpression "count(*)"
count = unsafeAggregate "count"
sum_ = unsafeAggregate "sum"
arrayAgg = unsafeAggregate "array_agg"
jsonAgg = unsafeAggregate "json_agg"
jsonbAgg = unsafeAggregate "jsonb_agg"
bitAnd = unsafeAggregate "bit_and"
bitOr = unsafeAggregate "bit_or"
boolAnd = unsafeAggregate "bool_and"
boolOr = unsafeAggregate "bool_or"
every = unsafeAggregate "every"
max_ = unsafeAggregate "max"
min_ = unsafeAggregate "min"
avg = unsafeAggregate "avg"
corr = unsafeAggregate "corr"
covarPop = unsafeAggregate "covar_pop"
covarSamp = unsafeAggregate "covar_samp"
regrAvgX = unsafeAggregate "regr_avgx"
regrAvgY = unsafeAggregate "regr_avgy"
regrCount = unsafeAggregate "regr_count"
regrIntercept = unsafeAggregate "regr_intercept"
regrR2 = unsafeAggregate "regr_r2"
regrSlope = unsafeAggregate "regr_slope"
regrSxx = unsafeAggregate "regr_sxx"
regrSxy = unsafeAggregate "regr_sxy"
regrSyy = unsafeAggregate "regr_syy"
stddev = unsafeAggregate "stddev"
stddevPop = unsafeAggregate "stddev_pop"
stddevSamp = unsafeAggregate "stddev_samp"
variance = unsafeAggregate "variance"
varPop = unsafeAggregate "var_pop"
varSamp = unsafeAggregate "var_samp"
unsafeAggregate
:: SOP.SListI xs
=> ByteString
-> AggregateArg xs lat with db params from
-> Expression ('Grouped bys) lat with db params from y
unsafeAggregate fun xs = UnsafeExpression $ fun <> renderSQL xs
type family PGSum ty where
PGSum 'PGint2 = 'PGint8
PGSum 'PGint4 = 'PGint8
PGSum 'PGint8 = 'PGnumeric
PGSum 'PGfloat4 = 'PGfloat4
PGSum 'PGfloat8 = 'PGfloat8
PGSum 'PGnumeric = 'PGnumeric
PGSum 'PGinterval = 'PGinterval
PGSum 'PGmoney = 'PGmoney
PGSum pg = TypeError
( 'Text "Squeal type error: Cannot sum with argument type "
':<>: 'ShowType pg )
type family PGAvg ty where
PGAvg 'PGint2 = 'PGnumeric
PGAvg 'PGint4 = 'PGnumeric
PGAvg 'PGint8 = 'PGnumeric
PGAvg 'PGnumeric = 'PGnumeric
PGAvg 'PGfloat4 = 'PGfloat8
PGAvg 'PGfloat8 = 'PGfloat8
PGAvg 'PGinterval = 'PGinterval
PGAvg pg = TypeError
('Text "Squeal type error: No average for " ':<>: 'ShowType pg)