{-# language FlexibleContexts #-}
{-# language MonoLocalBinds #-}

module Rel8.Aggregate.Function (
  aggregateFunction,
) where

-- base
import Prelude

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

-- rel8
import Rel8.Aggregate (Aggregator1, unsafeMakeAggregator)
import Rel8.Aggregate.Fold (Fallback (Empty))
import Rel8.Expr (Expr)
import Rel8.Expr.Opaleye (castExpr, fromColumn, fromPrimExpr)
import Rel8.Schema.Null (Sql)
import Rel8.Schema.QualifiedName (QualifiedName, showQualifiedName)
import Rel8.Table (Table)
import Rel8.Table.Opaleye (unpackspec)
import Rel8.Type (DBType)


-- | 'aggregateFunction' allows the use use of custom aggregation functions
-- or PostgreSQL aggregation functions which are not otherwise supported by
-- Rel8.
aggregateFunction ::
  (Table Expr i, Sql DBType a) =>
  QualifiedName ->
  Aggregator1 i (Expr a)
aggregateFunction :: forall i a.
(Table Expr i, Sql DBType a) =>
QualifiedName -> Aggregator1 i (Expr a)
aggregateFunction QualifiedName
name =
  (i -> i)
-> (Field_ Any Any -> Expr a)
-> Fallback 'Semi (Expr a)
-> Aggregator i (Field_ Any Any)
-> Aggregator' 'Semi i (Expr a)
forall i o (fold :: Fold) i' o'.
(i -> i')
-> (o' -> o)
-> Fallback fold o
-> Aggregator i' o'
-> Aggregator' fold i o
unsafeMakeAggregator
    i -> i
forall a. a -> a
id
    (Expr a -> Expr a
forall a. Sql DBType a => Expr a -> Expr a
castExpr (Expr a -> Expr a)
-> (Field_ Any Any -> Expr a) -> Field_ Any Any -> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimExpr -> Expr a
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Expr a)
-> (Field_ Any Any -> PrimExpr) -> Field_ Any Any -> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field_ Any Any -> PrimExpr
forall (n :: Nullability) b. Field_ n b -> PrimExpr
fromColumn)
    Fallback 'Semi (Expr a)
forall a. Fallback 'Semi a
Empty
    (Unpackspec i i -> AggrOp -> Aggregator i (Field_ Any Any)
forall a a' (n :: Nullability) b.
Unpackspec a a' -> AggrOp -> Aggregator a (Field_ n b)
Opaleye.makeAggrExplicit Unpackspec i i
forall a. Table Expr a => Unpackspec a a
unpackspec
      (String -> AggrOp
Opaleye.AggrOther (QualifiedName -> String
showQualifiedName QualifiedName
name)))