{-# language ApplicativeDo #-}
{-# language FlexibleContexts #-}
{-# language MonoLocalBinds #-}
{-# language NamedFieldPuns #-}

module Rel8.Table.Window
  ( currentRow
  , lag, lagOn
  , lead, leadOn
  , firstValue, firstValueOn
  , lastValue, lastValueOn
  , nthValue, nthValueOn
  )
where

-- base
import Data.Int (Int32)
import Prelude hiding (null)

-- opaleye
import qualified Opaleye.Window as Opaleye

-- profunctor
import Data.Profunctor (dimap, lmap)

-- rel8
import Rel8.Expr (Expr)
import Rel8.Expr.Null (null, nullify, snull)
import Rel8.Expr.Serialize (litExpr)
import Rel8.Expr.Window
  ( lagExpr, lagExprOn
  , leadExpr, leadExprOn
  , firstValueExpr
  , lastValueExpr
  , nthValueExpr, nthValueExprOn
  )
import Rel8.Schema.HTable (htraverseP)
import Rel8.Schema.HTable.Identity (HIdentity (HIdentity))
import Rel8.Schema.HTable.Label (hlabel)
import Rel8.Schema.HTable.Maybe (HMaybeTable (HMaybeTable))
import Rel8.Schema.HTable.Nullify (hnullify)
import Rel8.Schema.Null (Nullity (NotNull, Null))
import Rel8.Schema.Spec (Spec (..))
import Rel8.Table (Table, fromColumns, toColumns)
import Rel8.Table.Maybe (MaybeTable)
import Rel8.Type.Tag (MaybeTag (IsJust))
import Rel8.Window (Window (Window))


-- | Return every column of the current row of a window query.
currentRow :: Window a a
currentRow :: forall a. Window a a
currentRow = Windows a a -> Window a a
forall a b. Windows a b -> Window a b
Window (Windows a a -> Window a a) -> Windows a a -> Window a a
forall a b. (a -> b) -> a -> b
$ WindowFunction a a -> Window a -> Order a -> Windows a a
forall a b.
WindowFunction a b -> Window a -> Order a -> Windows a b
Opaleye.over ((a -> a) -> WindowFunction a a
forall a b. (a -> b) -> WindowFunction a b
Opaleye.noWindowFunction a -> a
forall a. a -> a
id) Window a
forall a. Monoid a => a
mempty Order a
forall a. Monoid a => a
mempty


-- | @'lag' n@ returns the row @n@ rows before the current row in a given
-- window. Returns 'Rel8.nothingTable' if @n@ is out of bounds.
lag :: Table Expr a => Expr Int32 -> Window a (MaybeTable Expr a)
lag :: forall a.
Table Expr a =>
Expr Int32 -> Window a (MaybeTable Expr a)
lag Expr Int32
n = do
  Expr (Maybe MaybeTag)
htag <- Expr Int32
-> Expr (Maybe MaybeTag)
-> (a -> Expr (Maybe MaybeTag))
-> Window a (Expr (Maybe MaybeTag))
forall a i.
Expr Int32 -> Expr a -> (i -> Expr a) -> Window i (Expr a)
lagExprOn Expr Int32
n Expr (Maybe MaybeTag)
forall a. DBType a => Expr (Maybe a)
null (\a
_ -> Expr MaybeTag -> Expr (Maybe MaybeTag)
forall a. NotNull a => Expr a -> Expr (Maybe a)
nullify (MaybeTag -> Expr MaybeTag
forall a. Sql DBType a => a -> Expr a
litExpr MaybeTag
IsJust))
  HNullify (Columns a) Expr
hjust <- (a -> Columns a Expr)
-> Window (Columns a Expr) (HNullify (Columns a) Expr)
-> Window a (HNullify (Columns a) Expr)
forall a b c. (a -> b) -> Window b c -> Window a c
forall (p :: * -> Context) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns (Window (Columns a Expr) (HNullify (Columns a) Expr)
 -> Window a (HNullify (Columns a) Expr))
-> Window (Columns a Expr) (HNullify (Columns a) Expr)
-> Window a (HNullify (Columns a) Expr)
forall a b. (a -> b) -> a -> b
$ (forall a. Spec a -> Window (Expr a) (Expr (Nullify a)))
-> Window (Columns a Expr) (HNullify (Columns a) Expr)
forall (t :: HTable) (p :: * -> Context) (context :: Context).
(HTable t, ProductProfunctor p) =>
(forall a. Spec a -> p (context a) (context (Nullify a)))
-> p (t context) (HNullify t context)
hnullify ((forall a. Spec a -> Window (Expr a) (Expr (Nullify a)))
 -> Window (Columns a Expr) (HNullify (Columns a) Expr))
-> (forall a. Spec a -> Window (Expr a) (Expr (Nullify a)))
-> Window (Columns a Expr) (HNullify (Columns a) Expr)
forall a b. (a -> b) -> a -> b
$ \Spec {TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info :: forall a. Spec a -> TypeInformation (Unnullify a)
info, Nullity a
nullity :: Nullity a
nullity :: forall a. Spec a -> Nullity a
nullity} ->
    case Nullity a
nullity of
      Nullity a
NotNull -> Expr Int32
-> Expr (Maybe a)
-> (Expr a -> Expr (Maybe a))
-> Window (Expr a) (Expr (Maybe a))
forall a i.
Expr Int32 -> Expr a -> (i -> Expr a) -> Window i (Expr a)
lagExprOn Expr Int32
n (TypeInformation a -> Expr (Maybe a)
forall a. TypeInformation a -> Expr (Maybe a)
snull TypeInformation a
TypeInformation (Unnullify a)
info) Expr a -> Expr (Maybe a)
forall a. NotNull a => Expr a -> Expr (Maybe a)
nullify
      Nullity a
Null -> Expr Int32 -> Expr a -> Window (Expr a) (Expr a)
forall a. Expr Int32 -> Expr a -> Window (Expr a) (Expr a)
lagExpr Expr Int32
n (TypeInformation a1 -> Expr (Maybe a1)
forall a. TypeInformation a -> Expr (Maybe a)
snull TypeInformation a1
TypeInformation (Unnullify a)
info)
  pure $ Columns (MaybeTable Expr a) Expr -> MaybeTable Expr a
forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns (Columns (MaybeTable Expr a) Expr -> MaybeTable Expr a)
-> Columns (MaybeTable Expr a) Expr -> MaybeTable Expr a
forall a b. (a -> b) -> a -> b
$ HLabel "isJust" (HIdentity (Maybe MaybeTag)) Expr
-> HLabel "Just" (HNullify (Columns a)) Expr
-> HMaybeTable (Columns a) Expr
forall (table :: HTable) (context :: Context).
HLabel "isJust" (HIdentity (Maybe MaybeTag)) context
-> HLabel "Just" (HNullify table) context
-> HMaybeTable table context
HMaybeTable (HIdentity (Maybe MaybeTag) Expr
-> HLabel "isJust" (HIdentity (Maybe MaybeTag)) Expr
forall (label :: Symbol) (t :: HTable) (context :: Context).
t context -> HLabel label t context
hlabel (Expr (Maybe MaybeTag) -> HIdentity (Maybe MaybeTag) Expr
forall a (context :: Context). context a -> HIdentity a context
HIdentity Expr (Maybe MaybeTag)
htag)) (HNullify (Columns a) Expr
-> HLabel "Just" (HNullify (Columns a)) Expr
forall (label :: Symbol) (t :: HTable) (context :: Context).
t context -> HLabel label t context
hlabel HNullify (Columns a) Expr
hjust)


-- | Applies 'lag' to the columns selected by the given function.
lagOn :: Table Expr a => Expr Int32 -> (i -> a) -> Window i (MaybeTable Expr a)
lagOn :: forall a i.
Table Expr a =>
Expr Int32 -> (i -> a) -> Window i (MaybeTable Expr a)
lagOn Expr Int32
n i -> a
f = (i -> a)
-> Window a (MaybeTable Expr a) -> Window i (MaybeTable Expr a)
forall a b c. (a -> b) -> Window b c -> Window a c
forall (p :: * -> Context) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap i -> a
f (Expr Int32 -> Window a (MaybeTable Expr a)
forall a.
Table Expr a =>
Expr Int32 -> Window a (MaybeTable Expr a)
lag Expr Int32
n)


-- | @'lead' n@ returns the row @n@ rows after the current row in a given
-- window. Returns 'Rel8.nothingTable' if @n@ is out of bounds.
lead :: Table Expr a => Expr Int32 -> Window a (MaybeTable Expr a)
lead :: forall a.
Table Expr a =>
Expr Int32 -> Window a (MaybeTable Expr a)
lead Expr Int32
n = do
  Expr (Maybe MaybeTag)
htag <- Expr Int32
-> Expr (Maybe MaybeTag)
-> (a -> Expr (Maybe MaybeTag))
-> Window a (Expr (Maybe MaybeTag))
forall a i.
Expr Int32 -> Expr a -> (i -> Expr a) -> Window i (Expr a)
leadExprOn Expr Int32
n Expr (Maybe MaybeTag)
forall a. DBType a => Expr (Maybe a)
null (\a
_ -> Expr MaybeTag -> Expr (Maybe MaybeTag)
forall a. NotNull a => Expr a -> Expr (Maybe a)
nullify (MaybeTag -> Expr MaybeTag
forall a. Sql DBType a => a -> Expr a
litExpr MaybeTag
IsJust))
  HNullify (Columns a) Expr
hjust <- (a -> Columns a Expr)
-> Window (Columns a Expr) (HNullify (Columns a) Expr)
-> Window a (HNullify (Columns a) Expr)
forall a b c. (a -> b) -> Window b c -> Window a c
forall (p :: * -> Context) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns (Window (Columns a Expr) (HNullify (Columns a) Expr)
 -> Window a (HNullify (Columns a) Expr))
-> Window (Columns a Expr) (HNullify (Columns a) Expr)
-> Window a (HNullify (Columns a) Expr)
forall a b. (a -> b) -> a -> b
$ (forall a. Spec a -> Window (Expr a) (Expr (Nullify a)))
-> Window (Columns a Expr) (HNullify (Columns a) Expr)
forall (t :: HTable) (p :: * -> Context) (context :: Context).
(HTable t, ProductProfunctor p) =>
(forall a. Spec a -> p (context a) (context (Nullify a)))
-> p (t context) (HNullify t context)
hnullify ((forall a. Spec a -> Window (Expr a) (Expr (Nullify a)))
 -> Window (Columns a Expr) (HNullify (Columns a) Expr))
-> (forall a. Spec a -> Window (Expr a) (Expr (Nullify a)))
-> Window (Columns a Expr) (HNullify (Columns a) Expr)
forall a b. (a -> b) -> a -> b
$ \Spec {TypeInformation (Unnullify a)
info :: forall a. Spec a -> TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info, Nullity a
nullity :: forall a. Spec a -> Nullity a
nullity :: Nullity a
nullity} ->
    case Nullity a
nullity of
      Nullity a
NotNull -> Expr Int32
-> Expr (Maybe a)
-> (Expr a -> Expr (Maybe a))
-> Window (Expr a) (Expr (Maybe a))
forall a i.
Expr Int32 -> Expr a -> (i -> Expr a) -> Window i (Expr a)
leadExprOn Expr Int32
n (TypeInformation a -> Expr (Maybe a)
forall a. TypeInformation a -> Expr (Maybe a)
snull TypeInformation a
TypeInformation (Unnullify a)
info) Expr a -> Expr (Maybe a)
forall a. NotNull a => Expr a -> Expr (Maybe a)
nullify
      Nullity a
Null -> Expr Int32 -> Expr a -> Window (Expr a) (Expr a)
forall a. Expr Int32 -> Expr a -> Window (Expr a) (Expr a)
leadExpr Expr Int32
n (TypeInformation a1 -> Expr (Maybe a1)
forall a. TypeInformation a -> Expr (Maybe a)
snull TypeInformation a1
TypeInformation (Unnullify a)
info)
  pure $ Columns (MaybeTable Expr a) Expr -> MaybeTable Expr a
forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns (Columns (MaybeTable Expr a) Expr -> MaybeTable Expr a)
-> Columns (MaybeTable Expr a) Expr -> MaybeTable Expr a
forall a b. (a -> b) -> a -> b
$ HLabel "isJust" (HIdentity (Maybe MaybeTag)) Expr
-> HLabel "Just" (HNullify (Columns a)) Expr
-> HMaybeTable (Columns a) Expr
forall (table :: HTable) (context :: Context).
HLabel "isJust" (HIdentity (Maybe MaybeTag)) context
-> HLabel "Just" (HNullify table) context
-> HMaybeTable table context
HMaybeTable (HIdentity (Maybe MaybeTag) Expr
-> HLabel "isJust" (HIdentity (Maybe MaybeTag)) Expr
forall (label :: Symbol) (t :: HTable) (context :: Context).
t context -> HLabel label t context
hlabel (Expr (Maybe MaybeTag) -> HIdentity (Maybe MaybeTag) Expr
forall a (context :: Context). context a -> HIdentity a context
HIdentity Expr (Maybe MaybeTag)
htag)) (HNullify (Columns a) Expr
-> HLabel "Just" (HNullify (Columns a)) Expr
forall (label :: Symbol) (t :: HTable) (context :: Context).
t context -> HLabel label t context
hlabel HNullify (Columns a) Expr
hjust)


-- | Applies 'lead' to the columns selected by the given function.
leadOn :: Table Expr a => Expr Int32 -> (i -> a) -> Window i (MaybeTable Expr a)
leadOn :: forall a i.
Table Expr a =>
Expr Int32 -> (i -> a) -> Window i (MaybeTable Expr a)
leadOn Expr Int32
n i -> a
f = (i -> a)
-> Window a (MaybeTable Expr a) -> Window i (MaybeTable Expr a)
forall a b c. (a -> b) -> Window b c -> Window a c
forall (p :: * -> Context) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap i -> a
f (Expr Int32 -> Window a (MaybeTable Expr a)
forall a.
Table Expr a =>
Expr Int32 -> Window a (MaybeTable Expr a)
lead Expr Int32
n)


-- | 'firstValue' returns the first row of the window of the current row.
firstValue :: Table Expr a => Window a a
firstValue :: forall a. Table Expr a => Window a a
firstValue = (a -> Columns a Expr)
-> (Columns a Expr -> a)
-> Window (Columns a Expr) (Columns a Expr)
-> Window a a
forall a b c d. (a -> b) -> (c -> d) -> Window b c -> Window a d
forall (p :: * -> Context) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns Columns a Expr -> a
forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns (Window (Columns a Expr) (Columns a Expr) -> Window a a)
-> Window (Columns a Expr) (Columns a Expr) -> Window a a
forall a b. (a -> b) -> a -> b
$ (forall a. Window (Expr a) (Expr a))
-> Window (Columns a Expr) (Columns a Expr)
forall (t :: HTable) (p :: * -> Context) (f :: Context)
       (g :: Context).
(HTable t, ProductProfunctor p) =>
(forall a. p (f a) (g a)) -> p (t f) (t g)
htraverseP Window (Expr a) (Expr a)
forall a. Window (Expr a) (Expr a)
firstValueExpr


-- | Applies 'firstValue' to the columns selected by the given function.
firstValueOn :: Table Expr a => (i -> a) -> Window i a
firstValueOn :: forall a i. Table Expr a => (i -> a) -> Window i a
firstValueOn i -> a
f = (i -> a) -> Window a a -> Window i a
forall a b c. (a -> b) -> Window b c -> Window a c
forall (p :: * -> Context) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap i -> a
f Window a a
forall a. Table Expr a => Window a a
firstValue


-- | 'lastValue' returns the first row of the window of the current row.
lastValue :: Table Expr a => Window a a
lastValue :: forall a. Table Expr a => Window a a
lastValue = (a -> Columns a Expr)
-> (Columns a Expr -> a)
-> Window (Columns a Expr) (Columns a Expr)
-> Window a a
forall a b c d. (a -> b) -> (c -> d) -> Window b c -> Window a d
forall (p :: * -> Context) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns Columns a Expr -> a
forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns (Window (Columns a Expr) (Columns a Expr) -> Window a a)
-> Window (Columns a Expr) (Columns a Expr) -> Window a a
forall a b. (a -> b) -> a -> b
$ (forall a. Window (Expr a) (Expr a))
-> Window (Columns a Expr) (Columns a Expr)
forall (t :: HTable) (p :: * -> Context) (f :: Context)
       (g :: Context).
(HTable t, ProductProfunctor p) =>
(forall a. p (f a) (g a)) -> p (t f) (t g)
htraverseP Window (Expr a) (Expr a)
forall a. Window (Expr a) (Expr a)
lastValueExpr


-- | Applies 'lastValue' to the columns selected by the given function.
lastValueOn :: Table Expr a => (i -> a) -> Window i a
lastValueOn :: forall a i. Table Expr a => (i -> a) -> Window i a
lastValueOn i -> a
f = (i -> a) -> Window a a -> Window i a
forall a b c. (a -> b) -> Window b c -> Window a c
forall (p :: * -> Context) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap i -> a
f Window a a
forall a. Table Expr a => Window a a
lastValue


-- | @'nthValue' n@ returns the @n@th row of the window of the current row.
-- Returns 'Rel8.nothingTable' if @n@ is out of bounds.
nthValue :: Table Expr a => Expr Int32 -> Window a (MaybeTable Expr a)
nthValue :: forall a.
Table Expr a =>
Expr Int32 -> Window a (MaybeTable Expr a)
nthValue Expr Int32
n = do
  Expr (Maybe MaybeTag)
htag <- Expr Int32
-> (a -> Expr MaybeTag) -> Window a (Expr (Nullify MaybeTag))
forall i a.
Expr Int32 -> (i -> Expr a) -> Window i (Expr (Nullify a))
nthValueExprOn Expr Int32
n (\a
_ -> MaybeTag -> Expr MaybeTag
forall a. Sql DBType a => a -> Expr a
litExpr MaybeTag
IsJust)
  HNullify (Columns a) Expr
hjust <- (a -> Columns a Expr)
-> Window (Columns a Expr) (HNullify (Columns a) Expr)
-> Window a (HNullify (Columns a) Expr)
forall a b c. (a -> b) -> Window b c -> Window a c
forall (p :: * -> Context) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns (Window (Columns a Expr) (HNullify (Columns a) Expr)
 -> Window a (HNullify (Columns a) Expr))
-> Window (Columns a Expr) (HNullify (Columns a) Expr)
-> Window a (HNullify (Columns a) Expr)
forall a b. (a -> b) -> a -> b
$ (forall a. Spec a -> Window (Expr a) (Expr (Nullify a)))
-> Window (Columns a Expr) (HNullify (Columns a) Expr)
forall (t :: HTable) (p :: * -> Context) (context :: Context).
(HTable t, ProductProfunctor p) =>
(forall a. Spec a -> p (context a) (context (Nullify a)))
-> p (t context) (HNullify t context)
hnullify ((forall a. Spec a -> Window (Expr a) (Expr (Nullify a)))
 -> Window (Columns a Expr) (HNullify (Columns a) Expr))
-> (forall a. Spec a -> Window (Expr a) (Expr (Nullify a)))
-> Window (Columns a Expr) (HNullify (Columns a) Expr)
forall a b. (a -> b) -> a -> b
$ \Spec a
_ -> Expr Int32 -> Window (Expr a) (Expr (Nullify a))
forall a. Expr Int32 -> Window (Expr a) (Expr (Nullify a))
nthValueExpr Expr Int32
n
  pure $ Columns (MaybeTable Expr a) Expr -> MaybeTable Expr a
forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns (Columns (MaybeTable Expr a) Expr -> MaybeTable Expr a)
-> Columns (MaybeTable Expr a) Expr -> MaybeTable Expr a
forall a b. (a -> b) -> a -> b
$ HLabel "isJust" (HIdentity (Maybe MaybeTag)) Expr
-> HLabel "Just" (HNullify (Columns a)) Expr
-> HMaybeTable (Columns a) Expr
forall (table :: HTable) (context :: Context).
HLabel "isJust" (HIdentity (Maybe MaybeTag)) context
-> HLabel "Just" (HNullify table) context
-> HMaybeTable table context
HMaybeTable (HIdentity (Maybe MaybeTag) Expr
-> HLabel "isJust" (HIdentity (Maybe MaybeTag)) Expr
forall (label :: Symbol) (t :: HTable) (context :: Context).
t context -> HLabel label t context
hlabel (Expr (Maybe MaybeTag) -> HIdentity (Maybe MaybeTag) Expr
forall a (context :: Context). context a -> HIdentity a context
HIdentity Expr (Maybe MaybeTag)
htag)) (HNullify (Columns a) Expr
-> HLabel "Just" (HNullify (Columns a)) Expr
forall (label :: Symbol) (t :: HTable) (context :: Context).
t context -> HLabel label t context
hlabel HNullify (Columns a) Expr
hjust)


-- | Applies 'nthValue' to the columns selected by the given function.
nthValueOn :: Table Expr a => Expr Int32 -> (i -> a) -> Window i (MaybeTable Expr a)
nthValueOn :: forall a i.
Table Expr a =>
Expr Int32 -> (i -> a) -> Window i (MaybeTable Expr a)
nthValueOn Expr Int32
n i -> a
f = (i -> a)
-> Window a (MaybeTable Expr a) -> Window i (MaybeTable Expr a)
forall a b c. (a -> b) -> Window b c -> Window a c
forall (p :: * -> Context) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap i -> a
f (Expr Int32 -> Window a (MaybeTable Expr a)
forall a.
Table Expr a =>
Expr Int32 -> Window a (MaybeTable Expr a)
nthValue Expr Int32
n)