-- https://www.postgresql.org/docs/current/tutorial-window.html#id-1.4.5.6.9.5
-- talks about partitions and window frames.  The window frame is the
-- way the elements of a partition are ordered for processing the
-- result row of each element of the partition.
--
-- So neither of these terms is suitable for the _whole thing_.
-- Perhaps the answer should be "Window"?  This is also attested by
-- the WINDOW declaration in a SELECT.

{-# LANGUAGE LambdaCase #-}

module Opaleye.Internal.Window where

import           Data.Profunctor (lmap, Profunctor, dimap)

import qualified Opaleye.Internal.Aggregate as A
import qualified Opaleye.Internal.PackMap as PM
import qualified Opaleye.Internal.PrimQuery as PQ
import qualified Opaleye.Internal.QueryArr as Q
import qualified Opaleye.Internal.Tag as T
import qualified Opaleye.Internal.Column as C
import qualified Opaleye.Internal.Order as O

import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ
import Data.Functor.Contravariant (contramap, Contravariant)
import Control.Arrow (second)


-- | 'WindowFunction' represents expressions that contain [window
-- functions](https://www.postgresql.org/docs/current/tutorial-window.html).
-- You can choose a 'WindowFunction' from the options below, and
-- combine and manipulate them using the @Applicative@ and
-- 'Data.Profunctor.Profunctor' operations.
newtype WindowFunction a b =
  WindowFunction (PM.PackMap HPQ.WndwOp HPQ.PrimExpr a b)

instance Functor (WindowFunction a) where
  fmap :: forall a b. (a -> b) -> WindowFunction a a -> WindowFunction a b
fmap a -> b
f (WindowFunction PackMap WndwOp PrimExpr a a
w) = PackMap WndwOp PrimExpr a b -> WindowFunction a b
forall a b. PackMap WndwOp PrimExpr a b -> WindowFunction a b
WindowFunction ((a -> b)
-> PackMap WndwOp PrimExpr a a -> PackMap WndwOp PrimExpr a b
forall a b.
(a -> b)
-> PackMap WndwOp PrimExpr a a -> PackMap WndwOp PrimExpr a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f PackMap WndwOp PrimExpr a a
w)

instance Applicative (WindowFunction a) where
  pure :: forall a. a -> WindowFunction a a
pure = PackMap WndwOp PrimExpr a a -> WindowFunction a a
forall a b. PackMap WndwOp PrimExpr a b -> WindowFunction a b
WindowFunction (PackMap WndwOp PrimExpr a a -> WindowFunction a a)
-> (a -> PackMap WndwOp PrimExpr a a) -> a -> WindowFunction a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PackMap WndwOp PrimExpr a a
forall a. a -> PackMap WndwOp PrimExpr a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  WindowFunction PackMap WndwOp PrimExpr a (a -> b)
f <*> :: forall a b.
WindowFunction a (a -> b)
-> WindowFunction a a -> WindowFunction a b
<*> WindowFunction PackMap WndwOp PrimExpr a a
x = PackMap WndwOp PrimExpr a b -> WindowFunction a b
forall a b. PackMap WndwOp PrimExpr a b -> WindowFunction a b
WindowFunction (PackMap WndwOp PrimExpr a (a -> b)
-> PackMap WndwOp PrimExpr a a -> PackMap WndwOp PrimExpr a b
forall a b.
PackMap WndwOp PrimExpr a (a -> b)
-> PackMap WndwOp PrimExpr a a -> PackMap WndwOp PrimExpr a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) PackMap WndwOp PrimExpr a (a -> b)
f PackMap WndwOp PrimExpr a a
x)

instance Profunctor WindowFunction where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> WindowFunction b c -> WindowFunction a d
dimap a -> b
f c -> d
g (WindowFunction PackMap WndwOp PrimExpr b c
w) =  PackMap WndwOp PrimExpr a d -> WindowFunction a d
forall a b. PackMap WndwOp PrimExpr a b -> WindowFunction a b
WindowFunction ((a -> b)
-> (c -> d)
-> PackMap WndwOp PrimExpr b c
-> PackMap WndwOp PrimExpr a d
forall a b c d.
(a -> b)
-> (c -> d)
-> PackMap WndwOp PrimExpr b c
-> PackMap WndwOp PrimExpr a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> b
f c -> d
g PackMap WndwOp PrimExpr b c
w)

-- | You can create @Windows@ using 'over', and combine and manipulate
-- them using the @Applicative@ and 'Data.Profunctor.Profunctor'
-- operations.
newtype Windows a b =
  Windows (PM.PackMap (HPQ.WndwOp, Window a) HPQ.PrimExpr a b)

instance Functor (Windows a) where
  fmap :: forall a b. (a -> b) -> Windows a a -> Windows a b
fmap a -> b
f (Windows PackMap (WndwOp, Window a) PrimExpr a a
w) = PackMap (WndwOp, Window a) PrimExpr a b -> Windows a b
forall a b. PackMap (WndwOp, Window a) PrimExpr a b -> Windows a b
Windows ((a -> b)
-> PackMap (WndwOp, Window a) PrimExpr a a
-> PackMap (WndwOp, Window a) PrimExpr a b
forall a b.
(a -> b)
-> PackMap (WndwOp, Window a) PrimExpr a a
-> PackMap (WndwOp, Window a) PrimExpr a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f PackMap (WndwOp, Window a) PrimExpr a a
w)

instance Applicative (Windows a) where
  pure :: forall a. a -> Windows a a
pure = PackMap (WndwOp, Window a) PrimExpr a a -> Windows a a
forall a b. PackMap (WndwOp, Window a) PrimExpr a b -> Windows a b
Windows (PackMap (WndwOp, Window a) PrimExpr a a -> Windows a a)
-> (a -> PackMap (WndwOp, Window a) PrimExpr a a)
-> a
-> Windows a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PackMap (WndwOp, Window a) PrimExpr a a
forall a. a -> PackMap (WndwOp, Window a) PrimExpr a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Windows PackMap (WndwOp, Window a) PrimExpr a (a -> b)
f <*> :: forall a b. Windows a (a -> b) -> Windows a a -> Windows a b
<*> Windows PackMap (WndwOp, Window a) PrimExpr a a
x = PackMap (WndwOp, Window a) PrimExpr a b -> Windows a b
forall a b. PackMap (WndwOp, Window a) PrimExpr a b -> Windows a b
Windows (PackMap (WndwOp, Window a) PrimExpr a (a -> b)
-> PackMap (WndwOp, Window a) PrimExpr a a
-> PackMap (WndwOp, Window a) PrimExpr a b
forall a b.
PackMap (WndwOp, Window a) PrimExpr a (a -> b)
-> PackMap (WndwOp, Window a) PrimExpr a a
-> PackMap (WndwOp, Window a) PrimExpr a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) PackMap (WndwOp, Window a) PrimExpr a (a -> b)
f PackMap (WndwOp, Window a) PrimExpr a a
x)

