Merge pull request #101 from RaphaelJ/master

Improved test for Yesod

yesod/bench/Application.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Application
     ( makeApplication
@@ -6,6 +7,7 @@ module Application
 
 import Import
 import Control.Monad
+import Control.DeepSeq (force)
 import System.Random
 
 import qualified Database.Persist.Store
@@ -17,23 +19,25 @@ import Yesod.Default.Config
 import Settings
 
 getJsonR :: Handler RepJson
-getJsonR = jsonToRepJson $ object ["message" .= ("Hello, World!" :: Text)]
+getJsonR = jsonToRepJson $ object [("message", "Hello, World!" :: Text)]
 
 getDBR :: Handler RepJson
 getDBR = do
-    (i, _) <- liftIO $ randomR (1, 10000) <$> newStdGen
-    liftIO $ print i
+    !i <- liftIO $ randomRIO (1, 10000)
     Just o <- runDB $ get $ Key $ PersistInt64 i
     jsonToRepJson $ object ["id" .= i, "randomNumber" .= worldRandomNumber o]
 
 getDB2R :: Int -> Handler RepJson
 getDB2R n = do
-    os <- runDB $ replicateM n $ do
-        (i, _) <- liftIO $ randomR (1, 10000) <$> newStdGen
-        Just o <- get $ Key $ PersistInt64 i
-        return $ object ["id" .= i, "randomNumber" .= worldRandomNumber o]
+    !is <- force . take n . randomRs (1, 10000) <$> liftIO newStdGen
 
-    jsonToRepJson $ array os
+    ns <- runDB $
+        forM is $ \i -> do
+            Just o <- get $ Key $ PersistInt64 i
+            return (i, worldRandomNumber o)
+
+    jsonToRepJson $ array
+        [ object ["id" .= i, "randomNumber" .= rn] | (i, rn) <- ns ]
 
 mkYesodDispatch "App" resourcesApp
 

yesod/bench/Foundation.hs

@@ -22,6 +22,7 @@ type Form x = Html -> MForm App App (FormResult x, Widget)
 
 instance Yesod App where
     approot = ApprootMaster $ appRoot . settings
+    logLevel _ = LevelError
 
 instance YesodPersist App where
     type YesodPersistBackend App = SqlPersist

yesod/bench/Settings.hs

@@ -1,8 +1,3 @@
--- | Settings are centralized, as much as possible, into this file. This
--- includes database connection settings, static file locations, etc.
--- In addition, you can configure a number of different aspects of Yesod
--- by overriding methods in the Yesod typeclass. That instance is
--- declared in the Foundation.hs file.
 module Settings where
 
 import Prelude

yesod/bench/bench.cabal

@@ -59,6 +59,7 @@ library
                  , monad-logger                  >= 0.3
                  , fast-logger                   >= 0.3
                  , random                        >= 1.0
+                 , deepseq                       >= 1.3
 
 executable         bench
     if flag(library-only)