Add support for GROUP BY.

src/Database/Esqueleto.hs

@@ -18,7 +18,7 @@ module Database.Esqueleto
     -- $gettingstarted
 
     -- * @esqueleto@'s Language
-    Esqueleto( where_, on, orderBy, asc, desc, limit, offset
+    Esqueleto( where_, on, groupBy, orderBy, asc, desc, limit, offset
              , sub_select, sub_selectDistinct, (^.), (?.)
              , val, isNothing, just, nothing, countRows, not_
              , (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)

src/Database/Esqueleto/Internal/Language.hs

@@ -128,6 +128,17 @@ class (Functor query, Applicative query, Monad query) =>
   -- 'LeftOuterJoin'.
   on :: expr (Value Bool) -> query ()
 
+  -- | @GROUP BY@ clause. To group by multiple columns call
+  -- groupBy several times.
+  --
+  -- @
+  -- select $ from \(foo `InnerJoin` bar) -> do
+  --   on (foo ^. FooBar ==. bar ^. BarId)
+  --   groupBy (bar ^. BarName)
+  --   return (bar ^. BarName, countRows)
+  -- @
+  groupBy :: expr (Value a) -> query ()
+
   -- | @ORDER BY@ clause. See also 'asc' and 'desc'.
   orderBy :: [expr OrderBy] -> query ()
 

src/Database/Esqueleto/Internal/Sql.hs

@@ -95,12 +95,13 @@ data SideData = SideData { sdFromClause    :: ![FromClause]
                          , sdWhereClause   :: !WhereClause
                          , sdOrderByClause :: ![OrderByClause]
                          , sdLimitClause   :: !LimitClause
+                         , sdGroupByClause :: !GroupByClause
                          }
 
 instance Monoid SideData where
-  mempty = SideData mempty mempty mempty mempty mempty
-  SideData f s w o l `mappend` SideData f' s' w' o' l' =
-    SideData (f <> f') (s <> s') (w <> w') (o <> o') (l <> l')
+  mempty = SideData mempty mempty mempty mempty mempty mempty
+  SideData f s w o l g `mappend` SideData f' s' w' o' l' g' =
+    SideData (f <> f') (s <> s') (w <> w') (o <> o') (l <> l') (g <> g')
 
 
 -- | A part of a @FROM@ clause.
@@ -153,6 +154,19 @@ instance Monoid WhereClause where
   Where e1 `mappend` Where e2 = Where (e1 &&. e2)
 
 
+-- | A @GROUP BY@ clause.
+data GroupByClause = GroupBy [SomeValue]
+
+-- Used to implement heterogeneous list for GroupByClause, may be
+-- useful elsewhere.
+data SomeValue where
+  SomeValue :: SqlExpr (Value a) -> SomeValue
+
+instance Monoid GroupByClause where
+  mempty = GroupBy []
+  GroupBy fs `mappend` GroupBy fs' = GroupBy (fs <> fs')
+
+
 -- | A @ORDER BY@ clause.
 type OrderByClause = SqlExpr OrderBy
 
@@ -267,6 +281,8 @@ instance Esqueleto SqlQuery SqlExpr SqlPersist where
 
   on expr = Q $ W.tell mempty { sdFromClause = [OnClause expr] }
 
+  groupBy field = Q $ W.tell mempty { sdGroupByClause = GroupBy [SomeValue field] }
+
   orderBy exprs = Q $ W.tell mempty { sdOrderByClause = exprs }
   asc  = EOrderBy ASC
   desc = EOrderBy DESC
@@ -616,7 +632,7 @@ builderToText = TL.toStrict . TLB.toLazyTextWith defaultChunkSize
 -- @persistent@.
 toRawSql :: SqlSelect a r => Mode -> Connection -> SqlQuery a -> (TLB.Builder, [PersistValue])
 toRawSql mode conn query =
-  let (ret, SideData fromClauses setClauses whereClauses orderByClauses limitClause) =
+  let (ret, SideData fromClauses setClauses whereClauses orderByClauses limitClause groupByClause) =
         flip S.evalState initialIdentState $
         W.runWriterT $
         unQ query
@@ -625,6 +641,7 @@ toRawSql mode conn query =
       , makeFrom    conn mode fromClauses
       , makeSet     conn setClauses
       , makeWhere   conn whereClauses
+      , makeGroupBy conn groupByClause
       , makeOrderBy conn orderByClauses
       , makeLimit   conn limitClause
       ]
@@ -703,6 +720,12 @@ makeWhere _    NoWhere            = mempty
 makeWhere conn (Where (ERaw _ f)) = first ("\nWHERE " <>) (f conn)
 
 
+makeGroupBy :: Connection -> GroupByClause -> (TLB.Builder, [PersistValue])
+makeGroupBy conn (GroupBy fields) = first ("\nGROUP BY " <>) build
+  where
+    build = uncommas' $ map (\(SomeValue (ERaw _ f)) -> f conn) fields
+
+
 makeOrderBy :: Connection -> [OrderByClause] -> (TLB.Builder, [PersistValue])
 makeOrderBy _    [] = mempty
 makeOrderBy conn os = first ("\nORDER BY " <>) $ uncommas' (map mk os)