Commits

Bryan O'Sullivan committed 92c26a6

Progress! Hastache-based reporting.

  • Participants
  • Parent commits 8931bbb

Comments (0)

Files changed (7)

 
 import Control.Applicative ((<$>))
 import Control.DeepSeq (rnf)
-import Control.Exception (catch, evaluate, finally)
+import Control.Exception (bracket, catch, evaluate, finally)
 import Control.Monad (forM_, unless)
 import Data.Aeson ((.=), encode, object)
 import Data.Char (toLower)
 import Network.HTTP.LoadTest (NetworkError(..), Req(..))
 import Network.HTTP.LoadTest.Analysis (analyseBasic, analyseFull)
 import Network.HTTP.LoadTest.Environment (environment)
-import Network.HTTP.LoadTest.Report (buildTime, csvEvents, reportBasic,
-                                     reportEvents, reportFull)
+import Network.HTTP.LoadTest.Report
 import Network.Socket (withSocketsDo)
 import Prelude hiding (catch)
 import System.CPUTime (getCPUTime)
 import System.Console.CmdArgs
 import System.Exit (ExitCode(ExitFailure), exitWith)
-import System.IO (hPutStrLn, stderr, stdout)
+import System.IO (Handle, IOMode(..), hClose, hPutStrLn, openFile, stderr, stdout)
 import qualified Data.Aeson.Generic as G
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as BL
 
     , bootstrap :: Bool
     , dump_events :: Maybe FilePath
+    , output :: Maybe FilePath
+    , template :: FilePath
     , json :: Maybe FilePath
     } deriving (Eq, Show, Typeable, Data)
 
                 &= help "Time to wait before killing a connection"
               , url = def &= argPos 0 &= typ "URL"
 
+              -- --------------------------------------------------
               , from_file = def &= typ "FILE"
                 &= groupname "Supplying a request body"
                 &= help "Use file contents as request body"
               , literal = def &= typ "STRING"
                 &= help "Use given text as request body"
 
+              -- --------------------------------------------------
               , bootstrap = def
                 &= groupname "Analysis of results"
                 &= help "Statistically robust analysis of results"
               , dump_events = def &= typ "FILE"
                 &= help "Save raw events in CSV format"
+              , output = def &= typ "FILE"
+                &= help "Write report to named file"
+              , template = "report.tpl" &= typ "FILE"
+                &= help "Use the given report template"
               , json = def &= typ "FILE"
                 &= help "Save analysis in JSON format"
               } &= verbosity
       let dump = object [ "config" .= cfg
                         , "environment" .= env
                         , "analysis" .= G.toJSON analysis ]
-      case json of
-        Just "-" -> BL.putStrLn (encode dump)
-        Just f   -> BL.writeFile f (encode dump)
-        _        -> return ()
-      case dump_events of
-        Just "-" -> TL.putStr . toLazyText . csvEvents $ results
-        Just f   -> TL.writeFile f . toLazyText . csvEvents $ results
-        _        -> return ()
+      maybeWriteFile json $ \h -> BL.hPutStrLn h . encode $ dump
+      maybeWriteFile dump_events $ \h ->
+          TL.hPutStr h . toLazyText . csvEvents $ results
+      maybeWriteFile output $ \h -> either (writeReport template h)
+                                           (writeReport template h) analysis
       whenNormal $ do
         reportEvents stdout results
         either (reportBasic stdout) (reportFull whenLoud stdout)
                analysis
 
+maybeWriteFile :: Maybe FilePath -> (Handle -> IO ()) -> IO ()
+maybeWriteFile (Just "-") act = act stdout
+maybeWriteFile (Just p)   act = bracket (openFile p WriteMode) hClose act
+maybeWriteFile _          _   = return ()
+
 validateArgs :: Args -> IO ()
 validateArgs Args{..} = do
   let p !? what | p         = Nothing

lib/Network/HTTP/LoadTest/Analysis.hs

                  latency = l
                , latency99 = weightedAvg 99 100 . G.map summElapsed $ sumv
                , latency999 = weightedAvg 999 1000 . G.map summElapsed $ sumv
+               , latValues = sumv
                , throughput = scale (recip timeSlice) t
                , throughput10 = (/ timeSlice) . weightedAvg 10 100 $ slices