instance Profunctor Windows where
  dimap :: forall a b c d. (a -> b) -> (c -> d) -> Windows b c -> Windows a d
dimap a -> b
f c -> d
g (Windows (PM.PackMap forall (f :: * -> *).
Applicative f =>
((WndwOp, Window b) -> f PrimExpr) -> b -> f c
pm)) =
    PackMap (WndwOp, Window a) PrimExpr a d -> Windows a d
forall a b. PackMap (WndwOp, Window a) PrimExpr a b -> Windows a b
Windows (PackMap (WndwOp, Window a) PrimExpr a d -> Windows a d)
-> PackMap (WndwOp, Window a) PrimExpr a d -> Windows a d
forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *).
 Applicative f =>
 ((WndwOp, Window a) -> f PrimExpr) -> a -> f d)
-> PackMap (WndwOp, Window a) PrimExpr a d
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
PM.PackMap ((forall (f :: * -> *).
  Applicative f =>
  ((WndwOp, Window a) -> f PrimExpr) -> a -> f d)
 -> PackMap (WndwOp, Window a) PrimExpr a d)
-> (forall (f :: * -> *).
    Applicative f =>
    ((WndwOp, Window a) -> f PrimExpr) -> a -> f d)
-> PackMap (WndwOp, Window a) PrimExpr a d
forall a b. (a -> b) -> a -> b
$ \(WndwOp, Window a) -> f PrimExpr
h a
a ->
      (c -> d) -> f c -> f d
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g (((WndwOp, Window b) -> f PrimExpr) -> b -> f c
forall (f :: * -> *).
Applicative f =>
((WndwOp, Window b) -> f PrimExpr) -> b -> f c
pm (\(WndwOp
op, Window b
w) -> (WndwOp, Window a) -> f PrimExpr
h (WndwOp
op, (a -> b) -> Window b -> Window a
forall a' a. (a' -> a) -> Window a -> Window a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap a -> b
f Window b
w)) (a -> b
f a
a))

