{-# language ApplicativeDo #-}
{-# language FlexibleContexts #-}
{-# language MonoLocalBinds #-}
{-# language NamedFieldPuns #-}
module Rel8.Table.Window
( currentRow
, lag, lagOn
, lead, leadOn
, firstValue, firstValueOn
, lastValue, lastValueOn
, nthValue, nthValueOn
)
where
import Data.Int (Int32)
import Prelude hiding (null)
import qualified Opaleye.Window as Opaleye
import Data.Profunctor (dimap, lmap)
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))
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 :: 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)
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 :: 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)
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 :: 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
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 :: 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
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 :: 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)
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)