haskell/esqueleto
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #7 from db81/groupby

Browse Source 
GROUP BY support.
This commit is contained in:
Felipe Lessa 2012-09-23 07:08:41 -07:00
commit ba14a86251
3 changed files with 132 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Database/Esqueleto.hs
View File

@ -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_
, (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)

104
src/Database/Esqueleto/Internal/Language.hs
View File

@ -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,6 +131,33 @@ class (Functor query, Applicative query, Monad query) =>
-- '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 ()
@ -238,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

31
src/Database/Esqueleto/Internal/Sql.hs
View File

@ -93,14 +93,15 @@ type SqlEntity ent = (PersistEntity ent, PersistEntityBackend ent ~ SqlPersist)
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 @@ instance Monoid WhereClause where
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 @@ instance Esqueleto SqlQuery SqlExpr SqlPersist where
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 @@ 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
@ -616,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) =
let (ret, SideData fromClauses setClauses whereClauses groupByClause orderByClauses limitClause) =
flip S.evalState initialIdentState $
W.runWriterT $
unQ query
@ -625,6 +640,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 +719,13 @@ 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])
makeOrderBy _ [] = mempty
makeOrderBy conn os = first ("\nORDER BY " <>) $ uncommas' (map mk os)