runWindows' :: Applicative f
  => Windows a b -> ((HPQ.WndwOp, Window a) -> f HPQ.PrimExpr) -> a -> f b
runWindows' :: forall (f :: * -> *) a b.
Applicative f =>
Windows a b -> ((WndwOp, Window a) -> f PrimExpr) -> a -> f b
runWindows' (Windows PackMap (WndwOp, Window a) PrimExpr a b
a) = PackMap (WndwOp, Window a) PrimExpr a b
-> ((WndwOp, Window a) -> f PrimExpr) -> a -> f b
forall (f :: * -> *) a b s t.
Applicative f =>
PackMap a b s t -> (a -> f b) -> s -> f t
PM.traversePM PackMap (WndwOp, Window a) PrimExpr a b
a


extractWindowFields
  :: T.Tag
  -> a
  -> (HPQ.WndwOp, Window a)
  -> PM.PM (PQ.Bindings (HPQ.WndwOp, HPQ.Partition)) HPQ.PrimExpr
extractWindowFields :: forall a.
Tag
-> a
-> (WndwOp, Window a)
-> PM (Bindings (WndwOp, Partition)) PrimExpr
extractWindowFields Tag
tag a
a (WndwOp
op, Window a -> [PrimExpr]
ps Order a
os) = do
  String
i <- PM (Bindings (WndwOp, Partition)) String
forall a. PM a String
PM.new
  let symbol :: Symbol
symbol = String -> Tag -> Symbol
HPQ.Symbol (String
"window" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
i) Tag
tag
  (Symbol, (WndwOp, Partition))
-> PM (Bindings (WndwOp, Partition)) ()
forall a. a -> PM [a] ()
PM.write (Symbol
symbol, (WndwOp
op, [PrimExpr] -> [OrderExpr] -> Partition
HPQ.Partition (a -> [PrimExpr]
ps a
a) (a -> Order a -> [OrderExpr]
forall a. a -> Order a -> [OrderExpr]
O.orderExprs a
a Order a
os)))
  PrimExpr -> PM (Bindings (WndwOp, Partition)) PrimExpr
forall a.
a -> StateT (Bindings (WndwOp, Partition), Int) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Symbol -> PrimExpr
HPQ.AttrExpr Symbol
symbol)


-- | A 'WindowFunction' that doesn't actually contain any window
-- function.
noWindowFunction :: (a -> b) -> WindowFunction a b
noWindowFunction :: forall a b. (a -> b) -> WindowFunction a b
noWindowFunction a -> b
f = (a -> b) -> WindowFunction a a -> WindowFunction a b
forall a b. (a -> b) -> WindowFunction a a -> WindowFunction a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (PackMap WndwOp PrimExpr a a -> WindowFunction a a
forall a b. PackMap WndwOp PrimExpr a b -> WindowFunction a b
WindowFunction ((forall (f :: * -> *).
 Applicative f =>
 (WndwOp -> f PrimExpr) -> a -> f a)
-> PackMap WndwOp PrimExpr a a
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
PM.PackMap ((a -> f a) -> (WndwOp -> f PrimExpr) -> a -> f a
forall a b. a -> b -> a
const a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)))


