Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add cache tag contention benchmark

  • Loading branch information...
commit a06083d1fe103009618aa0ada953986968697daa 1 parent 39d1370
Gregory Collins gregorycollins authored
1  src/Text/Templating/Heist/Internal.hs
View
@@ -1,5 +1,6 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
2  src/Text/Templating/Heist/Splices/Apply.hs
View
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
module Text.Templating.Heist.Splices.Apply where
------------------------------------------------------------------------------
2  src/Text/Templating/Heist/Splices/Bind.hs
View
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
module Text.Templating.Heist.Splices.Bind where
------------------------------------------------------------------------------
2  src/Text/Templating/Heist/Splices/Cache.hs
View
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
-- | The \"cache\" splice ensures that its contents are cached and only
-- evaluated periodically. The cached contents are returned every time the
-- splice is referenced.
2  src/Text/Templating/Heist/Splices/Html.hs
View
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
module Text.Templating.Heist.Splices.Html where
------------------------------------------------------------------------------
2  src/Text/Templating/Heist/Splices/Ignore.hs
View
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
module Text.Templating.Heist.Splices.Ignore where
------------------------------------------------------------------------------
2  src/Text/Templating/Heist/Splices/Markdown.hs
View
@@ -1,4 +1,6 @@
{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
+
{-| The \"markdown\" splice formats markdown content as HTML and inserts
it into the document.
58 test/benchmark/Benchmark.hs
View
@@ -6,12 +6,12 @@ module Main where
------------------------------------------------------------------------------
import Criterion
import Criterion.Main
+import Criterion.Measurement
------------------------------------------------------------------------------
+import Control.Concurrent.ParallelIO.Local
+import Control.Exception (evaluate)
+import Control.Monad
import Blaze.ByteString.Builder
-import qualified Data.ByteString as B
-import Data.Text (Text)
-import qualified Data.Text as T
-import Text.XmlHtml
import Text.Templating.Heist
import Text.Templating.Heist.TemplateDirectory
@@ -22,17 +22,55 @@ main = do
ts <- getDirectoryTS tdir
defaultMain [
- bench "cacheContention" $ cacheContentionBenchmark ts
+ bench contentionBenchmarkName $
+ cacheContentionBenchmark contentionThreads
+ contentionTasks
+ contentionTrials
+ ts
]
+ where
+ contentionThreads = 30
+ contentionTasks = 60
+ contentionTrials = 4
+
+ contentionBenchmarkName = concat [ "cacheContention/"
+ , show contentionThreads
+ , "/"
+ , show contentionTasks
+ , "/"
+ , show contentionTrials ]
+
------------------------------------------------------------------------------
+_estimateCostPerRun :: Int -> Int -> Double -> String
+_estimateCostPerRun tasks trials totalTime =
+ concat [ "per render under contention: average cost of "
+ , secs $ _costPerRun tasks trials totalTime ]
+
+_costPerRun :: Int -> Int -> Double -> Double
+_costPerRun tasks trials totalTime =
+ totalTime / fromIntegral (tasks * trials)
+
+
+------------------------------------------------------------------------------
+makeTemplateDirectory :: IO (TemplateDirectory IO)
makeTemplateDirectory = newTemplateDirectory' "templates" defaultHeistState
------------------------------------------------------------------------------
-cacheContentionBenchmark :: HeistState IO -> IO ()
-cacheContentionBenchmark heistState =
- renderTemplate heistState "cached_haddock" >>=
- maybe (error "render went wrong??")
- (undefined)
+cacheContentionBenchmark :: Int -- ^ number of tasks
+ -> Int -- ^ number of trials per task
+ -> Int -- ^ number of pool threads
+ -> HeistState IO
+ -> IO ()
+cacheContentionBenchmark nTasks nTrialsPerTask nThreads heistState =
+ withPool nThreads $ \pool -> do
+ parallel_ pool $ replicate nTasks
+ $ replicateM_ nTrialsPerTask (renderOne >>= evaluate)
+ return $! ()
+
+ where
+ renderOne =
+ renderTemplate heistState "cached_haddock" >>=
+ return . maybe (error "render went wrong??") (toByteString . fst)
Please sign in to comment.
Something went wrong with that request. Please try again.