consistent naming in aggregate functions #63

Doc/Tutorial/TutorialBasic.lhs

@@ -584,7 +584,7 @@ of such widgets and their average radius.  `aggregateWidgets` shows us
 how to do this.
 
 > aggregateWidgets :: Query (Widget (Column PGText) (Column PGText) (Column PGInt8)
->                                   (Column PGInt4) (Column PGFloat8))
+>                                   (Column PGInt8) (Column PGFloat8))
 > aggregateWidgets = aggregate (pWidget (Widget { style    = groupBy
 >                                               , color    = groupBy
 >                                               , location = count

Test/Test.hs

@@ -319,18 +319,8 @@ testDistinct :: Test
 testDistinct = testG (O.distinct table1Q)
                (\r -> L.sort (L.nub table1data) == L.sort r)
 
--- FIXME: the unsafeCoerceColumn is currently needed because the type
--- changes required for aggregation are not currently dealt with by
--- Opaleye.
-aggregateCoerceFIXME :: QueryArr (Column O.PGInt4) (Column O.PGInt8)
-aggregateCoerceFIXME = Arr.arr aggregateCoerceFIXME'
-
-aggregateCoerceFIXME' :: Column a -> Column O.PGInt8
-aggregateCoerceFIXME' = O.unsafeCoerceColumn
-
 testAggregate :: Test
-testAggregate = testG (Arr.second aggregateCoerceFIXME
-                        <<< O.aggregate (PP.p2 (O.groupBy, O.sum))
+testAggregate = testG (O.aggregate (PP.p2 (O.groupBy, O.sum))
                                            table1Q)
                       (\r -> [(1, 400) :: (Int, Int64), (2, 300)] == L.sort r)
 
@@ -339,7 +329,7 @@ testAggregateProfunctor = testG q expected
   where q = O.aggregate (PP.p2 (O.groupBy, countsum)) table1Q
         expected r = [(1, 1200) :: (Int, Int64), (2, 300)] == L.sort r
         countsum = P.dimap (\x -> (x,x))
-                           (\(x, y) -> aggregateCoerceFIXME' x * y)
+                           (\(x, y) -> x * y)
                            (PP.p2 (O.sum, O.count))
 
 testStringArrayAggregate :: Test
@@ -394,8 +384,7 @@ testOffsetLimit = testLOG (O.offset 2 . O.limit 2) (drop 2 . take 2)
 testDistinctAndAggregate :: Test
 testDistinctAndAggregate = testG q expected
   where q = O.distinct table1Q
-            &&& (Arr.second aggregateCoerceFIXME
-                 <<< O.aggregate (PP.p2 (O.groupBy, O.sum)) table1Q)
+            &&& (O.aggregate (PP.p2 (O.groupBy, O.sum)) table1Q)
         expected r = L.sort r == L.sort expectedResult
         expectedResult = A.liftA2 (,) (L.nub table1data)
                                       [(1 :: Int, 400 :: Int64), (2, 300)]

src/Opaleye/Aggregate.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+
 -- | Perform aggregations on query results.
 module Opaleye.Aggregate (module Opaleye.Aggregate, Aggregator) where
 
@@ -29,15 +32,15 @@ groupBy :: Aggregator (C.Column a) (C.Column a)
 groupBy = A.makeAggr' Nothing
 
 -- | Sum all rows in a group.
-sum :: Aggregator (C.Column a) (C.Column a)
+sum :: Sum a b => Aggregator (C.Column a) (C.Column b)
 sum = A.makeAggr HPQ.AggrSum
 
 -- | Count the number of non-null rows in a group.
 count :: Aggregator (C.Column a) (C.Column T.PGInt8)
 count = A.makeAggr HPQ.AggrCount
 
 -- | Average of a group
-avg :: Aggregator (C.Column T.PGFloat8) (C.Column T.PGFloat8)
+avg :: Avg a b => Aggregator (C.Column a) (C.Column b)
 avg = A.makeAggr HPQ.AggrAvg
 
 -- | Maximum of a group
@@ -57,5 +60,45 @@ boolAnd = A.makeAggr HPQ.AggrBoolAnd
 arrayAgg :: Aggregator (C.Column a) (C.Column (T.PGArray a))
 arrayAgg = A.makeAggr HPQ.AggrArr
 
-stringAgg :: C.Column T.PGText -> Aggregator (C.Column T.PGText) (C.Column T.PGText)
+stringAgg :: StringAgg a => C.Column a -> Aggregator (C.Column a) (C.Column a)
 stringAgg = A.makeAggr' . Just . HPQ.AggrStringAggr . IC.unColumn
+
+stddevPop :: StddevVar a b => Aggregator (C.Column a) (C.Column b)
+stddevPop = A.makeAggr HPQ.AggrStddevPop
+
+stddevSamp :: StddevVar a b => Aggregator (C.Column a) (C.Column b)
+stddevSamp = A.makeAggr HPQ.AggrStddevSamp
+
+varPop :: StddevVar a b => Aggregator (C.Column a) (C.Column b)
+varPop = A.makeAggr HPQ.AggrVarPop
+
+varSamp :: StddevVar a b => Aggregator (C.Column a) (C.Column b)
+varSamp = A.makeAggr HPQ.AggrVarSamp
+
+class StringAgg a where
+instance StringAgg T.PGText
+instance StringAgg T.PGCitext
+instance StringAgg T.PGBytea
+
+class Avg a b | a -> b where
+instance Avg T.PGInt2 T.PGNumeric
+instance Avg T.PGInt4 T.PGNumeric
+instance Avg T.PGInt8 T.PGNumeric
+instance Avg T.PGFloat4 T.PGFloat4
+instance Avg T.PGFloat8 T.PGFloat8
+
+class Sum a b | a -> b where
+instance Sum T.PGInt2 T.PGInt8
+instance Sum T.PGInt4 T.PGInt8
+instance Sum T.PGInt8 T.PGNumeric
+instance Sum T.PGFloat4 T.PGFloat4
+instance Sum T.PGFloat8 T.PGFloat8
+instance Sum T.PGNumeric T.PGNumeric
+
+class StddevVar a b | a -> b where
+instance StddevVar T.PGFloat4 T.PGFloat8
+instance StddevVar T.PGFloat8 T.PGFloat8
+instance StddevVar T.PGNumeric T.PGNumeric
+instance StddevVar T.PGInt2 T.PGNumeric
+instance StddevVar T.PGInt4 T.PGNumeric
+instance StddevVar T.PGInt8 T.PGNumeric

src/Opaleye/Internal/HaskellDB/PrimQuery.hs

@@ -66,7 +66,7 @@ data UnOp = OpNot
           deriving (Show,Read)
 
 data AggrOp     = AggrCount | AggrSum | AggrAvg | AggrMin | AggrMax
-                | AggrStdDev | AggrStdDevP | AggrVar | AggrVarP
+                | AggrStddevPop | AggrStddevSamp | AggrVarPop | AggrVarSamp
                 | AggrBoolOr | AggrBoolAnd | AggrArr | AggrStringAggr PrimExpr
                 | AggrOther String
                 deriving (Show,Read)

src/Opaleye/Internal/HaskellDB/Sql/Default.hs

@@ -178,10 +178,10 @@ showAggrOp AggrSum            = "SUM"
 showAggrOp AggrAvg            = "AVG"
 showAggrOp AggrMin            = "MIN"
 showAggrOp AggrMax            = "MAX"
-showAggrOp AggrStdDev         = "StdDev"
-showAggrOp AggrStdDevP        = "StdDevP"
-showAggrOp AggrVar            = "Var"
-showAggrOp AggrVarP           = "VarP"
+showAggrOp AggrStddevSamp     = "STDDEV_SAMP"
+showAggrOp AggrStddevPop      = "STDDEV_POP"
+showAggrOp AggrVarPop         = "VAR_POP"
+showAggrOp AggrVarSamp        = "VAR_SAMP"
 showAggrOp AggrBoolAnd        = "BOOL_AND"
 showAggrOp AggrBoolOr         = "BOOL_OR"
 showAggrOp AggrArr            = "ARRAY_AGG"