+               , thrValues = slices
     }
 
 analyseBasic :: V.Vector Summary -> Analysis Basic
                                 }
                     , latency99 = weightedAvg 99 100 . G.map summElapsed $ sumv
                     , latency999 = weightedAvg 999 1000 . G.map summElapsed $ sumv
+                    , latValues = sumv
                     , throughput = Basic {
                                      mean = S.mean slices / timeSlice
                                    , stdDev = S.stdDev slices / timeSlice
                                    }
                     , throughput10 = (/ timeSlice) . weightedAvg 10 100 $ slices
+                    , thrValues = slices
                     }
  where start = summStart . G.head $ sumv
        end = summEnd . G.last $ sumv

lib/Network/HTTP/LoadTest/Report.hs

       reportBasic
     , reportEvents
     , reportFull
-    , writeReportBasic
+    , writeReport
     -- * Other reports
     , csvEvents
     -- * Helper functions
 import Control.Monad (forM_)
 import Criterion.Analysis (SampleAnalysis(..), OutlierEffect(..),
                            OutlierVariance(..))
+import Data.Data (Data)
 import Data.List (sort)
 import Data.Monoid (mappend, mconcat, mempty)
 import Data.Text (Text)
 import Paths_pronk (getDataFileName)
 import Prelude hiding (print)
 import Statistics.Resampling.Bootstrap (Estimate(..))
-import System.FilePath ((</>))
 import System.IO (Handle)
+import System.IO.Unsafe (unsafePerformIO)
 import Text.Hastache (MuType(..))
 import Text.Hastache.Context (mkGenericContext)
+import qualified Criterion.Report as R
 import qualified Data.ByteString.Lazy as L
 import qualified Data.HashMap.Strict as H
 import qualified Data.Text.Format as T
     classify Timeout          = "timeout"
     classify HttpResponse{..} = build respCode
 
+-- | The path to the template and other files used for generating
+-- reports.
 templateDir :: FilePath
