Add HAVING support.

src/Database/Esqueleto.hs

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

src/Database/Esqueleto/Internal/Language.hs

@@ -173,6 +173,9 @@ class (Functor query, Applicative query, Monad query) =>
   -- | @OFFSET@.  Usually used with 'limit'.
   offset :: Int64 -> query ()
 
+  -- | @HAVING@.
+  having :: expr (Value Bool) -> query ()
+
   -- | Execute a subquery @SELECT@ in an expression.  Returns a
   -- simple value so should be used only when the @SELECT@ query
   -- is guaranteed to return just one row.

src/Database/Esqueleto/Internal/Sql.hs

@@ -93,14 +93,15 @@ data SideData = SideData { sdFromClause    :: ![FromClause]
                          , sdSetClause     :: ![SetClause]
                          , sdWhereClause   :: !WhereClause
                          , sdGroupByClause :: !GroupByClause
+                         , sdHavingClause  :: !HavingClause
                          , sdOrderByClause :: ![OrderByClause]
                          , sdLimitClause   :: !LimitClause
                          }
 
 instance Monoid SideData where
-  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')
+  mempty = SideData mempty mempty mempty mempty mempty mempty mempty
+  SideData f s w g h o l `mappend` SideData f' s' w' g' h' o' l' =
+    SideData (f <> f') (s <> s') (w <> w') (g <> g') (h <> h') (o <> o') (l <> l')
 
 
 -- | A part of a @FROM@ clause.
@@ -160,6 +161,8 @@ instance Monoid GroupByClause where
   mempty = GroupBy []
   GroupBy fs `mappend` GroupBy fs' = GroupBy (fs <> fs')
 
+-- | A @HAVING@ cause.
+type HavingClause = WhereClause
 
 -- | A @ORDER BY@ clause.
 type OrderByClause = SqlExpr OrderBy
@@ -279,6 +282,8 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where
 
   groupBy expr = Q $ W.tell mempty { sdGroupByClause = GroupBy $ toSomeValues expr }
 
+  having expr = Q $ W.tell mempty { sdHavingClause = Where expr }
+
   orderBy exprs = Q $ W.tell mempty { sdOrderByClause = exprs }
   asc  = EOrderBy ASC
   desc = EOrderBy DESC
@@ -681,7 +686,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 groupByClause orderByClauses limitClause) =
+  let (ret, SideData fromClauses setClauses whereClauses groupByClause havingClause orderByClauses limitClause) =
         flip S.evalState initialIdentState $
         W.runWriterT $
         unQ query
@@ -691,6 +696,7 @@ toRawSql mode conn query =
       , makeSet     conn setClauses
       , makeWhere   conn whereClauses
       , makeGroupBy conn groupByClause
+      , makeHaving  conn havingClause
       , makeOrderBy conn orderByClauses
       , makeLimit   conn limitClause
       ]
@@ -777,6 +783,9 @@ makeGroupBy conn (GroupBy fields) = first ("\nGROUP BY " <>) build
   where
     build = uncommas' $ map (\(SomeValue (ERaw _ f)) -> f conn) fields
 
+makeHaving :: Connection -> WhereClause -> (TLB.Builder, [PersistValue])
+makeHaving _    NoWhere            = mempty
+makeHaving conn (Where (ERaw _ f)) = first ("\nHAVING " <>) (f conn)
 
 makeOrderBy :: Connection -> [OrderByClause] -> (TLB.Builder, [PersistValue])
 makeOrderBy _    [] = mempty

test/Test.hs

@@ -517,6 +517,24 @@ main = do
                                   , (Entity p1k p1, Value 3)
                                   , (Entity p3k p3, Value 7) ]
 
+      it "GROUP BY works with HAVING" $
+        run $ do
+          p1k <- insert p1
+          p2k <- insert p2
+          p3k <- insert p3
+          replicateM_ 3 (insert $ BlogPost "" p1k)
+          replicateM_ 7 (insert $ BlogPost "" p3k)
+          ret <- select $
+                 from $ \(p `LeftOuterJoin` b) -> do
+                 on (p ^. PersonId ==. b ^. BlogPostAuthorId)
+                 let cnt = count (b ^. BlogPostId)
+                 groupBy (p ^. PersonId)
+                 having (cnt >. (val 0))
+                 orderBy [ asc cnt ]
+                 return (p, cnt)
+          liftIO $ ret `shouldBe` [ (Entity p1k p1, Value (3 :: Int))
+                                  , (Entity p3k p3, Value 7) ]
+
     describe "lists of values" $ do
       it "IN works for valList" $
         run $ do