Merge pull request #119 from stevely/master

Updated setup for Snap and Yesod Frameworks

snap/setup.py

@@ -9,8 +9,7 @@ def start(args):
   subprocess.check_call("cabal install --only-dependencies", shell=True, cwd="snap/bench")
   subprocess.check_call("cabal build", shell=True, cwd="snap/bench")
 
-  t = str(args.max_threads)
-  subprocess.Popen("dist/build/snap-bench/snap-bench +RTS -A" + t + "M -N" + t + " > /dev/null", shell=True, cwd="snap/bench")
+  subprocess.Popen("dist/build/snap-bench/snap-bench +RTS -A4M -N -qg2 -I0 -G2 > /dev/null", shell=True, cwd="snap/bench")
   return 0
 
 def stop():

yesod/README.md

@@ -13,12 +13,12 @@ The tests were run with:
 ## Test URLs
 ### JSON Encoding Test
 
-http://localhost:3000/json
+http://localhost:8000/json
 
 ### Data-Store/Database Mapping Test
 
-http://localhost:3000/db
+http://localhost:8000/db
 
 ### Variable Query Test
 
-http://localhost:3000/db2/2
+http://localhost:8000/db2/2

yesod/bench/Foundation.hs

@@ -23,6 +23,8 @@ type Form x = Html -> MForm App App (FormResult x, Widget)
 instance Yesod App where
     approot = ApprootMaster $ appRoot . settings
     logLevel _ = LevelError
+    makeSessionBackend _ = return Nothing
+    shouldLog _ _ _ = False
 
 instance YesodPersist App where
     type YesodPersistBackend App = SqlPersist

yesod/bench/bench.cabal

@@ -3,88 +3,28 @@ version:           0.0.0
 cabal-version:     >= 1.8
 build-type:        Simple
 
-Flag dev
-    Description:   Turn on development settings, like auto-reload templates.
-    Default:       False
-
-Flag library-only
-    Description:   Build for use with "yesod devel"
-    Default:       False
-
-library
-    exposed-modules: Application
-                     Foundation
-                     Import
-                     Model
-                     Settings
+executable         bench
+    main-is:           yesod.hs
+    hs-source-dirs:    src
 
-    if flag(dev) || flag(library-only)
-        cpp-options:   -DDEVELOPMENT
-        ghc-options:   -Wall -O0
-    else
-        ghc-options:   -Wall -O2
+    ghc-options:       -threaded -O2 -rtsopts
 
     extensions: TemplateHaskell
                 QuasiQuotes
                 OverloadedStrings
-                NoImplicitPrelude
-                CPP
                 MultiParamTypeClasses
                 TypeFamilies
                 GADTs
-                GeneralizedNewtypeDeriving
-                FlexibleContexts
                 EmptyDataDecls
-                NoMonomorphismRestriction
 
     build-depends: base                          >= 4          && < 5
-                 -- , yesod-platform                >= 1.1        && < 1.2
                  , yesod                         >= 1.1.5      && < 1.2
-                 , yesod-core                    >= 1.1.7      && < 1.2
-                 , yesod-default                 >= 1.1        && < 1.2
                  , text                          >= 0.11       && < 0.12
                  , persistent                    >= 1.1        && < 1.2
                  , persistent-mysql              >= 1.1        && < 1.2
-                 , persistent-template           >= 1.1.1      && < 1.2
-                 , template-haskell
-                 , monad-control                 >= 0.3        && < 0.4
-                 , wai-extra                     >= 1.3        && < 1.4
-                 , yaml                          >= 0.8        && < 0.9
-                 , http-conduit                  >= 1.8        && < 1.10
-                 , directory                     >= 1.1        && < 1.3
                  , warp                          >= 1.3        && < 1.4
-                 , data-default
-                 , aeson
-                 , conduit                       >= 1.0
-                 , monad-logger                  >= 0.3
-                 , fast-logger                   >= 0.3
-                 , random                        >= 1.0
-                 , deepseq                       >= 1.3
-
-executable         bench
-    if flag(library-only)
-        Buildable: False
-
-    main-is:           main.hs
-    hs-source-dirs:    app
-    build-depends:     base
-                     , bench
-                     , yesod-default
-
-    ghc-options:       -threaded -O2 -rtsopts
-
-test-suite test
-    type:              exitcode-stdio-1.0
-    main-is:           main.hs
-    hs-source-dirs:    tests
-    ghc-options:       -Wall
-
-    build-depends: base
-                 , bench
-                 , yesod-test >= 0.3 && < 0.4
-                 , yesod-default
-                 , yesod-core
-                 , persistent
-                 , persistent-mysql
-                 , resourcet
-                 , monad-logger
+                 , unix                          >= 2.5
+                 , network-conduit               >= 1.0
+                 , primitive                     >= 0.5
+                 , mwc-random                    >= 0.12
+                 , pool-conduit                  >= 0.1

