diff --git a/esqueleto.cabal b/esqueleto.cabal --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.2.4 +version: 1.3 synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 @@ -79,6 +79,7 @@ base, persistent, transformers, conduit, text -- Test-only dependencies + , containers , HUnit , QuickCheck , hspec >= 1.3 && < 1.7 diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -40,10 +40,11 @@ -- * @esqueleto@'s Language Esqueleto( where_, on, groupBy, orderBy, asc, desc, limit, offset, having , sub_select, sub_selectDistinct, (^.), (?.) - , val, isNothing, just, nothing, countRows, count, not_ + , val, isNothing, just, nothing, joinV, countRows, count, not_ , (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.) , (+.), (-.), (/.), (*.) - , random_, sum_, round_, ceiling_, floor_, avg_, min_, max_ + , random_, round_, ceiling_, floor_ + , min_, max_,_sum_, avg_, , like, (%), concat_, (++.) , subList_select, subList_selectDistinct, valList , in_, notIn, exists, notExists 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 @@ -208,6 +208,10 @@ -- | @NULL@ value. nothing :: expr (Value (Maybe typ)) + -- | Join nested 'Maybe's in a 'Value' into one. This is useful when + -- calling aggregate functions on nullable fields. + joinV :: expr (Value (Maybe (Maybe typ))) -> expr (Value (Maybe typ)) + -- | @COUNT(*)@ value. countRows :: Num a => expr (Value a) @@ -236,10 +240,11 @@ round_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value b) ceiling_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value b) floor_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value b) - sum_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value b) - min_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value b) - max_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value b) - avg_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value b) + + sum_ :: (PersistField a) => expr (Value a) -> expr (Value (Maybe a)) + min_ :: (PersistField a) => expr (Value a) -> expr (Value (Maybe a)) + max_ :: (PersistField a) => expr (Value a) -> expr (Value (Maybe a)) + avg_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value (Maybe b)) -- | @LIKE@ operator. like :: (PersistField s, IsString s) => expr (Value s) -> expr (Value s) -> expr (Value Bool) 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 @@ -313,6 +313,7 @@ isNothing (ERaw p f) = ERaw Parens $ first ((<> " IS NULL") . parensM p) . f just (ERaw p f) = ERaw p f nothing = unsafeSqlValue "NULL" + joinV (ERaw p f) = ERaw p f countRows = unsafeSqlValue "COUNT(*)" count (ERaw _ f) = ERaw Never $ \conn -> let (b, vals) = f conn in ("COUNT" <> parens b, vals) @@ -1432,7 +1433,7 @@ -- | Apply extra @SqlExpr Value@ arguments to a 'PersistField' constructor (<&>) :: SqlExpr (Insertion (a -> b)) -> SqlExpr (Value a) -> SqlExpr (Insertion b) -(EInsert _ f) <&> (ERaw _ g) = EInsert Proxy $ \x-> +(EInsert _ f) <&> (ERaw _ g) = EInsert Proxy $ \x-> let (fb, fv) = f x (gb, gv) = g x in (fb <> ", " <> gb, fv ++ gv) diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -14,7 +14,7 @@ module Main (main) where import Control.Applicative ((<$>)) -import Control.Monad (replicateM_) +import Control.Monad (replicateM, replicateM_) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Logger (MonadLogger(..), runStderrLoggingT, runNoLoggingT) import Control.Monad.Trans.Control (MonadBaseControl(..)) @@ -24,6 +24,7 @@ import Test.Hspec import qualified Data.Conduit as C +import qualified Data.Set as S -- Test schema @@ -273,10 +274,10 @@ _ <- insert' p4 ret <- select $ from $ \p-> - return $ sum_ (p ^. PersonAge) - liftIO $ ret `shouldBe` [ Value (36 + 17 + 17 :: Int) ] + return $ joinV $ sum_ (p ^. PersonAge) + liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Int) ] - it "works with sum_" $ + it "works with avg_" $ run $ do _ <- insert' p1 _ <- insert' p2 @@ -284,8 +285,8 @@ _ <- insert' p4 ret <- select $ from $ \p-> - return $ avg_ (p ^. PersonAge) - liftIO $ ret `shouldBe` [ Value ((36 + 17 + 17) / 3 :: Double) ] + return $ joinV $ avg_ (p ^. PersonAge) + liftIO $ ret `shouldBe` [ Value $ Just ((36 + 17 + 17) / 3 :: Double) ] it "works with min_" $ run $ do @@ -295,8 +296,8 @@ _ <- insert' p4 ret <- select $ from $ \p-> - return $ min_ (p ^. PersonAge) - liftIO $ ret `shouldBe` [ Value (17 :: Int) ] + return $ joinV $ min_ (p ^. PersonAge) + liftIO $ ret `shouldBe` [ Value $ Just (17 :: Int) ] it "works with max_" $ run $ do @@ -306,8 +307,8 @@ _ <- insert' p4 ret <- select $ from $ \p-> - return $ max_ (p ^. PersonAge) - liftIO $ ret `shouldBe` [ Value (36 :: Int) ] + return $ joinV $ max_ (p ^. PersonAge) + liftIO $ ret `shouldBe` [ Value $ Just (36 :: Int) ] it "works with random_" $ run $ do @@ -457,6 +458,24 @@ ] return (b ^. BlogPostId) liftIO $ ret `shouldBe` (Value <$> [b2k, b3k, b4k, b1k]) + + it "works with asc random_" $ + run $ do + p1e <- insert' p1 + p2e <- insert' p2 + p3e <- insert' p3 + p4e <- insert' p4 + rets <- + fmap S.fromList $ + replicateM 11 $ + select $ + from $ \p -> do + orderBy [asc (random_ :: SqlExpr (Value Double))] + return (p ^. PersonId :: SqlExpr (Value PersonId)) + -- There are 2^4 = 16 possible orderings. The chance + -- of 11 random samplings returning the same ordering + -- is 1/2^40, so this test should pass almost everytime. + liftIO $ S.size rets `shouldSatisfy` (>2) describe "selectDistinct" $