Commits

Bryan O'Sullivan committed d43d6ed

Add support for reporting a summary of event types.

Comments (0)

Files changed (4)

 import Data.Text (pack)
 import Data.Text.Encoding (encodeUtf8)
 import Network.HTTP.LoadTest (NetworkError(..), Req(..))
-import Network.HTTP.LoadTest.Report (reportBasic, reportFull)
+import Network.HTTP.LoadTest.Report (reportBasic, reportEvents, reportFull)
 import Network.Socket (withSocketsDo)
 import System.Console.CmdArgs
 import System.Exit (ExitCode(ExitFailure), exitWith)
         Just "-" -> L.putStrLn (encode dump)
         Just f   -> L.writeFile f (encode dump)
         _        -> return ()
-      whenNormal $ either (reportBasic stdout) (reportFull whenLoud stdout)
-                   analysis
+      whenNormal $ do
+        reportEvents stdout results
+        either (reportBasic stdout) (reportFull whenLoud stdout)
+               analysis
 
 validateArgs :: Args -> IO ()
 validateArgs Args{..} = do

lib/Network/HTTP/LoadTest/Report.hs

 module Network.HTTP.LoadTest.Report
     (
       reportBasic
+    , reportEvents
     , reportFull
     ) where
 
+import Control.Monad (forM_)
 import Criterion.Analysis (SampleAnalysis(..), OutlierEffect(..),
                            OutlierVariance(..))
+import Data.List (sort)
 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 Data.Vector (Vector)
+import Network.HTTP.LoadTest.Types (Analysis(..), Basic(..), Event(..),
+                                    Summary(..))
 import Prelude hiding (print)
 import Statistics.Resampling.Bootstrap (Estimate(..))
 import System.IO (Handle)
+import qualified Data.HashMap.Strict as H
 import qualified Data.Text.Format as T
+import qualified Data.Vector.Generic as G
 
 reportBasic :: Handle -> Analysis Basic -> IO ()
 reportBasic h Analysis{..} = do
                       Slight     -> "slightly"
                       Moderate   -> "moderately"
                       Severe     -> "severely"
+
+reportEvents :: Handle -> Vector Summary -> IO ()
+reportEvents h sumv = do
+  let evtMap = G.foldl' go H.empty . G.map summEvent $ sumv
+      go m e = H.insertWith (+) (classify e) (1::Int) m
+      classify Timeout          = 0
+      classify HttpResponse{..} = respCode
+  T.hprint h "responses:\n" ()
+  forM_ (sort . H.toList $ evtMap) $ \(e,n) -> do
+    let nameOf 0 = "timeout "
+        nameOf k = "HTTP " `mappend` build k
+    T.hprint h "    {} {}\n" (nameOf e, T.left 6 ' ' n)
+  T.hprint h "\n" ()

lib/Network/HTTP/LoadTest/Types.hs

 import Control.Arrow (first)
 import Control.Exception (Exception, IOException, SomeException, try)
 import Data.Aeson.Types (Value(..), FromJSON(..), ToJSON(..), (.:), (.=), object)
+import Data.Bits (xor)
 import Data.Data (Data)
+import Data.Hashable (Hashable(hash))
 import Data.Typeable (Typeable)
 import Network.HTTP.Enumerator (Request(..), parseUrl)
 import Network.HTTP.Types (renderQuery)
       respCode :: {-# UNPACK #-} !Int
     , respContentLength :: {-# UNPACK #-} !Int
     } | Timeout
-    deriving (Eq, Read, Show, Typeable, Data)
+    deriving (Eq, Ord, Read, Show, Typeable, Data)
+
+instance Hashable Event where
+    hash Timeout = 0
+    hash HttpResponse{..} = respCode `xor` respContentLength
 
 -- | Exception thrown if issuing a HTTP request fails.
 data NetworkError = NetworkError {
 instance Exception NetworkError
 
 data Summary = Summary {
-      summEvent :: Event
+      summStart :: {-# UNPACK #-} !Double
     , summElapsed :: {-# UNPACK #-} !Double
-    , summStart :: {-# UNPACK #-} !Double
-    } deriving (Eq, Read, Show, Typeable, Data)
+    , summEvent :: Event
+    } deriving (Eq, Ord, Read, Show, Typeable, Data)
 
 summEnd :: Summary -> Double
 summEnd Summary{..} = summStart + summElapsed
     bytestring,
     case-insensitive,
     criterion >= 0.5.1.0,
+    hashable >= 1.1.2.0,
     http-enumerator,
     http-types,
     statistics,
     text,
     text-format,
     time,
+    unordered-containers >= 0.1.4.0,
     vector,
     vector-algorithms