Add --no-measurements mode

The new mode minimizes the amount of work performed by criterion.
This allows to use conveniently the same code for benchmarking and profiling.

Criterion.hs

@@ -23,6 +23,7 @@ module Criterion
     , bgroup
     , runBenchmark
     , runAndAnalyse
+    , runNotAnalyse
     ) where
 
 import Control.Monad (replicateM_, when, mplus)
@@ -153,13 +154,34 @@ runAndAnalyse p env bs' = do
             concat `fmap` mapM (go (prefix pfx desc)) bs
         go pfx (BenchCompare bs) = ((:[]) . Compare . concat) `fmap` mapM (go pfx) bs
 
-        prefix ""  desc = desc
-        prefix pfx desc = pfx ++ '/' : desc
-
-        flatten :: ResultForest -> [Result]
-        flatten [] = []
-        flatten (Single r    : rs) = r : flatten rs
-        flatten (Compare crs : rs) = flatten crs ++ flatten rs
+runNotAnalyse :: (String -> Bool) -- ^ A predicate that chooses
+                                  -- whether to run a benchmark by its
+                                  -- name.
+              -> Benchmark
+              -> Criterion ()
+runNotAnalyse p bs' = goQuickly "" bs'
+  where goQuickly :: String -> Benchmark -> Criterion ()
+        goQuickly pfx (Benchmark desc b)
+            | p desc'   = do _ <- note "benchmarking %s\n" desc'
+                             runOne b
+            | otherwise = return ()
+            where desc' = prefix pfx desc
+        goQuickly pfx (BenchGroup desc bs) =
+            mapM_ (goQuickly (prefix pfx desc)) bs
+        goQuickly pfx (BenchCompare bs) = mapM_ (goQuickly pfx) bs
+
+        runOne b = do
+            samples <- getConfigItem $ fromLJ cfgSamples
+            liftIO $ run b samples
+
+prefix :: String -> String -> String
+prefix ""  desc = desc
+prefix pfx desc = pfx ++ '/' : desc
+
+flatten :: ResultForest -> [Result]
+flatten [] = []
+flatten (Single r    : rs) = r : flatten rs
+flatten (Compare crs : rs) = flatten crs ++ flatten rs
 
 resultForestToCSV :: ResultForest -> String
 resultForestToCSV = unlines

Criterion/Config.hs

@@ -56,6 +56,7 @@ data Config = Config {
     , cfgCompareFile  :: Last FilePath -- ^ Filename of the comparison CSV.
     , cfgTemplate     :: Last FilePath -- ^ Filename of report template.
     , cfgVerbosity    :: Last Verbosity -- ^ Whether to run verbosely.
+    , cfgMeasure      :: Last Bool   -- ^ Whether to do any measurement
     } deriving (Eq, Read, Show, Typeable)
 
 instance Monoid Config where
@@ -76,6 +77,7 @@ defaultConfig = Config {
                 , cfgCompareFile  = mempty
                 , cfgTemplate     = ljust "report.tpl"
                 , cfgVerbosity    = ljust Normal
+                , cfgMeasure      = ljust True
                 }
 
 -- | Constructor for 'Last' values.
@@ -103,6 +105,7 @@ emptyConfig = Config {
               , cfgCompareFile  = mempty
               , cfgTemplate     = mempty
               , cfgVerbosity    = mempty
+              , cfgMeasure      = mempty
               }
 
 appendConfig :: Config -> Config -> Config
@@ -119,5 +122,6 @@ appendConfig a b =
     , cfgCompareFile  = app cfgCompareFile a b
     , cfgTemplate     = app cfgTemplate a b
     , cfgVerbosity    = app cfgVerbosity a b
+    , cfgMeasure      = app cfgMeasure a b
     }
   where app f = mappend `on` f

Criterion/Main.hs

@@ -45,7 +45,7 @@ module Criterion.Main
     ) where
 
 import Control.Monad.Trans (liftIO)
-import Criterion (runAndAnalyse)
+import Criterion (runAndAnalyse, runNotAnalyse)
 import Criterion.Config
 import Criterion.Environment (measureEnvironment)
 import Criterion.IO (note, printError)
@@ -114,6 +114,8 @@ defaultOptions = [
           "produce a summary CSV file of all results"
  , Option ['r'] ["compare"] (ReqArg (\s -> return $ mempty { cfgCompareFile = ljust s }) "FILENAME")
           "produce a CSV file of comparisons\nagainst reference benchmarks.\nSee the bcompare combinator"
+ , Option ['n'] ["no-measurements"] (noArg mempty { cfgMeasure = ljust False })
+          "Don't do any measurements"
  , Option ['V'] ["version"] (noArg mempty { cfgPrintExit = Version })
           "display version, then exit"
  , Option ['v'] ["verbose"] (noArg mempty { cfgVerbosity = ljust Verbose })
@@ -196,19 +198,24 @@ defaultMainWith :: Config
                 -> IO ()
 defaultMainWith defCfg prep bs = do
   (cfg, args) <- parseArgs defCfg defaultOptions =<< getArgs
+  let shouldRun b = null args || any (`isPrefixOf` b) args
   withConfig cfg $
-   if cfgPrintExit cfg == List
-    then do
-      _ <- 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 ()
-      env <- measureEnvironment
-      let shouldRun b = null args || any (`isPrefixOf` b) args
-      prep
-      runAndAnalyse shouldRun env $ BenchGroup "" bs
+   if not $ fromLJ cfgMeasure cfg
+     then runNotAnalyse shouldRun bsgroup
+     else do
+       if cfgPrintExit cfg == List
+        then do
+          _ <- 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 ()
+          env <- measureEnvironment
+          prep
+          runAndAnalyse shouldRun env bsgroup
+  where
+  bsgroup = BenchGroup "" bs
 
 -- | Display an error message from a command line parsing failure, and
 -- exit.