{-# LANGUAGE BangPatterns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} -- | -- Module : Gauge.Benchmark -- Copyright : (c) 2009-2014 Bryan O'Sullivan -- -- License : BSD-style -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : GHC -- -- Constructing and running benchmarks. module Gauge.Benchmark ( -- * Evaluating IO Actions or Pure Functions -- $rnf -- * Benchmarkable -- $bench Benchmarkable(..) -- ** Constructing Benchmarkable , toBenchmarkable -- ** Benchmarking IO actions -- $io , nfIO , whnfIO -- ** Benchmarking pure code -- $pure , nf , whnf -- ** Benchmarking with Environment , perBatchEnv , perBatchEnvWithCleanup , perRunEnv , perRunEnvWithCleanup -- * Benchmarks , Benchmark(..) -- ** Constructing Benchmarks , bench , bgroup -- ** Benchmarks with Environment , env , envWithCleanup -- * Listing benchmarks , benchNames -- * Running Benchmarks , runBenchmark , BenchmarkAnalysis(..) ) where import Control.Applicative import Control.DeepSeq (NFData(rnf)) import Control.Exception (bracket, catch, evaluate, finally) import Control.Monad (foldM, void, when) import Data.Int (Int64) import Data.List (unfoldr) import Gauge.IO.Printf (note, prolix) import Gauge.Main.Options (Config(..), Verbosity(..)) import Gauge.Measurement (measure, getTime, secs, Measured(..)) import Gauge.Monad (Gauge, finallyGauge, askConfig, gaugeIO) import Gauge.Time (MilliSeconds(..), milliSecondsToDouble, microSecondsToDouble) import qualified Gauge.CSV as CSV import qualified Gauge.Optional as Optional import System.Directory (canonicalizePath, getTemporaryDirectory, removeFile) import System.IO (hClose, openTempFile) import System.Mem (performGC) import qualified Data.Vector as V import System.Process (callProcess) import Prelude -- $rnf -- -- To benchmark, an IO action or a pure function must be evaluated to weak head -- normal form (WHNF) or normal form NF. This library provides APIs to reduce -- IO actions or pure functions to WHNF (e.g. 'whnf' and 'whnfIO') or NF (e.g. -- 'nf' or 'nfIO'). -- -- Suppose we want to benchmark the following pure function: -- -- @ -- firstN :: Int -> [Int] -- firstN k = take k [(0::Int)..] -- @ -- -- We construct a benchmark evaluating it to NF as follows: -- -- @ -- 'nf' firstN 1000 -- @ -- -- We can also evaluate a pure function to WHNF, however we must remember that -- it only evaluates the result up to, well, WHNF. To naive eyes it might -- /appear/ that the following code ought to benchmark the production of the -- first 1000 list elements: -- -- @ -- 'whnf' firstN 1000 -- @ -- -- Since this forces the expression to only WHNF, what this would /actually/ -- benchmark is merely how long it takes to produce the first list element! ------------------------------------------------------------------------------- -- Constructing benchmarkable ------------------------------------------------------------------------------- -- $bench -- -- A 'Benchmarkable' is the basic type which in turn is used to construct a -- 'Benchmark'. It is a container for code that can be benchmarked. The value -- contained inside a 'Benchmarkable' could be an IO action or a pure function. -- | A pure function or impure action that can be benchmarked. The function to -- be benchmarked is wrapped into a function ('runRepeatedly') that takes an -- 'Int64' parameter which indicates the number of times to run the given -- function or action. The wrapper is constructed automatically by the APIs -- provided in this library to construct 'Benchmarkable'. -- -- When 'perRun' is not set then 'runRepeatedly' is invoked to perform all -- iterations in one measurement interval. When 'perRun' is set, -- 'runRepeatedly' is always invoked with 1 iteration in one measurement -- interval, before a measurement 'allocEnv' is invoked and after the -- measurement 'cleanEnv' is invoked. The performance counters for each -- iteration are then added together for all iterations. data Benchmarkable = forall a . NFData a => Benchmarkable { allocEnv :: Int64 -> IO a , cleanEnv :: Int64 -> a -> IO () , runRepeatedly :: a -> Int64 -> IO () , perRun :: Bool } noop :: Monad m => a -> m () noop = const $ return () {-# INLINE noop #-} -- | This is a low level function to construct a 'Benchmarkable' value from an -- impure wrapper action, where the 'Int64' parameter dictates the number of -- times the action wrapped inside would run. You would normally be using the -- other higher level APIs rather than this function to construct a -- benchmarkable. toBenchmarkable :: (Int64 -> IO ()) -> Benchmarkable toBenchmarkable f = Benchmarkable noop (const noop) (const f) False {-# INLINE toBenchmarkable #-} -- $pure -- -- Benchmarking pure functions is a bit tricky. Because GHC optimises -- aggressively when compiling with @-O@, it is potentially easy to write -- innocent-looking benchmark code that will only be evaluated once, for which -- all but the first iteration of the timing loop will be timing the cost of -- doing nothing. -- -- To work around this, the benchmark applies the function to its argument and -- evaluates the application. Unlike an IO action we need both the function and -- its argument. Therefore, the types of APIs to benchmark a pure function look -- like this: -- -- @ -- 'nf' :: 'NFData' b => (a -> b) -> a -> 'Benchmarkable' -- 'whnf' :: (a -> b) -> a -> 'Benchmarkable' -- @ -- -- As both of these types suggest, when you want to benchmark a -- function, you must supply two values: -- -- * The first element is the function, saturated with all but its -- last argument. -- -- * The second element is the last argument to the function. -- pureFunc :: (b -> c) -> (a -> b) -> a -> Benchmarkable pureFunc reduce f0 x0 = toBenchmarkable (go f0 x0) where go f x n | n <= 0 = return () | otherwise = evaluate (reduce (f x)) >> go f x (n-1) {-# INLINE pureFunc #-} -- | Apply an argument to a function, and evaluate the result to weak -- head normal form (WHNF). whnf :: (a -> b) -> a -> Benchmarkable whnf = pureFunc id {-# INLINE whnf #-} -- | Apply an argument to a function, and evaluate the result to -- normal form (NF). nf :: NFData b => (a -> b) -> a -> Benchmarkable nf = pureFunc rnf {-# INLINE nf #-} -- $io -- -- Benchmarking an 'IO' action is straightforward compared to benchmarking pure -- code. An 'IO' action resembling type @IO a@ can be turned into a -- 'Benchmarkable' using 'nfIO' to reduce it to normal form or using 'whnfIO' -- to reduce it to WHNF. impure :: (a -> b) -> IO a -> Int64 -> IO () impure strategy a = go where go n | n <= 0 = return () | otherwise = a >>= (evaluate . strategy) >> go (n-1) {-# INLINE impure #-} -- | Perform an action, then evaluate its result to normal form. -- This is particularly useful for forcing a lazy 'IO' action to be -- completely performed. nfIO :: NFData a => IO a -> Benchmarkable nfIO = toBenchmarkable . impure rnf {-# INLINE nfIO #-} -- | Perform an action, then evaluate its result to weak head normal -- form (WHNF). This is useful for forcing an 'IO' action whose result -- is an expression to be evaluated down to a more useful value. whnfIO :: IO a -> Benchmarkable whnfIO = toBenchmarkable . impure id {-# INLINE whnfIO #-} ------------------------------------------------------------------------------- -- Constructing Benchmarkable with Environment ------------------------------------------------------------------------------- -- | Same as `perBatchEnv`, but but allows for an additional callback -- to clean up the environment. Resource clean up is exception safe, that is, -- it runs even if the 'Benchmark' throws an exception. perBatchEnvWithCleanup :: (NFData env, NFData b) => (Int64 -> IO env) -- ^ Create an environment for a batch of N runs. The environment will be -- evaluated to normal form before running. -> (Int64 -> env -> IO ()) -- ^ Clean up the created environment. -> (env -> IO b) -- ^ Function returning the IO action that should be benchmarked with the -- newly generated environment. -> Benchmarkable perBatchEnvWithCleanup alloc clean work = Benchmarkable alloc clean (impure rnf . work) False -- | Create a Benchmarkable where a fresh environment is allocated for every -- batch of runs of the benchmarkable. -- -- The environment is evaluated to normal form before the benchmark is run. -- -- When using 'whnf', 'whnfIO', etc. Gauge creates a 'Benchmarkable' -- whichs runs a batch of @N@ repeat runs of that expressions. Gauge may -- run any number of these batches to get accurate measurements. Environments -- created by 'env' and 'envWithCleanup', are shared across all these batches -- of runs. -- -- This is fine for simple benchmarks on static input, but when benchmarking -- IO operations where these operations can modify (and especially grow) the -- environment this means that later batches might have their accuracy effected -- due to longer, for example, longer garbage collection pauses. -- -- An example: Suppose we want to benchmark writing to a Chan, if we allocate -- the Chan using environment and our benchmark consists of @writeChan env ()@, -- the contents and thus size of the Chan will grow with every repeat. If -- Gauge runs a 1,000 batches of 1,000 repeats, the result is that the -- channel will have 999,000 items in it by the time the last batch is run. -- Since GHC GC has to copy the live set for every major GC this means our last -- set of writes will suffer a lot of noise of the previous repeats. -- -- By allocating a fresh environment for every batch of runs this function -- should eliminate this effect. perBatchEnv :: (NFData env, NFData b) => (Int64 -> IO env) -- ^ Create an environment for a batch of N runs. The environment will be -- evaluated to normal form before running. -> (env -> IO b) -- ^ Function returning the IO action that should be benchmarked with the -- newly generated environment. -> Benchmarkable perBatchEnv alloc = perBatchEnvWithCleanup alloc (const noop) -- | Same as `perRunEnv`, but but allows for an additional callback -- to clean up the environment. Resource clean up is exception safe, that is, -- it runs even if the 'Benchmark' throws an exception. perRunEnvWithCleanup :: (NFData env, NFData b) => IO env -- ^ Action that creates the environment for a single run. -> (env -> IO ()) -- ^ Clean up the created environment. -> (env -> IO b) -- ^ Function returning the IO action that should be benchmarked with the -- newly genereted environment. -> Benchmarkable perRunEnvWithCleanup alloc clean work = bm { perRun = True } where bm = perBatchEnvWithCleanup (const alloc) (const clean) work -- | Create a Benchmarkable where a fresh environment is allocated for every -- run of the operation to benchmark. This is useful for benchmarking mutable -- operations that need a fresh environment, such as sorting a mutable Vector. -- -- As with 'env' and 'perBatchEnv' the environment is evaluated to normal form -- before the benchmark is run. -- -- This introduces extra noise and result in reduce accuracy compared to other -- Gauge benchmarks. But allows easier benchmarking for mutable operations -- than was previously possible. perRunEnv :: (NFData env, NFData b) => IO env -- ^ Action that creates the environment for a single run. -> (env -> IO b) -- ^ Function returning the IO action that should be benchmarked with the -- newly genereted environment. -> Benchmarkable perRunEnv alloc = perRunEnvWithCleanup alloc noop ------------------------------------------------------------------------------- -- Constructing benchmarks ------------------------------------------------------------------------------- -- | Specification of a collection of benchmarks and environments. A -- benchmark may consist of: -- -- * An environment that creates input data for benchmarks, created -- with 'env'. -- -- * A single 'Benchmarkable' item with a name, created with 'bench'. -- -- * A (possibly nested) group of 'Benchmark's, created with 'bgroup'. data Benchmark where Environment :: NFData env => IO env -> (env -> IO a) -> (env -> Benchmark) -> Benchmark Benchmark :: String -> Benchmarkable -> Benchmark BenchGroup :: String -> [Benchmark] -> Benchmark instance Show Benchmark where show (Environment _ _ b) = "Environment _ _" ++ show (b undefined) show (Benchmark d _) = "Benchmark " ++ show d show (BenchGroup d _) = "BenchGroup " ++ show d -- | Create a single benchmark. bench :: String -- ^ A name to identify the benchmark. -> Benchmarkable -- ^ An activity to be benchmarked. -> Benchmark bench = Benchmark -- | Group several benchmarks together under a common name. bgroup :: String -- ^ A name to identify the group of benchmarks. -> [Benchmark] -- ^ Benchmarks to group under this name. -> Benchmark bgroup = BenchGroup ------------------------------------------------------------------------------- -- Constructing Benchmarks with Environment ------------------------------------------------------------------------------- -- | Run a benchmark (or collection of benchmarks) in the given -- environment. The purpose of an environment is to lazily create -- input data to pass to the functions that will be benchmarked. -- -- A common example of environment data is input that is read from a -- file. Another is a large data structure constructed in-place. -- -- By deferring the creation of an environment when its associated -- benchmarks need the its, we avoid two problems that this strategy -- caused: -- -- * Memory pressure distorted the results of unrelated benchmarks. -- If one benchmark needed e.g. a gigabyte-sized input, it would -- force the garbage collector to do extra work when running some -- other benchmark that had no use for that input. Since the data -- created by an environment is only available when it is in scope, -- it should be garbage collected before other benchmarks are run. -- -- * The time cost of generating all needed inputs could be -- significant in cases where no inputs (or just a few) were really -- needed. This occurred often, for instance when just one out of a -- large suite of benchmarks was run, or when a user would list the -- collection of benchmarks without running any. -- -- __Creation.__ An environment is created right before its related -- benchmarks are run. The 'IO' action that creates the environment -- is run, then the newly created environment is evaluated to normal -- form (hence the 'NFData' constraint) before being passed to the -- function that receives the environment. -- -- __Complex environments.__ If you need to create an environment that -- contains multiple values, simply pack the values into a tuple. -- -- __Lazy pattern matching.__ In situations where a \"real\" -- environment is not needed, e.g. if a list of benchmark names is -- being generated, @undefined@ will be passed to the function that -- receives the environment. This avoids the overhead of generating -- an environment that will not actually be used. -- -- The function that receives the environment must use lazy pattern -- matching to deconstruct the tuple, as use of strict pattern -- matching will cause a crash if @undefined@ is passed in. -- -- __Example.__ This program runs benchmarks in an environment that -- contains two values. The first value is the contents of a text -- file; the second is a string. Pay attention to the use of a lazy -- pattern to deconstruct the tuple in the function that returns the -- benchmarks to be run. -- -- > setupEnv = do -- > let small = replicate 1000 (1 :: Int) -- > big <- map length . words <$> readFile "/usr/dict/words" -- > return (small, big) -- > -- > main = defaultMain [ -- > -- notice the lazy pattern match here! -- > env setupEnv $ \ ~(small,big) -> bgroup "main" [ -- > bgroup "small" [ -- > bench "length" $ whnf length small -- > , bench "length . filter" $ whnf (length . filter (==1)) small -- > ] -- > , bgroup "big" [ -- > bench "length" $ whnf length big -- > , bench "length . filter" $ whnf (length . filter (==1)) big -- > ] -- > ] ] -- -- __Discussion.__ The environment created in the example above is -- intentionally /not/ ideal. As Haskell's scoping rules suggest, the -- variable @big@ is in scope for the benchmarks that use only -- @small@. It would be better to create a separate environment for -- @big@, so that it will not be kept alive while the unrelated -- benchmarks are being run. env :: NFData env => IO env -- ^ Create the environment. The environment will be evaluated to -- normal form before being passed to the benchmark. -> (env -> Benchmark) -- ^ Take the newly created environment and make it available to -- the given benchmarks. -> Benchmark env alloc = Environment alloc noop -- | Same as `env`, but but allows for an additional callback -- to clean up the environment. Resource clean up is exception safe, that is, -- it runs even if the 'Benchmark' throws an exception. envWithCleanup :: NFData env => IO env -- ^ Create the environment. The environment will be evaluated to -- normal form before being passed to the benchmark. -> (env -> IO a) -- ^ Clean up the created environment. -> (env -> Benchmark) -- ^ Take the newly created environment and make it available to -- the given benchmarks. -> Benchmark envWithCleanup = Environment ------------------------------------------------------------------------------- -- Listing Benchmarks ------------------------------------------------------------------------------- -- | Add the given prefix to a name. If the prefix is empty, the name -- is returned unmodified. Otherwise, the prefix and name are -- separated by a @\'\/\'@ character. addPrefix :: String -- ^ Prefix. -> String -- ^ Name. -> String addPrefix "" desc = desc addPrefix pfx desc = pfx ++ '/' : desc -- | Retrieve the names of all benchmarks. Grouped benchmarks are -- prefixed with the name of the group they're in. benchNames :: Benchmark -> [String] benchNames (Environment _ _ b) = benchNames (b undefined) benchNames (Benchmark d _) = [d] benchNames (BenchGroup d bs) = map (addPrefix d) . concatMap benchNames $ bs ------------------------------------------------------------------------------- -- Running benchmarkable ------------------------------------------------------------------------------- -- | Take a 'Benchmarkable', number of iterations, a function to combine the -- results of multiple iterations and a measurement function to measure the -- stats over a number of iterations. iterateBenchmarkable :: Benchmarkable -> Int64 -> (a -> a -> a) -> (IO () -> IO a) -> IO a iterateBenchmarkable Benchmarkable{..} i comb f | perRun = work >>= go (i - 1) | otherwise = work where go 0 result = return result go !n !result = work >>= go (n - 1) . comb result count | perRun = 1 | otherwise = i work = do env0 <- allocEnv count let clean = cleanEnv count env0 run = runRepeatedly env0 count clean `seq` run `seq` evaluate $ rnf env0 performGC f run `finally` clean <* performGC {-# INLINE work #-} {-# INLINE iterateBenchmarkable #-} iterateBenchmarkable_ :: Benchmarkable -> Int64 -> IO () iterateBenchmarkable_ bm i = iterateBenchmarkable bm i (\() () -> ()) id {-# INLINE iterateBenchmarkable_ #-} series :: Double -> Maybe (Int64, Double) series k = Just (truncate l, l) where l = k * 1.05 -- Our series starts its growth very slowly when we begin at 1, so we -- eliminate repeated values. squish :: (Eq a) => [a] -> [a] squish ys = foldr go [] ys where go x xs = x : dropWhile (==x) xs -- | Run a single benchmark, and return measurements collected while executing -- it, along with the amount of time the measurement process took. The -- benchmark will not terminate until we reach all the minimum bounds -- specified. If the minimum bounds are satisfied, the benchmark will terminate -- as soon as we reach any of the maximums. runBenchmarkable' :: Benchmarkable -> MilliSeconds -- ^ Minimum sample duration in ms. -> Int -- ^ Minimum number of samples. -> Double -- ^ Upper bound on how long the benchmarking process -- should take. -> IO (V.Vector Measured, Double, Int64) runBenchmarkable' bm minDuration minSamples timeLimit = do start <- performGC >> getTime let loop [] !_ _ = error "unpossible!" loop (iters:niters) iTotal acc = do endTime <- getTime if length acc >= minSamples && endTime - start >= timeLimit then do let !v = V.reverse (V.fromList acc) return (v, endTime - start, iTotal) else do m <- measure (iterateBenchmarkable bm iters) iters if measTime m >= milliSecondsToDouble minDuration then loop niters (iTotal + iters) (m:acc) else loop niters (iTotal + iters) (acc) loop (squish (unfoldr series 1)) 0 [] withSystemTempFile :: String -- ^ File name template -> (FilePath -> IO a) -- ^ Callback that can use the file -> IO a withSystemTempFile template action = do tmpDir <- getTemporaryDirectory >>= canonicalizePath withTempFile tmpDir where withTempFile tmpDir = bracket (openTempFile tmpDir template >>= \(f, h) -> hClose h >> return f) (\name -> ignoringIOErrors (removeFile name)) (action) ignoringIOErrors act = act `catch` (\e -> const (return ()) (e :: IOError)) bmTimeLimit :: Config -> Double bmTimeLimit Config {..} = maybe (if quickMode then 0 else 5) id timeLimit bmMinSamples :: Config -> Int bmMinSamples Config {..} = maybe (if quickMode then 1 else 10) id minSamples -- | Run a single benchmark measurement in a separate process. runBenchmarkIsolated :: Config -> String -> String -> IO (V.Vector Measured) runBenchmarkIsolated cfg prog desc = withSystemTempFile "gauge-quarantine" $ \file -> do -- XXX This is dependent on option names, if the option names change this -- will break. let MilliSeconds ms = minDuration cfg callProcess prog ([ "--time-limit", show (bmTimeLimit cfg) , "--min-duration", show ms , "--min-samples", show (bmMinSamples cfg) , "--measure-only", file, desc ] ++ if (quickMode cfg) then ["--quick"] else []) meas <- readFile file >>= return . read writeMeas (csvRawFile cfg) desc meas return meas -- | Run a single benchmarkable and return the result. runBenchmarkable :: String -> Benchmarkable -> Gauge (V.Vector Measured) runBenchmarkable desc bm = do cfg@Config{..} <- askConfig case measureWith of Just prog -> gaugeIO $ runBenchmarkIsolated cfg prog desc Nothing -> gaugeIO $ runNormal cfg where runNormal cfg@Config{..} = do _ <- note "benchmarking %s ... " desc i0 <- if includeFirstIter then return 0 else iterateBenchmarkable_ bm 1 >> return 1 let limit = bmTimeLimit cfg (meas, timeTaken, i) <- runBenchmarkable' bm minDuration (bmMinSamples cfg) limit when ((verbosity == Verbose || not quickMode) && timeTaken > limit * 1.25) . void $ prolix "took %s, total %d iterations\n" (secs timeTaken) (i0 + i) writeMeas csvRawFile desc meas return meas writeMeas :: Maybe FilePath -> String -> V.Vector Measured -> IO () writeMeas fp desc meas = V.forM_ meas $ \m -> CSV.write fp $ CSV.Row [ CSV.string $ desc , CSV.integral $ measIters m , CSV.float $ measTime m , CSV.integral $ measCycles m , CSV.float $ measCpuTime m , opt (CSV.float . microSecondsToDouble) $ measUtime m , opt (CSV.float . microSecondsToDouble) $ measStime m , opt CSV.integral $ measMaxrss m , opt CSV.integral $ measMinflt m , opt CSV.integral $ measMajflt m , opt CSV.integral $ measNvcsw m , opt CSV.integral $ measNivcsw m , opt CSV.integral $ measAllocated m , opt CSV.integral $ measNumGcs m , opt CSV.integral $ measBytesCopied m , opt CSV.float $ measMutatorWallSeconds m , opt CSV.float $ measMutatorCpuSeconds m , opt CSV.float $ measGcWallSeconds m , opt CSV.float $ measGcCpuSeconds m ] where -- an optional CSV field is either the empty string or the normal field value opt :: Optional.OptionalTag a => (a -> CSV.Field) -> Optional.Optional a -> CSV.Field opt f = maybe (CSV.string "") f . Optional.toMaybe ------------------------------------------------------------------------------- -- Running benchmarks ------------------------------------------------------------------------------- -- | The function to run after measurement data BenchmarkAnalysis = forall a . BenchmarkNormal (String -> V.Vector Measured -> Gauge a) | BenchmarkIters Int64 -- | Run benchmarkables, selected by a given selector function, under a given -- benchmark and analyse the output using the given analysis function. runBenchmark :: (String -> Bool) -- ^ Select benchmarks by name. -> Benchmark -> BenchmarkAnalysis -- ^ Analysis function -> Gauge () runBenchmark selector bs analyse = for selector bs $ \_idx desc bm -> case analyse of BenchmarkNormal step -> runBenchmarkable desc bm >>= step desc >>= \_ -> return () BenchmarkIters iters -> do _ <- note "benchmarking %s\r" desc gaugeIO $ iterateBenchmarkable_ bm iters -- | Iterate over benchmarks. for :: (String -> Bool) -> Benchmark -> (Int -> String -> Benchmarkable -> Gauge ()) -> Gauge () for select bs0 handle = go (0::Int) ("", bs0) >> return () where go !idx (pfx, Environment mkenv cleanenv mkbench) | shouldRun pfx mkbench = do e <- gaugeIO $ do ee <- mkenv evaluate (rnf ee) return ee go idx (pfx, mkbench e) `finallyGauge` gaugeIO (cleanenv e) | otherwise = return idx go idx (pfx, Benchmark desc b) | select desc' = do handle idx desc' b; return $! idx + 1 | otherwise = return idx where desc' = addPrefix pfx desc go idx (pfx, BenchGroup desc bs) = foldM go idx [(addPrefix pfx desc, b) | b <- bs] shouldRun :: forall a. String -> (a -> Benchmark) -> Bool shouldRun pfx mkbench = any (select . addPrefix pfx) . benchNames . mkbench $ error "Gauge.env could not determine the list of your benchmarks since they force the environment (see the documentation for details)" {- -- | Write summary JUnit file (if applicable) junit :: [Report] -> Gauge () junit rs = do junitOpt <- asks junitFile case junitOpt of Just fn -> liftIO $ writeFile fn msg Nothing -> return () where msg = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" ++ printf "<testsuite name=\"Gauge benchmarks\" tests=\"%d\">\n" (length rs) ++ concatMap single rs ++ "</testsuite>\n" single Report{..} = printf " <testcase name=\"%s\" time=\"%f\" />\n" (attrEsc reportName) (estPoint $ anMean $ reportAnalysis) attrEsc = concatMap esc where esc '\'' = "'" esc '"' = """ esc '<' = "<" esc '>' = ">" esc '&' = "&" esc c = [c] -}