aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/Benchmarks
diff options
context:
space:
mode:
Diffstat (limited to 'src/Benchmarks')
-rw-r--r--src/Benchmarks/BenchmarkUtils.hs107
-rw-r--r--src/Benchmarks/BlazeTBenchmarks.hs133
-rw-r--r--src/Benchmarks/HtmlBenchmarks.hs132
-rw-r--r--src/Benchmarks/LICENSE30
-rw-r--r--src/Benchmarks/RunHtmlBenchmarks.hs36
-rw-r--r--src/Benchmarks/ServerChunkSize.hs52
-rw-r--r--src/Benchmarks/bigtable/erb.rb32
-rw-r--r--src/Benchmarks/bigtable/erubis.rb31
-rw-r--r--src/Benchmarks/bigtable/hamlet.hs33
-rw-r--r--src/Benchmarks/bigtable/html-minimalist.hs20
-rw-r--r--src/Benchmarks/bigtable/html.hs19
-rw-r--r--src/Benchmarks/bigtable/php.php30
-rw-r--r--src/Benchmarks/bigtable/xhtml.hs19
13 files changed, 674 insertions, 0 deletions
diff --git a/src/Benchmarks/BenchmarkUtils.hs b/src/Benchmarks/BenchmarkUtils.hs
new file mode 100644
index 0000000..4b9546c
--- /dev/null
+++ b/src/Benchmarks/BenchmarkUtils.hs
@@ -0,0 +1,107 @@
1-- | This is a module which contains some ad-hoc HTML combinators for use when
2-- benchmarking
3--
4{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction #-}
5module Benchmarks.BenchmarkUtils
6 ( Html
7 , toHtml
8
9 , tr
10 , td
11 , html
12 , head
13 , title
14 , body
15 , div
16 , h1
17 , h2
18 , p
19 , ol
20 , li
21 , table
22 , img
23 , id
24 ) where
25
26import Prelude hiding (div, head, id)
27import Text.Blaze
28import Text.Blaze.Internal
29
30type Html = Markup
31
32toHtml :: ToMarkup a => a -> Html
33toHtml = toMarkup
34
35tr :: Html -- ^ Inner HTML.
36 -> Html -- ^ Resulting HTML.
37tr = Parent "tr" "<tr" "</tr>"
38{-# INLINE tr #-}
39
40td :: Html -- ^ Inner HTML.
41 -> Html -- ^ Resulting HTML.
42td = Parent "td" "<td" "</td>"
43{-# INLINE td #-}
44
45html :: Html -- ^ Inner HTML.
46 -> Html -- ^ Resulting HTML.
47html = Parent "html" "<html" "</html>"
48{-# INLINE html #-}
49
50head :: Html -- ^ Inner HTML.
51 -> Html -- ^ Resulting HTML.
52head = Parent "head" "<head" "</head>"
53{-# INLINE head #-}
54
55title :: Html -- ^ Inner HTML.
56 -> Html -- ^ Resulting HTML.
57title = Parent "title" "<title" "</title>"
58{-# INLINE title #-}
59
60body :: Html -- ^ Inner HTML.
61 -> Html -- ^ Resulting HTML.
62body = Parent "body" "<body" "</body>"
63{-# INLINE body #-}
64
65div :: Html -- ^ Inner HTML.
66 -> Html -- ^ Resulting HTML.
67div = Parent "div" "<div" "</div>"
68{-# INLINE div #-}
69
70h1 :: Html -- ^ Inner HTML.
71 -> Html -- ^ Resulting HTML.
72h1 = Parent "h1" "<h1" "</h1>"
73{-# INLINE h1 #-}
74
75h2 :: Html -- ^ Inner HTML.
76 -> Html -- ^ Resulting HTML.
77h2 = Parent "h2" "<h2" "</h2>"
78{-# INLINE h2 #-}
79
80p :: Html -- ^ Inner HTML.
81 -> Html -- ^ Resulting HTML.
82p = Parent "p" "<p" "</p>"
83{-# INLINE p #-}
84
85ol :: Html -- ^ Inner HTML.
86 -> Html -- ^ Resulting HTML.
87ol = Parent "ol" "<ol" "</ol>"
88{-# INLINE ol #-}
89
90li :: Html -- ^ Inner HTML.
91 -> Html -- ^ Resulting HTML.
92li = Parent "li" "<li" "</li>"
93{-# INLINE li #-}
94
95table :: Html -- ^ Inner HTML.
96 -> Html -- ^ Resulting HTML.
97table = Parent "table" "<table" "</table>"
98{-# INLINE table #-}
99
100img :: Html -- ^ Resulting HTML.
101img = Leaf "img" "<img" ">"
102{-# INLINE img #-}
103
104id :: AttributeValue -- ^ Attribute value.
105 -> Attribute -- ^ Resulting attribute.
106id = attribute "id" " id=\""
107{-# INLINE id #-}
diff --git a/src/Benchmarks/BlazeTBenchmarks.hs b/src/Benchmarks/BlazeTBenchmarks.hs
new file mode 100644
index 0000000..83a38ad
--- /dev/null
+++ b/src/Benchmarks/BlazeTBenchmarks.hs
@@ -0,0 +1,133 @@
1-- | This is a collection of HTML benchmarks for BlazeMarkup.
2--
3{-# LANGUAGE OverloadedStrings, ExistentialQuantification, RankNTypes #-}
4{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
5module Benchmarks.BlazeTBenchmarks where
6
7import Data.Monoid (Monoid, mempty, mconcat, mappend)
8import Prelude hiding (div, id,map)
9import qualified Prelude as P
10
11import Text.BlazeT
12import Text.BlazeT.Html5
13import qualified Text.BlazeT.Html5 as H
14import qualified Text.BlazeT.Html5.Attributes as A
15
16-- | Description of an HTML benchmark
17--
18data HtmlBenchmark = forall a. HtmlBenchmark
19 String -- ^ Name.
20 (a -> Html) -- ^ Rendering function.
21 a -- ^ Data.
22 Html -- ^ Longer description.
23
24-- | List containing all benchmarks.
25--
26benchmarks :: [HtmlBenchmark]
27benchmarks =
28 [ HtmlBenchmark "bigTable" bigTable bigTableData $
29 let h = toHtml $ length bigTableData
30 w = toHtml $ length $ P.head bigTableData
31 in (string "Rendering of a big (") >> h >> (string "x") >> w >> ") HTML table"
32 , HtmlBenchmark "basic" basic basicData
33 "A simple, small basic template with a few holes to fill in"
34 , HtmlBenchmark "wideTree" wideTree wideTreeData $
35 (string "A very wide tree (") >> toHtml (length wideTreeData) >> " elements)"
36 , HtmlBenchmark "wideTreeEscaping" wideTree wideTreeEscapingData $ do
37 (string "A very wide tree (") >> toHtml (length wideTreeData) >> (string " elements)")
38 " with lots of escaping"
39 , HtmlBenchmark "deepTree" deepTree deepTreeData $ do
40 (string "A really deep tree (") >> toHtml deepTreeData >> " nested templates)"
41 , HtmlBenchmark "manyAttributes" manyAttributes manyAttributesData $ do
42 (string "A single element with ") >> toHtml (length manyAttributesData)
43 " attributes."
44 , HtmlBenchmark "customAttribute" customAttributes customAttributesData $
45 "Creating custom attributes"
46 ]
47
48rows :: Int
49rows = 1000
50
51bigTableData :: [[Int]]
52bigTableData = replicate rows [1..10]
53{-# NOINLINE bigTableData #-}
54
55basicData :: (String, String, [String])
56basicData = ("Just a test", "joe", items)
57{-# NOINLINE basicData #-}
58
59items :: [String]
60items = fmap (("Number " `mappend`) . show) [1 :: Int .. 14]
61{-# NOINLINE items #-}
62
63wideTreeData :: [String]
64wideTreeData = take 5000 $
65 cycle ["λf.(λx.fxx)(λx.fxx)", "These old days", "Foobar", "lol", "x ∈ A"]
66{-# NOINLINE wideTreeData #-}
67
68wideTreeEscapingData :: [String]
69wideTreeEscapingData = take 1000 $
70 cycle ["<><>", "\"lol\"", "<&>", "'>>'"]
71{-# NOINLINE wideTreeEscapingData #-}
72
73deepTreeData :: Int
74deepTreeData = 1000
75{-# NOINLINE deepTreeData #-}
76
77manyAttributesData :: [String]
78manyAttributesData = wideTreeData
79
80customAttributesData :: [(String, String)]
81customAttributesData = zip wideTreeData wideTreeData
82
83-- | Render the argument matrix as an HTML table.
84--
85bigTable :: [[Int]] -- ^ Matrix.
86 -> Html -- ^ Result.
87bigTable t = table $ mconcat $ fmap row t
88 where
89 row r = tr $ mconcat $ fmap (td . toHtml) r
90
91-- | Render a simple HTML page with some data.
92--
93basic :: (String, String, [String]) -- ^ (Title, User, Items)
94 -> Html -- ^ Result.
95basic (title', user, items') = html $ do
96 H.head $ title $ toHtml title'
97 body $ do
98 div ! A.id "header" $ (h1 $ toHtml title')
99 p $ "Hello, " `mappend` toHtml user `mappend` "!"
100 p $ "Hello, me!"
101 p $ "Hello, world!"
102 h2 $ "loop"
103 ol $ mconcat $ fmap (li . toHtml) items'
104 div ! A.id "footer" $ mempty
105
106-- | A benchmark producing a very wide but very shallow tree.
107--
108wideTree :: [String] -- ^ Text to create a tree from.
109 -> Html -- ^ Result.
110wideTree = div . mapM_ ((p ! A.id "foo") . toHtml)
111
112-- | Create a very deep tree.
113--
114deepTree :: Int -- ^ Depth of the tree.
115 -> Html -- ^ Result.
116deepTree 0 = "foo"
117deepTree n = p $ table $ tr $ td $ div $ deepTree (n - 1)
118
119-- | Create an element with many attributes.
120--
121manyAttributes :: [String] -- ^ List of attribute values.
122 -> Html -- ^ Result.
123manyAttributes = foldl setAttribute img
124 where
125 setAttribute html' value' = html' ! A.id (toValue value')
126 {-# INLINE setAttribute #-}
127
128customAttributes :: [(String, String)] -- ^ List of attribute name, value pairs
129 -> Html -- ^ Result
130customAttributes = foldl setAttribute img
131 where
132 setAttribute html' (name, value') =
133 html' ! customAttribute (stringTag name) (toValue value')
diff --git a/src/Benchmarks/HtmlBenchmarks.hs b/src/Benchmarks/HtmlBenchmarks.hs
new file mode 100644
index 0000000..3070d52
--- /dev/null
+++ b/src/Benchmarks/HtmlBenchmarks.hs
@@ -0,0 +1,132 @@
1-- | This is a collection of HTML benchmarks for BlazeMarkup.
2--
3{-# LANGUAGE OverloadedStrings, ExistentialQuantification #-}
4{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
5module Benchmarks.HtmlBenchmarks where
6
7import Data.Monoid (Monoid, mempty, mconcat, mappend)
8import Prelude hiding (div, id)
9import qualified Prelude as P
10
11import Benchmarks.BenchmarkUtils
12import Text.Blaze
13import qualified Benchmarks.BenchmarkUtils as H
14
15-- | Description of an HTML benchmark
16--
17data HtmlBenchmark = forall a. HtmlBenchmark
18 { hName :: String -- ^ Name.
19 , hR :: (a -> Html) -- ^ Rendering function.
20 , hD :: a -- ^ Data.
21 , hH :: Html } -- ^ Longer description.
22
23-- | List containing all benchmarks.
24--
25benchmarks :: [HtmlBenchmark]
26benchmarks =
27 [ HtmlBenchmark "bigTable" bigTable bigTableData $
28 let h = toHtml $ length bigTableData
29 w = toHtml $ length $ P.head bigTableData
30 in "Rendering of a big (" >> h >> "x" >> w >> ") HTML table"
31 , HtmlBenchmark "basic" basic basicData
32 "A simple, small basic template with a few holes to fill in"
33 , HtmlBenchmark "wideTree" wideTree wideTreeData $
34 "A very wide tree (" >> toHtml (length wideTreeData) >> " elements)"
35 , HtmlBenchmark "wideTreeEscaping" wideTree wideTreeEscapingData $ do
36 "A very wide tree (" >> toHtml (length wideTreeData) >> " elements)"
37 " with lots of escaping"
38 , HtmlBenchmark "deepTree" deepTree deepTreeData $ do
39 "A really deep tree (" >> toHtml deepTreeData >> " nested templates)"
40 , HtmlBenchmark "manyAttributes" manyAttributes manyAttributesData $ do
41 "A single element with " >> toHtml (length manyAttributesData)
42 " attributes."
43 , HtmlBenchmark "customAttribute" customAttributes customAttributesData $
44 "Creating custom attributes"
45 ]
46
47rows :: Int
48rows = 1000
49
50bigTableData :: [[Int]]
51bigTableData = replicate rows [1..10]
52{-# NOINLINE bigTableData #-}
53
54basicData :: (String, String, [String])
55basicData = ("Just a test", "joe", items)
56{-# NOINLINE basicData #-}
57
58items :: [String]
59items = map (("Number " `mappend`) . show) [1 :: Int .. 14]
60{-# NOINLINE items #-}
61
62wideTreeData :: [String]
63wideTreeData = take 5000 $
64 cycle ["λf.(λx.fxx)(λx.fxx)", "These old days", "Foobar", "lol", "x ∈ A"]
65{-# NOINLINE wideTreeData #-}
66
67wideTreeEscapingData :: [String]
68wideTreeEscapingData = take 1000 $
69 cycle ["<><>", "\"lol\"", "<&>", "'>>'"]
70{-# NOINLINE wideTreeEscapingData #-}
71
72deepTreeData :: Int
73deepTreeData = 1000
74{-# NOINLINE deepTreeData #-}
75
76manyAttributesData :: [String]
77manyAttributesData = wideTreeData
78
79customAttributesData :: [(String, String)]
80customAttributesData = zip wideTreeData wideTreeData
81
82-- | Render the argument matrix as an HTML table.
83--
84bigTable :: [[Int]] -- ^ Matrix.
85 -> Html -- ^ Result.
86bigTable t = table $ mconcat $ map row t
87 where
88 row r = tr $ mconcat $ map (td . toHtml) r
89
90-- | Render a simple HTML page with some data.
91--
92basic :: (String, String, [String]) -- ^ (Title, User, Items)
93 -> Html -- ^ Result.
94basic (title', user, items') = html $ do
95 H.head $ title $ toHtml title'
96 body $ do
97 div ! id "header" $ (h1 $ toHtml title')
98 p $ "Hello, " `mappend` toHtml user `mappend` "!"
99 p $ "Hello, me!"
100 p $ "Hello, world!"
101 h2 $ "loop"
102 ol $ mconcat $ map (li . toHtml) items'
103 div ! id "footer" $ mempty
104
105-- | A benchmark producing a very wide but very shallow tree.
106--
107wideTree :: [String] -- ^ Text to create a tree from.
108 -> Html -- ^ Result.
109wideTree = div . mapM_ ((p ! id "foo") . toHtml)
110
111-- | Create a very deep tree.
112--
113deepTree :: Int -- ^ Depth of the tree.
114 -> Html -- ^ Result.
115deepTree 0 = "foo"
116deepTree n = p $ table $ tr $ td $ div $ deepTree (n - 1)
117
118-- | Create an element with many attributes.
119--
120manyAttributes :: [String] -- ^ List of attribute values.
121 -> Html -- ^ Result.
122manyAttributes = foldl setAttribute img
123 where
124 setAttribute html' value' = html' ! id (toValue value')
125 {-# INLINE setAttribute #-}
126
127customAttributes :: [(String, String)] -- ^ List of attribute name, value pairs
128 -> Html -- ^ Result
129customAttributes = foldl setAttribute img
130 where
131 setAttribute html' (name, value') =
132 html' ! customAttribute (stringTag name) (toValue value')
diff --git a/src/Benchmarks/LICENSE b/src/Benchmarks/LICENSE
new file mode 100644
index 0000000..8122505
--- /dev/null
+++ b/src/Benchmarks/LICENSE
@@ -0,0 +1,30 @@
1Copyright Jasper Van der Jeugt 2010
2
3All rights reserved.
4
5Redistribution and use in source and binary forms, with or without
6modification, are permitted provided that the following conditions are met:
7
8 * Redistributions of source code must retain the above copyright
9 notice, this list of conditions and the following disclaimer.
10
11 * Redistributions in binary form must reproduce the above
12 copyright notice, this list of conditions and the following
13 disclaimer in the documentation and/or other materials provided
14 with the distribution.
15
16 * Neither the name of Jasper Van der Jeugt nor the names of other
17 contributors may be used to endorse or promote products derived
18 from this software without specific prior written permission.
19
20THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/src/Benchmarks/RunHtmlBenchmarks.hs b/src/Benchmarks/RunHtmlBenchmarks.hs
new file mode 100644
index 0000000..04c28ff
--- /dev/null
+++ b/src/Benchmarks/RunHtmlBenchmarks.hs
@@ -0,0 +1,36 @@
1-- | This is a module which runs the 'HtmlBenchmarks' module using the different
2-- renderers available.
3--
4module Benchmarks.RunHtmlBenchmarks where
5
6import Criterion.Main
7import qualified Data.Text.Lazy as LT
8import Data.List
9import qualified Data.ByteString.Lazy as LB
10
11import qualified Text.Blaze.Renderer.Utf8 as Utf8
12import qualified Text.Blaze.Renderer.String as String
13import qualified Text.Blaze.Renderer.Text as Text
14
15import Benchmarks.HtmlBenchmarks (HtmlBenchmark (..), benchmarks)
16import qualified Benchmarks.BlazeTBenchmarks as BT (HtmlBenchmark (..), benchmarks)
17import qualified Text.BlazeT.Renderer.Utf8 as TUtf8
18import qualified Text.BlazeT.Renderer.String as TString
19import qualified Text.BlazeT.Renderer.Text as TText
20
21-- | Function to run the benchmarks using criterion
22--
23main :: IO ()
24main = defaultMain $ zipWith g benchmarks BT.benchmarks
25 where
26 g x y = bgroup (hName x) $ benchHtml x ++ benchHtml2 y
27 benchHtml (HtmlBenchmark _ f x _) =
28 [ bench "Utf8" $ nf (LB.length . Utf8.renderMarkup . f) x
29 , bench "String" $ nf (String.renderMarkup . f) x
30 , bench "Text" $ nf (LT.length . Text.renderMarkup . f) x
31 ]
32 benchHtml2 (BT.HtmlBenchmark _ f x _) =
33 [ bench "BlazeT.Utf8" $ nf (LB.length . TUtf8.renderMarkup . f) x
34 , bench "BlazeT.String" $ nf (TString.renderMarkup . f) x
35 , bench "BlazeT.Text" $ nf (LT.length . TText.renderMarkup . f) x
36 ]
diff --git a/src/Benchmarks/ServerChunkSize.hs b/src/Benchmarks/ServerChunkSize.hs
new file mode 100644
index 0000000..7b01c68
--- /dev/null
+++ b/src/Benchmarks/ServerChunkSize.hs
@@ -0,0 +1,52 @@
1-- | A benchmark for measuring the impact of lazy bytestring chunk size on
2-- server performance.
3--
4{-# LANGUAGE OverloadedStrings #-}
5module Main where
6
7import Control.Concurrent (forkIO)
8import Control.Monad (forever)
9import Data.Monoid (mappend)
10import Network (listenOn, PortID (PortNumber))
11import Network.Socket (accept, sClose)
12import Prelude hiding (putStrLn)
13import System.Environment (getArgs)
14
15import Network.Socket.ByteString (recv, send)
16import Network.Socket.ByteString.Lazy (sendAll)
17import qualified Data.ByteString.Char8 as SBC
18import qualified Data.ByteString.Lazy as LB
19
20-- | Generate a 128k response, with a given chunk size.
21--
22makeResponse :: Int -- ^ Chunk size.
23 -> LB.ByteString -- ^ Result.
24makeResponse chunkSize =
25 let chunks = createChunks chunkSize totalSize
26 in LB.fromChunks chunks
27 where
28 -- A 64 kilobyte response.
29 totalSize = 128 * 1024
30
31 createChunks c s
32 | c < s = SBC.replicate c 'a' : createChunks c (s - c)
33 | otherwise = SBC.replicate s 'a' : []
34
35main :: IO ()
36main = do
37 args <- getArgs
38 let port = PortNumber $ fromIntegral $ (read $ head args :: Int)
39 chunkSize = read $ args !! 1
40
41 socket <- listenOn port
42 forever $ do
43 (s, _) <- accept socket
44 forkIO (respond chunkSize s)
45 where
46 respond chunkSize s = do
47 _ <- recv s 1024
48 _ <- send s $ "HTTP/1.1 200 OK\r\n"
49 `mappend` "Content-Type: text/html; charset=UTF-8\r\n"
50 `mappend` "\r\n"
51 sendAll s $ makeResponse chunkSize
52 sClose s
diff --git a/src/Benchmarks/bigtable/erb.rb b/src/Benchmarks/bigtable/erb.rb
new file mode 100644
index 0000000..c3a675a
--- /dev/null
+++ b/src/Benchmarks/bigtable/erb.rb
@@ -0,0 +1,32 @@
1# BigTable benchmark implemented in ERB.
2#
3require 'erb'
4require 'benchmark'
5include ERB::Util
6
7table = (1 .. 1000).map do |_| (1 .. 10) end
8
9template = ERB.new <<-EOF
10<table>
11 <% table.each do |row| %>
12 <tr>
13 <% row.each do |value| %>
14 <td>
15 <%= value %>
16 </td>
17 <% end %>
18 </tr>
19 <% end %>
20</table>
21EOF
22
23number_runs = 100
24start_time = Time.now.to_f
25number_runs.times do
26 template.result(binding)
27end
28end_time = Time.now.to_f
29
30# start_time and end_time are both in seconds now
31ms = (end_time - start_time) * 1000 / number_runs
32puts "\"ERB\", #{ms}"
diff --git a/src/Benchmarks/bigtable/erubis.rb b/src/Benchmarks/bigtable/erubis.rb
new file mode 100644
index 0000000..9a1edf9
--- /dev/null
+++ b/src/Benchmarks/bigtable/erubis.rb
@@ -0,0 +1,31 @@
1# BigTable benchmark implemented in erubis
2#
3require 'erubis'
4require 'benchmark'
5
6table = (1 .. 1000).map do |_| (1 .. 10) end
7
8template = Erubis::Eruby.new <<-EOF
9<table>
10 <% table.each do |row| %>
11 <tr>
12 <% row.each do |value| %>
13 <td>
14 <%= value %>
15 </td>
16 <% end %>
17 </tr>
18 <% end %>
19</table>
20EOF
21
22number_runs = 100
23start_time = Time.now.to_f
24number_runs.times do
25 template.result(binding)
26end
27end_time = Time.now.to_f
28
29# start_time and end_time are both in seconds now
30ms = (end_time - start_time) * 1000 / number_runs
31puts "\"Erubis\", #{ms}"
diff --git a/src/Benchmarks/bigtable/hamlet.hs b/src/Benchmarks/bigtable/hamlet.hs
new file mode 100644
index 0000000..2778f2d
--- /dev/null
+++ b/src/Benchmarks/bigtable/hamlet.hs
@@ -0,0 +1,33 @@
1-- | BigTable benchmark implemented using Hamlet.
2--
3{-# LANGUAGE QuasiQuotes #-}
4module Main where
5
6import Criterion.Main
7import Text.Hamlet
8import Text.Hamlet.Monad
9import Numeric (showInt)
10import Data.Text (Text)
11import qualified Data.Text as T
12import Data.Maybe (fromJust)
13
14main = defaultMain
15 [ bench "bigTable" $ nf bigTable bigTableData
16 ]
17 where
18 rows :: Int
19 rows = 1000
20
21 bigTableData :: [[Int]]
22 bigTableData = replicate rows [1..10]
23 {-# NOINLINE bigTableData #-}
24
25bigTable rows = fromJust $ hamletToText undefined [$hamlet|
26%table
27 $forall rows row
28 %tr
29 $forall row cell
30 %td $showInt'.cell$
31|]
32 where
33 showInt' i = Encoded $ T.pack $ showInt i ""
diff --git a/src/Benchmarks/bigtable/html-minimalist.hs b/src/Benchmarks/bigtable/html-minimalist.hs
new file mode 100644
index 0000000..2a52751
--- /dev/null
+++ b/src/Benchmarks/bigtable/html-minimalist.hs
@@ -0,0 +1,20 @@
1-- | BigTable benchmark using the html-minimalist package from hackage.
2--
3import Text.HTML.Light hiding (map)
4import Criterion.Main
5
6bigTable :: [[Int]] -> String
7bigTable t =
8 renderXHTML xhtml_1_0_strict $ html [] $ return $ table [] $ map row t
9 where
10 row r = tr [] $ map (td [] . return . cdata . show) r
11
12main = defaultMain
13 [ bench "bigTable" $ nf bigTable myTable ]
14 where
15 rows :: Int
16 rows = 1000
17
18 myTable :: [[Int]]
19 myTable = replicate rows [1..10]
20 {-# NOINLINE myTable #-}
diff --git a/src/Benchmarks/bigtable/html.hs b/src/Benchmarks/bigtable/html.hs
new file mode 100644
index 0000000..57a62b3
--- /dev/null
+++ b/src/Benchmarks/bigtable/html.hs
@@ -0,0 +1,19 @@
1-- | BigTable benchmark using the HTML package from hackage.
2--
3import Text.Html
4import Criterion.Main
5
6bigTable :: [[Int]] -> String
7bigTable t = renderHtml $ table $ concatHtml $ map row t
8 where
9 row r = tr $ concatHtml $ map (td . stringToHtml . show) r
10
11main = defaultMain
12 [ bench "bigTable" $ nf bigTable myTable ]
13 where
14 rows :: Int
15 rows = 1000
16
17 myTable :: [[Int]]
18 myTable = replicate rows [1..10]
19 {-# NOINLINE myTable #-}
diff --git a/src/Benchmarks/bigtable/php.php b/src/Benchmarks/bigtable/php.php
new file mode 100644
index 0000000..f2e51a4
--- /dev/null
+++ b/src/Benchmarks/bigtable/php.php
@@ -0,0 +1,30 @@
1<?php
2$table = array_fill(0, 1000, array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10));
3
4function test_bigtable($table) {
5 ob_start();
6?>
7<table>
8<?php foreach($table as $row) { ?>
9<tr>
10<?php foreach($row as $value) { ?>
11<td><?php echo $value; ?></td>
12<?php } ?>
13</tr>
14<?php } ?>
15</table>
16<?php
17 return ob_get_clean();
18}
19
20$request_count = 1000;
21
22$start = microtime(true);
23for ($i = 0; $i < $request_count; $i++)
24{
25 test_bigtable($table);
26}
27$elapsed = microtime(true) - $start;
28$time_per_request = ($elapsed / $request_count) * 1000;
29echo "\"PHP\", $time_per_request\n";
30?>
diff --git a/src/Benchmarks/bigtable/xhtml.hs b/src/Benchmarks/bigtable/xhtml.hs
new file mode 100644
index 0000000..993994c
--- /dev/null
+++ b/src/Benchmarks/bigtable/xhtml.hs
@@ -0,0 +1,19 @@
1-- | BigTable benchmark using the XHTML package from hackage.
2--
3import Text.XHtml.Strict
4import Criterion.Main
5
6bigTable :: [[Int]] -> String
7bigTable t = renderHtml $ table $ concatHtml $ map row t
8 where
9 row r = tr $ concatHtml $ map (td . stringToHtml . show) r
10
11main = defaultMain
12 [ bench "bigTable" $ nf bigTable myTable ]
13 where
14 rows :: Int
15 rows = 1000
16
17 myTable :: [[Int]]
18 myTable = replicate rows [1..10]
19 {-# NOINLINE myTable #-}
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 17:21:36 +0000