add filter and within group aggregates

Language/SQL/SimpleSQL/Parser.lhs

@@ -846,10 +846,35 @@ if there are no value exprs
 >                      <*> (optionMaybe orderBy))
 >   where
 >     makeApp i (SQDefault,es,Nothing) = App i es
->     makeApp i (d,es,od) = AggregateApp i d es (fromMaybe [] od)
+>     makeApp i (d,es,od) = AggregateApp i d es (fromMaybe [] od) Nothing
 
 > app :: [Name] -> Parser ValueExpr
-> app n = aggOrApp n >>= optionSuffix windowSuffix
+> app n = aggOrApp n >>= \a -> choice
+>         [windowSuffix a
+>         ,filterSuffix a
+>         ,withinGroupSuffix a
+>         ,return a]
+
+> filterSuffix :: ValueExpr -> Parser ValueExpr
+> filterSuffix (App nm es) =
+>     filterSuffix (AggregateApp nm SQDefault es [] Nothing)
+> filterSuffix agg@(AggregateApp {}) =
+>     filterSuffix' agg
+> filterSuffix _ = fail ""
+
+> filterSuffix' :: ValueExpr -> Parser ValueExpr
+> filterSuffix' agg =
+>     keyword_ "filter" >>
+>     rep <$> parens(keyword_ "where" *> (Just <$> valueExpr))
+>   where
+>     rep f = agg {aggFilter = f}
+
+
+
+> withinGroupSuffix :: ValueExpr -> Parser ValueExpr
+> withinGroupSuffix (App nm es) = keywords_ ["within", "group"] >>
+>     AggregateAppGroup nm es <$> parens orderBy
+> withinGroupSuffix _ = fail ""
 
 ==== window suffix
 
@@ -1934,11 +1959,11 @@ means).
 > reservedWord :: [String]
 > reservedWord =
 >     ["add"
->     ,"all"
+>     --,"all"
 >     ,"allocate"
 >     ,"alter"
 >     ,"and"
->     ,"any"
+>     --,"any"
 >     ,"are"
 >     ,"array"
 >     ,"as"
@@ -2101,15 +2126,15 @@ means).
 >     ,"ref"
 >     ,"references"
 >     ,"referencing"
->     ,"regr_avgx"
+>     --,"regr_avgx"
->     ,"regr_avgy"
+>     --,"regr_avgy"
->     ,"regr_count"
+>     --,"regr_count"
->     ,"regr_intercept"
+>     --,"regr_intercept"
->     ,"regr_r2"
+>     --,"regr_r2"
->     ,"regr_slope"
+>     --,"regr_slope"
->     ,"regr_sxx"
+>     --,"regr_sxx"
->     ,"regr_sxy"
+>     --,"regr_sxy"
->     ,"regr_syy"
+>     --,"regr_syy"
 >     ,"release"
 >     ,"result"
 >     ,"return"
@@ -2130,7 +2155,7 @@ means).
 >     --,"set"
 >     ,"similar"
 >     ,"smallint"
->     ,"some"
+>     --,"some"
 >     ,"specific"
 >     ,"specifictype"
 >     ,"sql"
@@ -2166,8 +2191,8 @@ means).
 >     ,"using"
 >     --,"value"
 >     ,"values"
->     ,"var_pop"
+>     --,"var_pop"
->     ,"var_samp"
+>     --,"var_samp"
 >     ,"varchar"
 >     ,"varying"
 >     ,"when"

Language/SQL/SimpleSQL/Pretty.lhs

@@ -52,7 +52,7 @@ which have been changed to try to improve the layout of the output.
 
 > valueExpr (App f es) = names f <> parens (commaSep (map valueExpr es))
 
-> valueExpr (AggregateApp f d es od) =
+> valueExpr (AggregateApp f d es od fil) =
 >     names f
 >     <> parens ((case d of
 >                   Distinct -> text "distinct"
@@ -60,6 +60,15 @@ which have been changed to try to improve the layout of the output.
 >                   SQDefault -> empty)
 >                <+> commaSep (map valueExpr es)
 >                <+> orderBy od)
+>     <+> me (\x -> text "filter"
+>                   <+> parens (text "where" <+> valueExpr x)) fil
+
+> valueExpr (AggregateAppGroup f es od) =
+>     names f
+>     <> parens (commaSep (map valueExpr es))
+>     <+> if null od
+>         then empty
+>         else text "within group" <+> parens(orderBy od)
 
 > valueExpr (WindowApp f es pb od fr) =
 >     names f <> parens (commaSep $ map valueExpr es)

Language/SQL/SimpleSQL/Syntax.lhs

@@ -78,6 +78,13 @@
 >       ,aggDistinct :: SetQuantifier -- ^ distinct
 >       ,aggArgs :: [ValueExpr]-- ^ args
 >       ,aggOrderBy :: [SortSpec] -- ^ order by