-- | @runWindows@ runs a query composed of expressions containing
-- [window
-- functions](https://www.postgresql.org/docs/current/tutorial-window.html).
-- @runWindows@ is similar to 'Opaleye.aggregate', with the main
-- difference being that in a window query, each input row corresponds
-- to one output row, whereas aggregation queries fold the entire
-- input query down into a single row per group. In Haskell
-- terminology, 'Opaleye.aggregate' is to 'foldl' as @runWindows@ is
-- to 'scanl'.
runWindows :: Windows a b -> Q.Select a -> Q.Select b
runWindows :: forall a b. Windows a b -> Select a -> Select b
runWindows Windows a b
wndw Select a
q = State Tag (b, PrimQuery) -> Query b
forall a. State Tag (a, PrimQuery) -> Query a
Q.productQueryArr (State Tag (b, PrimQuery) -> Query b)
-> State Tag (b, PrimQuery) -> Query b
forall a b. (a -> b) -> a -> b
$ do
  (a
a, PrimQuery
primQ) <- Select a -> State Tag (a, PrimQuery)
forall a. Select a -> State Tag (a, PrimQuery)
Q.runSimpleSelect Select a
q
  Tag
tag <- State Tag Tag
T.fresh
  let
    (b
b, Bindings (WndwOp, Partition)
bindings) = PM (Bindings (WndwOp, Partition)) b
-> (b, Bindings (WndwOp, Partition))
forall a r. PM [a] r -> (r, [a])
PM.run (Windows a b
-> ((WndwOp, Window a)
    -> PM (Bindings (WndwOp, Partition)) PrimExpr)
-> a
-> PM (Bindings (WndwOp, Partition)) b
forall (f :: * -> *) a b.
Applicative f =>
Windows a b -> ((WndwOp, Window a) -> f PrimExpr) -> a -> f b
runWindows' Windows a b
wndw (Tag
-> a
-> (WndwOp, Window a)
-> PM (Bindings (WndwOp, Partition)) PrimExpr
forall a.
Tag
-> a
-> (WndwOp, Window a)
-> PM (Bindings (WndwOp, Partition)) PrimExpr
extractWindowFields Tag
tag a
a) a
a)
  (b, PrimQuery) -> State Tag (b, PrimQuery)
forall a. a -> StateT Tag Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
b, Bindings (WndwOp, Partition) -> PrimQuery -> PrimQuery
forall a.
Bindings (WndwOp, Partition) -> PrimQuery' a -> PrimQuery' a
PQ.Window Bindings (WndwOp, Partition)
bindings PrimQuery
primQ)


windowsApply :: Windows (Windows a b, a) b
windowsApply :: forall a b. Windows (Windows a b, a) b
windowsApply = PackMap
  (WndwOp, Window (Windows a b, a)) PrimExpr (Windows a b, a) b
-> Windows (Windows a b, a) b
forall a b. PackMap (WndwOp, Window a) PrimExpr a b -> Windows a b
Windows (PackMap
   (WndwOp, Window (Windows a b, a)) PrimExpr (Windows a b, a) b
 -> Windows (Windows a b, a) b)
-> PackMap
     (WndwOp, Window (Windows a b, a)) PrimExpr (Windows a b, a) b
-> Windows (Windows a b, a) b
forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *).
 Applicative f =>
 ((WndwOp, Window (Windows a b, a)) -> f PrimExpr)
 -> (Windows a b, a) -> f b)
-> PackMap
     (WndwOp, Window (Windows a b, a)) PrimExpr (Windows a b, a) b
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
PM.PackMap ((forall (f :: * -> *).
  Applicative f =>
  ((WndwOp, Window (Windows a b, a)) -> f PrimExpr)
  -> (Windows a b, a) -> f b)
 -> PackMap
      (WndwOp, Window (Windows a b, a)) PrimExpr (Windows a b, a) b)
-> (forall (f :: * -> *).
    Applicative f =>
    ((WndwOp, Window (Windows a b, a)) -> f PrimExpr)
    -> (Windows a b, a) -> f b)
-> PackMap
     (WndwOp, Window (Windows a b, a)) PrimExpr (Windows a b, a) b
forall a b. (a -> b) -> a -> b
$ \(WndwOp, Window (Windows a b, a)) -> f PrimExpr
f (Windows a b
agg, a
a) ->
  case Windows a b
