Permalink
Browse files

Gotta learn some JS/canvas some day, right?

  • Loading branch information...
1 parent ee86bff commit dd4ebd2a0a1169d89799057cfdfcde0f06a3b2a0 @jaspervdj committed Jun 9, 2011
Showing with 125 additions and 44 deletions.
  1. +1 −1 .ghci
  2. +4 −1 criterion-to-html.cabal
  3. +62 −0 criterion-to-html.js
  4. +4 −1 src/Criterion/ToHtml.hs
  5. +20 −33 src/Criterion/ToHtml/Html.hs
  6. +34 −8 src/Criterion/ToHtml/Result.hs
View
2 .ghci
@@ -1 +1 @@
-:set -isrc
+:set -isrc -idist/build/autogen
View
@@ -10,6 +10,7 @@ Build-type: Simple
Homepage: http://github.com/jaspervdj/criterion-to-html
Bug-Reports: http://github.com/jaspervdj/criterion-to-html/issues
Cabal-version: >= 1.6
+Data-files: criterion-to-html.js
Description:
A program to convert criterion output (a CSV file) to an HTML which has some
@@ -43,7 +44,9 @@ Executable criterion-to-html
base >= 4 && < 5,
blaze-html >= 0.4 && < 0.5,
bytestring >= 0.9 && < 0.10,
- filepath >= 1.1 && < 1.3
+ filepath >= 1.1 && < 1.3,
+ aeson >= 0.3 && < 0.4,
+ containers >= 0.3 && < 0.5
Other-modules:
Criterion.ToHtml.Csv,
Criterion.ToHtml.Html,
View
@@ -0,0 +1,62 @@
+/* Create an element showing a group of results */
+function createResults(name, results) {
+ var div = $(document.createElement('div'));
+ div.append($(document.createElement('h2')).html(name));
+
+ for(i in results) div.append(createResult(results[i]));
+
+ return div;
+}
+
+/* Create an element showing a given result */
+function createResult(result) {
+ var div = $(document.createElement('div'));
+ var canvas = document.createElement('canvas');
+ $(canvas).attr('width', '500px').attr('height', '30px');
+ div.append(canvas);
+
+ var ctx = canvas.getContext('2d');
+ var width = canvas.width;
+ var height = canvas.height;
+
+ /* Bar */
+ ctx.fillStyle = barColor(result.normalizedMean);
+ ctx.fillRect(0, 0, result.normalizedMean * width, height);
+
+ /* Benchmark name */
+ ctx.fillStyle = 'black';
+ ctx.font = 'bold 16px sans-serif';
+ ctx.textAlign = 'left';
+ ctx.fillText(result.name, 10, 23);
+ ctx.font = '16px sans-serif';
+ ctx.textAlign = 'right';
+ ctx.fillText(result.mean + 's', width - 10, 23);
+
+ return div;
+}
+
+/* Calculate the bar color, based on normalized mean */
+function barColor(normalizedMean) {
+ var r, g, b;
+ var round = function(x) { return Math.round(255 * x); };
+ r = 0.8 * normalizedMean;
+ g = 1 - 0.8 * normalizedMean;
+ b = 0.0;
+ return 'rgb(' + round(r) + ', ' + round(g) + ', ' + round(b) + ')';
+}
+
+/* Calculate normalized means */
+function normalizeMeans(results) {
+ var max = 0;
+ for(i in results) if(results[i].mean > max) max = results[i].mean;
+ for(i in results) results[i].normalizedMean = results[i].mean / max;
+}
+
+/* Main handler, create the page */
+$(function() {
+ for(i in criterionResults) {
+ var group = criterionResults[i];
+ normalizeMeans(group.results);
+ $('body').append(createResults(group.name, group.results));
+ }
+});
View
@@ -9,16 +9,19 @@ import System.Environment (getArgs, getProgName)
import System.FilePath (replaceExtension)
import Text.Blaze.Renderer.Utf8 (renderHtml)
+import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Criterion.ToHtml.Html
import Criterion.ToHtml.Result
+import Paths_criterion_to_html (getDataFileName)
toHtml' :: FilePath -> FilePath -> IO ()
toHtml' csv html = do
+ js <- B.readFile =<< getDataFileName "criterion-to-html.js"
putStrLn $ "Parsing " ++ csv
csv' <- parseCriterionCsv <$> readFile csv
- BL.writeFile html $ renderHtml $ report csv'
+ BL.writeFile html $ renderHtml $ report js csv'
putStrLn $ "Wrote " ++ html
main :: IO ()
@@ -1,46 +1,33 @@
-- | Output the results to HTML
--
{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
module Criterion.ToHtml.Html
( report
) where
-import Data.List (sortBy)
-import Data.Monoid (mappend)
-import Data.Ord (comparing)
-import Text.Printf (printf)
+import Data.Monoid (mempty)
-import Text.Blaze (Html, toHtml, toValue, preEscapedString, (!))
+import Data.Aeson (encode)
+import Data.ByteString (ByteString)
+import Text.Blaze (Html, unsafeLazyByteString, unsafeByteString, (!))
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Criterion.ToHtml.Result
-report :: [Result] -> Html
-report results = H.docTypeHtml $ do
- H.head $ H.title "Criterion results"
- H.body $ do
- H.h1 "Results"
- table results
- H.h1 "Sorted"
- table $ sortBy (comparing resultMean) results
-
-table :: [Result] -> Html
-table results = H.table ! A.style "width: 100%;" $ do
- H.tr $ do
- H.th "Name"
- H.th "Mean"
- mapM_ row $ normalizeMeans results
-
-row :: (Result, Double) -> Html
-row (Result name _, n) = H.tr $ do
- H.td $ toHtml name
- H.td ! A.style "width: 100%" $
- H.div ! A.style (backgroundColor `mappend` "; " `mappend` width)
- $ preEscapedString "&nbsp;"
- where
- width = toValue $ "width: " ++ show (round (n * 100) :: Int) ++ "%"
- backgroundColor = toValue
- (printf "background-color: rgb(%d, %d, %d)" r g b :: String)
- r, g, b :: Int
- (r, g, b) = (round (150 * n), round (150 * (1 - n)), 0)
+report :: ByteString -> [ResultGroup] -> Html
+report js results = H.docTypeHtml $ do
+ H.head $ do
+ H.title "Criterion results"
+ -- jQuery for DOM manipulation
+ H.script ! A.type_ "text/javascript"
+ ! A.src "http://code.jquery.com/jquery-latest.js"
+ $ mempty
+ -- Our results as JSON
+ H.script ! A.type_ "text/javascript" $ do
+ "var criterionResults = "
+ unsafeLazyByteString $ encode results
+ ";"
+ H.script ! A.type_ "text/javascript" $ unsafeByteString js
+ H.body mempty
@@ -1,11 +1,18 @@
-- | Parse Criterion results
--
+{-# LANGUAGE OverloadedStrings #-}
module Criterion.ToHtml.Result
( Result (..)
+ , ResultGroup (..)
, parseCriterionCsv
- , normalizeMeans
+ , groupResults
) where
+import System.FilePath (splitFileName)
+import qualified Data.Map as M
+
+import Data.Aeson (ToJSON (toJSON), object, (.=))
+
import Criterion.ToHtml.Csv
-- | A criterion result
@@ -15,10 +22,25 @@ data Result = Result
, resultMean :: Double
}
+instance ToJSON Result where
+ toJSON (Result name mean) = object ["name" .= name, "mean" .= mean]
+
+-- | A criterion result group
+--
+data ResultGroup = ResultGroup
+ { resultGroupName :: String
+ , resultGroupResults :: [Result]
+ }
+
+instance ToJSON ResultGroup where
+ toJSON (ResultGroup name results) =
+ object ["name" .= name, "results" .= results]
+
-- | Parse a Criterion CSV file
--
-parseCriterionCsv :: String -> [Result]
-parseCriterionCsv = map parseCriterionResult . drop 1 . parseCsv
+parseCriterionCsv :: String -> [ResultGroup]
+parseCriterionCsv =
+ groupResults . map parseCriterionResult . drop 1 . parseCsv
-- | Parse a single result
--
@@ -27,9 +49,13 @@ parseCriterionResult (name : mean : _) = Result name (read mean)
parseCriterionResult _ = error
"Criterion.ToHtml.Parse.parseCriterionResult: invalid CSV file"
-normalizeMeans :: [Result] -> [(Result, Double)]
-normalizeMeans [] = []
-normalizeMeans results = map normalize results
+-- | Group results
+--
+groupResults :: [Result] -> [ResultGroup]
+groupResults =
+ map toGroup . M.toList . M.fromListWith (flip (++)) . map splitResult
where
- normalize result = (result, resultMean result / max')
- max' = maximum $ map resultMean results
+ toGroup = uncurry ResultGroup
+ splitResult (Result name mean) =
+ let (group, name') = splitFileName name
+ in (group, [Result name' mean])

0 comments on commit dd4ebd2

Please sign in to comment.