Merge pull request #58 from erikd/master

Implement orderBy [rand] expression

esqueleto.cabal

@@ -71,7 +71,7 @@ library
     , tagged               >= 0.2
 
     , monad-logger
-    , conduit
+    , conduit              >= 1.1
     , resourcet
   hs-source-dirs: src/
   ghc-options: -Wall

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

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/

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"
 

test/Test.hs

@@ -122,8 +122,8 @@ main = do
         run $ do
           p1k <- insert p1
           p2k <- insert p2
-          f1k <- insert (Follow p1k p2k)
+          _f1k <- insert (Follow p1k p2k)
-          f2k <- insert (Follow p2k p1k)
+          _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)
+          _f1k <- insert (Follow p1k p2k)
-          f2k <- insert (Follow p2k p1k)
+          _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
+          _p1e <- insert' p1
-          p2e <- insert' p2
+          _p2e <- insert' p2
-          p3e <- insert' p3
+          _p3e <- insert' p3
-          p4e <- insert' p4
+          _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
+          _p1k <- insert p1
-          p2k <- insert p2
+          _p2k <- insert p2
-          p3k <- insert p3
+          _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,9 +792,24 @@ 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)]
 
+    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