{-# language DataKinds #-}
{-# language DerivingVia #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language GADTs #-}
{-# language MultiParamTypeClasses #-}
{-# language NamedFieldPuns #-}
{-# language PolyKinds #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
{-# language UndecidableSuperClasses #-}

module Rel8.Aggregate
  ( Aggregate(..), foldInputs, mapInputs
  , Aggregator(..), unsafeMakeAggregate
  , Aggregates
  , Col( A, unA )
  )
where

-- base
import Data.Functor.Const ( Const( Const ), getConst )
import Data.Functor.Identity ( Identity )
import Data.Kind ( Constraint, Type )
import Prelude

-- opaleye
import qualified Opaleye.Internal.Aggregate as Opaleye
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
import qualified Opaleye.Internal.PackMap as Opaleye

-- rel8
import Rel8.Expr ( Expr )
import Rel8.Schema.Context ( Interpretation(..) )
import Rel8.Schema.Context.Label ( Labelable(..) )
import Rel8.Schema.HTable.Identity ( HIdentity(..), HType )
import Rel8.Schema.Name ( Name )
import Rel8.Schema.Null ( Sql )
import Rel8.Schema.Reify ( notReify )
import Rel8.Schema.Result ( Result )
import Rel8.Schema.Spec ( Spec( Spec ) )
import Rel8.Table
  ( Table, Columns, Context, fromColumns, toColumns
  , reify, unreify
  )
import Rel8.Table.Recontextualize ( Recontextualize )
import Rel8.Type ( DBType )


-- | An @Aggregate a@ describes how to aggregate @Table@s of type @a@. You can
-- unpack an @Aggregate@ back to @a@ by running it with 'Rel8.aggregate'. As
-- @Aggregate@ is almost an 'Applicative' functor - but there is no 'pure'
-- operation. This means 'Aggregate' is an instance of 'Apply', and you can
-- combine @Aggregate@s using the @<.>@ combinator.
type Aggregate :: k -> Type
data Aggregate a where
  Aggregate :: !(Opaleye.Aggregator () (Expr a)) -> Aggregate a


instance Interpretation Aggregate where
  data Col Aggregate _spec where
    A :: ()
      => { Col Aggregate ('Spec labels necessity a) -> Aggregate a
unA :: !(Aggregate a) }
      -> Col Aggregate ('Spec labels necessity a)


instance Sql DBType a => Table Aggregate (Aggregate a) where
  type Columns (Aggregate a) = HType a
  type Context (Aggregate a) = Aggregate

  toColumns :: Aggregate a -> Columns (Aggregate a) (Col Aggregate)
toColumns = Col Aggregate ('Spec '[] 'Required a)
-> HIdentity ('Spec '[] 'Required a) (Col Aggregate)
forall (spec :: Spec) (context :: HContext).
context spec -> HIdentity spec context
HIdentity (Col Aggregate ('Spec '[] 'Required a)
 -> HIdentity ('Spec '[] 'Required a) (Col Aggregate))
-> (Aggregate a -> Col Aggregate ('Spec '[] 'Required a))
-> Aggregate a
-> HIdentity ('Spec '[] 'Required a) (Col Aggregate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Aggregate a -> Col Aggregate ('Spec '[] 'Required a)
forall a (labels :: Labels) (necessity :: Necessity).
Aggregate a -> Col Aggregate ('Spec labels necessity a)
A
  fromColumns :: Columns (Aggregate a) (Col Aggregate) -> Aggregate a
fromColumns (HIdentity (A a)) = Aggregate a
Aggregate a
a

  reify :: (Aggregate :~: Reify ctx) -> Unreify (Aggregate a) -> Aggregate a
reify = (Aggregate :~: Reify ctx) -> Unreify (Aggregate a) -> Aggregate a
forall (context :: Context) (ctx :: Context) a.
NotReify context =>
(context :~: Reify ctx) -> a
notReify
  unreify :: (Aggregate :~: Reify ctx) -> Aggregate a -> Unreify (Aggregate a)
unreify = (Aggregate :~: Reify ctx) -> Aggregate a -> Unreify (Aggregate a)
forall (context :: Context) (ctx :: Context) a.
NotReify context =>
(context :~: Reify ctx) -> a
notReify


instance Sql DBType a =>
  Recontextualize Aggregate Aggregate (Aggregate a) (Aggregate a)


instance Sql DBType a =>
  Recontextualize Aggregate Expr (Aggregate a) (Expr a)


instance Sql DBType a =>
  Recontextualize Aggregate Result (Aggregate a) (Identity a)


instance Sql DBType a =>
  Recontextualize Aggregate Name (Aggregate a) (Name a)


instance Sql DBType a =>
  Recontextualize Expr Aggregate (Expr a) (Aggregate a)


instance Sql DBType a =>
  Recontextualize Result Aggregate (Identity a) (Aggregate a)


instance Sql DBType a =>
  Recontextualize Name Aggregate (Name a) (Aggregate a)


instance Labelable Aggregate where
  labeler :: Col Aggregate ('Spec labels necessity a)
-> Col Aggregate ('Spec (label : labels) necessity a)
labeler (A aggregate) = Aggregate a -> Col Aggregate ('Spec (label : labels) necessity a)
forall a (labels :: Labels) (necessity :: Necessity).
Aggregate a -> Col Aggregate ('Spec labels necessity a)
A Aggregate a
aggregate
  unlabeler :: Col Aggregate ('Spec (label : labels) necessity a)
-> Col Aggregate ('Spec labels necessity a)
unlabeler (A aggregate) = Aggregate a -> Col Aggregate ('Spec labels necessity a)
forall a (labels :: Labels) (necessity :: Necessity).
Aggregate a -> Col Aggregate ('Spec labels necessity a)
A Aggregate a
aggregate


-- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate' 'Expr's
-- for the columns in @b@.
type Aggregates :: Type -> Type -> Constraint
class Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs
instance Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs


foldInputs :: Monoid b
  => (Maybe Aggregator -> Opaleye.PrimExpr -> b) -> Aggregate a -> b
foldInputs :: (Maybe Aggregator -> PrimExpr -> b) -> Aggregate a -> b
foldInputs Maybe Aggregator -> PrimExpr -> b
f (Aggregate (Opaleye.Aggregator (Opaleye.PackMap forall (f :: * -> *).
Applicative f =>
((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
 -> f PrimExpr)
-> () -> f (Expr a)
agg))) =
  Const b (Expr a) -> b
forall a k (b :: k). Const a b -> a
getConst (Const b (Expr a) -> b) -> Const b (Expr a) -> b
forall a b. (a -> b) -> a -> b
$ (((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
  -> Const b PrimExpr)
 -> () -> Const b (Expr a))
-> ()
-> ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
    -> Const b PrimExpr)
-> Const b (Expr a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
 -> Const b PrimExpr)
-> () -> Const b (Expr a)
forall (f :: * -> *).
Applicative f =>
((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
 -> f PrimExpr)
-> () -> f (Expr a)
agg () (((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
  -> Const b PrimExpr)
 -> Const b (Expr a))
-> ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
    -> Const b PrimExpr)
-> Const b (Expr a)
forall a b. (a -> b) -> a -> b
$ \(Maybe (AggrOp, [OrderExpr], AggrDistinct)
aggregator, PrimExpr
a) ->
    b -> Const b PrimExpr
forall k a (b :: k). a -> Const a b
Const (b -> Const b PrimExpr) -> b -> Const b PrimExpr
forall a b. (a -> b) -> a -> b
$ Maybe Aggregator -> PrimExpr -> b
f ((AggrOp, [OrderExpr], AggrDistinct) -> Aggregator
detuplize ((AggrOp, [OrderExpr], AggrDistinct) -> Aggregator)
-> Maybe (AggrOp, [OrderExpr], AggrDistinct) -> Maybe Aggregator
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (AggrOp, [OrderExpr], AggrDistinct)
aggregator) PrimExpr
a
  where
    detuplize :: (AggrOp, [OrderExpr], AggrDistinct) -> Aggregator
detuplize (AggrOp
operation, [OrderExpr]
ordering, AggrDistinct
distinction) =
      Aggregator :: AggrOp -> [OrderExpr] -> AggrDistinct -> Aggregator
Aggregator {AggrOp
operation :: AggrOp
operation :: AggrOp
operation, [OrderExpr]
ordering :: [OrderExpr]
ordering :: [OrderExpr]
ordering, AggrDistinct
distinction :: AggrDistinct
distinction :: AggrDistinct
distinction}


mapInputs :: ()
  => (Opaleye.PrimExpr -> Opaleye.PrimExpr) -> Aggregate a -> Aggregate a
mapInputs :: (PrimExpr -> PrimExpr) -> Aggregate a -> Aggregate a
mapInputs PrimExpr -> PrimExpr
transform (Aggregate (Opaleye.Aggregator (Opaleye.PackMap forall (f :: * -> *).
Applicative f =>
((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
 -> f PrimExpr)
-> () -> f (Expr a)
agg))) =
  Aggregator () (Expr a) -> Aggregate a
forall k (a :: k). Aggregator () (Expr a) -> Aggregate a
Aggregate (Aggregator () (Expr a) -> Aggregate a)
-> Aggregator () (Expr a) -> Aggregate a
forall a b. (a -> b) -> a -> b
$ PackMap
  (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
  PrimExpr
  ()
  (Expr a)
-> Aggregator () (Expr a)
forall a b.
PackMap
  (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) PrimExpr a b
-> Aggregator a b
Opaleye.Aggregator (PackMap
   (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
   PrimExpr
   ()
   (Expr a)
 -> Aggregator () (Expr a))
-> PackMap
     (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
     PrimExpr
     ()
     (Expr a)
-> Aggregator () (Expr a)
forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *).
 Applicative f =>
 ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
  -> f PrimExpr)
 -> () -> f (Expr a))
-> PackMap
     (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
     PrimExpr
     ()
     (Expr a)
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 =>
  ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
   -> f PrimExpr)
  -> () -> f (Expr a))
 -> PackMap
      (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
      PrimExpr
      ()
      (Expr a))
-> (forall (f :: * -> *).
    Applicative f =>
    ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
     -> f PrimExpr)
    -> () -> f (Expr a))
-> PackMap
     (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
     PrimExpr
     ()
     (Expr a)
forall a b. (a -> b) -> a -> b
$ ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
 -> f PrimExpr)
-> () -> f (Expr a)
forall (f :: * -> *).
Applicative f =>
((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
 -> f PrimExpr)
-> () -> f (Expr a)
agg (((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
  -> f PrimExpr)
 -> () -> f (Expr a))
-> (((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
     -> f PrimExpr)
    -> (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
    -> f PrimExpr)
-> ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
    -> f PrimExpr)
-> ()
-> f (Expr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \(Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) -> f PrimExpr
f (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
input ->
    (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) -> f PrimExpr
f ((PrimExpr -> PrimExpr)
-> (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
-> (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrimExpr -> PrimExpr
transform (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
input)


type Aggregator :: Type
data Aggregator = Aggregator
  { Aggregator -> AggrOp
operation :: Opaleye.AggrOp
  , Aggregator -> [OrderExpr]
ordering :: [Opaleye.OrderExpr]
  , Aggregator -> AggrDistinct
distinction :: Opaleye.AggrDistinct
  }


unsafeMakeAggregate :: ()
  => (Expr input -> Opaleye.PrimExpr)
  -> (Opaleye.PrimExpr -> Expr output)
  -> Maybe Aggregator
  -> Expr input
  -> Aggregate output
unsafeMakeAggregate :: (Expr input -> PrimExpr)
-> (PrimExpr -> Expr output)
-> Maybe Aggregator
-> Expr input
-> Aggregate output
unsafeMakeAggregate Expr input -> PrimExpr
input PrimExpr -> Expr output
output Maybe Aggregator
aggregator Expr input
expr =
  Aggregator () (Expr output) -> Aggregate output
forall k (a :: k). Aggregator () (Expr a) -> Aggregate a
Aggregate (Aggregator () (Expr output) -> Aggregate output)
-> Aggregator () (Expr output) -> Aggregate output
forall a b. (a -> b) -> a -> b
$ PackMap
  (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
  PrimExpr
  ()
  (Expr output)
-> Aggregator () (Expr output)
forall a b.
PackMap
  (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) PrimExpr a b
-> Aggregator a b
Opaleye.Aggregator (PackMap
   (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
   PrimExpr
   ()
   (Expr output)
 -> Aggregator () (Expr output))
-> PackMap
     (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
     PrimExpr
     ()
     (Expr output)
-> Aggregator () (Expr output)
forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *).
 Applicative f =>
 ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
  -> f PrimExpr)
 -> () -> f (Expr output))
-> PackMap
     (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
     PrimExpr
     ()
     (Expr output)
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 =>
  ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
   -> f PrimExpr)
  -> () -> f (Expr output))
 -> PackMap
      (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
      PrimExpr
      ()
      (Expr output))
-> (forall (f :: * -> *).
    Applicative f =>
    ((Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
     -> f PrimExpr)
    -> () -> f (Expr output))
-> PackMap
     (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr)
     PrimExpr
     ()
     (Expr output)
forall a b. (a -> b) -> a -> b
$ \(Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) -> f PrimExpr
f ()
_ ->
    PrimExpr -> Expr output
output (PrimExpr -> Expr output) -> f PrimExpr -> f (Expr output)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (AggrOp, [OrderExpr], AggrDistinct), PrimExpr) -> f PrimExpr
f (Aggregator -> (AggrOp, [OrderExpr], AggrDistinct)
tuplize (Aggregator -> (AggrOp, [OrderExpr], AggrDistinct))
-> Maybe Aggregator -> Maybe (AggrOp, [OrderExpr], AggrDistinct)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Aggregator
aggregator, Expr input -> PrimExpr
input Expr input
expr)
  where
    tuplize :: Aggregator -> (AggrOp, [OrderExpr], AggrDistinct)
tuplize Aggregator {AggrOp
operation :: AggrOp
operation :: Aggregator -> AggrOp
operation, [OrderExpr]
ordering :: [OrderExpr]
ordering :: Aggregator -> [OrderExpr]
ordering, AggrDistinct
distinction :: AggrDistinct
distinction :: Aggregator -> AggrDistinct
distinction} =
      (AggrOp
operation, [OrderExpr]
ordering, AggrDistinct
distinction)