2e82fcc · rel8 · git.iko.soy

git.iko.soy/rel8

Window functions (#182)

commit2e82fccb02470198297f4a71b9da8f535d8029b1 authorShane <shane.obrien@circuithub.com> dateFri 14 Oct 2022, 02:06 (4 years ago) parentc69504e

10 files changed+331−23

compare with master

unifiedsplit

rel8.cabal+7−1 src/Rel8.hs+24 src/Rel8/Expr/Window.hs+121 src/Rel8/Order.hs−1 src/Rel8/Query/Indexed.hs+6−19 src/Rel8/Query/Window.hs+26 src/Rel8/Schema/HTable.hs+7−1 src/Rel8/Table/Opaleye.hs−1 src/Rel8/Table/Window.hs+43 src/Rel8/Window.hs+97

rel8.cabal+7−1

@@ -27,7 +27,7 @@ library

2727 , comonad

2828 , contravariant

2929 , hasql ^>= 1.4.5.1 || ^>= 1.5.0.0 || ^>= 1.6.0.0

30− , opaleye ^>= 0.9.3.3

30+ , opaleye ^>= 0.9.6.0

3131 , pretty

3232 , profunctors

3333 , product-profunctors

@@ -82,6 +82,7 @@ library

8282 Rel8.Expr.Order

8383 Rel8.Expr.Sequence

8484 Rel8.Expr.Serialize

85+ Rel8.Expr.Window

8586

8687 Rel8.FCF

8788

@@ -120,6 +121,7 @@ library

120121 Rel8.Query.SQL

121122 Rel8.Query.These

122123 Rel8.Query.Values

124+ Rel8.Query.Window

123125

124126 Rel8.Schema.Context.Nullify

125127 Rel8.Schema.Dict

@@ -179,6 +181,7 @@ library

179181 Rel8.Table.These

180182 Rel8.Table.Transpose

181183 Rel8.Table.Undefined

184+ Rel8.Table.Window

182185

183186 Rel8.Type

184187 Rel8.Type.Array

@@ -197,6 +200,9 @@ library

197200 Rel8.Type.Sum

198201 Rel8.Type.Tag

199202

203+ Rel8.Window

204+

205+

200206test-suite tests

201207 type: exitcode-stdio-1.0

202208 build-depends:

src/Rel8.hs+24

@@ -275,6 +275,26 @@ module Rel8

275275 , nullsLast

276276

277277 -- ** Window functions

278+ , Window

279+ , window

280+ , Partition

281+ , over

282+ , partitionBy

283+ , orderPartitionBy

284+ , cumulative

285+ , cumulative_

286+ , currentRow

287+ , rowNumber

288+ , rank

289+ , denseRank

290+ , percentRank

291+ , cumeDist

292+ , ntile

293+ , lag

294+ , lead

295+ , firstValue

296+ , lastValue

297+ , nthValue

278298 , indexed

279299

280300 -- ** Bindings

@@ -347,6 +367,7 @@ import Rel8.Expr.Order

347367import Rel8.Expr.Serialize

348368import Rel8.Expr.Sequence

349369import Rel8.Expr.Text ( like, ilike )

370+import Rel8.Expr.Window hiding ( cumulative )

350371import Rel8.Generic.Rel8able ( KRel8able, Rel8able )

351372import Rel8.Order

352373import Rel8.Query

@@ -368,6 +389,7 @@ import Rel8.Query.SQL (showQuery)

368389import Rel8.Query.Set

369390import Rel8.Query.These

370391import Rel8.Query.Values

392+import Rel8.Query.Window

371393import Rel8.Schema.Field

372394import Rel8.Schema.HTable

373395import Rel8.Schema.Name

@@ -403,6 +425,7 @@ import Rel8.Table.Rel8able ()

403425import Rel8.Table.Serialize

404426import Rel8.Table.These

405427import Rel8.Table.Transpose

428+import Rel8.Table.Window

406429import Rel8.Type

407430import Rel8.Type.Composite

408431import Rel8.Type.Eq

@@ -417,6 +440,7 @@ import Rel8.Type.ReadShow

417440import Rel8.Type.Semigroup

418441import Rel8.Type.String

419442import Rel8.Type.Sum

443+import Rel8.Window

420444

421445

422446-- $running

src/Rel8/Expr/Window.hsnew file+121

@@ -0,0 +1,121 @@

1+module Rel8.Expr.Window

2+ ( cumulative

3+ , rowNumber

4+ , rank

5+ , denseRank

6+ , percentRank

7+ , cumeDist

8+ , ntile

9+ , lag

10+ , lead

11+ , firstValue

12+ , lastValue

13+ , nthValue

14+ )

15+where

16+

17+-- base

18+import Data.Int ( Int32, Int64 )

19+import Prelude

20+

21+-- opaleye

22+import qualified Opaleye.Internal.Aggregate as Opaleye

23+import qualified Opaleye.Internal.PackMap as Opaleye

24+import qualified Opaleye.Internal.Window as Opaleye

25+import qualified Opaleye.Window as Opaleye

26+

27+-- profunctors

28+import Data.Profunctor (dimap)

29+

30+-- rel8

31+import Rel8.Aggregate ( Aggregate( Aggregate ) )

32+import Rel8.Expr ( Expr )

33+import Rel8.Expr.Opaleye ( fromColumn, fromPrimExpr, toColumn, toPrimExpr )

34+import Rel8.Schema.Null ( Nullify )

35+import Rel8.Window ( Window( Window ) )

36+

37+

38+cumulative :: (a -> Aggregate b) -> Window a (Expr b)

39+cumulative f =

40+ fromWindowFunction $ Opaleye.aggregatorWindowFunction (fromAggregate f) id

41+

42+

43+-- | [@row_number()@](https://www.postgresql.org/docs/current/functions-window.html)

44+rowNumber :: Window a (Expr Int64)

45+rowNumber = fromWindowFunction $ fromPrimExpr . fromColumn <$> Opaleye.rowNumber

46+

47+

48+-- | [@rank()@](https://www.postgresql.org/docs/current/functions-window.html)

49+rank :: Window a (Expr Int64)

50+rank = fromWindowFunction $ fromPrimExpr . fromColumn <$> Opaleye.rank

51+

52+

53+-- | [@dense_rank()@](https://www.postgresql.org/docs/current/functions-window.html)

54+denseRank :: Window a (Expr Int64)

55+denseRank = fromWindowFunction $ fromPrimExpr . fromColumn <$> Opaleye.denseRank

56+

57+

58+-- | [@percent_rank()@](https://www.postgresql.org/docs/current/functions-window.html)

59+percentRank :: Window a (Expr Double)

60+percentRank = fromWindowFunction $ fromPrimExpr . fromColumn <$> Opaleye.percentRank

61+

62+

63+-- | [@cume_dist()@](https://www.postgresql.org/docs/current/functions-window.html)

64+cumeDist :: Window a (Expr Double)

65+cumeDist = fromWindowFunction $ fromPrimExpr . fromColumn <$> Opaleye.cumeDist

66+

67+

68+-- | [@ntile(num_buckets)@](https://www.postgresql.org/docs/current/functions-window.html)

69+ntile :: Expr Int32 -> Window a (Expr Int32)

70+ntile buckets = fromWindowFunction $ fromPrimExpr . fromColumn <$>

71+ Opaleye.ntile (toColumn (toPrimExpr buckets))

72+

73+

74+-- | [@lag(value, offset, default)@](https://www.postgresql.org/docs/current/functions-window.html)

75+lag :: Expr Int32 -> Expr a -> Window (Expr a) (Expr a)

76+lag offset def =

77+ fromWindowFunction $

78+ dimap (toColumn . toPrimExpr) (fromPrimExpr . fromColumn) $

79+ Opaleye.lag (toColumn (toPrimExpr offset)) (toColumn (toPrimExpr def))

80+

81+

82+-- | [@lead(value, offset, default)@](https://www.postgresql.org/docs/current/functions-window.html)

83+lead :: Expr Int32 -> Expr a -> Window (Expr a) (Expr a)

84+lead offset def =

85+ fromWindowFunction $

86+ dimap (toColumn . toPrimExpr) (fromPrimExpr . fromColumn) $

87+ Opaleye.lead (toColumn (toPrimExpr offset)) (toColumn (toPrimExpr def))

88+

89+

90+-- | [@first_value(value)@](https://www.postgresql.org/docs/current/functions-window.html)

91+firstValue :: Window (Expr a) (Expr a)

92+firstValue =

93+ fromWindowFunction $

94+ dimap (toColumn . toPrimExpr) (fromPrimExpr . fromColumn)

95+ Opaleye.firstValue

96+

97+

98+-- | [@last_value(value)@](https://www.postgresql.org/docs/current/functions-window.html)

99+lastValue :: Window (Expr a) (Expr a)

100+lastValue =

101+ fromWindowFunction $

102+ dimap (toColumn . toPrimExpr) (fromPrimExpr . fromColumn)

103+ Opaleye.lastValue

104+

105+

106+-- | [@nth_value(value, n)@](https://www.postgresql.org/docs/current/functions-window.html)

107+nthValue :: Expr Int32 -> Window (Expr a) (Expr (Nullify a))

108+nthValue n =

109+ fromWindowFunction $

110+ dimap (toColumn . toPrimExpr) (fromPrimExpr . fromColumn) $

111+ Opaleye.nthValue (toColumn (toPrimExpr n))

112+

113+

114+fromAggregate :: (a -> Aggregate b) -> Opaleye.Aggregator a (Expr b)

115+fromAggregate f = Opaleye.Aggregator $ Opaleye.PackMap $ \w a -> case f a of

116+ Aggregate (Opaleye.Aggregator (Opaleye.PackMap x)) -> x w ()

117+

118+

119+fromWindowFunction :: Opaleye.WindowFunction a b -> Window a b

120+fromWindowFunction (Opaleye.WindowFunction (Opaleye.PackMap w)) =

121+ Window $ Opaleye.Windows $ Opaleye.PackMap $ \f -> w $ \o -> f (o, mempty)

src/Rel8/Order.hs−1

@@ -16,7 +16,6 @@ import Prelude

1616import Data.Functor.Contravariant.Divisible ( Decidable, Divisible )

1717

1818-- opaleye

19−import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

2019import qualified Opaleye.Order as Opaleye

2120

2221

src/Rel8/Query/Indexed.hs+6−19

@@ -4,31 +4,18 @@ module Rel8.Query.Indexed

44where

66-- base

7+import Control.Applicative ( liftA2 )

78import Data.Int ( Int64 )

8−import Prelude

9−

10−-- opaleye

11−import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

12−import qualified Opaleye.Internal.PackMap as Opaleye

13−import qualified Opaleye.Internal.PrimQuery as Opaleye

14−import qualified Opaleye.Internal.QueryArr as Opaleye

15−import qualified Opaleye.Internal.Tag as Opaleye

9+import Prelude ()

1610

1711-- rel8

1812import Rel8.Expr ( Expr )

19−import Rel8.Expr.Opaleye ( fromPrimExpr )

13+import Rel8.Expr.Window ( rowNumber )

2014import Rel8.Query ( Query )

21−import Rel8.Query.Opaleye ( mapOpaleye )

15+import Rel8.Query.Window ( window )

16+import Rel8.Table.Window ( currentRow )

2217

2318

2419-- | Pair each row of a query with its index within the query.

2520indexed :: Query a -> Query (Expr Int64, a)

26−indexed = mapOpaleye $ \f -> Opaleye.stateQueryArr $ \_ tag ->

27− let

28− (a, query, tag') = Opaleye.runStateQueryArr f () tag

29− tag'' = Opaleye.next tag'

30− window = Opaleye.ConstExpr $ Opaleye.OtherLit "ROW_NUMBER() OVER () - 1"

31− (index, bindings) = Opaleye.run $ Opaleye.extractAttr "index" tag' window

32− query' = query <> Opaleye.aRebind bindings

33− in

34− ((fromPrimExpr index, a), query', tag'')

21+indexed = window (liftA2 (,) rowNumber currentRow)

src/Rel8/Query/Window.hsnew file+26

@@ -0,0 +1,26 @@

1+module Rel8.Query.Window

2+ ( window

3+ )

4+where

6+-- base

7+import Prelude ()

9+-- opaleye

10+import qualified Opaleye.Window as Opaleye

11+

12+-- rel8

13+import Rel8.Query ( Query )

14+import Rel8.Query.Opaleye ( mapOpaleye )

15+import Rel8.Window ( Window( Window ) )

16+

17+

18+-- | 'window' runs a query composed of expressions containing

19+-- [window functions](https://www.postgresql.org/docs/current/tutorial-window.html).

20+-- 'window' is similar to 'Rel8.aggregate', with the main difference being

21+-- that in a window query, each input row corresponds to one output row,

22+-- whereas aggregation queries fold the entire input query down into a single

23+-- row. To put this into a Haskell context, 'Rel8.aggregate' is to 'foldl' as

24+-- 'window' is to 'scanl'.

25+window :: Window a b -> Query a -> Query b

26+window (Window a) = mapOpaleye (Opaleye.runWindows a)

src/Rel8/Schema/HTable.hs+7−1

@@ -16,11 +16,12 @@

1616module Rel8.Schema.HTable

1717 ( HTable (HField, HConstrainTable)

1818 , hfield, htabulate, htraverse, hdicts, hspecs

19− , hmap, htabulateA, htraverseP, htraversePWithField

19+ , hfoldMap, hmap, htabulateA, htraverseP, htraversePWithField

2020 )

2121where

2222

2323-- base

24+import Data.Functor.Const ( Const( Const ), getConst )

2425import Data.Kind ( Constraint, Type )

2526import Data.Functor.Compose ( Compose( Compose ), getCompose )

2627import Data.Proxy ( Proxy )

@@ -119,6 +120,11 @@ class HTable t where

119120 {-# INLINABLE hspecs #-}

120121

121122

123+hfoldMap :: (HTable t, Semigroup s)

124+ => (forall a. context a -> s) -> t context -> s

125+hfoldMap f a = getConst $ htraverse (Const . f) a

126+

127+

122128hmap :: HTable t

123129 => (forall a. context a -> context' a) -> t context -> t context'

124130hmap f a = htabulate $ \field -> f (hfield a field)

src/Rel8/Table/Opaleye.hs−1

@@ -35,7 +35,6 @@ import qualified Opaleye.Adaptors as Opaleye

3535import qualified Opaleye.Field as Opaleye ( Field_ )

3636import qualified Opaleye.Internal.Aggregate as Opaleye

3737import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

38−import qualified Opaleye.Internal.PackMap as Opaleye

3938import qualified Opaleye.Internal.Values as Opaleye

4039import qualified Opaleye.Table as Opaleye

4140

src/Rel8/Table/Window.hsnew file+43

@@ -0,0 +1,43 @@

1+{-# language MonoLocalBinds #-}

3+module Rel8.Table.Window

4+ ( cumulative

5+ , cumulative_

6+ , currentRow

7+ )

8+where

10+-- base

11+import Prelude

12+

13+-- opaleye

14+import qualified Opaleye.Window as Opaleye

15+

16+-- rel8

17+import Rel8.Aggregate ( Aggregates )

18+import qualified Rel8.Expr.Window as Expr

19+import Rel8.Schema.HTable ( hfield, htabulateA )

20+import Rel8.Table ( fromColumns, toColumns )

21+import Rel8.Window ( Window( Window ) )

22+

23+

24+-- | 'cumulative' allows the use of aggregation functions in 'Window'

25+-- expressions. In particular, @'cumulative' 'Rel8.sum'@

26+-- (when combined with 'Rel8.Window.orderPartitionBy') gives a running total,

27+-- also known as a \"cumulative sum\", hence the name @cumulative@.

28+cumulative :: Aggregates aggregates exprs => (a -> aggregates) -> Window a exprs

29+cumulative f =

30+ fmap fromColumns $

31+ htabulateA $ \field ->

32+ Expr.cumulative ((`hfield` field) . toColumns . f)

33+

34+

35+-- | A version of 'cumulative' for use with nullary aggregators like

36+-- 'Rel8.Expr.Aggregate.countStar'.

37+cumulative_ :: Aggregates aggregates exprs => aggregates -> Window a exprs

38+cumulative_ = cumulative . const

39+

40+

41+-- | Return every column of the current row of a window query.

42+currentRow :: Window a a

43+currentRow = Window $ Opaleye.over (Opaleye.noWindowFunction id) mempty mempty

src/Rel8/Window.hsnew file+97

@@ -0,0 +1,97 @@

1+{-# language DerivingVia #-}

2+{-# language FlexibleContexts #-}

3+{-# language GeneralizedNewtypeDeriving #-}

4+{-# language ScopedTypeVariables #-}

5+{-# language StandaloneKindSignatures #-}

6+{-# language TypeApplications #-}

8+module Rel8.Window

9+ ( Window(..)

10+ , Partition

11+ , over

12+ , partitionBy

13+ , orderPartitionBy

14+ )

15+where

16+

17+-- base

18+import Data.Functor.Const ( Const( Const ), getConst )

19+import Data.Functor.Contravariant ( Contravariant, contramap )

20+import Data.Kind ( Type )

21+import Prelude

22+

23+-- opaleye

24+import qualified Opaleye.Internal.Window as Opaleye

25+import qualified Opaleye.Internal.PackMap as Opaleye

26+

27+-- profunctors

28+import Data.Profunctor ( Profunctor )

29+

30+-- product-profunctors

31+import Data.Profunctor.Product ( ProductProfunctor, (****), purePP )

32+

33+-- rel8

34+import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )

35+import Rel8.Order( Order( Order ) )

36+import Rel8.Schema.HTable ( hfield, htabulateA )

37+import Rel8.Table ( Columns, toColumns )

38+import Rel8.Table.Eq ( EqTable )

39+

40+-- semigroupoids

41+import Data.Functor.Apply ( Apply, WrappedApplicative(..) )

42+

43+

44+-- | 'Window' is an applicative functor that represents expressions that

45+-- contain

46+-- [window functions](https://www.postgresql.org/docs/current/tutorial-window.html).

47+-- 'Rel8.Query.Window.window' can be used to

48+-- evaluate these expressions over a particular query.

49+type Window :: Type -> Type -> Type

50+newtype Window a b = Window (Opaleye.Windows a b)

51+ deriving newtype (Profunctor)

52+ deriving newtype (Functor, Applicative)

53+ deriving (Apply) via (WrappedApplicative (Window a))

54+

55+

56+instance ProductProfunctor Window where

57+ purePP = pure

58+ (****) = (<*>)

59+

60+

61+-- | In PostgreSQL, window functions must specify the \"window\" or

62+-- \"partition\" over which they operate. The syntax for this looks like:

63+-- @SUM(salary) OVER (PARTITION BY department)@. The Rel8 type 'Partition'

64+-- represents everything that comes after @OVER@.

65+--

66+-- 'Partition' is a 'Monoid', so 'Window's created with 'partitionBy' and

67+-- 'orderWindowBy' can be combined using '<>'.

68+type Partition :: Type -> Type

69+newtype Partition a = Partition (Opaleye.Window a)

70+ deriving newtype (Contravariant, Semigroup, Monoid)

71+

72+

73+-- | 'over' adds a 'Partition' to a 'Window' expression.

74+--

75+-- @@@

76+-- 'Rel8.Table.Window.cumulative' ('Rel8.Expr.Aggregate.sum' . salary) `over` 'partitionBy' department <> 'orderPartitionBy' (salary >$< 'Rel8.desc')

77+-- @@@

78+over :: Window a b -> Partition a -> Window a b

79+over (Window (Opaleye.Windows (Opaleye.PackMap w))) (Partition p) =

80+ Window $ Opaleye.Windows $ Opaleye.PackMap $ \f ->

81+ w (\(o, p') -> f (o, p' <> p))

82+infixl 1 `over`

83+

84+

85+-- | Restricts a window function to operate only the group of rows that share

86+-- the same value(s) for the given expression(s).

87+partitionBy :: forall b a. EqTable b => (a -> b) -> Partition a

88+partitionBy f =

89+ Partition $ contramap (toColumns . f) $ getConst $

90+ htabulateA @(Columns b) $ \field ->

91+ Const $ Opaleye.partitionBy (toColumn . toPrimExpr . (`hfield` field))

92+

93+

94+-- | Controls the order in which rows are processed by window functions. This

95+-- does not need to match the ordering of the overall query.

96+orderPartitionBy :: Order a -> Partition a

97+orderPartitionBy (Order ordering) = Partition $ Opaleye.orderPartitionBy ordering