{-# LANGUAGE
DataKinds
, DeriveGeneric
, DerivingStrategies
, FlexibleContexts
, FlexibleInstances
, GADTs
, GeneralizedNewtypeDeriving
, KindSignatures
, LambdaCase
, MultiParamTypeClasses
, OverloadedStrings
, PatternSynonyms
, RankNTypes
, TypeOperators
#-}
module Squeal.PostgreSQL.Expression.Window
(
WindowDefinition (..)
, partitionBy
, WindowFunction (..)
, WindowArg (..)
, pattern Window
, pattern Windows
, WinFun0
, type (-#->)
, type (--#->)
, rank
, rowNumber
, denseRank
, percentRank
, cumeDist
, ntile
, lag
, lead
, firstValue
, lastValue
, nthValue
, unsafeWindowFunction1
, unsafeWindowFunctionN
) where
import Control.DeepSeq
import Data.ByteString (ByteString)
import qualified GHC.Generics as GHC
import qualified Generics.SOP as SOP
import Squeal.PostgreSQL.Type.Alias
import Squeal.PostgreSQL.Expression
import Squeal.PostgreSQL.Expression.Aggregate
import Squeal.PostgreSQL.Expression.Logic
import Squeal.PostgreSQL.Expression.Sort
import Squeal.PostgreSQL.Type.List
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Type.Schema
instance Aggregate (WindowArg grp) (WindowFunction grp) where
countStar = UnsafeWindowFunction "count(*)"
count = unsafeWindowFunction1 "count"
sum_ = unsafeWindowFunction1 "sum"
arrayAgg = unsafeWindowFunction1 "array_agg"
jsonAgg = unsafeWindowFunction1 "json_agg"
jsonbAgg = unsafeWindowFunction1 "jsonb_agg"
bitAnd = unsafeWindowFunction1 "bit_and"
bitOr = unsafeWindowFunction1 "bit_or"
boolAnd = unsafeWindowFunction1 "bool_and"
boolOr = unsafeWindowFunction1 "bool_or"
every = unsafeWindowFunction1 "every"
max_ = unsafeWindowFunction1 "max"
min_ = unsafeWindowFunction1 "min"
avg = unsafeWindowFunction1 "avg"
corr = unsafeWindowFunctionN "corr"
covarPop = unsafeWindowFunctionN "covar_pop"
covarSamp = unsafeWindowFunctionN "covar_samp"
regrAvgX = unsafeWindowFunctionN "regr_avgx"
regrAvgY = unsafeWindowFunctionN "regr_avgy"
regrCount = unsafeWindowFunctionN "regr_count"
regrIntercept = unsafeWindowFunctionN "regr_intercept"
regrR2 = unsafeWindowFunctionN "regr_r2"
regrSlope = unsafeWindowFunctionN "regr_slope"
regrSxx = unsafeWindowFunctionN "regr_sxx"
regrSxy = unsafeWindowFunctionN "regr_sxy"
regrSyy = unsafeWindowFunctionN "regr_syy"
stddev = unsafeWindowFunction1 "stddev"
stddevPop = unsafeWindowFunction1 "stddev_pop"
stddevSamp = unsafeWindowFunction1 "stddev_samp"
variance = unsafeWindowFunction1 "variance"
varPop = unsafeWindowFunction1 "var_pop"
varSamp = unsafeWindowFunction1 "var_samp"
data WindowDefinition grp lat with db params from where
WindowDefinition
:: SOP.SListI bys
=> NP (Expression grp lat with db params from) bys
-> [SortExpression grp lat with db params from]
-> WindowDefinition grp lat with db params from
instance OrderBy (WindowDefinition grp) grp where
orderBy sortsR (WindowDefinition parts sortsL)
= WindowDefinition parts (sortsL ++ sortsR)
instance RenderSQL (WindowDefinition lat with db from grp params) where
renderSQL (WindowDefinition part ord) =
renderPartitionByClause part <> renderSQL ord
where
renderPartitionByClause = \case
Nil -> ""
parts -> "PARTITION" <+> "BY" <+> renderCommaSeparated renderExpression parts
partitionBy
:: SOP.SListI bys
=> NP (Expression grp lat with db params from) bys
-> WindowDefinition grp lat with db params from
partitionBy bys = WindowDefinition bys []
newtype WindowFunction
(grp :: Grouping)
(lat :: FromType)
(with :: FromType)
(db :: SchemasType)
(params :: [NullType])
(from :: FromType)
(ty :: NullType)
= UnsafeWindowFunction { renderWindowFunction :: ByteString }
deriving stock (GHC.Generic,Show,Eq,Ord)
deriving newtype (NFData)
data WindowArg
(grp :: Grouping)
(args :: [NullType])
(lat :: FromType)
(with :: FromType)
(db :: SchemasType)
(params :: [NullType])
(from :: FromType)
= WindowArg
{ windowArgs :: NP (Expression grp lat with db params from) args
, windowFilter :: [Condition grp lat with db params from]
} deriving stock (GHC.Generic)
instance SOP.SListI args
=> RenderSQL (WindowArg grp args lat with db params from) where
renderSQL (WindowArg args filters) =
parenthesized (renderCommaSeparated renderSQL args)
& renderFilters filters
where
renderFilter wh = "FILTER" <+> parenthesized ("WHERE" <+> wh)
renderFilters = \case
[] -> id
wh:whs -> (<+> renderFilter (renderSQL (foldr (.&&) wh whs)))
instance FilterWhere (WindowArg grp) grp where
filterWhere wh (WindowArg args filters) = WindowArg args (wh : filters)
pattern Window
:: Expression grp lat with db params from arg
-> WindowArg grp '[arg] lat with db params from
pattern Window x = Windows (x :* Nil)
pattern Windows
:: NP (Expression grp lat with db params from) args
-> WindowArg grp args lat with db params from
pattern Windows xs = WindowArg xs []
instance RenderSQL (WindowFunction grp lat with db params from ty) where
renderSQL = renderWindowFunction
type WinFun0 x
= forall grp lat with db params from
. WindowFunction grp lat with db params from x
type (-#->) x y
= forall grp lat with db params from
. WindowArg grp '[x] lat with db params from
-> WindowFunction grp lat with db params from y
type (--#->) xs y
= forall grp lat with db params from
. WindowArg grp xs lat with db params from
-> WindowFunction grp lat with db params from y
unsafeWindowFunction1 :: ByteString -> x -#-> y
unsafeWindowFunction1 fun x
= UnsafeWindowFunction $ fun <> renderSQL x
unsafeWindowFunctionN :: SOP.SListI xs => ByteString -> xs --#-> y
unsafeWindowFunctionN fun xs = UnsafeWindowFunction $ fun <> renderSQL xs
rank :: WinFun0 ('NotNull 'PGint8)
rank = UnsafeWindowFunction "rank()"
rowNumber :: WinFun0 ('NotNull 'PGint8)
rowNumber = UnsafeWindowFunction "row_number()"
denseRank :: WinFun0 ('NotNull 'PGint8)
denseRank = UnsafeWindowFunction "dense_rank()"
percentRank :: WinFun0 ('NotNull 'PGfloat8)
percentRank = UnsafeWindowFunction "percent_rank()"
cumeDist :: WinFun0 ('NotNull 'PGfloat8)
cumeDist = UnsafeWindowFunction "cume_dist()"
ntile :: 'NotNull 'PGint4 -#-> 'NotNull 'PGint4
ntile = unsafeWindowFunction1 "ntile"
lag :: '[ty, 'NotNull 'PGint4, ty] --#-> ty
lag = unsafeWindowFunctionN "lag"
lead :: '[ty, 'NotNull 'PGint4, ty] --#-> ty
lead = unsafeWindowFunctionN "lead"
firstValue :: ty -#-> ty
firstValue = unsafeWindowFunction1 "first_value"
lastValue :: ty -#-> ty
lastValue = unsafeWindowFunction1 "last_value"
nthValue :: '[null ty, 'NotNull 'PGint4] --#-> 'Null ty
nthValue = unsafeWindowFunctionN "nth_value"