{-# 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. (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
.# :: forall a b c (q :: * -> * -> *).
Coercible b a =>
Window b c -> q 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 c b =>
q 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
rmap :: forall b c a. (b -> c) -> Window a b -> Window a c
$crmap :: forall b c a. (b -> c) -> Window a b -> Window a c
lmap :: forall a b c. (a -> b) -> Window b c -> Window a c
$clmap :: forall a b c. (a -> b) -> Window b c -> Window a c
dimap :: forall a b c d. (a -> b) -> (c -> d) -> Window b c -> Window a d
$cdimap :: forall a b c d. (a -> b) -> (c -> d) -> Window b c -> Window a d
Profunctor)
  deriving newtype (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
<$ :: forall a b. a -> Window a b -> Window a a
$c<$ :: forall a a b. a -> Window a b -> Window a a
fmap :: forall a b. (a -> b) -> Window a a -> Window a b
$cfmap :: forall a a b. (a -> b) -> Window a a -> Window a b
Functor, 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
<* :: forall a b. Window a a -> Window a b -> Window a a
$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 b
$c*> :: forall a a b. Window a a -> Window a b -> Window a b
liftA2 :: forall a b c.
(a -> b -> c) -> Window a a -> Window a b -> Window a c
$cliftA2 :: forall a a b c.
(a -> b -> c) -> Window a a -> Window a b -> Window a c
<*> :: forall a b. Window a (a -> b) -> Window a a -> Window a b
$c<*> :: forall a a b. Window a (a -> b) -> Window a a -> Window a b
pure :: forall a. a -> Window a a
$cpure :: forall a a. a -> Window a a
Applicative)
  deriving (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
liftF2 :: forall a b c.
(a -> b -> c) -> Window a a -> Window a b -> Window a c
$cliftF2 :: forall a 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 a
$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 b
$c.> :: forall a a b. Window a a -> Window a b -> Window a b
<.> :: forall a b. Window a (a -> b) -> Window a a -> Window a b
$c<.> :: forall a a b. Window a (a -> b) -> Window a a -> Window a b
Apply) via (WrappedApplicative (Window a))


instance ProductProfunctor Window where
  purePP :: forall b a. b -> Window a b
purePP = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  **** :: forall a 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 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
>$ :: forall b a. b -> Partition b -> Partition a
$c>$ :: forall b a. b -> Partition b -> Partition a
contramap :: forall a' a. (a' -> a) -> Partition a -> Partition a'
$ccontramap :: forall a' a. (a' -> a) -> Partition a -> Partition a'
Contravariant, NonEmpty (Partition a) -> Partition a
Partition a -> Partition a -> 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
stimes :: forall b. Integral b => b -> Partition a -> Partition a
$cstimes :: forall a b. Integral b => b -> Partition a -> Partition a
sconcat :: NonEmpty (Partition a) -> Partition a
$csconcat :: forall a. NonEmpty (Partition a) -> Partition a
<> :: Partition a -> Partition a -> Partition a
$c<> :: forall a. Partition a -> Partition a -> Partition a
Semigroup, 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
mconcat :: [Partition a] -> Partition a
$cmconcat :: forall a. [Partition a] -> Partition a
mappend :: Partition a -> Partition a -> Partition a
$cmappend :: forall a. Partition a -> Partition a -> Partition a
mempty :: Partition a
$cmempty :: forall 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) =
  forall a b. Windows a b -> Window a b
Window forall a b. (a -> b) -> a -> b
$ forall a b. PackMap (WndwOp, Window a) PrimExpr a b -> Windows a b
Opaleye.Windows forall a b. (a -> b) -> 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 a b. (a -> b) -> a -> b
$ \(WndwOp, Window a) -> f PrimExpr
f ->
    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' 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 =
  forall a. Window a -> Partition a
Partition forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) forall a b. (a -> b) -> a -> b
$ forall {k} a (b :: k). Const a b -> a
getConst 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 b. (a -> b) -> a -> b
$ \HField (Columns b) a
field ->
      forall {k} a (b :: k). a -> Const a b
Const forall a b. (a -> b) -> a -> b
$ forall a (n :: Nullability) b. (a -> Field_ n b) -> Window a
Opaleye.partitionBy (forall (n :: Nullability) b. PrimExpr -> Field_ n b
toColumn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Expr a -> PrimExpr
toPrimExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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) = forall a. Window a -> Partition a
Partition forall a b. (a -> b) -> a -> b
$ forall a. Order a -> Window a
Opaleye.orderPartitionBy Order a
ordering