diff --git a/esqueleto.cabal b/esqueleto.cabal --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,5 +1,5 @@ name: esqueleto -version: 1.3.9 +version: 1.3.10 synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 @@ -71,7 +71,7 @@ , tagged >= 0.2 , monad-logger - , conduit + , conduit >= 1.1 , resourcet hs-source-dirs: src/ ghc-options: -Wall diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -38,7 +38,7 @@ -- $gettingstarted -- * @esqueleto@'s Language - Esqueleto( where_, on, groupBy, orderBy, asc, desc, limit, offset, having + Esqueleto( where_, on, groupBy, orderBy, rand, asc, desc, limit, offset, having , sub_select, sub_selectDistinct, (^.), (?.) , val, isNothing, just, nothing, joinV, countRows, count, 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 @@ -174,6 +174,11 @@ -- | @OFFSET@. Usually used with 'limit'. offset :: Int64 -> query () + -- | @ORDER BY random()@ clause. + -- + -- /Since: 1.3.10/ + rand :: expr OrderBy + -- | @HAVING@. -- -- /Since: 1.2.2/ 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 @@ -256,6 +256,7 @@ -- A 'SqlExpr' accepted only by 'orderBy'. EOrderBy :: OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy + EOrderRandom :: SqlExpr OrderBy -- A 'SqlExpr' accepted only by 'set'. ESet :: (SqlExpr (Entity val) -> SqlExpr (Value ())) -> SqlExpr (Update val) @@ -322,6 +323,8 @@ asc = EOrderBy ASC desc = EOrderBy DESC + rand = EOrderRandom + limit n = Q $ W.tell mempty { sdLimitClause = Limit (Just n) Nothing } offset n = Q $ W.tell mempty { sdLimitClause = Limit Nothing (Just n) } @@ -903,7 +906,9 @@ makeOrderBy _ [] = mempty makeOrderBy info os = first ("\nORDER BY " <>) $ uncommas' (map mk os) where + mk :: OrderByClause -> (TLB.Builder, [PersistValue]) mk (EOrderBy t (ERaw p f)) = first ((<> orderByType t) . parensM p) (f info) + mk EOrderRandom = first ((<> "RANDOM()")) mempty orderByType ASC = " ASC" orderByType DESC = " DESC" diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -122,8 +122,8 @@ run $ do p1k <- insert p1 p2k <- insert p2 - f1k <- insert (Follow p1k p2k) - f2k <- insert (Follow p2k p1k) + _f1k <- insert (Follow p1k p2k) + _f2k <- insert (Follow p2k p1k) ret <- select $ from $ \followA -> do let subquery = @@ -138,8 +138,8 @@ run $ do p1k <- insert p1 p2k <- insert p2 - f1k <- insert (Follow p1k p2k) - f2k <- insert (Follow p2k p1k) + _f1k <- insert (Follow p1k p2k) + _f2k <- insert (Follow p2k p1k) ret <- select $ from $ \followA -> do where_ $ exists $ @@ -368,9 +368,9 @@ it "works with random_" $ run $ do #if defined(WITH_POSTGRESQL) || defined(WITH_MYSQL) - ret <- select $ return (random_ :: SqlExpr (Value Double)) + _ <- select $ return (random_ :: SqlExpr (Value Double)) #else - ret <- select $ return (random_ :: SqlExpr (Value Int)) + _ <- select $ return (random_ :: SqlExpr (Value Int)) #endif return () @@ -530,10 +530,10 @@ it "works with asc random_" $ run $ do - p1e <- insert' p1 - p2e <- insert' p2 - p3e <- insert' p3 - p4e <- insert' p4 + _p1e <- insert' p1 + _p2e <- insert' p2 + _p3e <- insert' p3 + _p4e <- insert' p4 rets <- fmap S.fromList $ replicateM 11 $ @@ -680,7 +680,7 @@ it "GROUP BY works with HAVING" $ run $ do p1k <- insert p1 - p2k <- insert p2 + _p2k <- insert p2 p3k <- insert p3 replicateM_ 3 (insert $ BlogPost "" p1k) replicateM_ 7 (insert $ BlogPost "" p3k) @@ -700,7 +700,7 @@ run $ do p1k <- insert p1 p2k <- insert p2 - p3k <- insert p3 + _p3k <- insert p3 ret <- select $ from $ \p -> do where_ (p ^. PersonName `in_` valList (personName <$> [p1, p2])) @@ -710,9 +710,9 @@ it "IN works for valList (null list)" $ run $ do - p1k <- insert p1 - p2k <- insert p2 - p3k <- insert p3 + _p1k <- insert p1 + _p2k <- insert p2 + _p3k <- insert p3 ret <- select $ from $ \p -> do where_ (p ^. PersonName `in_` valList []) @@ -722,7 +722,7 @@ it "IN works for subList_select" $ run $ do p1k <- insert p1 - p2k <- insert p2 + _p2k <- insert p2 p3k <- insert p3 _ <- insert (BlogPost "" p1k) _ <- insert (BlogPost "" p3k) @@ -756,7 +756,7 @@ it "EXISTS works for subList_select" $ run $ do p1k <- insert p1 - p2k <- insert p2 + _p2k <- insert p2 p3k <- insert p3 _ <- insert (BlogPost "" p1k) _ <- insert (BlogPost "" p3k) @@ -792,10 +792,25 @@ _ <- insert p3 insertSelect $ from $ \p -> do return $ BlogPost <# val "FakePost" <&> (p ^. PersonId) - ret <- select $ from (\(b::(SqlExpr (Entity BlogPost))) -> return countRows) + ret <- select $ from (\(_::(SqlExpr (Entity BlogPost))) -> return countRows) liftIO $ ret `shouldBe` [Value (3::Int)] + describe "rand works" $ do + it "returns result in random order" $ + run $ do + _ <- insert p1 + _ <- insert p2 + _ <- insert p3 + _ <- insert p4 + ret1 <- fmap (map unValue) $ select $ from $ \p -> do + orderBy [rand] + return (p ^. PersonId) + ret2 <- fmap (map unValue) $ select $ from $ \p -> do + orderBy [rand] + return (p ^. PersonId) + liftIO $ (ret1 == ret2) `shouldBe` False + ---------------------------------------------------------------------- @@ -859,3 +874,6 @@ #else (runMigrationSilent migrateAll >>) $ act #endif + +unValue :: Value a -> a +unValue (Value a) = a