diff --git a/Gauge/IO/Printf.hs b/Gauge/IO/Printf.hs --- a/Gauge/IO/Printf.hs +++ b/Gauge/IO/Printf.hs @@ -9,13 +9,14 @@ -- -- Input and output actions. -{-# LANGUAGE FlexibleInstances, Rank2Types, TypeSynonymInstances #-} +{-# LANGUAGE CPP, FlexibleInstances, Rank2Types, TypeSynonymInstances #-} module Gauge.IO.Printf ( CritHPrintfType , note , printError , prolix + , rewindClearLine ) where import Control.Monad (when) @@ -88,3 +89,12 @@ -- | Print an error message. printError :: (CritHPrintfType r) => String -> r printError = chPrintf (const True) stderr + +-- | ansi escape on unix to rewind and clear the line to the end +rewindClearLine :: String +#ifdef mingw32_HOST_OS +rewindClearLine = "\n" +#else +rewindClearLine = "\r\ESC[0K" +#endif + diff --git a/Gauge/Internal.hs b/Gauge/Internal.hs --- a/Gauge/Internal.hs +++ b/Gauge/Internal.hs @@ -24,7 +24,7 @@ import Foundation.Monad.Reader (ask) import Data.Int (Int64) import Gauge.Analysis (analyseSample, noteOutliers) -import Gauge.IO.Printf (note, printError, prolix) +import Gauge.IO.Printf (note, printError, prolix, rewindClearLine) import Gauge.Measurement (runBenchmark, runBenchmarkable_, secs) import Gauge.Monad (Gauge) import Gauge.Monad.ExceptT @@ -32,6 +32,7 @@ import qualified Data.Map as Map import qualified Data.Vector as V import Statistics.Types (Estimate(..),ConfInt(..),confidenceInterval,cl95,confidenceLevel) +import System.IO (hSetBuffering, BufferMode(..), stdout) import Text.Printf (printf) -- | Run a single benchmark. @@ -52,37 +53,44 @@ case erp of Left err -> printError "*** Error: %s\n" err Right rpt@Report{..} -> do - let SampleAnalysis{..} = reportAnalysis - OutlierVariance{..} = anOutlierVar - wibble = case ovEffect of - Unaffected -> "unaffected" :: String - Slight -> "slightly inflated" - Moderate -> "moderately inflated" - Severe -> "severely inflated" - (builtin, others) = splitAt 1 anRegress - let r2 n = printf "%.3f R\178" n - forM_ builtin $ \Regression{..} -> - case Map.lookup "iters" regCoeffs of - Nothing -> return () - Just t -> bs secs "time" t >> bs r2 "" regRSquare - bs secs "mean" anMean - bs secs "std dev" anStdDev - forM_ others $ \Regression{..} -> do - _ <- bs r2 (regResponder ++ ":") regRSquare - forM_ (Map.toList regCoeffs) $ \(prd,val) -> - bs (printf "%.3g") (" " ++ prd) val - --writeCsv - -- (desc, - -- estPoint anMean, fst $ confidenceInterval anMean, snd $ confidenceInterval anMean, - -- estPoint anStdDev, fst $ confidenceInterval anStdDev, snd $ confidenceInterval anStdDev - -- ) - when (verbosity == Verbose || (ovEffect > Slight && verbosity > Quiet)) $ do - when (verbosity == Verbose) $ noteOutliers reportOutliers - _ <- note "variance introduced by outliers: %d%% (%s)\n" - (round (ovFraction * 100) :: Int) wibble - return () - _ <- note "\n" - return (Analysed rpt) + let SampleAnalysis{..} = reportAnalysis + OutlierVariance{..} = anOutlierVar + wibble = printOverallEffect ovEffect + (builtin, others) = splitAt 1 anRegress + case displayMode of + StatsTable -> do + _ <- note "%sbenchmarked %s\n" rewindClearLine desc + let r2 n = printf "%.3f R\178" n + forM_ builtin $ \Regression{..} -> + case Map.lookup "iters" regCoeffs of + Nothing -> return () + Just t -> bs secs "time" t >> bs r2 "" regRSquare + bs secs "mean" anMean + bs secs "std dev" anStdDev + forM_ others $ \Regression{..} -> do + _ <- bs r2 (regResponder ++ ":") regRSquare + forM_ (Map.toList regCoeffs) $ \(prd,val) -> + bs (printf "%.3g") (" " ++ prd) val + --writeCsv + -- (desc, + -- estPoint anMean, fst $ confidenceInterval anMean, snd $ confidenceInterval anMean, + -- estPoint anStdDev, fst $ confidenceInterval anStdDev, snd $ confidenceInterval anStdDev + -- ) + when (verbosity == Verbose || (ovEffect > Slight && verbosity > Quiet)) $ do + when (verbosity == Verbose) $ noteOutliers reportOutliers + _ <- note "variance introduced by outliers: %d%% (%s)\n" + (round (ovFraction * 100) :: Int) wibble + return () + _ <- note "\n" + pure () + Condensed -> do + _ <- note "%s%-40s " rewindClearLine desc + bsSmall secs "mean" anMean + bsSmall secs "( +-" anStdDev + _ <- note ")\n" + pure () + + return (Analysed rpt) where bs :: (Double -> String) -> String -> Estimate ConfInt Double -> Gauge () bs f metric e@Estimate{..} = note "%-20s %-10s (%s .. %s%s)\n" metric @@ -92,8 +100,17 @@ | otherwise = printf ", ci %.3f" (confidenceLevel cl) in str ) + bsSmall :: (Double -> String) -> String -> Estimate ConfInt Double -> Gauge () + bsSmall f metric Estimate{..} = + note "%s %-10s" metric (f estPoint) +printOverallEffect :: OutlierEffect -> String +printOverallEffect Unaffected = "unaffected" +printOverallEffect Slight = "slightly inflated" +printOverallEffect Moderate = "moderately inflated" +printOverallEffect Severe = "severely inflated" + -- | Run a single benchmark and analyse its performance. runAndAnalyseOne :: Int -> String -> Benchmarkable -> Gauge DataRecord runAndAnalyseOne i desc bm = do @@ -113,8 +130,9 @@ --liftIO $ hPutStr handle $ "[ \"" ++ headerRoot ++ "\", " ++ -- "\"" ++ critVersion ++ "\", [ " + liftIO $ hSetBuffering stdout NoBuffering for select bs $ \idx desc bm -> do - _ <- note "benchmarking %s\n" desc + _ <- note "benchmarking %s" desc Analysed _ <- runAndAnalyseOne idx desc bm return () --unless (idx == 0) $ @@ -153,7 +171,7 @@ -> Gauge () runFixedIters iters select bs = for select bs $ \_idx desc bm -> do - _ <- note "benchmarking %s\n" desc + _ <- note "benchmarking %s\r" desc liftIO $ runBenchmarkable_ bm iters -- | Iterate over benchmarks. diff --git a/Gauge/Main/Options.hs b/Gauge/Main/Options.hs --- a/Gauge/Main/Options.hs +++ b/Gauge/Main/Options.hs @@ -22,7 +22,7 @@ import Data.Monoid import Gauge.Analysis (validateAccessors) -import Gauge.Types (Config(..), Verbosity(..), Mode(..), MatchType(..)) +import Gauge.Types (Config(..), Verbosity(..), Mode(..), DisplayMode(..), MatchType(..)) --import Gauge.Types (Config(..), Verbosity(..), measureAccessors, measureKeys, Mode(..), MatchType(..)) import Data.Char (isSpace, toLower) import Data.List (foldl') @@ -50,6 +50,7 @@ , iters = Nothing , match = Prefix , mode = DefaultMode + , displayMode = StatsTable } parseWith :: Config @@ -80,6 +81,7 @@ , Option "m" ["match"] (ReqArg setMatch "MATCH") "How to match benchmark names: prefix, glob, pattern, or ipattern" , Option "l" ["list"] (NoArg $ setMode List) "List benchmarks" , Option "" ["version"] (NoArg $ setMode Version) "Show version info" + , Option "s" ["small"] (NoArg $ setDisplayMode Condensed) "Set benchmark display to the minimum useful information" , Option "h" ["help"] (NoArg $ setMode Help) "Show help" ] where @@ -106,6 +108,7 @@ _ -> optionError ("unknown match type: " <> s) in v { match = m } setMode m v = v { mode = m } + setDisplayMode m v = v { displayMode = m } -- FIXME optionError :: String -> a diff --git a/Gauge/Measurement.hs b/Gauge/Measurement.hs --- a/Gauge/Measurement.hs +++ b/Gauge/Measurement.hs @@ -240,7 +240,11 @@ threshold = 0.03 {-# INLINE threshold #-} -runBenchmarkable :: Benchmarkable -> Int64 -> (a -> a -> a) -> (IO () -> IO a) -> IO a +runBenchmarkable :: Benchmarkable + -> Int64 + -> (a -> a -> a) + -> (IO () -> IO a) + -> IO a runBenchmarkable Benchmarkable{..} i comb f | perRun = work >>= go (i - 1) | otherwise = work diff --git a/Gauge/Types.hs b/Gauge/Types.hs --- a/Gauge/Types.hs +++ b/Gauge/Types.hs @@ -30,6 +30,7 @@ -- * Configuration Config(..) , Mode(..) + , DisplayMode(..) , MatchType(..) , Verbosity(..) -- * Benchmark descriptions @@ -118,7 +119,10 @@ -- ^ Default Benchmark mode deriving (Eq, Read, Show, Typeable, Data, Generic) - +data DisplayMode = + Condensed + | StatsTable + deriving (Eq, Read, Show, Typeable, Data, Generic) -- | Top-level benchmarking configuration. data Config = Config { @@ -159,6 +163,7 @@ -- ^ Type of matching to use, if any , mode :: Mode -- ^ Mode of operation + , displayMode :: DisplayMode } deriving (Eq, Read, Show, Typeable, Data, Generic) diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -10,7 +10,12 @@ * CSV export * JSON export * HTML/javascript pages +* Glob benchmark matching +Added: + +* Small condensed output (`-s` or `--small`) + ## Future Feature Plan * Remove further dependencies @@ -18,6 +23,15 @@ * Add a standalong program taking benchmark data files and rendering to html/javascript/graphs * Make the library more useful as a standalone library to gather benchmark numbers related to functions in a programatic way +## Small mode + +It's hard to compare many benchmarks with criterion, so gauge has a `--small` output: + +``` +identity mean 41.65 ns ( +- 2.246 ns ) +slow mean 163.9 ns ( +- 9.683 ns ) +``` + ## Direct dependencies removed compared to criterion Number of total dependencies (direct & indirect): @@ -74,5 +88,11 @@ * vector-algorithms 0.7.0.1 * vector-binary-instances 0.2.3.5 + +Criterion graph of dependencies: + ![Criterion](/.README.imgs/criterion.png) + +Gauge graph of dependencies: + ![Gauge](/.README.imgs/gauge.png) diff --git a/benchs/Main.hs b/benchs/Main.hs --- a/benchs/Main.hs +++ b/benchs/Main.hs @@ -1,7 +1,19 @@ +{-# LANGUAGE BangPatterns #-} module Main where import Gauge.Main +import System.IO.Unsafe +import Control.Concurrent +import Control.Exception +delayed :: (a -> b) -> a -> b +delayed f a = unsafePerformIO $ do + !b <- evaluate (f a) + threadDelay 10000 + pure b +{-# NOINLINE delayed #-} + main = defaultMain - [ bench "identity" $ whnf (map (+ 1)) [1,2,3 :: Int] + [ bench "identity" $ nf (map (+ 1)) [1,2,3 :: Int] + , bench "slow" $ nf (map (\i -> delayed (+ 1))) [1..10::Int] ] diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,11 @@ +# 0.1.2 + +* condensed display with `--small` + +# 0.1.1 + +* remove optparse-applicative + # 0.1.0 * remove bunch of dependencies diff --git a/gauge.cabal b/gauge.cabal --- a/gauge.cabal +++ b/gauge.cabal @@ -1,5 +1,5 @@ name: gauge -version: 0.1.1 +version: 0.1.2 synopsis: small framework for performance measurement and analysis license: BSD3 license-file: LICENSE