Bryan O'Sullivan avatar Bryan O'Sullivan committed b4fa64d

Move the default reporting code into its own module.

It seems likely that clients might want to reuse this code.

Comments (0)

Files changed (3)

 
 import Control.Applicative ((<$>))
 import Control.Monad (forM_, unless)
-import Criterion.Analysis (SampleAnalysis(..), OutlierEffect(..),
-                           OutlierVariance(..))
 import Data.Aeson ((.=), encode, object)
 import Data.Maybe (catMaybes)
-import Data.Monoid (mappend)
-import Data.Text (Text, pack)
-import Data.Text.Buildable (build)
+import Data.Text (pack)
 import Data.Text.Encoding (encodeUtf8)
-import Data.Text.Lazy.Builder (Builder)
-import Network.HTTP.LoadTest (Analysis(..), Basic(..), NetworkError(..),
-                              Req(..))
+import Network.HTTP.LoadTest (NetworkError(..), Req(..))
+import Network.HTTP.LoadTest.Report (reportBasic, reportFull)
 import Network.Socket (withSocketsDo)
-import Statistics.Resampling.Bootstrap (Estimate(..))
 import System.Console.CmdArgs
 import System.Exit (ExitCode(ExitFailure), exitWith)
-import System.IO (hPutStrLn, stderr)
+import System.IO (hPutStrLn, stderr, stdout)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Text.Format as T
   run <- LoadTest.run cfg
   case run of
     Left [NetworkError err] ->
-      T.hprint stderr "Error: {}" [show err] >> exitWith (ExitFailure 1)
+      T.hprint stderr "Error: {}\n" [show err] >> exitWith (ExitFailure 1)
     Left errs -> do
       T.hprint stderr "Errors:\n" ()
       forM_ errs $ \(NetworkError err) -> T.hprint stderr "  {}\n" [show err]
         Just "-" -> L.putStrLn (encode dump)
         Just f   -> L.writeFile f (encode dump)
         _        -> return ()
-      whenNormal $ either reportBasic reportFull analysis
+      whenNormal $ either (reportBasic stdout) (reportFull whenLoud stdout)
+                   analysis
 
 validateArgs :: Args -> IO ()
 validateArgs Args{..} = do
 createRequest :: Args -> IO (E.Request IO)
 createRequest Args{..} = do
   req0 <- E.parseUrl url
-  let check Nothing = return "POST"
+  let check Nothing       = return "POST"
       check (Just "POST") = return "POST"
       check (Just "PUT")  = return "PUT"
       check _      = do
     _ -> do
       hPutStrLn stderr "Error: --literal and --from-file are mutually exclusive"
       exitWith (ExitFailure 1)
-
-reportBasic :: Analysis Basic -> IO ()
-reportBasic Analysis{..} = do
-  T.print "latency:\n" ()
-  T.print "    mean:    {}\n" [time (mean latency)]
-  T.print "    std dev: {}\n" [time (stdDev latency)]
-  T.print "    99%:     {}\n    99.9%:   {}\n" (time latency99, time latency999)
-  T.print "\nthroughput:\n" ()
-  T.print "    mean:    {} req/sec\n" [mean throughput]
-  T.print "    std dev: {} req/sec\n" [stdDev throughput]
-  T.print "    10%:     {} req/sec\n" [throughput10]
-
-
-reportFull :: Analysis SampleAnalysis -> IO ()
-reportFull Analysis{..} = do
-  T.print "latency:\n" ()
-  T.print "    mean:    {}\n" [time (estPoint (anMean latency))]
-  whenLoud $ do
-    T.print "      lower: {}\n" [time (estLowerBound (anMean latency))]
-    T.print "      upper: {}\n" [time (estUpperBound (anMean latency))]
-  T.print "    std dev: {}\n" [time (estPoint (anStdDev latency))]
-  whenLoud $ do
-    T.print "      lower: {}\n" [time (estLowerBound (anStdDev latency))]
-    T.print "      upper: {}\n" [time (estUpperBound (anStdDev latency))]
-  effect (anOutliers latency)
-  T.print "    99%:     {}\n    99.9%:   {}\n" (time latency99, time latency999)
-  T.print "\nthroughput:\n" ()
-  T.print "    mean:    {} req/sec\n" [estPoint (anMean throughput)]
-  whenLoud $ do
-    T.print "      lower: {} req/sec\n" [estLowerBound (anMean throughput)]
-    T.print "      upper: {} req/sec\n" [estUpperBound (anMean throughput)]
-  T.print "    std dev: {} req/sec\n" [estPoint (anStdDev throughput)]
-  whenLoud $ do
-    T.print "      lower: {} req/sec\n" [estLowerBound (anStdDev throughput)]
-    T.print "      upper: {} req/sec\n" [estUpperBound (anStdDev throughput)]
-  effect (anOutliers throughput)
-  T.print "    10%:     {} req/sec\n" [throughput10]
-
-time :: Double -> Builder
-time t
-     | t < 1e-3  = build (t * 1e6) `mappend` " usec"
-     | t < 1     = build (t * 1e3) `mappend` " msec"
-     | otherwise = build t `mappend` " sec"
-
-effect :: OutlierVariance -> IO ()
-effect OutlierVariance{..} =
-    case ovEffect of
-      Unaffected -> return ()
-      _ -> T.print "    estimates {} affected by outliers ({}%)\n"
-           (howMuch, T.fixed 1 (ovFraction * 100))
-    where howMuch = case ovEffect of
-                      Unaffected -> "not" :: Text
-                      Slight     -> "slightly"
-                      Moderate   -> "moderately"
-                      Severe     -> "severely"

