Merge branch 'master' of https://github.com/TechEmpower/FrameworkBenchmarks

frameworks/Haskell/yesod/bash_profile.sh

@@ -0,0 +1,3 @@
+# Where to find the ghc and cabal executables
+export PATH="/opt/ghc/7.8.3/bin:/opt/cabal/1.20/bin:$PATH"
+export LANG=en_US.UTF-8

frameworks/Haskell/yesod/bench/bench.cabal

@@ -16,20 +16,21 @@ executable         bench
                 TypeFamilies
                 GADTs
                 EmptyDataDecls
+                CPP
 
-    build-depends: base                          >= 4          && < 5
-                 , yesod                         == 1.2.2
-                 , yesod-core                    == 1.2.4
-                 , text                          >= 0.11       && < 0.12
-                 , persistent                    >= 1.2        && < 1.3
-                 , persistent-mysql              >= 1.2        && < 1.3
-                 , persistent-mongoDB            >= 1.2        && < 1.3
-                 , warp                          >= 1.3        && < 1.4
-                 , unix                          >= 2.5
-                 , network-conduit               >= 1.0
+    build-depends: base                          >= 4.7        && < 5
+                 , yesod                         >= 1.4        && < 1.5
+                 , yesod-core                    >= 1.4        && < 1.5
+                 , text                          >= 0.11       && < 1.3
+                 , persistent                    >= 2.1        && < 2.2
+                 , persistent-mysql              >= 2.1        && < 2.2
+                 , persistent-mongoDB            >= 2.1        && < 2.2
+                 , warp                          >= 3.0.2.2    && < 3.1
+                 , auto-update                   >= 0.1.1.4    && < 0.2
                  , primitive                     >= 0.5
                  , mwc-random                    >= 0.12
                  , pool-conduit                  >= 0.1.2
                  , network
                  , mongoDB
-                 , aeson
+                 , monad-logger
+                 , mtl

frameworks/Haskell/yesod/bench/src/yesod.hs

