on da76712 help sign in
rel8/src/Rel8/Window.hs
97 lines 3.2 kB history raw
1{-# language DerivingVia #-}
2{-# language FlexibleContexts #-}
3{-# language GeneralizedNewtypeDeriving #-}
4{-# language ScopedTypeVariables #-}
5{-# language StandaloneKindSignatures #-}
6{-# language TypeApplications #-}
8module Rel8.Window
9 ( Window(..)
10 , Partition
11 , over
12 , partitionBy
13 , orderPartitionBy
14 )
15where
17-- base
18import Data.Functor.Const ( Const( Const ), getConst )
19import Data.Functor.Contravariant ( Contravariant, contramap )
20import Data.Kind ( Type )
21import Prelude
23-- opaleye
24import qualified Opaleye.Internal.Window as Opaleye
25import qualified Opaleye.Internal.PackMap as Opaleye
27-- profunctors
28import Data.Profunctor ( Profunctor )
30-- product-profunctors
31import Data.Profunctor.Product ( ProductProfunctor, (****), purePP )
33-- rel8
34import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )
35import Rel8.Order( Order( Order ) )
36import Rel8.Schema.HTable ( hfield, htabulateA )
37import Rel8.Table ( Columns, toColumns )
38import Rel8.Table.Eq ( EqTable )
40-- semigroupoids
41import Data.Functor.Apply ( Apply, WrappedApplicative(..) )
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.
49type Window :: Type -> Type -> Type
50newtype Window a b = Window (Opaleye.Windows a b)
51 deriving newtype (Profunctor)
52 deriving newtype (Functor, Applicative)
53 deriving (Apply) via (WrappedApplicative (Window a))
56instance ProductProfunctor Window where
57 purePP = pure
58 (****) = (<*>)
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 '<>'.
68type Partition :: Type -> Type
69newtype Partition a = Partition (Opaleye.Window a)
70 deriving newtype (Contravariant, Semigroup, Monoid)
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-- @@@
78over :: Window a b -> Partition a -> Window a b
79over (Window (Opaleye.Windows (Opaleye.PackMap w))) (Partition p) =
80 Window $ Opaleye.Windows $ Opaleye.PackMap $ \f ->
81 w (\(o, p') -> f (o, p' <> p))
82infixl 1 `over`
85-- | Restricts a window function to operate only the group of rows that share
86-- the same value(s) for the given expression(s).
87partitionBy :: forall b a. EqTable b => (a -> b) -> Partition a
88partitionBy f =
89 Partition $ contramap (toColumns . f) $ getConst $
90 htabulateA @(Columns b) $ \field ->
91 Const $ Opaleye.partitionBy (toColumn . toPrimExpr . (`hfield` field))
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.
96orderPartitionBy :: Order a -> Partition a
97orderPartitionBy (Order ordering) = Partition $ Opaleye.orderPartitionBy ordering