From a3fa8732697aebaa065a56397415d9d66c0d1a7b Mon Sep 17 00:00:00 2001
From: Shane O'Brien <shane.obrien@circuithub.com>
Date: Fri, 6 Oct 2023 13:31:08 +0100
Subject: [PATCH] Add ability to use custom aggregation functions with
 `aggregateFunction`

---
 ...9_170238_shane.obrien_aggregateFunction.md |  3 ++
 rel8.cabal                                    |  1 +
 src/Rel8.hs                                   |  2 +
 src/Rel8/Aggregate/Function.hs                | 40 +++++++++++++++++++
 4 files changed, 46 insertions(+)
 create mode 100644 changelog.d/20231009_170238_shane.obrien_aggregateFunction.md
 create mode 100644 src/Rel8/Aggregate/Function.hs

diff --git a/changelog.d/20231009_170238_shane.obrien_aggregateFunction.md b/changelog.d/20231009_170238_shane.obrien_aggregateFunction.md
new file mode 100644
index 00000000..e40c2a53
--- /dev/null
+++ b/changelog.d/20231009_170238_shane.obrien_aggregateFunction.md
@@ -0,0 +1,3 @@
+### Added
+
+- `aggregationFunction`, which allows custom aggregation functions to be used.
diff --git a/rel8.cabal b/rel8.cabal
index 11e3a7e4..1876f057 100644
--- a/rel8.cabal
+++ b/rel8.cabal
@@ -70,6 +70,7 @@ library
   other-modules:
     Rel8.Aggregate
     Rel8.Aggregate.Fold
+    Rel8.Aggregate.Function
 
     Rel8.Column
     Rel8.Column.ADT
diff --git a/src/Rel8.hs b/src/Rel8.hs
index 722ffa07..632bd593 100644
--- a/src/Rel8.hs
+++ b/src/Rel8.hs
@@ -284,6 +284,7 @@ module Rel8
   , countWhere, countWhereOn
   , and, andOn
   , or, orOn
+  , aggregateFunction
 
   , mode, modeOn
   , percentile, percentileOn
@@ -383,6 +384,7 @@ import Prelude ()
 -- rel8
 import Rel8.Aggregate
 import Rel8.Aggregate.Fold
+import Rel8.Aggregate.Function
 import Rel8.Column
 import Rel8.Column.ADT
 import Rel8.Column.Either
diff --git a/src/Rel8/Aggregate/Function.hs b/src/Rel8/Aggregate/Function.hs
new file mode 100644
index 00000000..b8c3537c
--- /dev/null
+++ b/src/Rel8/Aggregate/Function.hs
@@ -0,0 +1,40 @@
+{-# 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 name =
+  unsafeMakeAggregator
+    id
+    (castExpr . fromPrimExpr . fromColumn)
+    Empty
+    (Opaleye.makeAggrExplicit unpackspec
+      (Opaleye.AggrOther (showQualifiedName name)))