diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index 1545adc..b9c4479 100644 --- a/src/Database/Esqueleto.hs +++ b/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_ , (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.) diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index de42919..8dfe5d4 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/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 () diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index dd8433a..b49a496 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/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)