Port HTML report to chart.js

Criterion/Analysis.hs

@@ -89,9 +89,9 @@ outlierVariance
 outlierVariance µ σ a = OutlierVariance effect desc varOutMin
   where
     ( effect, desc ) | varOutMin < 0.01 = (Unaffected, "no")
-                     | varOutMin < 0.1  = (Slight,     "slight")
-                     | varOutMin < 0.5  = (Moderate,   "moderate")
-                     | otherwise        = (Severe,     "severe")
+                     | varOutMin < 0.1  = (Slight,     "a slight")
+                     | varOutMin < 0.5  = (Moderate,   "a moderate")
+                     | otherwise        = (Severe,     "a severe")
     varOutMin = (minBy varOut 1 (minBy cMax 0 µgMin)) / σb2
     varOut c  = (ac / a) * (σb2 - ac * σg2) where ac = a - c
     σb        = B.estPoint σ

Criterion/EmbeddedData.hs

@@ -11,27 +11,19 @@
 --
 -- When the @embed-data-files@ @Cabal@ flag is enabled, this module exports
 -- the contents of various files (the @data-files@ from @criterion.cabal@, as
--- well as minimized versions of jQuery and Flot) embedded as 'ByteString's.
+-- well as a minimized version of Chart.js) embedded as a 'ByteString'.
 module Criterion.EmbeddedData
   ( dataFiles
-  , jQueryContents
-  , flotContents
-  , flotErrorbarsContents
-  , flotNavigateContents
+  , chartContents
   ) where
 
 import Data.ByteString (ByteString)
 import Data.FileEmbed (embedDir, embedFile)
 import Language.Haskell.TH.Syntax (runIO)
-import qualified Language.Javascript.Flot as Flot
-import qualified Language.Javascript.JQuery as JQuery
+import qualified Language.Javascript.Chart as Chart
 
 dataFiles :: [(FilePath, ByteString)]
 dataFiles = $(embedDir "templates")
 
-jQueryContents, flotContents,
-  flotErrorbarsContents, flotNavigateContents :: ByteString
-jQueryContents        = $(embedFile =<< runIO JQuery.file)
-flotContents          = $(embedFile =<< runIO (Flot.file Flot.Flot))
-flotErrorbarsContents = $(embedFile =<< runIO (Flot.file Flot.FlotErrorbars))
-flotNavigateContents  = $(embedFile =<< runIO (Flot.file Flot.FlotNavigate))
+chartContents :: ByteString
+chartContents = $(embedFile =<< runIO (Chart.file Chart.Chart))

Criterion/Report.hs

@@ -37,13 +37,12 @@ import Control.Monad.IO.Class (MonadIO(liftIO))
 import Control.Monad.Reader (ask)
 import Criterion.Monad (Criterion)
 import Criterion.Types
-import Data.Aeson (ToJSON (..), Value(..), object, (.=), Value, encode)
+import Data.Aeson (ToJSON (..), Value(..), object, (.=), Value)
 import Data.Data (Data, Typeable)
 import Data.Foldable (forM_)
 import GHC.Generics (Generic)
 import Paths_criterion (getDataFileName)
 import Statistics.Function (minMax)
-import Statistics.Types (confidenceInterval, confidenceLevel, confIntCL, estError)
 import System.Directory (doesFileExist)
 import System.FilePath ((</>), (<.>), isPathSeparator)
 import System.IO (hPutStrLn, stderr)
@@ -53,21 +52,21 @@ import Prelude ()
 import Prelude.Compat
 import qualified Control.Exception as E
 import qualified Data.Text as T
+#if defined(EMBED)
 import qualified Data.Text.Lazy.Encoding as TLE
+#endif
 import qualified Data.Text.IO as T
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.IO as TL
 import qualified Data.Vector.Generic as G
 import qualified Data.Vector.Unboxed as U
 
 #if defined(EMBED)
-import Criterion.EmbeddedData (dataFiles, jQueryContents, flotContents,
-                               flotErrorbarsContents, flotNavigateContents)
+import Criterion.EmbeddedData (dataFiles, chartContents)
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text.Encoding as TE
 #else
-import qualified Language.Javascript.Flot as Flot
-import qualified Language.Javascript.JQuery as JQuery
+import qualified Language.Javascript.Chart as Chart
 #endif
 
 -- | Trim long flat tails from a KDE plot.
@@ -113,26 +112,18 @@ formatReport reports templateName = do
         Left err -> fail (show err) -- TODO: throw a template exception?
         Right x -> return x
 
-    jQuery            <- jQueryFileContents
-    flot              <- flotFileContents
-    flotErrorbars     <- flotErrorbarsFileContents
-    flotNavigate      <- flotNavigateFileContents
-    jQueryCriterionJS <- readDataFile ("js" </> "jquery.criterion.js")
-    criterionCSS      <- readDataFile "criterion.css"
+    criterionJS <- readDataFile "criterion.js"
+    criterionCSS <- readDataFile "criterion.css"
+    chartJS <- chartFileContents
 
     -- includes, only top level
     templates <- getTemplateDir
     template <- includeTemplate (includeFile [templates]) template0
-    reports' <- mapM inner reports
 
     let context = object
             [ "json"                .= reports
-            , "report"              .= reports'
-            , "js-jquery"           .= jQuery
-            , "js-flot"             .= flot
-            , "js-flot-errorbars"   .= flotErrorbars
-            , "js-flot-navigate"    .= flotNavigate
-            , "jquery-criterion-js" .= jQueryCriterionJS
+            , "js-criterion"        .= criterionJS
+            , "js-chart"            .= chartJS
             , "criterion-css"       .= criterionCSS
             ]
 