agg of
    Windows (PM.PackMap forall (f :: * -> *).
Applicative f =>
((WndwOp, Window a) -> f PrimExpr) -> a -> f b
inner) -> ((WndwOp, Window a) -> f PrimExpr) -> a -> f b
forall (f :: * -> *).
Applicative f =>
((WndwOp, Window a) -> f PrimExpr) -> a -> f b
inner ((WndwOp, Window (Windows a b, a)) -> f PrimExpr
f ((WndwOp, Window (Windows a b, a)) -> f PrimExpr)
-> ((WndwOp, Window a) -> (WndwOp, Window (Windows a b, a)))
-> (WndwOp, Window a)
-> f PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window a -> Window (Windows a b, a))
-> (WndwOp, Window a) -> (WndwOp, Window (Windows a b, a))
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (((Windows a b, a) -> a) -> Window a -> Window (Windows a b, a)
forall a' a. (a' -> a) -> Window a -> Window a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (Windows a b, a) -> a
forall a b. (a, b) -> b
snd)) a
a


makeWndw :: WindowFunction HPQ.WndwOp (C.Field_ n a)
makeWndw :: forall (n :: Nullability) a. WindowFunction WndwOp (Field_ n a)
makeWndw = PackMap WndwOp PrimExpr WndwOp (Field_ n a)
-> WindowFunction WndwOp (Field_ n a)
forall a b. PackMap WndwOp PrimExpr a b -> WindowFunction a b
WindowFunction ((forall (f :: * -> *).
 Applicative f =>
 (WndwOp -> f PrimExpr) -> WndwOp -> f (Field_ n a))
-> PackMap WndwOp PrimExpr WndwOp (Field_ n a)
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
PM.PackMap (\WndwOp -> f PrimExpr
f WndwOp
op -> PrimExpr -> Field_ n a
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
C.Column (PrimExpr -> Field_ n a) -> f PrimExpr -> f (Field_ n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WndwOp -> f PrimExpr
f WndwOp
op))


makeWndwField :: (HPQ.PrimExpr -> HPQ.WndwOp)
              -> WindowFunction (C.Field_ n a) (C.Field_ n' a')
makeWndwField :: forall (n :: Nullability) a (n' :: Nullability) a'.
(PrimExpr -> WndwOp) -> WindowFunction (Field_ n a) (Field_ n' a')
makeWndwField PrimExpr -> WndwOp
f = (Field_ n a -> WndwOp)
-> WindowFunction WndwOp (Field_ n' a')
-> WindowFunction (Field_ n a) (Field_ n' a')
forall a b c. (a -> b) -> WindowFunction b c -> WindowFunction a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (PrimExpr -> WndwOp
f (PrimExpr -> WndwOp)
-> (Field_ n a -> PrimExpr) -> Field_ n a -> WndwOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field_ n a -> PrimExpr
forall (n :: Nullability) a. Field_ n a -> PrimExpr
C.unColumn) WindowFunction WndwOp (Field_ n' a')
forall (n :: Nullability) a. WindowFunction WndwOp (Field_ n a)
makeWndw


makeWndwAny :: HPQ.WndwOp -> WindowFunction a (C.Field_ n b)
makeWndwAny :: forall a (n :: Nullability) b.
WndwOp -> WindowFunction a (Field_ n b)
makeWndwAny WndwOp
op = (a -> WndwOp)
-> WindowFunction WndwOp (Field_ n b)
-> WindowFunction a (Field_ n b)
forall a b c. (a -> b) -> WindowFunction b c -> WindowFunction a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (WndwOp -> a -> WndwOp
forall a b. a -> b -> a
const WndwOp
op) WindowFunction WndwOp (Field_ n b)
forall (n :: Nullability) a. WindowFunction WndwOp (Field_ n a)
makeWndw

-- | 'aggregatorWindowFunction' allows the use of 'A.Aggregator's in
-- 'WindowFunction's. In particular, @'aggregatorWindowFunction'
-- 'Opaleye.sum'@ gives a running total (when combined with an order
-- argument to 'over').
aggregatorWindowFunction :: A.Aggregator a b -> (a' -> a) -> WindowFunction a' b
aggregatorWindowFunction :: forall a b a'. Aggregator a b -> (a' -> a) -> WindowFunction a' b
aggregatorWindowFunction Aggregator a b
agg a' -> a
g = PackMap WndwOp PrimExpr a' b -> WindowFunction a' b
forall a b. PackMap WndwOp PrimExpr a b -> WindowFunction a b
WindowFunction (PackMap WndwOp PrimExpr a' b -> WindowFunction a' b)
-> PackMap WndwOp PrimExpr a' b -> WindowFunction a' b
forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *).
 Applicative f =>
 (WndwOp -> f PrimExpr) -> a' -> f b)
-> PackMap WndwOp PrimExpr a' b
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
PM.PackMap ((forall (f :: * -> *).
  Applicative f =>
  (WndwOp -> f PrimExpr) -> a' -> f b)
 -> PackMap WndwOp PrimExpr a' b)
-> (forall (f :: * -> *).
    Applicative f =>
    (WndwOp -> f PrimExpr) -> a' -> f b)
-> PackMap WndwOp PrimExpr a' b
forall a b. (a -> b) -> a -> b
$ \WndwOp -> f PrimExpr
f a'
a ->
  (Aggregate -> f PrimExpr) -> a' -> f b
forall (f :: * -> *).
Applicative f =>
(Aggregate -> f PrimExpr) -> a' -> f b
pm (\case
         HPQ.GroupBy PrimExpr
expr -> PrimExpr -> f PrimExpr
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimExpr
expr
         HPQ.Aggregate (HPQ.Aggr AggrOp
op [PrimExpr]
e [OrderExpr]
_ AggrDistinct
_ [OrderExpr]
_ Maybe PrimExpr
_) -> WndwOp -> f PrimExpr
f (AggrOp -> [PrimExpr] -> WndwOp
HPQ.WndwAggregate AggrOp
op [PrimExpr]
e)) a'
a
  where A.Aggregator (PM.PackMap forall (f :: * -> *).
Applicative f =>
(Aggregate -> f PrimExpr) -> a' -> f b
pm) = (a' -> a) -> Aggregator a b -> Aggregator a' b
forall a b c. (a -> b) -> Aggregator b c -> Aggregator a c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a' -> a
g Aggregator a b
agg

-- | 'over' applies a 'WindowFunction' on a particular 'Window'.  For
-- example,
--
-- @
-- over ('aggregatorWindowFunction' 'Opaleye.sum' salary) ('partitionBy' department) ('Opaleye.desc' salary)
-- @
--
-- If you want to use a 'Window' that consists of the entire @SELECT@
-- then supply 'mempty' for the @'Window' a@ argument.  If you don't
-- want to order the 'Window' then supply 'mempty' for the @'O.Order'
-- a@ argument.
over :: WindowFunction a b -> Window a -> O.Order a -> Windows a b
over :: forall a b.
WindowFunction a b -> Window a -> Order a -> Windows a b
over (WindowFunction PackMap WndwOp PrimExpr a b
windowFunction) Window a
partition Order a
order =
  let PM.PackMap forall (f :: * -> *).
Applicative f =>
(WndwOp -> f PrimExpr) -> a -> f b
pm = PackMap WndwOp PrimExpr a b
windowFunction
      orderPartitionBy' :: Window a
orderPartitionBy' = Order a -> Window a
forall a. Order a -> Window a
orderPartitionBy Order a
order
  in PackMap (WndwOp, Window a) PrimExpr a b -> Windows a b
forall a b. PackMap (WndwOp, Window a) PrimExpr a b -> Windows a b
Windows (PackMap (WndwOp, Window a) PrimExpr a b -> Windows a b)
-> PackMap (WndwOp, Window a) PrimExpr a b -> Windows a b
forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *).
 Applicative f =>
 ((WndwOp, Window a) -> f PrimExpr) -> a -> f b)
-> PackMap (WndwOp, Window a) PrimExpr a b
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
PM.PackMap ((forall (f :: * -> *).
  Applicative f =>
  ((WndwOp, Window a) -> f PrimExpr) -> a -> f b)
 -> PackMap (WndwOp, Window a) PrimExpr a b)
-> (forall (f :: * -> *).
    Applicative f =>
    ((WndwOp, Window a) -> f PrimExpr) -> a -> f b)
-> PackMap (WndwOp, Window a) PrimExpr a b
forall a b. (a -> b) -> a -> b
$ \(WndwOp, Window a) -> f PrimExpr
f -> (WndwOp -> f PrimExpr) -> a -> f b
forall (f :: * -> *).
Applicative f =>
(WndwOp -> f PrimExpr) -> a -> f b
pm (\WndwOp
op ->
    (WndwOp, Window a) -> f PrimExpr
f (WndwOp
op, Window a
partition Window a -> Window a -> Window a
forall a. Semigroup a => a -> a -> a
<> Window a
orderPartitionBy'))

-- | In PostgreSQL, window functions must specify the \"window\" over
-- which they operate. The syntax for this looks like: @SUM(salary)
-- OVER (PARTITION BY department)@. The Opaleye type 'Window'
-- represents the segment consisting of the @PARTIION BY@.
--
-- You can create a @Window@ using 'partitionBy' and combine two
-- @Windows@ in a single one which combines the partition of both by
-- using '<>'.
data Window a = Window (a -> [HPQ.PrimExpr]) (O.Order a)

instance Semigroup (Window a) where
  Window a -> [PrimExpr]
p1 Order a
o1 <> :: Window a -> Window a -> Window a
<> Window a -> [PrimExpr]
p2 Order a
o2 = (a -> [PrimExpr]) -> Order a -> Window a
forall a. (a -> [PrimExpr]) -> Order a -> Window a
Window (a -> [PrimExpr]
p1 (a -> [PrimExpr]) -> (a -> [PrimExpr]) -> a -> [PrimExpr]
forall a. Semigroup a => a -> a -> a
<> a -> [PrimExpr]
p2) (Order a
o1 Order a -> Order a -> Order a
forall a. Semigroup a => a -> a -> a
<> Order a
o2)

instance Monoid (Window a) where
  mempty :: Window a
mempty = (a -> [PrimExpr]) -> Order a -> Window a
forall a. (a -> [PrimExpr]) -> Order a -> Window a
Window a -> [PrimExpr]
forall a. Monoid a => a
mempty Order a
forall a. Monoid a => a
mempty
  mappend :: Window a -> Window a -> Window a
mappend = Window a -> Window a -> Window a
forall a. Semigroup a => a -> a -> a
(<>)

instance Contravariant Window where
  contramap :: forall a' a. (a' -> a) -> Window a -> Window a'
contramap a' -> a
f (Window a -> [PrimExpr]
p Order a
o) = (a' -> [PrimExpr]) -> Order a' -> Window a'
forall a. (a -> [PrimExpr]) -> Order a -> Window a
Window ((a' -> a) -> (a -> [PrimExpr]) -> a' -> [PrimExpr]
forall a b c. (a -> b) -> (b -> c) -> a -> c
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a' -> a
f a -> [PrimExpr]
p) ((a' -> a) -> Order a -> Order a'
forall a' a. (a' -> a) -> Order a -> Order a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap a' -> a
f Order a
o)

-- | The window where each partition shares the same value for the
-- given 'Field'.
partitionBy :: (a -> C.Field_ n b) -> Window a
partitionBy :: forall a (n :: Nullability) b. (a -> Field_ n b) -> Window a
partitionBy a -> Field_ n b
f = (a -> [PrimExpr]) -> Order a -> Window a
forall a. (a -> [PrimExpr]) -> Order a -> Window a
Window (\a
a -> [Field_ n b -> PrimExpr
forall (n :: Nullability) a. Field_ n a -> PrimExpr
C.unColumn (a -> Field_ n b
f a
a)]) Order a
forall a. Monoid a => a
mempty

-- | Controls the order in which rows are processed by window functions. This
-- does not need to match the ordering of the overall query.
orderPartitionBy :: O.Order a -> Window a
orderPartitionBy :: forall a. Order a -> Window a
orderPartitionBy = (a -> [PrimExpr]) -> Order a -> Window a
forall a. (a -> [PrimExpr]) -> Order a -> Window a
Window a -> [PrimExpr]
forall a. Monoid a => a
mempty