{-# language DerivingVia #-}
{-# language FlexibleContexts #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeApplications #-}

module Rel8.Window
  ( Window(..)
  , Partition
  , over
  , partitionBy
  , orderPartitionBy
  )
where

-- base
import Data.Functor.Const ( Const( Const ), getConst )
import Data.Functor.Contravariant ( Contravariant, contramap )
import Data.Kind ( Type )
import Prelude

-- opaleye
import qualified Opaleye.Internal.Window as Opaleye
import qualified Opaleye.Internal.PackMap as Opaleye

-- profunctors
import Data.Profunctor ( Profunctor )

-- product-profunctors
import Data.Profunctor.Product ( ProductProfunctor, (****), purePP )

-- rel8
import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )
import Rel8.Order( Order( Order ) )
import Rel8.Schema.HTable ( hfield, htabulateA )
import Rel8.Table ( Columns, toColumns )
import Rel8.Table.Eq ( EqTable )

-- semigroupoids
import Data.Functor.Apply ( Apply, WrappedApplicative(..) )


-- | 'Window' is an applicative functor that represents expressions that
-- contain
-- [window functions](https://www.postgresql.org/docs/current/tutorial-window.html).
-- 'Rel8.Query.Window.window' can be used to
-- evaluate these expressions over a particular query.
type Window :: Type -> Type -> Type
newtype Window a b = Window (Opaleye.Windows a b)
  deriving newtype ((forall a b c d. (a -> b) -> (c -> d) -> Window b c -> Window a d)
-> (forall a b c. (a -> b) -> Window b c -> Window a c)
-> (forall b c a. (b -> c) -> Window a b -> Window a c)
-> (forall a b c (q :: * -> * -> *).
    Coercible c b =>
    q b c -> Window a b -> Window a c)
-> (forall a b c (q :: * -> * -> *).
    Coercible b a =>
    Window b c -> q a b -> Window a c)
-> Profunctor Window
forall a b c. (a -> b) -> Window b c -> Window a c
forall b c a. (b -> c) -> Window a b -> Window a c
forall a b c d. (a -> b) -> (c -> d) -> Window b c -> Window a d
forall a b c (q :: * -> * -> *).
Coercible b a =>
Window b c -> q a b -> Window a c
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> Window a b -> Window a c
forall (p :: * -> * -> *).
(forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d)
-> (forall a b c. (a -> b) -> p b c -> p a c)
-> (forall b c a. (b -> c) -> p a b -> p a c)
-> (forall a b c (q :: * -> * -> *).
    Coercible c b =>
    q b c -> p a b -> p a c)
-> (forall a b c (q :: * -> * -> *).
    Coercible b a =>
    p b c -> q a b -> p a c)
-> Profunctor p
$cdimap :: forall a b c d. (a -> b) -> (c -> d) -> Window b c -> Window a d
dimap :: forall a b c d. (a -> b) -> (c -> d) -> Window b c -> Window a d
$clmap :: forall a b c. (a -> b) -> Window b c -> Window a c
lmap :: forall a b c. (a -> b) -> Window b c -> Window a c
$crmap :: forall b c a. (b -> c) -> Window a b -> Window a c
rmap :: forall b c a. (b -> c) -> Window a b -> Window a c
$c#. :: forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> Window a b -> Window a c
#. :: forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> Window a b -> Window a c
$c.# :: forall a b c (q :: * -> * -> *).
Coercible b a =>
Window b c -> q a b -> Window a c
.# :: forall a b c (q :: * -> * -> *).
Coercible b a =>
Window b c -> q a b -> Window a c
Profunctor)
  deriving newtype ((forall a b. (a -> b) -> Window a a -> Window a b)
-> (forall a b. a -> Window a b -> Window a a)
-> Functor (Window a)
forall a b. a -> Window a b -> Window a a
forall a b. (a -> b) -> Window a a -> Window a b
forall a a b. a -> Window a b -> Window a a
forall a a b. (a -> b) -> Window a a -> Window a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a a b. (a -> b) -> Window a a -> Window a b
fmap :: forall a b. (a -> b) -> Window a a -> Window a b
$c<$ :: forall a a b. a -> Window a b -> Window a a
<$ :: forall a b. a -> Window a b -> Window a a
Functor, Functor (Window a)
Functor (Window a) =>
(forall a. a -> Window a a)
-> (forall a b. Window a (a -> b) -> Window a a -> Window a b)
-> (forall a b c.
    (a -> b -> c) -> Window a a -> Window a b -> Window a c)
-> (forall a b. Window a a -> Window a b -> Window a b)
-> (forall a b. Window a a -> Window a b -> Window a a)
-> Applicative (Window a)
forall a. Functor (Window a)
forall a. a -> Window a a
forall a a. a -> Window a a
forall a b. Window a a -> Window a b -> Window a a
forall a b. Window a a -> Window a b -> Window a b
forall a b. Window a (a -> b) -> Window a a -> Window a b
forall a a b. Window a a -> Window a b -> Window a a
forall a a b. Window a a -> Window a b -> Window a b
forall a a b. Window a (a -> b) -> Window a a -> Window a b
forall a b c.
(a -> b -> c) -> Window a a -> Window a b -> Window a c
forall a a b c.
(a -> b -> c) -> Window a a -> Window a b -> Window a c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a a. a -> Window a a
pure :: forall a. a -> Window a a
$c<*> :: forall a a b. Window a (a -> b) -> Window a a -> Window a b
<*> :: forall a b. Window a (a -> b) -> Window a a -> Window a b
$cliftA2 :: forall a a b c.
(a -> b -> c) -> Window a a -> Window a b -> Window a c
liftA2 :: forall a b c.
(a -> b -> c) -> Window a a -> Window a b -> Window a c
$c*> :: forall a a b. Window a a -> Window a b -> Window a b
*> :: forall a b. Window a a -> Window a b -> Window a b
$c<* :: forall a a b. Window a a -> Window a b -> Window a a
<* :: forall a b. Window a a -> Window a b -> Window a a
Applicative)
  deriving (Functor (Window a)
Functor (Window a) =>
(forall a b. Window a (a -> b) -> Window a a -> Window a b)
-> (forall a b. Window a a -> Window a b -> Window a b)
-> (forall a b. Window a a -> Window a b -> Window a a)
-> (forall a b c.
    (a -> b -> c) -> Window a a -> Window a b -> Window a c)
-> Apply (Window a)
forall a. Functor (Window a)
forall a b. Window a a -> Window a b -> Window a a
forall a b. Window a a -> Window a b -> Window a b
forall a b. Window a (a -> b) -> Window a a -> Window a b
forall a a b. Window a a -> Window a b -> Window a a
forall a a b. Window a a -> Window a b -> Window a b
forall a a b. Window a (a -> b) -> Window a a -> Window a b
forall a b c.
(a -> b -> c) -> Window a a -> Window a b -> Window a c
forall a a b c.
(a -> b -> c) -> Window a a -> Window a b -> Window a c
forall (f :: * -> *).
Functor f =>
(forall a b. f (a -> b) -> f a -> f b)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> Apply f
$c<.> :: forall a a b. Window a (a -> b) -> Window a a -> Window a b
<.> :: forall a b. Window a (a -> b) -> Window a a -> Window a b
$c.> :: forall a a b. Window a a -> Window a b -> Window a b
.> :: forall a b. Window a a -> Window a b -> Window a b
$c<. :: forall a a b. Window a a -> Window a b -> Window a a
<. :: forall a b. Window a a -> Window a b -> Window a a
$cliftF2 :: forall a a b c.
(a -> b -> c) -> Window a a -> Window a b -> Window a c
liftF2 :: forall a b c.
(a -> b -> c) -> Window a a -> Window a b -> Window a c
Apply) via (WrappedApplicative (Window a))


instance ProductProfunctor Window where
  purePP :: forall b a. b -> Window a b
purePP = b -> Window a b
forall a. a -> Window a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  **** :: forall a a b. Window a (a -> b) -> Window a a -> Window a b
(****) = Window a (b -> c) -> Window a b -> Window a c
forall a b. Window a (a -> b) -> Window a a -> Window a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)


-- | In PostgreSQL, window functions must specify the \"window\" or
-- \"partition\" over which they operate. The syntax for this looks like:
-- @SUM(salary) OVER (PARTITION BY department)@. The Rel8 type 'Partition'
-- represents everything that comes after @OVER@.
--
-- 'Partition' is a 'Monoid', so 'Window's created with 'partitionBy' and
-- 'orderWindowBy' can be combined using '<>'.
type Partition :: Type -> Type
newtype Partition a = Partition (Opaleye.Window a)
  deriving newtype ((forall a' a. (a' -> a) -> Partition a -> Partition a')
-> (forall b a. b -> Partition b -> Partition a)
-> Contravariant Partition
forall b a. b -> Partition b -> Partition a
forall a' a. (a' -> a) -> Partition a -> Partition a'
forall (f :: * -> *).
(forall a' a. (a' -> a) -> f a -> f a')
-> (forall b a. b -> f b -> f a) -> Contravariant f
$ccontramap :: forall a' a. (a' -> a) -> Partition a -> Partition a'
contramap :: forall a' a. (a' -> a) -> Partition a -> Partition a'
$c>$ :: forall b a. b -> Partition b -> Partition a
>$ :: forall b a. b -> Partition b -> Partition a
Contravariant, NonEmpty (Partition a) -> Partition a
Partition a -> Partition a -> Partition a
(Partition a -> Partition a -> Partition a)
-> (NonEmpty (Partition a) -> Partition a)
-> (forall b. Integral b => b -> Partition a -> Partition a)
-> Semigroup (Partition a)
forall b. Integral b => b -> Partition a -> Partition a
forall a. NonEmpty (Partition a) -> Partition a
forall a. Partition a -> Partition a -> Partition a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> Partition a -> Partition a
$c<> :: forall a. Partition a -> Partition a -> Partition a
<> :: Partition a -> Partition a -> Partition a
$csconcat :: forall a. NonEmpty (Partition a) -> Partition a
sconcat :: NonEmpty (Partition a) -> Partition a
$cstimes :: forall a b. Integral b => b -> Partition a -> Partition a
stimes :: forall b. Integral b => b -> Partition a -> Partition a
Semigroup, Semigroup (Partition a)
Partition a
Semigroup (Partition a) =>
Partition a
-> (Partition a -> Partition a -> Partition a)
-> ([Partition a] -> Partition a)
-> Monoid (Partition a)
[Partition a] -> Partition a
Partition a -> Partition a -> Partition a
forall a. Semigroup (Partition a)
forall a. Partition a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [Partition a] -> Partition a
forall a. Partition a -> Partition a -> Partition a
$cmempty :: forall a. Partition a
mempty :: Partition a
$cmappend :: forall a. Partition a -> Partition a -> Partition a
mappend :: Partition a -> Partition a -> Partition a
$cmconcat :: forall a. [Partition a] -> Partition a
mconcat :: [Partition a] -> Partition a
Monoid)


