Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Improve table benchmark

  • Loading branch information...
commit 636437007483fe220314b623b230576420e1a818 1 parent 1a3b0d8
Gregory Collins authored June 12, 2011

Showing 1 changed file with 40 additions and 22 deletions. Show diff stats Hide diff stats

  1. 62  snap-bench/src/table.hs
62  snap-bench/src/table.hs
... ...
@@ -1,40 +1,58 @@
  1
+{-# LANGUAGE BangPatterns #-}
  2
+
1 3
 module Main where
2 4
 
3 5
 import           System
  6
+import           Blaze.ByteString.Builder
  7
+import           Blaze.ByteString.Builder.Char8
4 8
 import           Control.Applicative
5 9
 import           Control.Monad.Trans
6 10
 import qualified Data.ByteString.Char8 as BS
  11
+import           Data.Monoid
7 12
 import           Snap.Http.Server
8 13
 import           Snap.Iteratee
9 14
 import           Snap.Types
10 15
 import           Snap.Util.FileServe
11 16
 
12 17
 
13  
-tableRow :: Int -> Snap ()
14  
-tableRow x
15  
-  | x <= 50   = do
16  
-                  writeBS "<td>" 
17  
-                  writeBS (BS.pack (show x))
18  
-                  writeBS "</td>"
19  
-                  tableRow (x+1)
20  
-  | otherwise = return ()
21  
-
22  
-tableBody :: Int -> Snap ()
23  
-tableBody x
24  
-  | x <= 1000 = do 
25  
-                  writeBS "<tr><td>"
26  
-                  writeBS (BS.pack (show x))
27  
-                  writeBS "</td>"
28  
-                  tableRow 1 
29  
-                  writeBS "</tr>\n"
30  
-                  tableBody (x+1)
31  
-  | otherwise = return ()
  18
+tdOp, tdCl, trOp, trCl :: Builder
  19
+tdOp   = fromByteString "<td>"
  20
+tdCl   = fromByteString "</td>"
  21
+trOp   = fromByteString "<tr>"
  22
+trCl   = fromByteString "</tr>\n"
  23
+
  24
+
  25
+tableRow :: Int -> Builder
  26
+tableRow = go mempty
  27
+  where
  28
+    col !x = mconcat [ tdOp, fromShow x, tdCl ]
  29
+
  30
+    go !bldr !x | x <= 50 = let b' = bldr `mappend` col x
  31
+                            in go b' (x+1)
  32
+                | otherwise = bldr
  33
+
  34
+
  35
+tableBody :: Int -> Builder
  36
+tableBody = go mempty
  37
+  where
  38
+    row !x = mconcat [ trOp
  39
+                     , tdOp
  40
+                     , fromShow x
  41
+                     , tdCl
  42
+                     , tableRow 1
  43
+                     , trCl ]
  44
+
  45
+    go !bldr !x | x <= 1000 = let b' = bldr `mappend` row x
  46
+                              in go b' (x+1)
  47
+                | otherwise = bldr
  48
+
32 49
 
33 50
 tableServer :: Snap ()
34 51
 tableServer = do
35  
-    writeBS "<html><body><table>\n"
36  
-    tableBody 1
37  
-    writeBS "</table></body></html>"
  52
+    writeBuilder $ mconcat [ fromByteString "<html><body><table>\n"
  53
+                           , tableBody 1
  54
+                           , fromByteString "</table></body></html>" ]
  55
+
38 56
     
39 57
 main :: IO ()
40 58
 main = do

0 notes on commit 6364370

Please sign in to comment.
Something went wrong with that request. Please try again.