@@ -1,35 +1,48 @@
-{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses, OverloadedStrings #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE EmptyDataDecls #-}
-{-# LANGUAGE RankNTypes #-}
-import Yesod hiding (Field)
-import System.Environment (getArgs)
-import qualified Network.Wai.Handler.Warp as Warp
-import Data.Text (Text)
-import Data.Conduit.Pool (Pool)
-import qualified Database.Persist.MySQL as My
+{-# LANGUAGE EmptyDataDecls        #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE RecordWildCards       #-}
+{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE ViewPatterns          #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Main (main, resourcesApp, Widget, WorldId) where
+import           Control.Monad            (replicateM)
+import           Control.Monad.Logger     (runNoLoggingT)
+import           Control.Monad.Primitive  (PrimState)
+import           Control.Monad.Reader     (ReaderT)
+import           Data.Conduit.Pool        (Pool)
+import           Data.Int                 (Int64)
+import           Data.Text                (Text)
+import           Database.MongoDB         (Field ((:=)), (=:))
+import qualified Database.MongoDB         as Mongo
 import qualified Database.Persist.MongoDB as Mongo
-import qualified Database.MongoDB as Mongo
-import Database.MongoDB ((=:), Field((:=)))
-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_)
-import Network (PortID (PortNumber))
-import Data.Int (Int64)
-
-mkPersist sqlSettings [persistLowerCase|
+import qualified Database.Persist.MySQL   as My
+import           Network                  (PortID (PortNumber))
+import qualified Network.Wai.Handler.Warp as Warp
+import           System.Environment       (getArgs)
+import qualified System.Random.MWC        as R
+import           Yesod                    hiding (Field)
+
+mkPersist sqlSettings { mpsGeneric = True } [persistLowerCase|
 World sql=World
     randomNumber Int sql=randomNumber
+#ifdef MONGODB
+    id           Int64
+    UniqueId
+#endif
 |]
 
 data App = App
-    { appGen :: R.Gen (PrimState IO)
-    , mySqlPool :: Pool My.Connection
-    , mongoDBPool :: Pool Mongo.Connection
+    { appGen      :: !(R.Gen (PrimState IO))
+    , mySqlPool   :: !(Pool My.SqlBackend)
+    , mongoDBPool :: !(Pool Mongo.Connection)
     }
 
 -- | Not actually using the non-raw mongoDB.
@@ -40,8 +53,10 @@ mkYesod "App" [parseRoutes|
 /db                 DbR       GET
 /dbs/#Int           DbsR      GET
 
+#ifdef MONGODB
 /mongo/db           MongoDbR  GET
 /mongo/dbs/#Int     MongoDbsR GET
+#endif
 
 /mongo/raw/db       MongoRawDbR  GET
 /mongo/raw/dbs/#Int MongoRawDbsR GET
@@ -49,18 +64,26 @@ mkYesod "App" [parseRoutes|
 
 instance Yesod App where
     makeSessionBackend _ = return Nothing
+    {-# INLINE makeSessionBackend #-}
     shouldLog _ _ _ = False
+    {-# INLINE shouldLog #-}
     yesodMiddleware = id
+    {-# INLINE yesodMiddleware #-}
+    cleanPath _ = Right
+    {-# INLINE cleanPath #-}
 
-getJsonR :: Handler Value
-getJsonR = return $ object ["message" .= ("Hello, World!" :: Text)]
+getJsonR :: Handler TypedContent
+getJsonR = return $ TypedContent typeJson
+         $ toContent $ object ["message" .= ("Hello, World!" :: Text)]
 
 
 getDbR :: Handler Value
-getDbR = getDb (intQuery runMySQL )
+getDbR = getDb (intQuery runMySQL My.toSqlKey)
 
+#ifdef MONGODB
 getMongoDbR :: Handler Value
-getMongoDbR = getDb (intQuery runMongoDB )
+getMongoDbR = getDb (intQuery runMongoDB (getBy . UniqueId))
+#endif
 
 getMongoRawDbR :: Handler Value
 getMongoRawDbR = getDb rawMongoIntQuery
@@ -68,10 +91,12 @@ getMongoRawDbR = getDb rawMongoIntQuery
 getDbsR :: Int -> Handler Value
 getDbsR cnt = do
     App {..} <- getYesod
-    multiRandomHandler (intQuery runMySQL) cnt
+    multiRandomHandler (intQuery runMySQL My.toSqlKey) cnt
 
+#ifdef MONGODB
 getMongoDbsR :: Int -> Handler Value
-getMongoDbsR cnt = multiRandomHandler (intQuery runMongoDB) cnt
+getMongoDbsR cnt = multiRandomHandler (intQuery runMongoDB (getBy . UniqueId)) cnt
+#endif
 
 getMongoRawDbsR :: Int -> Handler Value
 getMongoRawDbsR cnt = multiRandomHandler rawMongoIntQuery cnt
@@ -97,13 +122,14 @@ runMySQL f = do
   App {..} <- getYesod
   My.runSqlPool f mySqlPool
 
-intQuery :: forall (m :: * -> *) (m1 :: * -> *) val backend.
-           (Monad m, PersistEntity val, PersistStore m1,
-            PersistEntityBackend val ~ PersistMonadBackend m1) =>
-           (m1 (Maybe val) -> m (Maybe (WorldGeneric backend)))
+intQuery :: (MonadIO m, PersistEntity val, PersistStore backend
+            , backend ~ PersistEntityBackend val
+            ) =>
+           (ReaderT backend m (Maybe val) -> m (Maybe (WorldGeneric backend)))
+           -> (Int64 -> Key val)
            -> Int64 -> m Value
-intQuery db i = do
-    Just x <- db $ get (Key $ PersistInt64 i)
+intQuery db toKey i = do
+    Just x <- db $ get $ toKey i
     return $ jsonResult (worldRandomNumber x)
   where
     jsonResult :: Int -> Value
@@ -111,7 +137,7 @@ intQuery db i = do
 
 rawMongoIntQuery :: Mongo.Val v => v -> Handler Value
 rawMongoIntQuery i = do
-    Just x <- runMongoDB $ Mongo.findOne (Mongo.select ["id" =: i] "world")
+    Just x <- runMongoDB $ Mongo.findOne (Mongo.select ["id" =: i] "World")
     return $ documentToJson x
 
 multiRandomHandler :: ToJSON a
@@ -141,9 +167,8 @@ instance ToJSON Mongo.Value where
 
 main :: IO ()
 main = R.withSystemRandom $ \gen -> do
-    socket <- bindPort 8000 "*"
-    [cores, host] <- getArgs
-    myPool <- My.createMySQLPool My.defaultConnectInfo
+    [_cores, host] <- getArgs
+    myPool <- runNoLoggingT $ My.createMySQLPool My.defaultConnectInfo
         { My.connectUser = "benchmarkdbuser"
         , My.connectPassword = "benchmarkdbpass"
         , My.connectDatabase = "hello_world"
@@ -161,10 +186,9 @@ main = R.withSystemRandom $ \gen -> do
         , mySqlPool = myPool
         , mongoDBPool = mongoPool
         }
-    let run = Warp.runSettingsSocket Warp.defaultSettings
-                { Warp.settingsPort = 8000
-                , Warp.settingsHost = "*"
-                , Warp.settingsOnException = const $ return ()
-                } socket app
-    replicateM_ (read cores - 1) $ forkProcess run
-    run
+    Warp.runSettings
+        ( Warp.setPort 8000
+        $ Warp.setHost "*"
+        $ Warp.setOnException (\_ _ -> return ())
+          Warp.defaultSettings
+        ) app

frameworks/Haskell/yesod/install.sh

@@ -1,3 +1,3 @@
 #!/bin/bash
 
-fw_depends yesod haskell
+fw_depends haskell78

frameworks/Haskell/yesod/setup.py

@@ -5,16 +5,12 @@ import setup_util
 import os
 
 def start(args, logfile, errfile):
-  #setup_util.replace_text("yesod/bench/config/mysql.yml", "host: .*", "host: " + args.database_host)
-  
   subprocess.check_call("cabal update", shell=True, cwd="yesod/bench", stderr=errfile, stdout=logfile)
   subprocess.check_call("cabal install", shell=True, cwd="yesod/bench", stderr=errfile, stdout=logfile)
-  subprocess.check_call("cabal configure", shell=True, cwd="yesod/bench", stderr=errfile, stdout=logfile)
-  subprocess.check_call("cabal build", shell=True, cwd="yesod/bench", stderr=errfile, stdout=logfile)
 
   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", shell=True, cwd="yesod/bench", stderr=errfile, stdout=logfile)
+  subprocess.Popen("dist/build/bench/bench " + threads + " " + db_host + " +RTS -A32M -N", shell=True, cwd="yesod/bench", stderr=errfile, stdout=logfile)
   return 0
 
 def stop(logfile, errfile):

toolset/setup/linux/frameworks/yesod.sh

@@ -1,6 +0,0 @@
-#!/bin/bash
-
-fw_depends haskell
-
-cabal update
-cabal install yesod persistent-mysql

toolset/setup/linux/languages/haskell78.sh

@@ -0,0 +1,13 @@
+#!/bin/bash -ex
+
+RETCODE=$(fw_exists /opt/ghc/7.8.3/bin/ghc)
+[ ! "$RETCODE" == 0 ] || { return 0; }
+
+lsb_release -a
+env
+
+export LANG=en_US.UTF-8
+
+sudo add-apt-repository -y ppa:hvr/ghc
+sudo apt-get update
+sudo apt-get install -y ghc-7.8.3 cabal-install-1.20 libpcre3-dev

toolset/setup/linux/prerequisites.sh

@@ -1,5 +1,8 @@
 #!/bin/bash
 
+set -x
+export DEBIAN_FRONTEND=noninteractive
+
 RETCODE=$(fw_exists fwbm_prereqs_installed)
 [ ! "$RETCODE" == 0 ] || { \
   echo "Prerequisites installed!"; 
@@ -12,10 +15,10 @@ sudo apt-key adv --keyserver hkp://keyserver.ubuntu.com:80 --recv 7F0CEB10
 echo 'deb http://downloads-distro.mongodb.org/repo/ubuntu-upstart dist 10gen' | sudo tee /etc/apt/sources.list.d/mongodb.list
 
 sudo apt-get -y update
-sudo apt-get -y upgrade
+sudo apt-get -y upgrade -o Dpkg::Options::="--force-confdef" -o Dpkg::Options::="--force-confold"
 
 # WARNING: DONT PUT A SPACE AFTER ANY BACKSLASH OR APT WILL BREAK
-sudo apt-get -y install \
+sudo apt-get -y install -o Dpkg::Options::="--force-confdef" -o Dpkg::Options::="--force-confold" \
   cmake build-essential automake    `# Needed for building code` \
   curl wget unzip                   `# Common tools` \
   software-properties-common        `# Needed for add-apt-repository` \