From 97afd44d1d6b8e46e9549a89719a5cf5b4014068 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Sun, 17 Nov 2013 19:57:04 +1100 Subject: [PATCH 1/4] Silence 'Defined but not used' warnings in tests. --- test/Test.hs | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/test/Test.hs b/test/Test.hs index a7901ae..85e886c 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -122,8 +122,8 @@ main = do 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 @@ main = do 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 @@ main = do 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 @@ main = do 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 @@ main = do 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 @@ main = do 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 @@ main = do 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 @@ main = do 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 @@ main = do 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,7 +792,7 @@ main = do _ <- 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)] From 8df36fb9c7dcc9f2b695efbd257d9afcd9ec9a62 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Tue, 8 Apr 2014 17:53:49 +1000 Subject: [PATCH 2/4] esqueleto.cabal : Relax constraint on conduit. --- esqueleto.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 2eaf47b..42fb46c 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -71,7 +71,7 @@ library , tagged >= 0.2 , monad-logger - , conduit + , conduit >= 1.1 , resourcet hs-source-dirs: src/ ghc-options: -Wall From d37331e04dd0f9916abef92fc6c3aa883f25e0a4 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Tue, 8 Apr 2014 17:54:18 +1000 Subject: [PATCH 3/4] Implement orderBy[rand] modifier. --- src/Database/Esqueleto.hs | 2 +- src/Database/Esqueleto/Internal/Language.hs | 3 +++ src/Database/Esqueleto/Internal/Sql.hs | 5 +++++ 3 files changed, 9 insertions(+), 1 deletion(-) diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index 383f0d7..b9fa17b 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -38,7 +38,7 @@ module Database.Esqueleto -- $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 index 48ad25b..4bfde9a 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -174,6 +174,9 @@ class (Functor query, Applicative query, Monad query) => -- | @OFFSET@. Usually used with 'limit'. offset :: Int64 -> query () + -- | @ORDER BY random()@ clause. + rand :: expr OrderBy + -- | @HAVING@. -- -- /Since: 1.2.2/ diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index dbea46c..3cff09f 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -256,6 +256,7 @@ data SqlExpr a where -- 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 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where 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 :: IdentInfo -> [OrderByClause] -> (TLB.Builder, [PersistValue]) 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" From 60bc2b1a8b8354b6565793d2a40b8cc4287fc15c Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Tue, 8 Apr 2014 18:10:32 +1000 Subject: [PATCH 4/4] Add test for orderRandom. --- test/Test.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/test/Test.hs b/test/Test.hs index 85e886c..e1f3152 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -795,6 +795,21 @@ main = do 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 @@ run_worker act = #else (runMigrationSilent migrateAll >>) $ act #endif + +unValue :: Value a -> a +unValue (Value a) = a