content: Benchmark server: all benchmarks from 'Utf8Html' can be requested through this
  server via URL's. At the same time, the server shows some information about
  these benchmarks at the root URL.
  
  Example:
  
      GET /manyAttributes HTTP/1.1
  
  Will give you the @manyAttributes@ benchmark.
  
  Example:
  
      GET / HTTP/1.1
  
  Will give you a page with some information and a benchmark listing As always in
  a literate Haskell file, feel free to skip the imports.
  
  > {-# LANGUAGE OverloadedStrings #-}
  > module BenchmarkServer where
  
  > import Prelude hiding (putStrLn)
  
  > import Control.Concurrent (forkIO)
  > import Data.Monoid (mappend, mconcat)
  > import Control.Applicative ((<$>))
  > import Control.Monad (forever, forM_)
  > import Network.Socket (accept, sClose)
  > import Network (listenOn, PortID (PortNumber))
  > import System (getArgs)
  > import Data.Char (ord, toLower)
  > import Data.Map (Map)
  > import qualified Data.Map as M
  
  > import Network.Socket.ByteString (recv, send, sendAll)
  > import qualified Network.Socket.ByteString.Lazy as LN (sendAll) 
  > import qualified Data.ByteString as SB
  > import qualified Data.ByteString.Char8 as SBC
  > import qualified Data.ByteString.Lazy as LB
  
  > import HtmlBenchmarks (HtmlBenchmark (..), benchmarks)
  > import Text.Blaze.Html5 hiding (map, head)
  > import qualified Text.Blaze.Html5 as H
  > import Text.Blaze.Html5.Attributes hiding (title, rows, accept)
  > import qualified Text.Blaze.Html5.Attributes as A
  > import Text.Blaze.Renderer.Utf8 (renderHtml, renderHtmlToByteStringIO)
  
  Our first template is the root page. It's a static template, so it takes no
  parameters.
  
  > root :: Html
  > root = docTypeHtml $ do
  >     H.head $ do
  >         title "BlazeHtml benchmarks"
  >     body ! A.style "width: 500px; margin: 0px auto 0px auto;" $ do
  >         h1 "Benchmarks"
  >         p $ do
  >             "This is a server showing BlazeHtml benchmarks, written using"
  >             " BlazeHtml. You can check out this benchmarks here, but it is"
  >             " probably more interesting to measure them using a tool like"
  >             " " >> code "ab" >> " or " >> code "httperf" >> "."
  
  Now, the interesting part comes. `benchmarks` is a list of `HtmlBenchmark`'s,
  imported from the `Utf8Html` module, which contains a number of benchmarks for
  BlazeHtml. Here, we *loop* over these benchmarks and render them using the
  `benchmark` template (defined below).
  
  >         forM_ benchmarks benchmark
  
  Alternatively, one could have written `mconcat $ map benchmark benchmarks`.
  
  And so, we arrive at our second benchmark. It simply pattern matches on a
  `HtmlBenchmark` (which only has one constructor) and generates some HTML
  describing this benchmark.
  
  > benchmark :: HtmlBenchmark -> Html
  > benchmark (HtmlBenchmark name _ _ description) = do
  >     h2 $ string name
  >     p $ description
  >     p $ "URL: " >> code ("/" >> string name)
  >     p $ a ! href (stringValue name) $ "Go to benchmark."
  
  The auxiliary function builds the lookup table of benchmarks. Note that we store
  the key as lowercase, so our URL's we be case-independent.
  
  > benchmarkMap :: Map String HtmlBenchmark
  > benchmarkMap = let t b@(HtmlBenchmark n _ _ _) = (map toLower n, b)
  >                in M.fromList $ map t benchmarks
  
  This is the main function that runs the server. It takes one command line
  argument: the port it should listen on.
  
  > main :: IO ()
  > main = do
  >     port <- PortNumber . fromIntegral . read . head <$> getArgs
  >     socket <- listenOn port
  
  It forks for every incoming connection -- this is the standard control flow in
  most Haskell servers.
  
  >     forever $ do
  >         (s, _) <- accept socket
  >         forkIO (respond s)
  >   where
  
  Okay, now we get to the fun part: parsing the request and building the response.
  
  >     respond s = do
  
  We take 1024 bytes from the socket -- this should be plenty. The HTTP request
  will look something like `GET /url HTTP/1.1`. We are only interested in the url,
  so we split the input on spaces and take the second part (`!!` is zero-based).
  
  >         input <- recv s 1024
  >         let requestUrl = (SB.split (fromIntegral $ ord ' ') input) !! 1
  
  We split the URL on '/' characters and drop the first element of the resulting
  list -- this element contains no information, since the URL will always start
  with a '/'.
  
  >         case tail (SB.split (fromIntegral $ ord '/') requestUrl) of
  
  If the result of this split is empty, it means we have accessed the root URL. In
  that case, we send the root template back. The `ok s` sends a `200 OK` response,
  letting the browser know all is fine.
  
  >             [""] -> do
  >                 ok s
  >                 LN.sendAll s $ renderHtml root
  
                    renderHtmlToByteStringIO root (sendAll s)
  
  We do a very broad pattern match now, taking the first part of the URL. This is
  supposed to be the name of a benchmark.
  
  >             (x : _) -> do
  
  We convert the benchmark name to lowercase, and then look it up in a lookup
  table which maps benchmark names to actual benchmarks.
  
  >                 let requestedBenchmark = map toLower $ SBC.unpack x
  >                     benchmark = M.lookup requestedBenchmark benchmarkMap
  
  If all goes well, we found a benchmark. In that case, we can run and send it.
  
  >                 case benchmark of
  >                     Just (HtmlBenchmark _ f x _) -> do
  >                         ok s
  >                         LN.sendAll s $ renderHtml $ f x
  
                            renderHtmlToByteStringIO (f x) (sendAll s)
  
  If the benchmark is not found, we give a `404` error back.
  
  >                     Nothing -> notFound s
  
  If our earlier pattern match failed (which really should not happen) we send a
  `404`, too.
  
  >             _ -> notFound s
  
  After this, we can safely close the connection.
  
  >         sClose s
  
  Now, we have two functions which send a response header back to the browser,
  nothing special going on here.
  
  >     ok s = do
  >         _ <- send s $ "HTTP/1.1 200 OK\r\n"
  >                     `mappend` "Content-Type: text/html; charset=UTF-8\r\n"
  >                     `mappend` "\r\n"
  >         return ()
  > 
  >     notFound s = 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>Page not found</h1>"
  >         return ()
  
  Note that while we directly used sockets here, this is probably *not* the way
  you want to go if you are writing a serious web application. In that case, you
  should use BlazeHtml behind some kind of web framework (unless you're really
  masochistic).
  