+>       ,aggFilter :: Maybe ValueExpr -- ^ filter
+>       }
+>       -- | aggregates with within group
+>     | AggregateAppGroup
+>       {aggName :: [Name] -- ^ aggregate function name
+>       ,aggArgs :: [ValueExpr] -- ^ args
+>       ,aggGroup :: [SortSpec] -- ^ within group
 >       }
 >       -- | window application, which adds over (partition by a order
 >       -- by b) to regular function application. Explicit frames are

tools/Language/SQL/SimpleSQL/SQL2003.lhs

@@ -46,6 +46,7 @@ large amount of the SQL.
 >     ,uniquePredicate
 >     ,matchPredicate
 >     ,collateClause
+>     ,aggregateFunctions
 >     ,sortSpecificationList
 >     ]
 
@@ -3051,7 +3052,73 @@ Specify a value computed from a collection of rows.
 
 <inverse distribution function type>    ::=   PERCENTILE_CONT | PERCENTILE_DISC
 
-TODO: aggregate functions
+> aggregateFunctions :: TestItem
+> aggregateFunctions = Group "aggregate functions" $ map (uncurry TestValueExpr) $
+>     [("count(*)",App [Name "count"] [Star])
+>     ,("count(*) filter (where something > 5)"
+>      ,AggregateApp [Name "count"] SQDefault [Star] [] fil)
+
+gsf
+
+>     ,("count(a)",App [Name "count"] [Iden [Name "a"]])
+>     ,("count(distinct a)"
+>      ,AggregateApp [Name "count"]
+>                    Distinct
+>                    [Iden [Name "a"]] [] Nothing)
+>     ,("count(all a)"
+>      ,AggregateApp [Name "count"]
+>                    All
+>                    [Iden [Name "a"]] [] Nothing)
+>     ,("count(all a) filter (where something > 5)"
+>      ,AggregateApp [Name "count"]
+>                    All
+>                    [Iden [Name "a"]] [] fil)
+>     ] ++ concatMap mkSimpleAgg
+>          ["avg","max","min","sum"
+>          ,"every", "any", "some"
+>          ,"stddev_pop","stddev_samp","var_samp","var_pop"
+>          ,"collect","fusion","intersection"]
+
+bsf
+
+>     ++ concatMap mkBsf
+>          ["COVAR_POP","COVAR_SAMP","CORR","REGR_SLOPE"
+>           ,"REGR_INTERCEPT","REGR_COUNT","REGR_R2"
+>           ,"REGR_AVGX","REGR_AVGY"
+>           ,"REGR_SXX","REGR_SYY","REGR_SXY"]
+
+osf
+
+>     ++
+>     [("rank(a,c) within group (order by b)"
+>      ,AggregateAppGroup [Name "rank"]
+>           [Iden [Name "a"], Iden [Name "c"]]
+>           ob)]
+>     ++ map mkGp ["dense_rank","percent_rank"
+>                 ,"cume_dist", "percentile_cont"
+>                 ,"percentile_disc"]
+
+>   where
+>     fil = Just $ BinOp (Iden [Name "something"]) [Name ">"] (NumLit "5")
+>     ob = [SortSpec (Iden [Name "b"]) DirDefault NullsOrderDefault]
+>     mkGp nm = (nm ++ "(a) within group (order by b)"
+>               ,AggregateAppGroup [Name nm]
+>                [Iden [Name "a"]]
+>                ob)
+
+>     mkSimpleAgg nm =
+>         [(nm ++ "(a)",App [Name nm] [Iden [Name "a"]])
+>         ,(nm ++ "(distinct a)"
+>          ,AggregateApp [Name nm]
+>                        Distinct
+>                        [Iden [Name "a"]] [] Nothing)]
+>     mkBsf nm =
+>         [(nm ++ "(a,b)",App [Name nm] [Iden [Name "a"],Iden [Name "b"]])
+>         ,(nm ++"(a,b) filter (where something > 5)"
+>           ,AggregateApp [Name nm]
+>                         SQDefault
+>                         [Iden [Name "a"],Iden [Name "b"]] [] fil)]
+
 
 == 10.10 <sort specification list> (p515)
 

tools/Language/SQL/SimpleSQL/ValueExprs.lhs

@@ -331,13 +331,13 @@ target_string
 
 >     ,("sum(a order by a)"
 >     ,AggregateApp [Name "sum"] SQDefault [Iden [Name "a"]]
->                   [SortSpec (Iden [Name "a"]) DirDefault NullsOrderDefault])
+>                   [SortSpec (Iden [Name "a"]) DirDefault NullsOrderDefault] Nothing)
 
 >     ,("sum(all a)"
->     ,AggregateApp [Name "sum"] All [Iden [Name "a"]] [])
+>     ,AggregateApp [Name "sum"] All [Iden [Name "a"]] [] Nothing)
 
 >     ,("count(distinct a)"
->     ,AggregateApp [Name "count"] Distinct [Iden [Name "a"]] [])
+>     ,AggregateApp [Name "count"] Distinct [Iden [Name "a"]] [] Nothing)
 >     ]
 
 > windowFunctions :: TestItem