Bryan O'Sullivan avatar Bryan O'Sullivan committed 2f9cd5e

Make report and template names configurable via API and command line.

Comments (0)

Files changed (3)

Criterion/Config.hs

     , cfgPerformGC    :: Last Bool   -- ^ Whether to run the GC between passes.
     , cfgPrintExit    :: PrintExit   -- ^ Whether to print information and exit.
     , cfgResamples    :: Last Int    -- ^ Number of resamples to perform.
+    , cfgReport       :: Last FilePath -- ^ Filename of report.
     , cfgSamples      :: Last Int    -- ^ Number of samples to collect.
-    , cfgSummaryFile  :: Last FilePath -- ^ Filename of summary CSV
+    , cfgSummaryFile  :: Last FilePath -- ^ Filename of summary CSV.
+    , cfgTemplate     :: Last FilePath -- ^ Filename of report template.
     , cfgVerbosity    :: Last Verbosity -- ^ Whether to run verbosely.
     } deriving (Eq, Read, Show, Typeable)
 
                 , cfgPerformGC    = ljust False
                 , cfgPrintExit    = Nada
                 , cfgResamples    = ljust (100 * 1000)
+                , cfgReport       = mempty
                 , cfgSamples      = ljust 100
                 , cfgSummaryFile  = mempty
+                , cfgTemplate     = ljust "report.tpl"
                 , cfgVerbosity    = ljust Normal
                 }
 
               , cfgConfInterval = mempty
               , cfgPerformGC    = mempty
               , cfgPrintExit    = mempty
+              , cfgReport       = mempty
               , cfgResamples    = mempty
               , cfgSamples      = mempty
               , cfgSummaryFile  = mempty
+              , cfgTemplate     = mempty
               , cfgVerbosity    = mempty
               }
 
     , cfgConfInterval = app cfgConfInterval a b
     , cfgPerformGC    = app cfgPerformGC a b
     , cfgPrintExit    = app cfgPrintExit a b
+    , cfgReport       = app cfgReport a b
+    , cfgResamples    = app cfgResamples a b
     , cfgSamples      = app cfgSamples a b
     , cfgSummaryFile  = app cfgSummaryFile a b
-    , cfgResamples    = app cfgResamples a b
+    , cfgTemplate     = app cfgTemplate a b
     , cfgVerbosity    = app cfgVerbosity a b
     }
   where app f = mappend `on` f

Criterion/Main.hs

           "bootstrap confidence interval"
  , Option ['l'] ["list"] (noArg mempty { cfgPrintExit = List })
           "print only a list of benchmark names"
+ , Option ['o'] ["output"]
+          (ReqArg (\t -> return $ mempty { cfgReport = ljust t }) "FILENAME")
+          "report file to write to"
  , Option ['q'] ["quiet"] (noArg mempty { cfgVerbosity = ljust Quiet })
           "print less output"
  , Option [] ["resamples"]
  , Option ['s'] ["samples"]
           (ReqArg (pos "sample count" $ \n -> mempty { cfgSamples = n }) "N")
           "number of samples to collect"
+ , Option ['t'] ["template"]
+          (ReqArg (\t -> return $ mempty { cfgTemplate = ljust t }) "FILENAME")
+          "template file to use"
  , Option ['u'] ["summary"] (ReqArg (\s -> return $ mempty { cfgSummaryFile = ljust s }) "FILENAME")
           "produce a summary CSV file of all results"
  , Option ['V'] ["version"] (noArg mempty { cfgPrintExit = Version })

Criterion/Report.hs

 module Criterion.Report
     (
       Report(..)
+    , formatReport
     , report
     -- * Rendering helper functions
     , TemplateException(..)
     , vector2
     ) where
 
-import Control.Applicative ((<$>))
 import Control.Exception (Exception, IOException, catch, throwIO)
 import Control.Monad (mplus)
 import Control.Monad.IO.Class (MonadIO(liftIO))
 import Criterion.Analysis (Outliers(..), SampleAnalysis(..))
-import Criterion.IO (note)
-import Criterion.Monad (Criterion)
-import Data.Char (isSpace, toLower)
+import Criterion.Config (cfgReport, cfgTemplate, fromLJ)
+import Criterion.Monad (Criterion, getConfig)
 import Data.Data (Data, Typeable)
-import Data.List (group)
+import Data.Monoid (Last(..))
 import Paths_criterion (getDataFileName)
 import Prelude hiding (catch)
 import Statistics.Sample.KernelDensity (kde)
 import Statistics.Types (Sample)
 import System.Directory (doesFileExist)
-import System.Environment (getProgName)
-import System.FilePath ((</>), isPathSeparator, takeFileName)
+import System.FilePath ((</>), isPathSeparator)
 import System.IO.Unsafe (unsafePerformIO)
 import Text.Hastache (MuType(..))
 import Text.Hastache.Context (mkGenericContext, mkStrContext)
-import Text.Printf (printf)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Vector.Generic as G
 templateDir = unsafePerformIO $ getDataFileName "templates"
 {-# NOINLINE templateDir #-}
 
--- | Write out a series of 'Report' values to a single file.
+-- | Write out a series of 'Report' values to a single file, if
+-- configured to do so.
 report :: [Report] -> Criterion ()
 report reports = do
+  cfg <- getConfig
+  case cfgReport cfg of
+    Last Nothing -> return ()
+    Last (Just name) -> liftIO $ do
+      tpl <- loadTemplate [".",templateDir] (fromLJ cfgTemplate cfg)
+      L.writeFile name =<< formatReport reports tpl
+
+-- | Format a series of 'Report' values using the given Hastache
+-- template.
+formatReport :: [Report]
+             -> B.ByteString    -- ^ Hastache template.
+             -> IO L.ByteString
+formatReport reports template = do
   let context "report"  = MuList $ map inner reports
       context "include" = MuLambdaM $ includeFile [templateDir]
       context _         = MuNothing
                            _          -> mkGenericContext reportOutliers $
                                          H.encodeStr nym
           where (kdeTimes,kdePDF) = kde 128 reportTimes
-  rep <- liftIO $ do
-    tpl <- loadTemplate [".",templateDir] "report.tpl"
-    bs <- H.hastacheStr H.defaultConfig tpl context
-    progName <- takeFileName <$> getProgName
-    let name = safePath $ printf "%s criterion.html" progName
-    L.writeFile name bs
-    return name
-  note "report written to %s\n" rep
+  H.hastacheStr H.defaultConfig template context
 
 -- | Render the elements of a vector.
 --
                        | nym == name2 -> MuVariable j
                        | otherwise    -> MuNothing
 
--- | Get rid of spaces and other potentially troublesome characters
--- from a file name.
-safePath :: String -> FilePath
-safePath = concatMap (replace ((==) '-' . head) "-")
-       . group
-       . map (replace isSpace '-' . replace (`elem` "\"'();/\\") '-' . toLower)
-
-replace :: (a -> Bool) -> a -> a -> a
-replace p r c | p c       = r
-              | otherwise = c
-
 -- | Attempt to include the contents of a file based on a search path.
 -- Returns 'B.empty' if the search fails or the file could not be read.
 --
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.