{-|
Module: Squeal.PostgreSQL.Expression.Window
Description: window functions, arguments and definitions
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

window functions, arguments and definitions
-}

{-# LANGUAGE
    DataKinds
  , DeriveGeneric
  , DerivingStrategies
  , FlexibleContexts
  , FlexibleInstances
  , GADTs
  , GeneralizedNewtypeDeriving
  , KindSignatures
  , LambdaCase
  , MultiParamTypeClasses
  , OverloadedStrings
  , PatternSynonyms
  , RankNTypes
  , ScopedTypeVariables
  , TypeApplications
  , TypeOperators
  , UndecidableInstances
#-}

module Squeal.PostgreSQL.Expression.Window
  ( -- * Window Definition
    WindowDefinition (..)
  , partitionBy
    -- * Window Function
    -- ** Types
  , WindowFunction (..)
  , WindowArg (..)
  , pattern Window
  , pattern Windows
  , WinFun0
  , type (-#->)
  , type (--#->)
    -- ** Functions
  , 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 :: WindowFunction grp lat with db params from ('NotNull 'PGint8)
countStar = ByteString
-> WindowFunction grp lat with db params from ('NotNull 'PGint8)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> WindowFunction grp lat with db params from ty
UnsafeWindowFunction ByteString
"count(*)"
  count :: WindowArg grp '[ty] lat with db params from
-> WindowFunction grp lat with db params from ('NotNull 'PGint8)
count = ByteString -> ty -#-> 'NotNull 'PGint8
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"count"
  sum_ :: WindowArg grp '[null ty] lat with db params from
-> WindowFunction grp lat with db params from ('Null (PGSum ty))
sum_ = ByteString -> null ty -#-> 'Null (PGSum ty)
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"sum"
  arrayAgg :: WindowArg grp '[ty] lat with db params from
-> WindowFunction
     grp lat with db params from ('Null ('PGvararray ty))
arrayAgg = ByteString -> ty -#-> 'Null ('PGvararray ty)
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"array_agg"
  jsonAgg :: WindowArg grp '[ty] lat with db params from
-> WindowFunction grp lat with db params from ('Null 'PGjson)
jsonAgg = ByteString -> ty -#-> 'Null 'PGjson
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"json_agg"
  jsonbAgg :: WindowArg grp '[ty] lat with db params from
-> WindowFunction grp lat with db params from ('Null 'PGjsonb)
jsonbAgg = ByteString -> ty -#-> 'Null 'PGjsonb
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"jsonb_agg"
  bitAnd :: WindowArg grp '[null int] lat with db params from
-> WindowFunction grp lat with db params from ('Null int)
bitAnd = ByteString -> null int -#-> 'Null int
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"bit_and"
  bitOr :: WindowArg grp '[null int] lat with db params from
-> WindowFunction grp lat with db params from ('Null int)
bitOr = ByteString -> null int -#-> 'Null int
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"bit_or"
  boolAnd :: WindowArg grp '[null 'PGbool] lat with db params from
-> WindowFunction grp lat with db params from ('Null 'PGbool)
boolAnd = ByteString -> null 'PGbool -#-> 'Null 'PGbool
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"bool_and"
  boolOr :: WindowArg grp '[null 'PGbool] lat with db params from
-> WindowFunction grp lat with db params from ('Null 'PGbool)
boolOr = ByteString -> null 'PGbool -#-> 'Null 'PGbool
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"bool_or"
  every :: WindowArg grp '[null 'PGbool] lat with db params from
-> WindowFunction grp lat with db params from ('Null 'PGbool)
every = ByteString -> null 'PGbool -#-> 'Null 'PGbool
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"every"
  max_ :: WindowArg grp '[null ty] lat with db params from
-> WindowFunction grp lat with db params from ('Null ty)
max_ = ByteString -> null ty -#-> 'Null ty
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"max"
  min_ :: WindowArg grp '[null ty] lat with db params from
-> WindowFunction grp lat with db params from ('Null ty)
min_ = ByteString -> null ty -#-> 'Null ty
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"min"
  avg :: WindowArg grp '[null ty] lat with db params from
-> WindowFunction grp lat with db params from ('Null (PGAvg ty))
avg = ByteString -> null ty -#-> 'Null (PGAvg ty)
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"avg"
  corr :: WindowArg
  grp '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> WindowFunction grp lat with db params from ('Null 'PGfloat8)
corr = ByteString
-> '[null 'PGfloat8, null 'PGfloat8] --#-> 'Null 'PGfloat8
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs --#-> y
unsafeWindowFunctionN ByteString
"corr"
  covarPop :: WindowArg
  grp '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> WindowFunction grp lat with db params from ('Null 'PGfloat8)
covarPop = ByteString
-> '[null 'PGfloat8, null 'PGfloat8] --#-> 'Null 'PGfloat8
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs --#-> y
unsafeWindowFunctionN ByteString
"covar_pop"
  covarSamp :: WindowArg
  grp '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> WindowFunction grp lat with db params from ('Null 'PGfloat8)
covarSamp = ByteString
-> '[null 'PGfloat8, null 'PGfloat8] --#-> 'Null 'PGfloat8
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs --#-> y
unsafeWindowFunctionN ByteString
"covar_samp"
  regrAvgX :: WindowArg
  grp '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> WindowFunction grp lat with db params from ('Null 'PGfloat8)
regrAvgX = ByteString
-> '[null 'PGfloat8, null 'PGfloat8] --#-> 'Null 'PGfloat8
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs --#-> y
unsafeWindowFunctionN ByteString
"regr_avgx"
  regrAvgY :: WindowArg
  grp '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> WindowFunction grp lat with db params from ('Null 'PGfloat8)
regrAvgY = ByteString
-> '[null 'PGfloat8, null 'PGfloat8] --#-> 'Null 'PGfloat8
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs --#-> y
unsafeWindowFunctionN ByteString
"regr_avgy"
  regrCount :: WindowArg
  grp '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> WindowFunction grp lat with db params from ('Null 'PGint8)
regrCount = ByteString -> '[null 'PGfloat8, null 'PGfloat8] --#-> 'Null 'PGint8
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs --#-> y
unsafeWindowFunctionN ByteString
"regr_count"
  regrIntercept :: WindowArg
  grp '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> WindowFunction grp lat with db params from ('Null 'PGfloat8)
regrIntercept = ByteString
-> '[null 'PGfloat8, null 'PGfloat8] --#-> 'Null 'PGfloat8
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs --#-> y
unsafeWindowFunctionN ByteString
"regr_intercept"
  regrR2 :: WindowArg
  grp '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> WindowFunction grp lat with db params from ('Null 'PGfloat8)
regrR2 = ByteString
-> '[null 'PGfloat8, null 'PGfloat8] --#-> 'Null 'PGfloat8
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs --#-> y
unsafeWindowFunctionN ByteString
"regr_r2"
  regrSlope :: WindowArg
  grp '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> WindowFunction grp lat with db params from ('Null 'PGfloat8)
regrSlope = ByteString
-> '[null 'PGfloat8, null 'PGfloat8] --#-> 'Null 'PGfloat8
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs --#-> y
unsafeWindowFunctionN ByteString
"regr_slope"
  regrSxx :: WindowArg
  grp '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> WindowFunction grp lat with db params from ('Null 'PGfloat8)
regrSxx = ByteString
-> '[null 'PGfloat8, null 'PGfloat8] --#-> 'Null 'PGfloat8
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs --#-> y
unsafeWindowFunctionN ByteString
"regr_sxx"
  regrSxy :: WindowArg
  grp '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> WindowFunction grp lat with db params from ('Null 'PGfloat8)
regrSxy = ByteString
-> '[null 'PGfloat8, null 'PGfloat8] --#-> 'Null 'PGfloat8
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs --#-> y
unsafeWindowFunctionN ByteString
"regr_sxy"
  regrSyy :: WindowArg
  grp '[null 'PGfloat8, null 'PGfloat8] lat with db params from
-> WindowFunction grp lat with db params from ('Null 'PGfloat8)
regrSyy = ByteString
-> '[null 'PGfloat8, null 'PGfloat8] --#-> 'Null 'PGfloat8
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs --#-> y
unsafeWindowFunctionN ByteString
"regr_syy"
  stddev :: WindowArg grp '[null ty] lat with db params from
-> WindowFunction grp lat with db params from ('Null (PGAvg ty))
stddev = ByteString -> null ty -#-> 'Null (PGAvg ty)
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"stddev"
  stddevPop :: WindowArg grp '[null ty] lat with db params from
-> WindowFunction grp lat with db params from ('Null (PGAvg ty))
stddevPop = ByteString -> null ty -#-> 'Null (PGAvg ty)
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"stddev_pop"
  stddevSamp :: WindowArg grp '[null ty] lat with db params from
-> WindowFunction grp lat with db params from ('Null (PGAvg ty))
stddevSamp = ByteString -> null ty -#-> 'Null (PGAvg ty)
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"stddev_samp"
  variance :: WindowArg grp '[null ty] lat with db params from
-> WindowFunction grp lat with db params from ('Null (PGAvg ty))
variance = ByteString -> null ty -#-> 'Null (PGAvg ty)
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"variance"
  varPop :: WindowArg grp '[null ty] lat with db params from
-> WindowFunction grp lat with db params from ('Null (PGAvg ty))
varPop = ByteString -> null ty -#-> 'Null (PGAvg ty)
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"var_pop"
  varSamp :: WindowArg grp '[null ty] lat with db params from
-> WindowFunction grp lat with db params from ('Null (PGAvg ty))
varSamp = ByteString -> null ty -#-> 'Null (PGAvg ty)
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"var_samp"

-- | A `WindowDefinition` is a set of table rows that are somehow related
-- to the current row
data WindowDefinition grp lat with db params from where
  WindowDefinition
    :: SOP.SListI bys
    => NP (Expression grp lat with db params from) bys
       -- ^ `partitionBy` clause
    -> [SortExpression grp lat with db params from]
       -- ^ `Squeal.PostgreSQL.Expression.Sort.orderBy` clause
    -> WindowDefinition grp lat with db params from

instance OrderBy (WindowDefinition grp) grp where
  orderBy :: [SortExpression grp lat with db params from]
-> WindowDefinition grp lat with db params from
-> WindowDefinition grp lat with db params from
orderBy [SortExpression grp lat with db params from]
sortsR (WindowDefinition NP (Expression grp lat with db params from) bys
parts [SortExpression grp lat with db params from]
sortsL)
    = NP (Expression grp lat with db params from) bys
-> [SortExpression grp lat with db params from]
-> WindowDefinition grp lat with db params from
forall (bys :: [NullType]) (grp :: Grouping) (lat :: FromType)
       (with :: FromType) (db :: SchemasType) (params :: [NullType])
       (from :: FromType).
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
WindowDefinition NP (Expression grp lat with db params from) bys
parts ([SortExpression grp lat with db params from]
sortsL [SortExpression grp lat with db params from]
-> [SortExpression grp lat with db params from]
-> [SortExpression grp lat with db params from]
forall a. [a] -> [a] -> [a]
++ [SortExpression grp lat with db params from]
sortsR)

instance RenderSQL (WindowDefinition grp lat with db params from) where
  renderSQL :: WindowDefinition grp lat with db params from -> ByteString
renderSQL (WindowDefinition NP (Expression grp lat with db params from) bys
part [SortExpression grp lat with db params from]
ord) =
    NP (Expression grp lat with db params from) bys -> ByteString
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType).
NP (Expression grp lat with db params from) bys -> ByteString
renderPartitionByClause NP (Expression grp lat with db params from) bys
part ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [SortExpression grp lat with db params from] -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL [SortExpression grp lat with db params from]
ord
    where
      renderPartitionByClause :: NP (Expression grp lat with db params from) bys -> ByteString
renderPartitionByClause = \case
        NP (Expression grp lat with db params from) bys
Nil -> ByteString
""
        NP (Expression grp lat with db params from) bys
parts -> ByteString
"PARTITION" ByteString -> ByteString -> ByteString
<+> ByteString
"BY" ByteString -> ByteString -> ByteString
<+> (forall (x :: NullType).
 Expression grp lat with db params from x -> ByteString)
-> NP (Expression grp lat with db params from) bys -> ByteString
forall k (xs :: [k]) (expression :: k -> *).
SListI xs =>
(forall (x :: k). expression x -> ByteString)
-> NP expression xs -> ByteString
renderCommaSeparated forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
Expression grp lat with db params from ty -> ByteString
forall (x :: NullType).
Expression grp lat with db params from x -> ByteString
renderExpression NP (Expression grp lat with db params from) bys
parts

{- |
The `partitionBy` clause within `Squeal.PostgreSQL.Query.Over` divides the rows into groups,
or partitions, that share the same values of the `partitionBy` `Expression`(s).
For each row, the window function is computed across the rows that fall into
the same partition as the current row.
-}
partitionBy
  :: SOP.SListI bys
  => NP (Expression grp lat with db params from) bys -- ^ partitions
  -> WindowDefinition grp lat with db params from
partitionBy :: NP (Expression grp lat with db params from) bys
-> WindowDefinition grp lat with db params from
partitionBy NP (Expression grp lat with db params from) bys
bys = NP (Expression grp lat with db params from) bys
-> [SortExpression grp lat with db params from]
-> WindowDefinition grp lat with db params from
forall (bys :: [NullType]) (grp :: Grouping) (lat :: FromType)
       (with :: FromType) (db :: SchemasType) (params :: [NullType])
       (from :: FromType).
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
WindowDefinition NP (Expression grp lat with db params from) bys
bys []

{- |
A window function performs a calculation across a set of table rows
that are somehow related to the current row. This is comparable to the type
of calculation that can be done with an aggregate function.
However, window functions do not cause rows to become grouped into a single
output row like non-window aggregate calls would.
Instead, the rows retain their separate identities.
Behind the scenes, the window function is able to access more than
just the current row of the query result.
-}
newtype WindowFunction
  (grp :: Grouping)
  (lat :: FromType)
  (with :: FromType)
  (db :: SchemasType)
  (params :: [NullType])
  (from :: FromType)
  (ty :: NullType)
    = UnsafeWindowFunction { WindowFunction grp lat with db params from ty -> ByteString
renderWindowFunction :: ByteString }
    deriving stock ((forall x.
 WindowFunction grp lat with db params from ty
 -> Rep (WindowFunction grp lat with db params from ty) x)
-> (forall x.
    Rep (WindowFunction grp lat with db params from ty) x
    -> WindowFunction grp lat with db params from ty)
-> Generic (WindowFunction grp lat with db params from ty)
forall x.
Rep (WindowFunction grp lat with db params from ty) x
-> WindowFunction grp lat with db params from ty
forall x.
WindowFunction grp lat with db params from ty
-> Rep (WindowFunction grp lat with db params from ty) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType) x.
Rep (WindowFunction grp lat with db params from ty) x
-> WindowFunction grp lat with db params from ty
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType) x.
WindowFunction grp lat with db params from ty
-> Rep (WindowFunction grp lat with db params from ty) x
$cto :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType) x.
Rep (WindowFunction grp lat with db params from ty) x
-> WindowFunction grp lat with db params from ty
$cfrom :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType) x.
WindowFunction grp lat with db params from ty
-> Rep (WindowFunction grp lat with db params from ty) x
GHC.Generic,Int -> WindowFunction grp lat with db params from ty -> ShowS
[WindowFunction grp lat with db params from ty] -> ShowS
WindowFunction grp lat with db params from ty -> String
(Int -> WindowFunction grp lat with db params from ty -> ShowS)
-> (WindowFunction grp lat with db params from ty -> String)
-> ([WindowFunction grp lat with db params from ty] -> ShowS)
-> Show (WindowFunction grp lat with db params from ty)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
Int -> WindowFunction grp lat with db params from ty -> ShowS
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
[WindowFunction grp lat with db params from ty] -> ShowS
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty -> String
showList :: [WindowFunction grp lat with db params from ty] -> ShowS
$cshowList :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
[WindowFunction grp lat with db params from ty] -> ShowS
show :: WindowFunction grp lat with db params from ty -> String
$cshow :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty -> String
showsPrec :: Int -> WindowFunction grp lat with db params from ty -> ShowS
$cshowsPrec :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
Int -> WindowFunction grp lat with db params from ty -> ShowS
Show,WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Bool
(WindowFunction grp lat with db params from ty
 -> WindowFunction grp lat with db params from ty -> Bool)
-> (WindowFunction grp lat with db params from ty
    -> WindowFunction grp lat with db params from ty -> Bool)
-> Eq (WindowFunction grp lat with db params from ty)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Bool
/= :: WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Bool
$c/= :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Bool
== :: WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Bool
$c== :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Bool
Eq,Eq (WindowFunction grp lat with db params from ty)
Eq (WindowFunction grp lat with db params from ty)
-> (WindowFunction grp lat with db params from ty
    -> WindowFunction grp lat with db params from ty -> Ordering)
-> (WindowFunction grp lat with db params from ty
    -> WindowFunction grp lat with db params from ty -> Bool)
-> (WindowFunction grp lat with db params from ty
    -> WindowFunction grp lat with db params from ty -> Bool)
-> (WindowFunction grp lat with db params from ty
    -> WindowFunction grp lat with db params from ty -> Bool)
-> (WindowFunction grp lat with db params from ty
    -> WindowFunction grp lat with db params from ty -> Bool)
-> (WindowFunction grp lat with db params from ty
    -> WindowFunction grp lat with db params from ty
    -> WindowFunction grp lat with db params from ty)
-> (WindowFunction grp lat with db params from ty
    -> WindowFunction grp lat with db params from ty
    -> WindowFunction grp lat with db params from ty)
-> Ord (WindowFunction grp lat with db params from ty)
WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Bool
WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Ordering
WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
Eq (WindowFunction grp lat with db params from ty)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Bool
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Ordering
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty
min :: WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty
$cmin :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty
max :: WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty
$cmax :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty
>= :: WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Bool
$c>= :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Bool
> :: WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Bool
$c> :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Bool
<= :: WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Bool
$c<= :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Bool
< :: WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Bool
$c< :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Bool
compare :: WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Ordering
$ccompare :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty
-> WindowFunction grp lat with db params from ty -> Ordering
$cp1Ord :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
Eq (WindowFunction grp lat with db params from ty)
Ord)
    deriving newtype (WindowFunction grp lat with db params from ty -> ()
(WindowFunction grp lat with db params from ty -> ())
-> NFData (WindowFunction grp lat with db params from ty)
forall a. (a -> ()) -> NFData a
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty -> ()
rnf :: WindowFunction grp lat with db params from ty -> ()
$crnf :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty -> ()
NFData)

{- |
`WindowArg`s are used for the input of `WindowFunction`s.
-}
data WindowArg
  (grp :: Grouping)
  (args :: [NullType])
  (lat :: FromType)
  (with :: FromType)
  (db :: SchemasType)
  (params :: [NullType])
  (from :: FromType)
    = WindowArg
    { WindowArg grp args lat with db params from
-> NP (Expression grp lat with db params from) args
windowArgs :: NP (Expression grp lat with db params from) args
      -- ^ `Window` or `Windows`
    , WindowArg grp args lat with db params from
-> [Condition grp lat with db params from]
windowFilter :: [Condition grp lat with db params from]
      -- ^ `filterWhere`
    } deriving stock ((forall x.
 WindowArg grp args lat with db params from
 -> Rep (WindowArg grp args lat with db params from) x)
-> (forall x.
    Rep (WindowArg grp args lat with db params from) x
    -> WindowArg grp args lat with db params from)
-> Generic (WindowArg grp args lat with db params from)
forall x.
Rep (WindowArg grp args lat with db params from) x
-> WindowArg grp args lat with db params from
forall x.
WindowArg grp args lat with db params from
-> Rep (WindowArg grp args lat with db params from) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (grp :: Grouping) (args :: [NullType]) (lat :: FromType)
       (with :: FromType) (db :: SchemasType) (params :: [NullType])
       (from :: FromType) x.
Rep (WindowArg grp args lat with db params from) x
-> WindowArg grp args lat with db params from
forall (grp :: Grouping) (args :: [NullType]) (lat :: FromType)
       (with :: FromType) (db :: SchemasType) (params :: [NullType])
       (from :: FromType) x.
WindowArg grp args lat with db params from
-> Rep (WindowArg grp args lat with db params from) x
$cto :: forall (grp :: Grouping) (args :: [NullType]) (lat :: FromType)
       (with :: FromType) (db :: SchemasType) (params :: [NullType])
       (from :: FromType) x.
Rep (WindowArg grp args lat with db params from) x
-> WindowArg grp args lat with db params from
$cfrom :: forall (grp :: Grouping) (args :: [NullType]) (lat :: FromType)
       (with :: FromType) (db :: SchemasType) (params :: [NullType])
       (from :: FromType) x.
WindowArg grp args lat with db params from
-> Rep (WindowArg grp args lat with db params from) x
GHC.Generic)

instance (HasUnique tab (Join from lat) row, Has col row ty)
  => IsLabel col (WindowArg 'Ungrouped '[ty] lat with db params from) where
    fromLabel :: WindowArg 'Ungrouped '[ty] lat with db params from
fromLabel = Expression 'Ungrouped lat with db params from ty
-> WindowArg 'Ungrouped '[ty] lat with db params from
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (arg :: NullType).
Expression grp lat with db params from arg
-> WindowArg grp '[arg] lat with db params from
Window (forall a. IsLabel col a => a
forall (x :: Symbol) a. IsLabel x a => a
fromLabel @col)
instance (Has tab (Join from lat) row, Has col row ty)
  => IsQualified tab col (WindowArg 'Ungrouped '[ty] lat with db params from) where
    Alias tab
tab ! :: Alias tab
-> Alias col -> WindowArg 'Ungrouped '[ty] lat with db params from
! Alias col
col = Expression 'Ungrouped lat with db params from ty
-> WindowArg 'Ungrouped '[ty] lat with db params from
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (arg :: NullType).
Expression grp lat with db params from arg
-> WindowArg grp '[arg] lat with db params from
Window (Alias tab
tab Alias tab
-> Alias col -> Expression 'Ungrouped lat with db params from ty
forall (qualifier :: Symbol) (alias :: Symbol) expression.
IsQualified qualifier alias expression =>
Alias qualifier -> Alias alias -> expression
! Alias col
col)
instance (HasUnique tab (Join from lat) row, Has col row ty, GroupedBy tab col bys)
  => IsLabel col (WindowArg ('Grouped bys) '[ty] lat with db params from) where
    fromLabel :: WindowArg ('Grouped bys) '[ty] lat with db params from
fromLabel = Expression ('Grouped bys) lat with db params from ty
-> WindowArg ('Grouped bys) '[ty] lat with db params from
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (arg :: NullType).
Expression grp lat with db params from arg
-> WindowArg grp '[arg] lat with db params from
Window (forall a. IsLabel col a => a
forall (x :: Symbol) a. IsLabel x a => a
fromLabel @col)
instance (Has tab (Join from lat) row, Has col row ty, GroupedBy tab col bys)
  => IsQualified tab col (WindowArg ('Grouped bys) '[ty] lat with db params from) where
    Alias tab
tab ! :: Alias tab
-> Alias col
-> WindowArg ('Grouped bys) '[ty] lat with db params from
! Alias col
col = Expression ('Grouped bys) lat with db params from ty
-> WindowArg ('Grouped bys) '[ty] lat with db params from
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (arg :: NullType).
Expression grp lat with db params from arg
-> WindowArg grp '[arg] lat with db params from
Window (Alias tab
tab Alias tab
-> Alias col
-> Expression ('Grouped bys) lat with db params from ty
forall (qualifier :: Symbol) (alias :: Symbol) expression.
IsQualified qualifier alias expression =>
Alias qualifier -> Alias alias -> expression
! Alias col
col)

instance SOP.SListI args
  => RenderSQL (WindowArg grp args lat with db params from) where
    renderSQL :: WindowArg grp args lat with db params from -> ByteString
renderSQL (WindowArg NP (Expression grp lat with db params from) args
args [Condition grp lat with db params from]
filters) =
      ByteString -> ByteString
parenthesized ((forall (x :: NullType).
 Expression grp lat with db params from x -> ByteString)
-> NP (Expression grp lat with db params from) args -> ByteString
forall k (xs :: [k]) (expression :: k -> *).
SListI xs =>
(forall (x :: k). expression x -> ByteString)
-> NP expression xs -> ByteString
renderCommaSeparated forall sql. RenderSQL sql => sql -> ByteString
forall (x :: NullType).
Expression grp lat with db params from x -> ByteString
renderSQL NP (Expression grp lat with db params from) args
args)
      ByteString -> (ByteString -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& [Condition grp lat with db params from] -> ByteString -> ByteString
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (null :: PGType -> NullType).
[Expression grp lat with db params from (null 'PGbool)]
-> ByteString -> ByteString
renderFilters [Condition grp lat with db params from]
filters
      where
        renderFilter :: ByteString -> ByteString
renderFilter ByteString
wh = ByteString
"FILTER" ByteString -> ByteString -> ByteString
<+> ByteString -> ByteString
parenthesized (ByteString
"WHERE" ByteString -> ByteString -> ByteString
<+> ByteString
wh)
        renderFilters :: [Expression grp lat with db params from (null 'PGbool)]
-> ByteString -> ByteString
renderFilters = \case
          [] -> ByteString -> ByteString
forall a. a -> a
id
          Expression grp lat with db params from (null 'PGbool)
wh:[Expression grp lat with db params from (null 'PGbool)]
whs -> (ByteString -> ByteString -> ByteString
<+> ByteString -> ByteString
renderFilter (Expression grp lat with db params from (null 'PGbool) -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL ((Expression grp lat with db params from (null 'PGbool)
 -> Expression grp lat with db params from (null 'PGbool)
 -> Expression grp lat with db params from (null 'PGbool))
-> Expression grp lat with db params from (null 'PGbool)
-> [Expression grp lat with db params from (null 'PGbool)]
-> Expression grp lat with db params from (null 'PGbool)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Expression grp lat with db params from (null 'PGbool)
-> Expression grp lat with db params from (null 'PGbool)
-> Expression grp lat with db params from (null 'PGbool)
forall (null :: PGType -> NullType).
Operator (null 'PGbool) (null 'PGbool) (null 'PGbool)
(.&&) Expression grp lat with db params from (null 'PGbool)
wh [Expression grp lat with db params from (null 'PGbool)]
whs)))

instance FilterWhere (WindowArg grp) grp where
  filterWhere :: Condition grp lat with db params from
-> WindowArg grp xs lat with db params from
-> WindowArg grp xs lat with db params from
filterWhere Condition grp lat with db params from
wh (WindowArg NP (Expression grp lat with db params from) xs
args [Condition grp lat with db params from]
filters) = NP (Expression grp lat with db params from) xs
-> [Condition grp lat with db params from]
-> WindowArg grp xs lat with db params from
forall (grp :: Grouping) (args :: [NullType]) (lat :: FromType)
       (with :: FromType) (db :: SchemasType) (params :: [NullType])
       (from :: FromType).
NP (Expression grp lat with db params from) args
-> [Condition grp lat with db params from]
-> WindowArg grp args lat with db params from
WindowArg NP (Expression grp lat with db params from) xs
args (Condition grp lat with db params from
wh Condition grp lat with db params from
-> [Condition grp lat with db params from]
-> [Condition grp lat with db params from]
forall a. a -> [a] -> [a]
: [Condition grp lat with db params from]
filters)

-- | `Window` invokes a `WindowFunction` on a single argument.
pattern Window
  :: Expression grp lat with db params from arg
  -- ^ argument
  -> WindowArg grp '[arg] lat with db params from
pattern $bWindow :: Expression grp lat with db params from arg
-> WindowArg grp '[arg] lat with db params from
$mWindow :: forall r (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (arg :: NullType).
WindowArg grp '[arg] lat with db params from
-> (Expression grp lat with db params from arg -> r)
-> (Void# -> r)
-> r
Window x = Windows (x :* Nil)

-- | `Windows` invokes a `WindowFunction` on multiple argument.
pattern Windows
  :: NP (Expression grp lat with db params from) args
  -- ^ arguments
  -> WindowArg grp args lat with db params from
pattern $bWindows :: NP (Expression grp lat with db params from) args
-> WindowArg grp args lat with db params from
$mWindows :: forall r (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (args :: [NullType]).
WindowArg grp args lat with db params from
-> (NP (Expression grp lat with db params from) args -> r)
-> (Void# -> r)
-> r
Windows xs = WindowArg xs []

instance RenderSQL (WindowFunction grp lat with db params from ty) where
  renderSQL :: WindowFunction grp lat with db params from ty -> ByteString
renderSQL = WindowFunction grp lat with db params from ty -> ByteString
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
WindowFunction grp lat with db params from ty -> ByteString
renderWindowFunction

{- |
A @RankNType@ for window functions with no arguments.
-}
type WinFun0 x
  = forall grp lat with db params from
  . WindowFunction grp lat with db params from x
    -- ^ cannot reference aliases

{- |
A @RankNType@ for window functions with 1 argument.
-}
type (-#->) x y
  =  forall grp lat with db params from
  .  WindowArg grp '[x] lat with db params from
     -- ^ input
  -> WindowFunction grp lat with db params from y
     -- ^ output

{- | A @RankNType@ for window functions with a fixed-length
list of heterogeneous arguments.
Use the `*:` operator to end your argument lists.
-}
type (--#->) xs y
  =  forall grp lat with db params from
  .  WindowArg grp xs lat with db params from
     -- ^ inputs
  -> WindowFunction grp lat with db params from y
     -- ^ output

-- | escape hatch for defining window functions
unsafeWindowFunction1 :: ByteString -> x -#-> y
unsafeWindowFunction1 :: ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
fun WindowArg grp '[x] lat with db params from
x
  = ByteString -> WindowFunction grp lat with db params from y
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> WindowFunction grp lat with db params from ty
UnsafeWindowFunction (ByteString -> WindowFunction grp lat with db params from y)
-> ByteString -> WindowFunction grp lat with db params from y
forall a b. (a -> b) -> a -> b
$ ByteString
fun ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> WindowArg grp '[x] lat with db params from -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL WindowArg grp '[x] lat with db params from
x

-- | escape hatch for defining multi-argument window functions
unsafeWindowFunctionN :: SOP.SListI xs => ByteString -> xs --#-> y
unsafeWindowFunctionN :: ByteString -> xs --#-> y
unsafeWindowFunctionN ByteString
fun WindowArg grp xs lat with db params from
xs = ByteString -> WindowFunction grp lat with db params from y
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> WindowFunction grp lat with db params from ty
UnsafeWindowFunction (ByteString -> WindowFunction grp lat with db params from y)
-> ByteString -> WindowFunction grp lat with db params from y
forall a b. (a -> b) -> a -> b
$ ByteString
fun ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> WindowArg grp xs lat with db params from -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL WindowArg grp xs lat with db params from
xs

{- | rank of the current row with gaps; same as `rowNumber` of its first peer

>>> printSQL rank
rank()
-}
rank :: WinFun0 ('NotNull 'PGint8)
rank :: WindowFunction grp lat with db params from ('NotNull 'PGint8)
rank = ByteString
-> WindowFunction grp lat with db params from ('NotNull 'PGint8)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> WindowFunction grp lat with db params from ty
UnsafeWindowFunction ByteString
"rank()"

{- | number of the current row within its partition, counting from 1

>>> printSQL rowNumber
row_number()
-}
rowNumber :: WinFun0 ('NotNull 'PGint8)
rowNumber :: WindowFunction grp lat with db params from ('NotNull 'PGint8)
rowNumber = ByteString
-> WindowFunction grp lat with db params from ('NotNull 'PGint8)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> WindowFunction grp lat with db params from ty
UnsafeWindowFunction ByteString
"row_number()"

{- | rank of the current row without gaps; this function counts peer groups

>>> printSQL denseRank
dense_rank()
-}
denseRank :: WinFun0 ('NotNull 'PGint8)
denseRank :: WindowFunction grp lat with db params from ('NotNull 'PGint8)
denseRank = ByteString
-> WindowFunction grp lat with db params from ('NotNull 'PGint8)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> WindowFunction grp lat with db params from ty
UnsafeWindowFunction ByteString
"dense_rank()"

{- | relative rank of the current row: (rank - 1) / (total partition rows - 1)

>>> printSQL percentRank
percent_rank()
-}
percentRank :: WinFun0 ('NotNull 'PGfloat8)
percentRank :: WindowFunction grp lat with db params from ('NotNull 'PGfloat8)
percentRank = ByteString
-> WindowFunction grp lat with db params from ('NotNull 'PGfloat8)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> WindowFunction grp lat with db params from ty
UnsafeWindowFunction ByteString
"percent_rank()"

{- | cumulative distribution: (number of partition rows
preceding or peer with current row) / total partition rows

>>> printSQL cumeDist
cume_dist()
-}
cumeDist :: WinFun0 ('NotNull 'PGfloat8)
cumeDist :: WindowFunction grp lat with db params from ('NotNull 'PGfloat8)
cumeDist = ByteString
-> WindowFunction grp lat with db params from ('NotNull 'PGfloat8)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> WindowFunction grp lat with db params from ty
UnsafeWindowFunction ByteString
"cume_dist()"

{- | integer ranging from 1 to the argument value,
dividing the partition as equally as possible

>>> printSQL $ ntile (Window 5)
ntile((5 :: int4))
-}
ntile :: 'NotNull 'PGint4 -#-> 'NotNull 'PGint4
ntile :: WindowArg grp '[ 'NotNull 'PGint4] lat with db params from
-> WindowFunction grp lat with db params from ('NotNull 'PGint4)
ntile = ByteString -> 'NotNull 'PGint4 -#-> 'NotNull 'PGint4
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"ntile"

{- | returns value evaluated at the row that is offset rows before the current
row within the partition; if there is no such row, instead return default
(which must be of the same type as value). Both offset and default are
evaluated with respect to the current row.
-}
lag :: '[ty, 'NotNull 'PGint4, ty] --#-> ty
lag :: WindowArg grp '[ty, 'NotNull 'PGint4, ty] lat with db params from
-> WindowFunction grp lat with db params from ty
lag = ByteString -> '[ty, 'NotNull 'PGint4, ty] --#-> ty
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs --#-> y
unsafeWindowFunctionN ByteString
"lag"

{- | returns value evaluated at the row that is offset rows after the current
row within the partition; if there is no such row, instead return default
(which must be of the same type as value). Both offset and default are
evaluated with respect to the current row.
-}
lead :: '[ty, 'NotNull 'PGint4, ty] --#-> ty
lead :: WindowArg grp '[ty, 'NotNull 'PGint4, ty] lat with db params from
-> WindowFunction grp lat with db params from ty
lead = ByteString -> '[ty, 'NotNull 'PGint4, ty] --#-> ty
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs --#-> y
unsafeWindowFunctionN ByteString
"lead"

{- | returns value evaluated at the row that is the
first row of the window frame
-}
firstValue :: ty -#-> ty
firstValue :: WindowArg grp '[ty] lat with db params from
-> WindowFunction grp lat with db params from ty
firstValue = ByteString -> ty -#-> ty
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"first_value"

{- | returns value evaluated at the row that is the
last row of the window frame
-}
lastValue :: ty -#-> ty
lastValue :: WindowArg grp '[ty] lat with db params from
-> WindowFunction grp lat with db params from ty
lastValue = ByteString -> ty -#-> ty
forall (x :: NullType) (y :: NullType). ByteString -> x -#-> y
unsafeWindowFunction1 ByteString
"last_value"

{- | returns value evaluated at the row that is the nth
row of the window frame (counting from 1); null if no such row
-}
nthValue :: '[null ty, 'NotNull 'PGint4] --#-> 'Null ty
nthValue :: WindowArg grp '[null ty, 'NotNull 'PGint4] lat with db params from
-> WindowFunction grp lat with db params from ('Null ty)
nthValue = ByteString -> '[null ty, 'NotNull 'PGint4] --#-> 'Null ty
forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs --#-> y
unsafeWindowFunctionN ByteString
"nth_value"