yesod/bench/src/yesod.hs

@@ -0,0 +1,79 @@
+{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses, OverloadedStrings #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE EmptyDataDecls #-}
+import Yesod
+import System.Environment (getArgs)
+import qualified Network.Wai.Handler.Warp as Warp
+import Data.Text (Text)
+import Data.Conduit.Pool (Pool)
+import Database.Persist.Store (get, PersistValue (PersistInt64))
+import Database.Persist.MySQL
+import qualified System.Random.MWC as R
+import Control.Monad.Primitive (PrimState)
+import Control.Monad (replicateM)
+import Data.Conduit.Network (bindPort)
+import System.Posix.Process (forkProcess)
+import Control.Monad (replicateM_)
+
+mkPersist sqlSettings [persist|
+World sql=World
+    randomNumber Int sql=randomNumber
+|]
+
+data App = App
+    { appConnPool :: Pool Connection
+    , appGen :: R.Gen (PrimState IO)
+    }
+
+mkYesod "App" [parseRoutes|
+/json JsonR GET
+/db DbR GET
+/dbs/#Int DbsR GET
+|]
+
+instance Yesod App where
+    makeSessionBackend _ = return Nothing
+    shouldLog _ _ _ = False
+    yesodMiddleware = id
+
+getJsonR :: Handler RepJson
+getJsonR = jsonToRepJson $ object ["message" .= ("Hello, World!" :: Text)]
+
+getDbR :: Handler RepJson
+getDbR = do
+    App {..} <- getYesod
+    i <- liftIO $ R.uniformR (1, 10000) appGen
+    Just x <- flip runSqlPool appConnPool $ get (Key $ PersistInt64 i :: WorldId)
+    jsonToRepJson $ object ["id" .= i, "randomNumber" .= worldRandomNumber x]
+
+getDbsR :: Int -> Handler RepJson
+getDbsR cnt = do
+    App {..} <- getYesod
+    objs <- replicateM cnt $ do
+        i <- liftIO $ R.uniformR (1, 10000) appGen
+        Just x <- flip runSqlPool appConnPool $ get (Key $ PersistInt64 i :: WorldId)
+        return $ object ["id" .= i, "randomNumber" .= worldRandomNumber x]
+    jsonToRepJson $ array objs
+
+main :: IO ()
+main = R.withSystemRandom $ \gen -> do
+    socket <- bindPort 8000 "*"
+    [cores, host] <- getArgs
+    pool <- createMySQLPool defaultConnectInfo
+        { connectUser = "benchmarkdbuser"
+        , connectPassword = "benchmarkdbpass"
+        , connectDatabase = "hello_world"
+        , connectHost = host
+        } 1000
+    app <- toWaiAppPlain App
+        { appConnPool = pool
+        , appGen = gen
+        }
+    let run = Warp.runSettingsSocket Warp.defaultSettings
+                { Warp.settingsPort = 8000
+                , Warp.settingsHost = "*"
+                , Warp.settingsOnException = const $ return ()
+                } socket app
+    replicateM_ (read cores - 1) $ forkProcess run
+    run

yesod/benchmark_config

@@ -5,8 +5,8 @@
       "setup_file": "setup",
       "json_url": "/json",
       "db_url": "/db",
-      "query_url": "/db2/",
-      "port": 3000,
+      "query_url": "/dbs/",
+      "port": 8000,
       "sort": 37
     }
   }]

yesod/setup.py

@@ -7,11 +7,13 @@ import os
 def start(args):
   setup_util.replace_text("yesod/bench/config/mysql.yml", "host: .*", "host: " + args.database_host)
   
-  subprocess.check_call("cabal configure", shell=True, cwd="yesod/bench")
+  subprocess.check_call("cabal update", shell=True, cwd="yesod/bench")
+  subprocess.check_call("cabal install --only-dependencies", shell=True, cwd="yesod/bench")
   subprocess.check_call("cabal build", shell=True, cwd="yesod/bench")
 
-  heap = args.max_threads
-  subprocess.Popen("dist/build/bench/bench Production +RTS -A"+str(heap)+"m -N" + str(args.max_threads) + " > /dev/null", shell=True, cwd="yesod/bench")
+  db_host = args.database_host
+  threads = str(args.max_threads)
+  subprocess.Popen("dist/build/bench/bench " + threads + " " + db_host + " +RTS -A4M -N -qg2 -I0 -G2 > /dev/null", shell=True, cwd="yesod/bench")
   return 0
 
 def stop():
@@ -25,4 +27,4 @@ def stop():
       except OSError:
         pass
 
-  return 0
+  return 0