diff --git a/esqueleto.cabal b/esqueleto.cabal --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 0.2.7 +version: 0.2.8 synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -18,7 +18,7 @@ -- $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 --- 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 @@ Esqueleto(..) , from , Value(..) + , SomeValue(..) + , ToSomeValues(..) , InnerJoin(..) , CrossJoin(..) , LeftOuterJoin(..) @@ -128,6 +131,33 @@ -- 'LeftOuterJoin'. on :: expr (Value Bool) -> query () + -- | @GROUP BY@ clause. You can enclose multiple columns + -- in a tuple. + -- + -- @ + -- select $ from \\(foo ``InnerJoin`` bar) -> do + -- on (foo ^. FooBarId ==. bar ^. BarId) + -- groupBy (bar ^. BarId, bar ^. BarName) + -- return (bar ^. BarId, bar ^. BarName, countRows) + -- @ + -- + -- 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 () @@ -236,6 +266,80 @@ -- @('^.')@ or @('?.')@ to get a 'Value' from an 'Entity'. 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). diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -93,14 +93,15 @@ data SideData = SideData { sdFromClause :: ![FromClause] , sdSetClause :: ![SetClause] , sdWhereClause :: !WhereClause + , sdGroupByClause :: !GroupByClause , sdOrderByClause :: ![OrderByClause] , sdLimitClause :: !LimitClause } 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,14 @@ Where e1 `mappend` Where e2 = Where (e1 &&. e2) +-- | A @GROUP BY@ clause. +newtype GroupByClause = GroupBy [SomeValue SqlExpr] + +instance Monoid GroupByClause where + mempty = GroupBy [] + GroupBy fs `mappend` GroupBy fs' = GroupBy (fs <> fs') + + -- | A @ORDER BY@ clause. type OrderByClause = SqlExpr OrderBy @@ -267,6 +276,8 @@ on expr = Q $ W.tell mempty { sdFromClause = [OnClause expr] } + groupBy expr = Q $ W.tell mempty { sdGroupByClause = GroupBy $ toSomeValues expr } + orderBy exprs = Q $ W.tell mempty { sdOrderByClause = exprs } asc = EOrderBy ASC desc = EOrderBy DESC @@ -324,6 +335,10 @@ 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 @@ -616,7 +631,7 @@ -- @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 groupByClause orderByClauses limitClause) = flip S.evalState initialIdentState $ W.runWriterT $ unQ query @@ -625,6 +640,7 @@ , makeFrom conn mode fromClauses , makeSet conn setClauses , makeWhere conn whereClauses + , makeGroupBy conn groupByClause , makeOrderBy conn orderByClauses , makeLimit conn limitClause ] @@ -701,6 +717,13 @@ makeWhere :: Connection -> WhereClause -> (TLB.Builder, [PersistValue]) makeWhere _ NoWhere = mempty 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 makeOrderBy :: Connection -> [OrderByClause] -> (TLB.Builder, [PersistValue])