Permalink
Browse files

Add a table creation benchmark

  • Loading branch information...
lpsmith committed Apr 30, 2010
1 parent 1e33205 commit b5e77abb6e16803069758b4bdfc7d3deb8d495ad
Showing with 69 additions and 2 deletions.
  1. +20 −2 snap-bench/snap-bench.cabal
  2. 0 snap-bench/src/{Main.hs → pong.hs}
  3. +49 −0 snap-bench/src/table.hs
@@ -8,9 +8,27 @@ Category: Web
Build-type: Simple
Cabal-version: >=1.2
-Executable snap-bench
+Executable pong-server
hs-source-dirs: src
- main-is: Main.hs
+ main-is: pong.hs
+
+ Build-depends:
+ base >= 4,
+ haskell98,
+ transformers,
+ bytestring,
+ snap-core,
+ snap-server,
+ heist,
+ filepath
+
+ ghc-options: -O2 -Wall -fwarn-tabs -funbox-strict-fields -threaded -fno-warn-unused-imports
+
+ Extensions: OverloadedStrings
+
+Executable table-server
+ hs-source-dirs: src
+ main-is: table.hs
Build-depends:
base >= 4,
File renamed without changes.
View
@@ -0,0 +1,49 @@
+module Main where
+
+import System
+import Control.Applicative
+import Control.Monad.Trans
+import qualified Data.ByteString.Char8 as BS
+import Snap.Http.Server
+import Snap.Iteratee
+import Snap.Types
+import Snap.Util.FileServe
+import Text.Templating.Heist
+
+
+tableRow :: Int -> Snap ()
+tableRow x
+ | x <= 50 = do
+ writeBS "<td>"
+ writeBS (BS.pack (show x))
+ writeBS "</td>"
+ tableRow (x+1)
+ | otherwise = return ()
+
+tableBody :: Int -> Snap ()
+tableBody x
+ | x <= 1000 = do
+ writeBS "<tr><td>"
+ writeBS (BS.pack (show x))
+ writeBS "</td>"
+ tableRow 1
+ writeBS "</tr>\n"
+ tableBody (x+1)
+ | otherwise = return ()
+
+tableServer :: Snap ()
+tableServer = do
+ writeBS "<html><body><table>\n"
+ tableBody 1
+ writeBS "</table></body></html>"
+
+main :: IO ()
+main = do
+ args <- getArgs
+ let port = case args of
+ [] -> 8000
+ p:_ -> read p
+ httpServe "*" port "myserver"
+ Nothing -- (Just "access.log")
+ Nothing -- (Just "error.log")
+ tableServer

0 comments on commit b5e77ab

Please sign in to comment.