lib/Network/HTTP/LoadTest/Report.hs

+{-# LANGUAGE OverloadedStrings, RecordWildCards, RelaxedPolyRec #-}
+
+module Network.HTTP.LoadTest.Report
+    (
+      reportBasic
+    , reportFull
+    ) where
+
+import Criterion.Analysis (SampleAnalysis(..), OutlierEffect(..),
+                           OutlierVariance(..))
+import Data.Monoid (mappend)
+import Data.Text (Text)
+import Data.Text.Buildable (build)
+import Data.Text.Lazy.Builder (Builder)
+import Network.HTTP.LoadTest.Types (Analysis(..), Basic(..))
+import Prelude hiding (print)
+import Statistics.Resampling.Bootstrap (Estimate(..))
+import System.IO (Handle)
+import qualified Data.Text.Format as T
+
+reportBasic :: Handle -> Analysis Basic -> IO ()
+reportBasic h Analysis{..} = do
+  let print a b = T.hprint h a b
+  print "latency:\n" ()
+  print "    mean:    {}\n" [time (mean latency)]
+  print "    std dev: {}\n" [time (stdDev latency)]
+  print "    99%:     {}\n    99.9%:   {}\n" (time latency99, time latency999)
+  print "\nthroughput:\n" ()
+  print "    mean:    {} req/sec\n" [mean throughput]
+  print "    std dev: {} req/sec\n" [stdDev throughput]
+  print "    10%:     {} req/sec\n" [throughput10]
+
+reportFull :: (IO () -> IO ()) -> Handle -> Analysis SampleAnalysis -> IO ()
+reportFull whenLoud h Analysis{..} = do
+  let print a b = T.hprint h a b
+  print "latency:\n" ()
+  print "    mean:    {}\n" [time (estPoint (anMean latency))]
+  whenLoud $ do
+    print "      lower: {}\n" [time (estLowerBound (anMean latency))]
+    print "      upper: {}\n" [time (estUpperBound (anMean latency))]
+  print "    std dev: {}\n" [time (estPoint (anStdDev latency))]
+  whenLoud $ do
+    print "      lower: {}\n" [time (estLowerBound (anStdDev latency))]
+    print "      upper: {}\n" [time (estUpperBound (anStdDev latency))]
+  effect h (anOutliers latency)
+  print "    99%:     {}\n    99.9%:   {}\n" (time latency99, time latency999)
+  print "\nthroughput:\n" ()
+  print "    mean:    {} req/sec\n" [estPoint (anMean throughput)]
+  whenLoud $ do
+    print "      lower: {} req/sec\n" [estLowerBound (anMean throughput)]
+    print "      upper: {} req/sec\n" [estUpperBound (anMean throughput)]
+  print "    std dev: {} req/sec\n" [estPoint (anStdDev throughput)]
+  whenLoud $ do
+    print "      lower: {} req/sec\n" [estLowerBound (anStdDev throughput)]
+    print "      upper: {} req/sec\n" [estUpperBound (anStdDev throughput)]
+  effect h (anOutliers throughput)
+  print "    10%:     {} req/sec\n" [throughput10]
+
+time :: Double -> Builder
+time t
+     | t < 1e-3  = build (t * 1e6) `mappend` " usec"
+     | t < 1     = build (t * 1e3) `mappend` " msec"
+     | otherwise = build t `mappend` " sec"
+
+effect :: Handle -> OutlierVariance -> IO ()
+effect h OutlierVariance{..} =
+    case ovEffect of
+      Unaffected -> return ()
+      _ -> T.hprint h "    estimates {} affected by outliers ({}%)\n"
+           (howMuch, T.fixed 1 (ovFraction * 100))
+    where howMuch = case ovEffect of
+                      Unaffected -> "not" :: Text
+                      Slight     -> "slightly"
+                      Moderate   -> "moderately"
+                      Severe     -> "severely"
   hs-source-dirs: lib
   exposed-modules:
     Network.HTTP.LoadTest
+    Network.HTTP.LoadTest.Report
     Network.HTTP.LoadTest.Types
 
   ghc-options: -Wall
     http-types,
     statistics,
     text,
+    text-format,
     time,
     vector,
     vector-algorithms
     http-enumerator,
     pronk,
     network,
-    statistics,
     text,
     text-format
 
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.