-templateDir = "templates"
+templateDir = unsafePerformIO $ getDataFileName "templates"
+{-# NOINLINE templateDir #-}
 
-writeReportBasic :: Handle -> Analysis Basic -> IO ()
-writeReportBasic h Analysis{..} = do
-  tpl <- getDataFileName templateDir
-  let context n@"latency" = mkGenericContext latency n
-      context _           = MuNothing
-  bs <- H.hastacheFile H.defaultConfig (tpl </> "report.tpl") context
+writeReport :: (Data a) => FilePath -> Handle -> Analysis a -> IO ()
+writeReport template h a@Analysis{..} = do
+  let context "include" = MuLambdaM $
+                          R.includeFile [templateDir, R.templateDir]
+      context "latValues" = MuList . map mkGenericContext . G.toList $ lats
+      context "thrValues" = R.vector "x" thrValues
+      context n = mkGenericContext a n
+      lats = G.map (\s -> s { summStart = summStart s - t }) latValues
+          where t = summStart . G.head $ latValues
+  tpl <- R.loadTemplate [".",templateDir] template
+  bs <- H.hastacheStr H.defaultConfig tpl context
   L.hPutStr h bs

lib/Network/HTTP/LoadTest/Types.hs

 {-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards,
-    ScopedTypeVariables #-}
+    ScopedTypeVariables, ViewPatterns #-}
 
 module Network.HTTP.LoadTest.Types
     (
     , Basic(..)
     ) where
 
-import Control.Applicative ((<$>), (<*>), empty)
+import Control.Applicative ((<$>), (<*>), pure, empty)
 import Control.Arrow (first)
 import Control.DeepSeq (NFData(rnf))
 import Control.Exception (Exception, IOException, SomeException, try)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.CaseInsensitive as CI
 import qualified Data.Text as T
+import qualified Data.Vector as V
+import qualified Data.Vector.Generic as G
+import qualified Data.Vector.Unboxed as U
 
 newtype Req = Req {
       fromReq :: Request IO
     hash Timeout = 0
     hash HttpResponse{..} = respCode `xor` respContentLength
 
+instance ToJSON Event where
+    toJSON HttpResponse{..} = toJSON (respCode, respContentLength)
+    toJSON Timeout          = "timeout"
+
+instance FromJSON Event where
+    parseJSON (Array (G.toList -> [Number c,Number l])) =
+        pure $ HttpResponse (truncate c) (truncate l)
+    parseJSON (String "timeout") = pure Timeout
+    parseJSON _ = empty
+
 -- | Exception thrown if issuing a HTTP request fails.
 data NetworkError = NetworkError {
       fromNetworkError :: IOException
 summEnd :: Summary -> Double
 summEnd Summary{..} = summStart + summElapsed
 
+instance ToJSON Summary where
+    toJSON Summary{..} = object [
+                           "start" .= summStart
+                         , "elapsed" .= summElapsed
+                         , "event" .= summEvent
+                         ]
+                                  
+instance FromJSON Summary where
+    parseJSON (Object v) = Summary <$>
+                           v .: "start" <*>
+                           v .: "elapsed" <*>
+                           v .: "event"
+    parseJSON _ = empty
+
 data Analysis a = Analysis {
       latency :: !a
     , latency99 :: !Double
     , latency999 :: !Double
+    , latValues :: V.Vector Summary
     , throughput :: !a
     , throughput10 :: !Double
+    , thrValues :: U.Vector Double
     } deriving (Eq, Show, Typeable, Data)
 
 instance (NFData a) => NFData (Analysis a) where
                             "latency" .= latency
                           , "latency99" .= latency99
                           , "latency999" .= latency999
+                          , "latValues" .= latValues
                           , "throughput" .= throughput
                           , "throughput10" .= throughput10
+                          , "thrValues" .= thrValues
                           ]
 
 instance (FromJSON a) => FromJSON (Analysis a) where
                            v .: "latency" <*>
                            v .: "latency99" <*>
                            v .: "latency999" <*>
+                           v .: "latValues" <*>
                            v .: "throughput" <*>
-                           v .: "throughput10"
+                           v .: "throughput10" <*>
+                           v .: "thrValues"
     parseJSON _ = empty
     servers/ping/ping-servers.cabal
     servers/ping/src/*.hs
 
+data-files:
+  templates/report.tpl
+
 flag developer
   description: operate in developer mode
   default: False

templates/basic.tpl

+lat: {{latency.mean}}
+values:
+{{#latValues}}
+  {{summStart}}
+{{/latValues}}
+thr:
+{{#thrValues}}
+  {{x}}
+{{/thrValues}}

templates/report.tpl

+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<html>
+ <head>
+    <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+    <title>criterion report</title>
+    <!--[if lte IE 8]>
+      <script language="javascript" type="text/javascript">
+        {{#include}}js/excanvas-r3.min.js{{/include}}
+      </script>
+    <![endif]-->
+    <script language="javascript" type="text/javascript">
+      {{#include}}js/jquery-1.6.4.min.js{{/include}}
+    </script>
+    <script language="javascript" type="text/javascript">
+      {{#include}}js/jquery.flot-0.7.min.js{{/include}}
+    </script>
+    <script language="javascript" type="text/javascript">
+      {{#include}}js/jquery.criterion.js{{/include}}
+    </script>
+    <style type="text/css">
+{{#include}}criterion.css{{/include}}
+</style>
+ </head>
+    <body>
+      <div class="body">
+    <h1>criterion performance measurements</h1>
+
+<h2>overview</h2>
+
+<div id="overview" class="ovchart" style="width:900px;height:100px;"></div>
+
+{{#report}}
+<h2><a name="b{{number}}">{{name}}</a></h2>
+ <table width="100%">
+  <tbody>
+   <tr>
+    <td><div id="kde{{number}}" class="kdechart"
+             style="width:450px;height:278px;"></div></td>
+    <td><div id="time{{number}}" class="timechart"
+             style="width:450px;height:278px;"></div></td>
+  </tbody>
+ </table>
+ <table>
+  <thead class="analysis">
+   <th></th>
+   <th class="cibound"
+       title="{{anMean.estConfidenceLevel}} confidence level">lower bound</th>
+   <th>estimate</th>
+   <th class="cibound"
+       title="{{anMean.estConfidenceLevel}} confidence level">upper bound</th>
+  </thead>
+  <tbody>
+   <tr>
+    <td>Mean execution time</td>
+    <td><span class="citime">{{anMean.estLowerBound}}</span></td>
+    <td><span class="time">{{anMean.estPoint}}</span></td>
+    <td><span class="citime">{{anMean.estUpperBound}}</span></td>
+   </tr>
+   <tr>
+    <td>Standard deviation</td>
+    <td><span class="citime">{{anStdDev.estLowerBound}}</span></td>
+    <td><span class="time">{{anStdDev.estPoint}}</span></td>
+    <td><span class="citime">{{anStdDev.estUpperBound}}</span></td>
+   </tr>
+  </tbody>
+ </table>
+
+ <span class="outliers">
+   <p>Outlying measurements have {{anOutlierVar.ovDesc}}
+     (<span class="percent">{{anOutlierVar.ovFraction}}</span>%)
+     effect on estimated standard deviation.</p>
+ </span>
+{{/report}}
+
+<script type="text/javascript">
+$(function () {
+  function mangulate(number, name, mean, times, kdetimes, kdepdf) {
+    kdetimes = $.scaleTimes(kdetimes)[0];
+    var meanSecs = mean;
+    mean *= $.timeUnits(mean)[0];
+    var ts = $.scaleTimes(times);
+    var units = ts[1];
+    ts = ts[0];
+    var kq = $("#kde" + number);
+    var k = $.plot(kq,
+           [{ label: name + " time densities (" + units + ")",
+              data: $.zip(kdetimes, kdepdf),
+              }],
+           { yaxis: { ticks: false },
+             grid: { hoverable: true, markings: [ { color: '#6fd3fb',
+                     lineWidth: 1.5, xaxis: { from: mean, to: mean } } ] },
+           });
+    var o = k.pointOffset({ x: mean, y: 0});
+    kq.append('<div class="meanlegend" title="' + $.renderTime(meanSecs) +
+              '" style="position:absolute;left:' + (o.left + 4) +
+              'px;bottom:139px;">mean</div>');
+    var timepairs = new Array(ts.length);
+    for (var i = 0; i < ts.length; i++)
+      timepairs[i] = [ts[i],i];
+    $.plot($("#time" + number),
+           [{ label: name + " times (" + units + ")",
+              data: timepairs }],
+           { points: { show: true },
+             grid: { hoverable: true },
+             xaxis: { min: kdetimes[0], max: kdetimes[kdetimes.length-1] },
+             yaxis: { ticks: false },
+           });
+    $.addTooltip("#kde" + number, function(x,y) { return x + ' ' + units; });
+    $.addTooltip("#time" + number, function(x,y) { return x + ' ' + units; });
+  };
+  {{#report}}
+  mangulate({{number}}, "{{name}}",
+            {{anMean.estPoint}},
+            [{{#times}}{{x}},{{/times}}],
+            [{{#kdetimes}}{{x}},{{/kdetimes}}],
+            [{{#kdepdf}}{{x}},{{/kdepdf}}]);
+  {{/report}}
+
+  var benches = [{{#report}}"{{name}}",{{/report}}];
+  var ylabels = [{{#report}}[-{{number}},'<a href="#b{{number}}">{{name}}</a>'],{{/report}}];
+  var means = $.scaleTimes([{{#report}}{{anMean.estPoint}},{{/report}}]);
+  var xs = [];
+  var prev = null;
+  for (var i = 0; i < means[0].length; i++) {
+    var name = benches[i].split(/\//);
+    name.pop();
+    name = name.join('/');
+    if (name != prev) {
+      xs.push({ label: name, data: [[means[0][i], -i]]});
+      prev = name;
+    }
+    else
+      xs[xs.length-1].data.push([means[0][i],-i]);
+  }
+  var oq = $("#overview");
+  o = $.plot(oq, xs, { bars: { show: true, horizontal: true,
+                               barWidth: 0.75, align: "center" },
+                       grid: { hoverable: true },
+                       legend: { show: xs.length > 1 },
+                       xaxis: { max: Math.max.apply(undefined,means[0]) * 1.02 },
+                       yaxis: { ticks: ylabels, tickColor: '#ffffff' } });
+  if (benches.length > 3)
+    o.getPlaceholder().height(28*benches.length);
+  o.resize();
+  o.setupGrid();
+  o.draw();
+  $.addTooltip("#overview", function(x,y) { return x + ' ' + means[1]; });
+});
+$(document).ready(function () {
+    $(".time").text(function(_, text) {
+        return $.renderTime(text);
+      });
+    $(".citime").text(function(_, text) {
+        return $.renderTime(text);
+      });
+    $(".percent").text(function(_, text) {
+        return (text*100).toFixed(1);
+      });
+  });
+</script>
+
+   </div>
+ </body>
+</html>