-- | 'over' adds a 'Partition' to a 'Window' expression.
--
-- @@@
-- 'Rel8.Table.Window.cumulative' ('Rel8.Expr.Aggregate.sum' . salary) `over` 'partitionBy' department <> 'orderPartitionBy' (salary >$< 'Rel8.desc')
-- @@@
over :: Window a b -> Partition a -> Window a b
over :: forall a b. Window a b -> Partition a -> Window a b
over (Window (Opaleye.Windows (Opaleye.PackMap forall (f :: * -> *).
Applicative f =>
((WndwOp, Window a) -> f PrimExpr) -> a -> f b
w))) (Partition Window a
p) =
  Windows a b -> Window a b
forall a b. Windows a b -> Window a b
Window (Windows a b -> Window a b) -> Windows a b -> Window a b
forall a b. (a -> b) -> a -> b
$ PackMap (WndwOp, Window a) PrimExpr a b -> Windows a b
forall a b. PackMap (WndwOp, Window a) PrimExpr a b -> Windows a b
Opaleye.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
Opaleye.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, Window a) -> f PrimExpr) -> a -> f b
forall (f :: * -> *).
Applicative f =>
((WndwOp, Window a) -> f PrimExpr) -> a -> f b
w (\(WndwOp
o, Window a
p') -> (WndwOp, Window a) -> f PrimExpr
f (WndwOp
o, Window a
p' Window a -> Window a -> Window a
forall a. Semigroup a => a -> a -> a
<> Window a
p))
infixl 1 `over`


-- | Restricts a window function to operate only the group of rows that share
-- the same value(s) for the given expression(s).
partitionBy :: forall b a. EqTable b => (a -> b) -> Partition a
partitionBy :: forall b a. EqTable b => (a -> b) -> Partition a
partitionBy a -> b
f =
  Window a -> Partition a
forall a. Window a -> Partition a
Partition (Window a -> Partition a) -> Window a -> Partition a
forall a b. (a -> b) -> a -> b
$ (a -> Columns b Expr) -> Window (Columns b Expr) -> Window a
forall a' a. (a' -> a) -> Window a -> Window a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (b -> Columns b Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns (b -> Columns b Expr) -> (a -> b) -> a -> Columns b Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (Window (Columns b Expr) -> Window a)
-> Window (Columns b Expr) -> Window a
forall a b. (a -> b) -> a -> b
$ Const (Window (Columns b Expr)) (Columns b Any)
-> Window (Columns b Expr)
forall {k} a (b :: k). Const a b -> a
getConst (Const (Window (Columns b Expr)) (Columns b Any)
 -> Window (Columns b Expr))
-> Const (Window (Columns b Expr)) (Columns b Any)
-> Window (Columns b Expr)
forall a b. (a -> b) -> a -> b
$
    forall (t :: HTable) (m :: * -> *) (context :: * -> *).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA @(Columns b) ((forall a.
  HField (Columns b) a -> Const (Window (Columns b Expr)) (Any a))
 -> Const (Window (Columns b Expr)) (Columns b Any))
-> (forall a.
    HField (Columns b) a -> Const (Window (Columns b Expr)) (Any a))
-> Const (Window (Columns b Expr)) (Columns b Any)
forall a b. (a -> b) -> a -> b
$ \HField (Columns b) a
field ->
      Window (Columns b Expr) -> Const (Window (Columns b Expr)) (Any a)
forall {k} a (b :: k). a -> Const a b
Const (Window (Columns b Expr)
 -> Const (Window (Columns b Expr)) (Any a))
-> Window (Columns b Expr)
-> Const (Window (Columns b Expr)) (Any a)
forall a b. (a -> b) -> a -> b
$ (Columns b Expr -> Field_ Any Any) -> Window (Columns b Expr)
forall a (n :: Nullability) b. (a -> Field_ n b) -> Window a
Opaleye.partitionBy (PrimExpr -> Field_ Any Any
forall (n :: Nullability) b. PrimExpr -> Field_ n b
toColumn (PrimExpr -> Field_ Any Any)
-> (Columns b Expr -> PrimExpr) -> Columns b Expr -> Field_ Any Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr a -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr (Expr a -> PrimExpr)
-> (Columns b Expr -> Expr a) -> Columns b Expr -> PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Columns b Expr -> HField (Columns b) a -> Expr a
forall (context :: * -> *) a.
Columns b context -> HField (Columns b) a -> context a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
`hfield` HField (Columns b) a
field))


-- | Controls the order in which rows are processed by window functions. This
-- does not need to match the ordering of the overall query.
orderPartitionBy :: Order a -> Partition a
orderPartitionBy :: forall a. Order a -> Partition a
orderPartitionBy (Order Order a
ordering) = Window a -> Partition a
forall a. Window a -> Partition a
Partition (Window a -> Partition a) -> Window a -> Partition a
forall a b. (a -> b) -> a -> b
$ Order a -> Window a
forall a. Order a -> Window a
Opaleye.orderPartitionBy Order a
ordering