From ceab69a4e9df0bfde989a808d6ecce673e30b7db Mon Sep 17 00:00:00 2001
From: belevy <benjaminlevy007@gmail.com>
Date: Sun, 14 Feb 2021 20:18:20 -0600
Subject: [PATCH] Add source to SqlAggregate, the Over instance uses this to
 prevent pseudo-aggregates(from groupBy) and already windowed values from
 being windowed

---
 src/Database/Esqueleto/Experimental.hs        |  2 +-
 .../Esqueleto/Experimental/Aggregates.hs      | 26 +++++++++++--------
 .../Esqueleto/Experimental/WindowFunctions.hs | 16 +++++-------
 3 files changed, 22 insertions(+), 22 deletions(-)

diff --git a/src/Database/Esqueleto/Experimental.hs b/src/Database/Esqueleto/Experimental.hs
index e9ddd9f..c48d351 100644
--- a/src/Database/Esqueleto/Experimental.hs
+++ b/src/Database/Esqueleto/Experimental.hs
@@ -90,7 +90,7 @@ module Database.Esqueleto.Experimental
     , joinV
     , withNonNull
 
-    , countRows
+    , countRows_
     , count
     , countDistinct
 
diff --git a/src/Database/Esqueleto/Experimental/Aggregates.hs b/src/Database/Esqueleto/Experimental/Aggregates.hs
index 315908c..416e53d 100644
--- a/src/Database/Esqueleto/Experimental/Aggregates.hs
+++ b/src/Database/Esqueleto/Experimental/Aggregates.hs
@@ -55,15 +55,15 @@ instance SqlExprEntity SqlExpr where
     (^.) = (I.^.)
     (?.) = (I.?.)
 
-newtype SqlAggregate a = SqlAggregate { unsafeSqlAggregate :: SqlExpr a }
-deriving via SqlExpr instance SqlExprEntity SqlAggregate
-instance forall a. PersistField a => SqlSelect (SqlAggregate a) a where
+newtype SqlAggregate source a = SqlAggregate { unsafeSqlAggregate :: SqlExpr a }
+deriving via SqlExpr instance SqlExprEntity (SqlAggregate source)
+instance forall a source. PersistField a => SqlSelect (SqlAggregate source a) a where
     sqlSelectCols info (SqlAggregate e) = sqlSelectCols info e
     sqlSelectColCount = const 1
     sqlSelectProcessRow _ = sqlSelectProcessRow (Proxy :: Proxy (SqlExpr a))
-instance SqlQueryHaving (SqlAggregate Bool) where
+instance SqlQueryHaving (SqlAggregate source Bool) where
     having expr = Q $ W.tell mempty { sdHavingClause = I.Where (coerce expr) }
-instance SqlQueryHaving (SqlAggregate (Maybe Bool)) where
+instance SqlQueryHaving (SqlAggregate source (Maybe Bool)) where
     having expr = Q $ W.tell mempty { sdHavingClause = I.Where (coerce expr) }
 
 test :: (PersistEntity ent, PersistField a, PersistField b, PersistField c)
@@ -76,8 +76,6 @@ test ent field y other = do
     groupBy (ent, y) $ \(ent', y') ->
         pure (ent' ?. field, y', sum_ other, countRows_)
 
-countRows_ :: (PersistField n, Integral n) => SqlAggregate n
-countRows_ = SqlAggregate $ ERaw noMeta $ \_ _ -> ("COUNT(*)", [])
 
 -- Tuple magic, only SqlExprs are on the leaves.
 -- The Coercible instance from the SqlExpr a -> SqlExpr b allows 0 cost casting
@@ -88,8 +86,9 @@ class Coercible a r => Aggregateable a r | a -> r, r -> a where
     fromAggregate :: r -> a
     fromAggregate = coerce
 
+data GroupedValue
 instance Aggregateable () () where
-instance Aggregateable (SqlExpr a) (SqlAggregate a) where
+instance Aggregateable (SqlExpr a) (SqlAggregate GroupedValue a) where
 instance (Aggregateable a ra, Aggregateable b rb) => Aggregateable (a,b) (ra, rb) where
 instance
     ( Aggregateable a ra
@@ -137,9 +136,6 @@ instance
     , Aggregateable h rh
     ) => Aggregateable (a,b,c,d,e,f,g,h) (ra,rb,rc,rd,re,rf,rg,rh) where
 
-sum_ :: (PersistField a, PersistField n, Integral n) => SqlExpr a -> SqlAggregate (Maybe n)
-sum_ = coerce . unsafeSqlFunction "SUM"
-
 groupBy :: ( ToSomeValues a
            , Aggregateable a a'
            , Aggregateable b b'
@@ -147,3 +143,11 @@ groupBy :: ( ToSomeValues a
 groupBy a f = do
     Q $ W.tell $ mempty{sdGroupByClause = GroupBy $ toSomeValues a }
     fmap fromAggregate $ f $ toAggregate a
+
+-- Aggregation Functions
+countRows_ :: forall n s. (PersistField n, Integral n) => SqlAggregate s n
+countRows_ = SqlAggregate $ ERaw noMeta $ \_ _ -> ("COUNT(*)", [])
+
+sum_ :: forall n a w. (PersistField a, PersistField n, Integral n) => SqlExpr a -> SqlAggregate w (Maybe n)
+sum_ = coerce . unsafeSqlFunction "SUM"
+
diff --git a/src/Database/Esqueleto/Experimental/WindowFunctions.hs b/src/Database/Esqueleto/Experimental/WindowFunctions.hs
index 2b6c441..324ccef 100644
--- a/src/Database/Esqueleto/Experimental/WindowFunctions.hs
+++ b/src/Database/Esqueleto/Experimental/WindowFunctions.hs
@@ -253,16 +253,9 @@ unboundedFollowing = FrameRangeFollowing FrameRangeUnbounded
 currentRow :: FrameRange
 currentRow = FrameRangeCurrentRow
 
+data WindowAggregate
 class Over expr where
-    over_ :: RenderWindow window => expr a -> window -> SqlAggregate (WindowedValue a)
-
-data WindowedValue a = WindowedValue { unWindowedValue :: a }
-instance PersistField a => SqlSelect (SqlExpr (WindowedValue a)) (WindowedValue a) where
-    sqlSelectCols info expr = sqlSelectCols info (coerce expr :: SqlExpr a)
-    sqlSelectColCount = const 1
-    sqlSelectProcessRow _ [pv] = WindowedValue <$> fromPersistValue pv
-    sqlSelectProcessRow _ pvs  = WindowedValue <$> fromPersistValue (PersistList pvs)
-
+    over_ :: RenderWindow window => expr a -> window -> SqlAggregate WindowAggregate a
 
 newtype WindowExpr a = WindowExpr { unsafeWindowExpr :: SqlExpr a }
 instance Over WindowExpr where
@@ -271,4 +264,7 @@ instance Over WindowExpr where
             (w, vw) = renderWindow info window
         in (parensM p $ b <> " OVER " <> parens w , v <> vw)
 
-deriving via WindowExpr instance Over SqlAggregate
+-- Only universally quantified SqlAggregate's can be used
+-- TODO Add nicer type error
+data NoWindow
+deriving via WindowExpr instance (s ~ NoWindow) => Over (SqlAggregate s)