Add a bigtable server as proper benchmark.

.gitignore

@@ -7,3 +7,4 @@ local
 
 benchmarks/Utf8Builder
 benchmarks/Utf8Html
+benchmarks/BigTableServer

Makefile

@@ -1,8 +1,11 @@
 
 bench-html:
-	ghc --make -O2 -fforce-recomp -isrc -ilib/binary-0.5.0.2/src benchmarks/Utf8Html.hs
+	ghc --make -O2 -fforce-recomp -isrc -ilib/binary-0.5.0.2/src -main-is Utf8Html benchmarks/Utf8Html.hs
 	./benchmarks/Utf8Html --resamples 10000
 
 bench-builder:
-	ghc --make -O2 -fforce-recomp -isrc -ilib/binary-0.5.0.2/src benchmarks/Utf8Builder.hs
+	ghc --make -O2 -fforce-recomp -isrc -ilib/binary-0.5.0.2/src -main-is Utf8Builder benchmarks/Utf8Builder.hs
 	./benchmarks/Utf8Builder --resamples 10000
+
+bench-bigtableserver:
+	ghc --make -O2 -fforce-recomp -isrc -ilib/binary-0.5.0.2/src -ibenchmarks -main-is BigTableServer benchmarks/BigTableServer.hs

benchmarks/BigTableServer.hs

@@ -0,0 +1,60 @@
+-- | This is a simple benchmark containing some IO. This program runs as a HTTP
+-- server on a given port. It responds by spamming big tables in the right size.
+-- The request protocol for clients is:
+--
+-- > GET /rows/columns HTTP/1.1
+--
+-- For example,
+--
+-- > GET /1000/10 HTTP/1.1
+--
+-- The server then responds with an HTML table with the requested dimensions.
+--
+{-# LANGUAGE OverloadedStrings #-}
+module BigTableServer where
+
+import Prelude hiding (putStrLn)
+
+import Data.Monoid (mappend)
+import Control.Applicative ((<$>))
+import Control.Monad (forever, mapM_)
+import Network.Socket (listen, accept, sClose)
+import Network (listenOn, PortID (PortNumber))
+import System (getArgs)
+import Data.Char (ord)
+
+import Network.Socket.ByteString (recv, send, sendMany)
+import qualified Data.ByteString as SB
+import qualified Data.ByteString.Char8 as SBC
+import qualified Data.ByteString.Lazy as LB
+
+import Utf8Html hiding (main)
+
+main :: IO ()
+main = do
+    port <- PortNumber . fromIntegral . read . head <$> getArgs
+    socket <- listenOn port
+    forever $ respond socket
+  where
+    respond socket = do
+        (s, _) <- accept socket 
+        string <- recv s 1024
+        let words = SB.split (fromIntegral $ ord ' ') string
+            requestUrl = words !! 1
+        case SB.split (fromIntegral $ ord '/') requestUrl of
+            (_ : h : w : _) -> do
+                let height = read $ SBC.unpack h
+                    width = read $ SBC.unpack w
+                    rows = [1 .. width]
+                    matrix = replicate height rows
+                _ <- send s $ "HTTP/1.1 200 OK\r\n"
+                    `mappend` "Content-Type: text/html; charset=UTF-8\r\n"
+                    `mappend` "\r\n"
+                sendMany s $ LB.toChunks $ bigTable matrix
+            _ -> do
+                _<- send s $ "HTTP/1.1 404 Not Found\r\n"
+                    `mappend` "Content-Type: text/html; charset=UTF-8\r\n"
+                    `mappend` "\r\n"
+                    `mappend` "<h1>Not Found</h1>\r\n"
+                return ()
+        sClose s

benchmarks/Utf8Builder.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Main where
+module Utf8Builder where
 
 import Data.Char (ord)
 import Data.Int (Int64)

benchmarks/Utf8Html.hs

@@ -1,6 +1,6 @@
 -- | This is a possible library implementation experiment and benchmark.
 {-# LANGUAGE OverloadedStrings #-}
-module Main where
+module Utf8Html where
 
 import Data.Monoid (Monoid, mempty, mconcat, mappend)
 import Prelude hiding (div, id, head)