From 3c932f5a79b997f1dfbf4dbdd43ef6e1d57f6def Mon Sep 17 00:00:00 2001 From: Danny B Date: Sun, 23 Sep 2012 06:07:01 +1100 Subject: [PATCH 1/4] Add support for GROUP BY. --- src/Database/Esqueleto.hs | 2 +- src/Database/Esqueleto/Internal/Language.hs | 11 ++++++++ src/Database/Esqueleto/Internal/Sql.hs | 31 ++++++++++++++++++--- 3 files changed, 39 insertions(+), 5 deletions(-) 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) From 8a79bdaad1777e66db6358575a58ac405e33ea81 Mon Sep 17 00:00:00 2001 From: Danny B Date: Sun, 23 Sep 2012 23:11:24 +1100 Subject: [PATCH 2/4] Add some tuple magic to groupBy. Now you can say things like: groupBy (foo ^. FooId, foo ^. FooName, Bar ^. BarName) instead of: groupBy $ foo ^. Fooid groupBy $ foo ^. FooName groupBy $ Bar ^. BarName --- src/Database/Esqueleto/Internal/Language.hs | 107 ++++++++++++++++++-- src/Database/Esqueleto/Internal/Sql.hs | 13 ++- 2 files changed, 106 insertions(+), 14 deletions(-) diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index 8dfe5d4..503c15e 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -6,6 +6,7 @@ , MultiParamTypeClasses , TypeFamilies , UndecidableInstances + , GADTs #-} -- | This is an internal module, anything exported by this module -- may change without a major version bump. Please use only @@ -15,6 +16,8 @@ module Database.Esqueleto.Internal.Language Esqueleto(..) , from , Value(..) + , SomeValue(..) + , ToSomeValues(..) , InnerJoin(..) , CrossJoin(..) , LeftOuterJoin(..) @@ -128,16 +131,32 @@ 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. + -- | @GROUP BY@ clause. You can enclose multiple columns + -- in a tuple. -- -- @ - -- select $ from \(foo `InnerJoin` bar) -> do - -- on (foo ^. FooBar ==. bar ^. BarId) - -- groupBy (bar ^. BarName) - -- return (bar ^. BarName, countRows) + -- select $ from \\(foo ``InnerJoin`` bar) -> do + -- on (foo ^. FooBarId ==. bar ^. BarId) + -- groupBy (bar ^. BarId, bar ^. BarName) + -- return (bar ^. BarId, bar ^. BarName, countRows) -- @ - groupBy :: expr (Value a) -> query () + -- + -- With groupBy you can sort by aggregate functions, like so (we + -- used @let@ to restrict the more general `countRows` to + -- @SqlExpr (Value Int)@ to avoid ambiguity): + -- + -- @ + -- r \<- select $ from \\(foo ``InnerJoin`` bar) -> do + -- on (foo ^. FooBarId ==. bar ^. BarId) + -- groupBy $ bar ^. BarName + -- let countRows' = countRows + -- orderBy [asc countRows'] + -- return (bar ^. BarName, countRows') + -- forM_ r $ \\((Value name), (Value count)) -> do + -- print name + -- print (count :: Int) + -- @ + groupBy :: (ToSomeValues expr a) => a -> query () -- | @ORDER BY@ clause. See also 'asc' and 'desc'. orderBy :: [expr OrderBy] -> query () @@ -249,6 +268,80 @@ data Value a = Value a deriving (Eq, Ord, Show, Typeable) -- Note: because of GHC bug #6124 we use @data@ instead of @newtype@. +-- | A wrapper type for for any @expr (Value a)@ for all a. +data SomeValue expr where + SomeValue :: Esqueleto query expr backend => expr (Value a) -> SomeValue expr + +-- | A class of things that can be converted into a list of SomeValue. It has +-- instances for tuples and is the reason why groupBy can take tuples, like +-- @groupBy (foo ^. FooId, foo ^. FooName, foo ^. FooType)@. +class ToSomeValues expr a where + toSomeValues :: a -> [SomeValue expr] + +instance ( ToSomeValues expr a + , ToSomeValues expr b + ) => ToSomeValues expr (a, b) where + toSomeValues (a,b) = toSomeValues a ++ toSomeValues b + +instance ( ToSomeValues expr a + , ToSomeValues expr b + , ToSomeValues expr c + ) => ToSomeValues expr (a, b, c) where + toSomeValues (a,b,c) = toSomeValues a ++ toSomeValues b ++ toSomeValues c + +instance ( ToSomeValues expr a + , ToSomeValues expr b + , ToSomeValues expr c + , ToSomeValues expr d + ) => ToSomeValues expr (a, b, c, d) where + toSomeValues (a,b,c,d) = toSomeValues a ++ toSomeValues b ++ toSomeValues c ++ + toSomeValues d + +instance ( ToSomeValues expr a + , ToSomeValues expr b + , ToSomeValues expr c + , ToSomeValues expr d + , ToSomeValues expr e + ) => ToSomeValues expr (a, b, c, d, e) where + toSomeValues (a,b,c,d,e) = toSomeValues a ++ toSomeValues b ++ + toSomeValues c ++ toSomeValues d ++ toSomeValues e + +instance ( ToSomeValues expr a + , ToSomeValues expr b + , ToSomeValues expr c + , ToSomeValues expr d + , ToSomeValues expr e + , ToSomeValues expr f + ) => ToSomeValues expr (a, b, c, d, e, f) where + toSomeValues (a,b,c,d,e,f) = toSomeValues a ++ toSomeValues b ++ + toSomeValues c ++ toSomeValues d ++ toSomeValues e ++ toSomeValues f + +instance ( ToSomeValues expr a + , ToSomeValues expr b + , ToSomeValues expr c + , ToSomeValues expr d + , ToSomeValues expr e + , ToSomeValues expr f + , ToSomeValues expr g + ) => ToSomeValues expr (a, b, c, d, e, f, g) where + toSomeValues (a,b,c,d,e,f,g) = toSomeValues a ++ toSomeValues b ++ + toSomeValues c ++ toSomeValues d ++ toSomeValues e ++ toSomeValues f ++ + toSomeValues g + +instance ( ToSomeValues expr a + , ToSomeValues expr b + , ToSomeValues expr c + , ToSomeValues expr d + , ToSomeValues expr e + , ToSomeValues expr f + , ToSomeValues expr g + , ToSomeValues expr h + ) => ToSomeValues expr (a, b, c, d, e, f, g, h) where + toSomeValues (a,b,c,d,e,f,g,h) = toSomeValues a ++ toSomeValues b ++ + toSomeValues c ++ toSomeValues d ++ toSomeValues e ++ toSomeValues f ++ + toSomeValues g ++ toSomeValues h + + -- | Data type that represents an @INNER JOIN@ (see 'LeftOuterJoin' for an example). data InnerJoin a b = a `InnerJoin` b diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index b49a496..389e943 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -155,12 +155,7 @@ instance Monoid WhereClause where -- | 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 +data GroupByClause = GroupBy [SomeValue SqlExpr] instance Monoid GroupByClause where mempty = GroupBy [] @@ -281,7 +276,7 @@ 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] } + groupBy expr = Q $ W.tell mempty { sdGroupByClause = GroupBy $ toSomeValues expr } orderBy exprs = Q $ W.tell mempty { sdOrderByClause = exprs } asc = EOrderBy ASC @@ -340,6 +335,10 @@ instance Esqueleto SqlQuery SqlExpr SqlPersist where field /=. expr = setAux field (\ent -> ent ^. field /. expr) +instance ToSomeValues SqlExpr (SqlExpr (Value a)) where + toSomeValues a = [SomeValue a] + + fieldName :: (PersistEntity val, PersistField typ) => Connection -> EntityField val typ -> TLB.Builder fieldName conn = fromDBName conn . fieldDB . persistFieldDef From cc88aa701e3c51b7dcf47ead4f6e1405b37b4ef8 Mon Sep 17 00:00:00 2001 From: Danny B Date: Mon, 24 Sep 2012 00:28:35 +1100 Subject: [PATCH 3/4] Minor fixes. --- src/Database/Esqueleto/Internal/Sql.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 389e943..82085f4 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -93,9 +93,9 @@ type SqlEntity ent = (PersistEntity ent, PersistEntityBackend ent ~ SqlPersist) data SideData = SideData { sdFromClause :: ![FromClause] , sdSetClause :: ![SetClause] , sdWhereClause :: !WhereClause + , sdGroupByClause :: !GroupByClause , sdOrderByClause :: ![OrderByClause] , sdLimitClause :: !LimitClause - , sdGroupByClause :: !GroupByClause } instance Monoid SideData where @@ -155,7 +155,7 @@ instance Monoid WhereClause where -- | A @GROUP BY@ clause. -data GroupByClause = GroupBy [SomeValue SqlExpr] +newtype GroupByClause = GroupBy [SomeValue SqlExpr] instance Monoid GroupByClause where mempty = GroupBy [] @@ -631,7 +631,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 groupByClause) = + let (ret, SideData fromClauses setClauses whereClauses groupByClause orderByClauses limitClause) = flip S.evalState initialIdentState $ W.runWriterT $ unQ query From 97400eb9adbc93a799eae2dfe1cad0ac7af124e0 Mon Sep 17 00:00:00 2001 From: Danny B Date: Mon, 24 Sep 2012 00:51:22 +1100 Subject: [PATCH 4/4] Make queries *without* groupBy work again. --- src/Database/Esqueleto/Internal/Sql.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 82085f4..492a12d 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -720,6 +720,7 @@ makeWhere conn (Where (ERaw _ f)) = first ("\nWHERE " <>) (f conn) makeGroupBy :: Connection -> GroupByClause -> (TLB.Builder, [PersistValue]) +makeGroupBy _ (GroupBy []) = (mempty, []) makeGroupBy conn (GroupBy fields) = first ("\nGROUP BY " <>) build where build = uncommas' $ map (\(SomeValue (ERaw _ f)) -> f conn) fields