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
This commit is contained in:
parent
3c932f5a79
commit
8a79bdaad1
@ -6,6 +6,7 @@
|
|||||||
, MultiParamTypeClasses
|
, MultiParamTypeClasses
|
||||||
, TypeFamilies
|
, TypeFamilies
|
||||||
, UndecidableInstances
|
, UndecidableInstances
|
||||||
|
, GADTs
|
||||||
#-}
|
#-}
|
||||||
-- | This is an internal module, anything exported by this module
|
-- | This is an internal module, anything exported by this module
|
||||||
-- may change without a major version bump. Please use only
|
-- may change without a major version bump. Please use only
|
||||||
@ -15,6 +16,8 @@ module Database.Esqueleto.Internal.Language
|
|||||||
Esqueleto(..)
|
Esqueleto(..)
|
||||||
, from
|
, from
|
||||||
, Value(..)
|
, Value(..)
|
||||||
|
, SomeValue(..)
|
||||||
|
, ToSomeValues(..)
|
||||||
, InnerJoin(..)
|
, InnerJoin(..)
|
||||||
, CrossJoin(..)
|
, CrossJoin(..)
|
||||||
, LeftOuterJoin(..)
|
, LeftOuterJoin(..)
|
||||||
@ -128,16 +131,32 @@ class (Functor query, Applicative query, Monad query) =>
|
|||||||
-- 'LeftOuterJoin'.
|
-- 'LeftOuterJoin'.
|
||||||
on :: expr (Value Bool) -> query ()
|
on :: expr (Value Bool) -> query ()
|
||||||
|
|
||||||
-- | @GROUP BY@ clause. To group by multiple columns call
|
-- | @GROUP BY@ clause. You can enclose multiple columns
|
||||||
-- groupBy several times.
|
-- in a tuple.
|
||||||
--
|
--
|
||||||
-- @
|
-- @
|
||||||
-- select $ from \(foo `InnerJoin` bar) -> do
|
-- select $ from \\(foo ``InnerJoin`` bar) -> do
|
||||||
-- on (foo ^. FooBar ==. bar ^. BarId)
|
-- on (foo ^. FooBarId ==. bar ^. BarId)
|
||||||
-- groupBy (bar ^. BarName)
|
-- groupBy (bar ^. BarId, bar ^. BarName)
|
||||||
-- return (bar ^. BarName, countRows)
|
-- 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'.
|
-- | @ORDER BY@ clause. See also 'asc' and 'desc'.
|
||||||
orderBy :: [expr OrderBy] -> query ()
|
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@.
|
-- 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 type that represents an @INNER JOIN@ (see 'LeftOuterJoin' for an example).
|
||||||
data InnerJoin a b = a `InnerJoin` b
|
data InnerJoin a b = a `InnerJoin` b
|
||||||
|
|
||||||
|
|||||||
@ -155,12 +155,7 @@ instance Monoid WhereClause where
|
|||||||
|
|
||||||
|
|
||||||
-- | A @GROUP BY@ clause.
|
-- | A @GROUP BY@ clause.
|
||||||
data GroupByClause = GroupBy [SomeValue]
|
data GroupByClause = GroupBy [SomeValue SqlExpr]
|
||||||
|
|
||||||
-- Used to implement heterogeneous list for GroupByClause, may be
|
|
||||||
-- useful elsewhere.
|
|
||||||
data SomeValue where
|
|
||||||
SomeValue :: SqlExpr (Value a) -> SomeValue
|
|
||||||
|
|
||||||
instance Monoid GroupByClause where
|
instance Monoid GroupByClause where
|
||||||
mempty = GroupBy []
|
mempty = GroupBy []
|
||||||
@ -281,7 +276,7 @@ instance Esqueleto SqlQuery SqlExpr SqlPersist where
|
|||||||
|
|
||||||
on expr = Q $ W.tell mempty { sdFromClause = [OnClause expr] }
|
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 }
|
orderBy exprs = Q $ W.tell mempty { sdOrderByClause = exprs }
|
||||||
asc = EOrderBy ASC
|
asc = EOrderBy ASC
|
||||||
@ -340,6 +335,10 @@ instance Esqueleto SqlQuery SqlExpr SqlPersist where
|
|||||||
field /=. expr = setAux field (\ent -> ent ^. field /. expr)
|
field /=. expr = setAux field (\ent -> ent ^. field /. expr)
|
||||||
|
|
||||||
|
|
||||||
|
instance ToSomeValues SqlExpr (SqlExpr (Value a)) where
|
||||||
|
toSomeValues a = [SomeValue a]
|
||||||
|
|
||||||
|
|
||||||
fieldName :: (PersistEntity val, PersistField typ)
|
fieldName :: (PersistEntity val, PersistField typ)
|
||||||
=> Connection -> EntityField val typ -> TLB.Builder
|
=> Connection -> EntityField val typ -> TLB.Builder
|
||||||
fieldName conn = fromDBName conn . fieldDB . persistFieldDef
|
fieldName conn = fromDBName conn . fieldDB . persistFieldDef
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user