@@ -152,17 +143,11 @@ formatReport reports templateName = do
         criterionWarning $ displayMustacheWarning warning
     return formatted
   where
-    jQueryFileContents, flotFileContents :: IO T.Text
+    chartFileContents :: IO T.Text
 #if defined(EMBED)
-    jQueryFileContents        = pure $ TE.decodeUtf8 jQueryContents
-    flotFileContents          = pure $ TE.decodeUtf8 flotContents
-    flotErrorbarsFileContents = pure $ TE.decodeUtf8 flotErrorbarsContents
-    flotNavigateFileContents  = pure $ TE.decodeUtf8 flotNavigateContents
+    chartFileContents        = pure $ TE.decodeUtf8 chartContents
 #else
-    jQueryFileContents        = T.readFile =<< JQuery.file
-    flotFileContents          = T.readFile =<< Flot.file Flot.Flot
-    flotErrorbarsFileContents = T.readFile =<< Flot.file Flot.FlotErrorbars
-    flotNavigateFileContents  = T.readFile =<< Flot.file Flot.FlotNavigate
+    chartFileContents        = T.readFile =<< Chart.file Chart.Chart
 #endif
 
     readDataFile :: FilePath -> IO T.Text
@@ -185,58 +170,6 @@ formatReport reports templateName = do
         fmap TextBlock (f (T.unpack fp))
     includeNode _ n = return n
 
-    -- Merge Report with it's analysis and outliers
-    merge :: ToJSON a => a -> Value -> Value
-    merge x y = case toJSON x of
-        Object x' -> case y of
-            Object y' -> Object (x' <> y')
-            _         -> y
-        _         -> y
-
-    inner :: Report -> IO Value
-    inner r@Report {..} = do
-      reportName' <- sanitizeJSString $ T.pack reportName
-      return $ merge reportAnalysis $ merge reportOutliers $ object
-        [ "name"                  .= reportName'
-        , "json"                  .= TLE.decodeUtf8 (encode r)
-        , "number"                .= reportNumber
-        , "iters"                 .= vector "x" iters
-        , "times"                 .= vector "x" times
-        , "cycles"                .= vector "x" cycles
-        , "kdetimes"              .= vector "x" kdeValues
-        , "kdepdf"                .= vector "x" kdePDF
-        , "kde"                   .= vector2 "time" "pdf" kdeValues kdePDF
-        , "anMeanConfidenceLevel" .= anMeanConfidenceLevel
-        , "anMeanLowerBound"      .= anMeanLowerBound
-        , "anMeanUpperBound"      .= anMeanUpperBound
-        , "anStdDevLowerBound"    .= anStdDevLowerBound
-        , "anStdDevUpperBound"    .= anStdDevUpperBound
-        ]
-      where
-        [KDE{..}]          = reportKDEs
-        SampleAnalysis{..} = reportAnalysis
-
-        iters  = measure measIters reportMeasured
-        times  = measure measTime reportMeasured
-        cycles = measure measCycles reportMeasured
-        anMeanConfidenceLevel
-               = confidenceLevel $ confIntCL $ estError anMean
-        (anMeanLowerBound, anMeanUpperBound)
-               = confidenceInterval anMean
-        (anStdDevLowerBound, anStdDevUpperBound)
-               = confidenceInterval anStdDev
-
-        sanitizeJSString :: T.Text -> IO T.Text
-        sanitizeJSString str = do
-          let pieces = T.splitOn "\n" str
-          case pieces of
-            (_word1:_word2:_) -> do
-              criterionWarning $
-                "Report name " ++ show str ++ " contains newlines, which " ++
-                "will be replaced with spaces in the HTML report."
-              return $ T.unwords pieces
-            _ -> return str
-
 criterionWarning :: String -> IO ()
 criterionWarning msg =
   hPutStrLn stderr $ unlines

changelog.md

@@ -1,3 +1,23 @@
+Unreleased
+
+* The HTML reports have been reworked.
+
+  * The `flot` plotting library (`js-flot` on Hackage) has been replaced by
+    `Chart.js` (`js-chart`).
+  * Most practical changes focus on improving the functionality of the overview
+    chart:
+    * It now supports logarithmic scale (#213). The scale can be toggled by
+      clicking the x-axis.
+    * Manual zooming has been replaced by clicking to focus a single bar.
+    * It now supports a variety of sort orders.
+    * The legend can now be toggled on/off and is hidden by default.
+    * Clicking the name of a group in the legend shows/hides all bars in that
+      group.
+  * The regression line on the scatter plot shows confidence interval.
+  * Better support for mobile and print.
+  * JSON escaping has been made more robust by no longer directly injecting
+    reports as JavaScript code.
+
 1.5.7.0
 
 * Warn if an HTML report name contains newlines, and replace newlines with

criterion.cabal

@@ -33,7 +33,7 @@ tested-with:
 data-files:
   templates/*.css
   templates/*.tpl
-  templates/js/jquery.criterion.js
+  templates/*.js
 
 description:
   This library provides a powerful but simple way to measure software
@@ -97,8 +97,7 @@ library
     filepath,
     Glob >= 0.7.2,
     microstache >= 1.0.1 && < 1.1,
-    js-flot,
-    js-jquery,
+    js-chart >= 2.9.4 && < 3,
     mtl >= 2,
     mwc-random >= 0.8.0.3,
     optparse-applicative >= 0.13,

stack.yaml

@@ -7,5 +7,6 @@ packages:
 extra-deps:
 - microstache-1.0.1.1
 - statistics-0.14.0.0
+- js-chart-2.9.4.1
 
 flags: {}