criterion-to-html 0.0.0.1 → 0.0.0.2
raw patch · 5 files changed
+179/−39 lines, 5 filesdep +aesondep +containers
Dependencies added: aeson, containers
Files
- criterion-to-html.cabal +7/−4
- criterion-to-html.js +98/−0
- src/Criterion/ToHtml.hs +4/−1
- src/Criterion/ToHtml/Html.hs +36/−26
- src/Criterion/ToHtml/Result.hs +34/−8
criterion-to-html.cabal view
@@ -1,15 +1,16 @@ Name: criterion-to-html-Version: 0.0.0.1+Version: 0.0.0.2 Synopsis: Convert criterion output to HTML reports License: BSD3 License-file: LICENSE-Author: Jasper Van der Jeugt-Maintainer: m@jaspervdj.be+Author: Jasper Van der Jeugt <m@jaspervdj.be>+Maintainer: Jasper Van der Jeugt <m@jaspervdj.be> Category: Development 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 @@ 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,
+ criterion-to-html.js view
@@ -0,0 +1,98 @@+/* Create an element showing a group of results */+function createResults(group) {+ /* If attributes are not set, we should set them */+ group.sort = group.sort ? true : false;++ var div = $(document.createElement('div')).addClass('results');++ var controls = $(document.createElement('div')).addClass('controls');+ div.append(controls);++ div.append($(document.createElement('h2')).html(group.name));++ /* Create a box and label to sort the results */+ var sortBox = $(document.createElement('input'))+ .attr('type', 'checkbox')+ .attr('id', 'sort-' + sanitizeName(group.name))+ .attr('checked', group.sort);+ var sortLabel = $(document.createElement('label'))+ .attr('for', 'sort-' + sanitizeName(group.name))+ .html('Sort results');+ controls.append(sortLabel);+ controls.append(sortBox);++ /* When the sort box is changed, we need to reset this div */+ sortBox.click(function() {+ group.sort = sortBox.attr('checked');+ div.replaceWith(createResults(group));+ });++ /* Create an array copy in order to sort them */+ var results = group.results.slice(0);+ prepareResults(results, group.sort);+ for(i in results) div.append(createResult(results[i]));++ return div;+}++/* Sanitize a name to something we can use as ID */+function sanitizeName(name) {+ return name.toLowerCase().replace(/[^a-z0-9]/, '-');+}++/* Create an element showing a given result */+function createResult(result) {+ var div = $(document.createElement('div'));+ var canvas = document.createElement('canvas');+ $(canvas).attr('width', '600px').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) + ')';+}++/* Prepare results */+function prepareResults(results, sort) {+ /* Sort if necessary */+ if(sort) {+ results.sort(function(r1, r2) { return r1.mean - r2.mean; });+ }++ 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];+ $('body').append(createResults(group));+ }+});
src/Criterion/ToHtml.hs view
@@ -9,16 +9,19 @@ 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 $ table csv'+ BL.writeFile html $ renderHtml $ report js csv' putStrLn $ "Wrote " ++ html main :: IO ()
src/Criterion/ToHtml/Html.hs view
@@ -1,38 +1,48 @@ -- | Output the results to HTML -- {-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} module Criterion.ToHtml.Html- ( table+ ( report ) where -import Data.Monoid (mappend)-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 -table :: [Result] -> Html-table results = H.docTypeHtml $ do- H.head $ H.title "Criterion results"- H.body $ do - 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 " "- 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.style ! A.type_ "text/css" $ do+ "html {"+ " font-size: 16px;"+ " font-family: sans-serif;"+ "}"+ "body {"+ " width: 600px;"+ " margin: 0px auto 0px auto;"+ "}"+ "div.controls {"+ " float: right;"+ "}"+ "div.results {"+ " margin-bottom: 50px;"+ "}"+ H.body mempty
src/Criterion/ToHtml/Result.hs view
@@ -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 @@ , 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 _ = 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])