Browse Source

* Fixed random number generation (1 to 10,000)
* Added /updates code

Saurabh Nanda 9 years ago
parent
commit
19fbb64765

+ 37 - 11
frameworks/Haskell/yesod-postgres/bench/src/Main.hs

@@ -106,6 +106,8 @@ mkYesod "App" [parseRoutes|
 /queries/#Int       QueriesR     GET
 !/queries/#Text      DefaultQueriesR     GET
 /fortunes           FortunesR    GET
+/updates/#Int       UpdatesR     GET
+!/updates/#Text     DefaultUpdatesR GET
 |]
 
 fakeInternalState :: InternalState
@@ -142,7 +144,7 @@ runPg dbAction = do
 
 getRandomRow = do
   app <- getYesod
-  randomNumber <- liftIO $ ((R.uniformR (1, 1000) (appGen app)) :: IO Int)
+  randomNumber <- liftIO $ ((R.uniformR (1, 10000) (appGen app)) :: IO Int)
   let wId = (toSqlKey $ fromIntegral randomNumber) :: WorldId
   get wId >>= \case
     Nothing -> return Nothing
@@ -176,15 +178,39 @@ getFortunesR = do
   defaultLayout $ do
       setTitle "Fortunes"
       [whamlet|
-                      <table>
-                        <tr>
-                          <th>id
-                          <th>message
-                        $forall fortune <- fortunes
-                          <tr>
-                            <td>#{entityKey fortune}
-                            <td>#{fortuneMessage $ entityVal fortune}
-                          |]
+              <table>
+                <tr>
+                  <th>id
+                  <th>message
+                $forall fortune <- fortunes
+                  <tr>
+                    <td>#{entityKey fortune}
+                    <td>#{fortuneMessage $ entityVal fortune}
+                    |]
+
+getUpdatesR :: Int -> Handler Value
+getUpdatesR cnt = do
+  worldRows <- runPg $ forM [1..sanitizedCount] (\_ -> fmap fromJust getRandomRow)
+  app <- getYesod
+  updatedWorldRows <- runPg $ mapM (replaceWorldRow app) worldRows
+  returnJson updatedWorldRows
+  where
+    sanitizedCount
+      | cnt<1 = 1
+      | cnt>500 = 500
+      | otherwise = cnt
+
+    replaceWorldRow app (Entity wId wRow) = do
+      randomNumber <- liftIO $ ((R.uniformR (1, 10000) (appGen app)) :: IO Int)
+      -- TODO: Should I be using replace, or update, or updateGet -- which is
+      -- idiomatic Yesod code for this operation?
+      let newRow =wRow{worldRandomNumber=randomNumber}
+      replace wId newRow
+      return (Entity wId newRow)
+
+
+getDefaultUpdatesR :: Text -> Handler Value
+getDefaultUpdatesR _ = getUpdatesR 1
 
 -- Getmongorawdbr :: Handler Value
 -- getMongoRawDbR = getDb rawMongoIntQuery
@@ -238,7 +264,7 @@ getFortunesR = do
 --             status200
 --             [("Content-Type", simpleContentType typeJson)]
 --         $ copyByteString
---         $ L.toStrict
+--         $ L.toSfortfortunestrict
 --         $ encode value
 
 

+ 1 - 0
frameworks/Haskell/yesod-postgres/benchmark_config.json

@@ -7,6 +7,7 @@
       "db_url": "/db",
       "query_url": "/queries/",
       "fortune_url": "/fortunes",
+      "update_url": "/updates/",
       "port": 8000,
       "approach": "Realistic",
       "classification": "Fullstack",