Commits

Bryan O'Sullivan committed 58c8c25

Produce valid CSV (gh-23)

The previous method of dumping out CSV data was a grotesque hack.
This is waaaaay more sane.

Comments (0)

Files changed (4)

Criterion/IO/Printf.hs

     , note
     , printError
     , prolix
-    , summary
+    , writeCsv
     ) where
 
 import Control.Monad (when)
 import Control.Monad.Trans (liftIO)
-import Criterion.Config (Config, Verbosity(..), cfgSummaryFile, cfgVerbosity, fromLJ)
+import Criterion.Config (Config, Verbosity(..), cfgSummaryFile, cfgVerbosity,
+                         fromLJ)
 import Criterion.Monad (Criterion, getConfig, getConfigItem)
 import Data.Monoid (getLast)
 import System.IO (Handle, stderr, stdout)
+import Text.Printf (PrintfArg)
+import qualified Data.ByteString.Lazy as B
+import qualified Data.Csv as Csv
+import qualified Data.Vector.Generic as G
 import qualified Text.Printf (HPrintfType, hPrintf)
-import Text.Printf (PrintfArg)
 
 -- First item is the action to print now, given all the arguments
 -- gathered together so far.  The second item is the function that
 printError :: (CritHPrintfType r) => String -> r
 printError = chPrintf (const True) stderr
 
--- | Add to summary CSV (if applicable)
-summary :: String -> Criterion ()
-summary msg
-  = do sumOpt <- getConfigItem (getLast . cfgSummaryFile)
-       case sumOpt of
-         Just fn -> liftIO $ appendFile fn msg
-         Nothing -> return ()
+-- | Write a record to a CSV file.
+writeCsv :: Csv.ToRecord a => a -> Criterion ()
+writeCsv val = do
+  sumOpt <- getConfigItem (getLast . cfgSummaryFile)
+  case sumOpt of
+    Just fn -> liftIO . B.appendFile fn . Csv.encode . G.singleton $ val
+    Nothing -> return ()

Criterion/Internal.hs

 import Criterion.Config (Config(..), Verbosity(..), fromLJ)
 import Criterion.Environment (Environment(..))
 import Criterion.IO (header, hGetResults)
-import Criterion.IO.Printf (note, prolix, summary)
+import Criterion.IO.Printf (note, prolix, writeCsv)
 import Criterion.Measurement (getTime, runForAtLeast, secs,
                               time_)
 import Criterion.Monad (Criterion, getConfig, getConfigItem)
   return times
 
 -- | Run a single benchmark and analyse its performance.
-runAndAnalyseOne :: Environment -> String -> Benchmarkable
+runAndAnalyseOne :: Environment -> Maybe String -> Benchmarkable
                  -> Criterion (Sample,SampleAnalysis,Outliers)
-runAndAnalyseOne env _desc b = do
-  times <- runBenchmark env b
+runAndAnalyseOne env mdesc bm = do
+  times <- runBenchmark env bm
   ci <- getConfigItem $ fromLJ cfgConfInterval
   numResamples <- getConfigItem $ fromLJ cfgResamples
   _ <- prolix "analysing with %d resamples\n" numResamples
                  Slight -> "slightly inflated"
                  Moderate -> "moderately inflated"
                  Severe -> "severely inflated"
-  bs "mean" anMean
-  summary ","
-  bs "std dev" anStdDev
-  summary "\n"
+  (a,b,c) <- bs "mean" anMean
+  (d,e,f) <- bs "std dev" anStdDev
+  case mdesc of
+    Just desc -> writeCsv (desc,a,b,c,d,e,f)
+    Nothing   -> writeCsv (a,b,c,d,e,f)
   vrb <- getConfigItem $ fromLJ cfgVerbosity
   let out = classifyOutliers times
   when (vrb == Verbose || (ovEffect > Unaffected && vrb > Quiet)) $ do
     _ <- note "variance is %s by outliers\n" wibble
     return ()
   return (times,an,out)
-  where bs :: String -> Estimate -> Criterion ()
-        bs d e = do _ <- note "%s: %s, lb %s, ub %s, ci %.3f\n" d
-                      (secs $ estPoint e)
-                      (secs $ estLowerBound e) (secs $ estUpperBound e)
-                      (estConfidenceLevel e)
-                    summary $ printf "%g,%g,%g"
-                      (estPoint e)
-                      (estLowerBound e) (estUpperBound e)
+  where bs :: String -> Estimate -> Criterion (Double,Double,Double)
+        bs d e = do
+          _ <- note "%s: %s, lb %s, ub %s, ci %.3f\n" d
+               (secs $ estPoint e)
+               (secs $ estLowerBound e) (secs $ estUpperBound e)
+               (estConfidenceLevel e)
+          return (estPoint e, estLowerBound e, estUpperBound e)
 
 
 plotAll :: [Result] -> Criterion ()
 
   let go !k (pfx, Benchmark desc b)
           | p desc'   = do _ <- note "\nbenchmarking %s\n" desc'
-                           summary (show desc' ++ ",") -- String will be quoted
-                           (x,an,out) <- runAndAnalyseOne env desc' b
+                           (x,an,out) <- runAndAnalyseOne env (Just desc') b
                            let result = Single desc' $ Payload x an out
                            liftIO $ L.hPut handle (encode result)
                            return $! k + 1

Criterion/Main.hs

     ) where
 
 import Control.Monad (unless)
-import Control.Monad.Trans (liftIO)
 import Criterion.Internal (runAndAnalyse, runNotAnalyse, prefix)
 import Criterion.Config
 import Criterion.Environment (measureEnvironment)
-import Criterion.IO.Printf (note, printError)
+import Criterion.IO.Printf (note, printError, writeCsv)
 import Criterion.Monad (Criterion, withConfig)
 import Criterion.Types (Benchmarkable(..), Benchmark(..), bench,
                         benchNames, bgroup, nf, nfIO, whnf, whnfIO)
           _ <- note "Benchmarks:\n"
           mapM_ (note "  %s\n") (sort $ concatMap benchNames bs)
         else do
-          case getLast $ cfgSummaryFile cfg of
-            Just fn -> liftIO $ writeFile fn "Name,Mean,MeanLB,MeanUB,Stddev,StddevLB,StddevUB\n"
-            Nothing -> return ()
+          writeCsv ("Name","Mean","MeanLB","MeanUB","Stddev","StddevLB",
+                    "StddevUB")
           env <- measureEnvironment
           prep
           runAndAnalyse shouldRun env bsgroup
     base < 5,
     binary >= 0.6.3.0,
     bytestring >= 0.9 && < 1.0,
+    cassava,
     containers,
     deepseq >= 1.1.0.0,
     directory,