Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 124 lines (110 sloc) 4.383 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123
{-# LANGUAGE DeriveDataTypeable #-}

-- |
-- Module : Criterion.Config
-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
--
-- License : BSD-style
-- Maintainer : bos@serpentine.com
-- Stability : experimental
-- Portability : GHC
--
-- Benchmarking configuration.

module Criterion.Config
    (
      Config(..)
    , PrintExit(..)
    , Verbosity(..)
    , defaultConfig
    , fromLJ
    , ljust
    ) where

import Data.Data (Data)
import Data.Function (on)
import Data.Monoid (Monoid(..), Last(..))
import Data.Typeable (Typeable)

-- | Control the amount of information displayed.
data Verbosity = Quiet
               | Normal
               | Verbose
                 deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable)

-- | Print some information and exit, without running any benchmarks.
data PrintExit = Nada -- ^ Do not actually print-and-exit. (Default.)
               | List -- ^ Print a list of known benchmarks.
               | Version -- ^ Print version information (if known).
               | Help -- ^ Print a help\/usaage message.
                 deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable, Data)

instance Monoid PrintExit where
    mempty = Nada
    mappend = max

-- | Top-level program configuration.
data Config = Config {
      cfgBanner :: Last String -- ^ The \"version\" banner to print.
    , cfgConfInterval :: Last Double -- ^ Confidence interval to use.
    , 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.
    , cfgCompareFile :: Last FilePath -- ^ Filename of the comparison CSV.
    , cfgTemplate :: Last FilePath -- ^ Filename of report template.
    , cfgVerbosity :: Last Verbosity -- ^ Whether to run verbosely.
    } deriving (Eq, Read, Show, Typeable)

instance Monoid Config where
    mempty = emptyConfig
    mappend = appendConfig

-- | A configuration with sensible defaults.
defaultConfig :: Config
defaultConfig = Config {
                  cfgBanner = ljust "I don't know what version I am."
                , cfgConfInterval = ljust 0.95
                , cfgPerformGC = ljust False
                , cfgPrintExit = Nada
                , cfgResamples = ljust (100 * 1000)
                , cfgReport = mempty
                , cfgSamples = ljust 100
                , cfgSummaryFile = mempty
                , cfgCompareFile = mempty
                , cfgTemplate = ljust "report.tpl"
                , cfgVerbosity = ljust Normal
                }

-- | Constructor for 'Last' values.
ljust :: a -> Last a
ljust = Last . Just

-- | Deconstructor for 'Last' values.
fromLJ :: (Config -> Last a) -- ^ Field to access.
       -> Config -- ^ Default to use.
       -> a
fromLJ f cfg = case f cfg of
                 Last Nothing -> fromLJ f defaultConfig
                 Last (Just a) -> a

emptyConfig :: Config
emptyConfig = Config {
                cfgBanner = mempty
              , cfgConfInterval = mempty
              , cfgPerformGC = mempty
              , cfgPrintExit = mempty
              , cfgReport = mempty
              , cfgResamples = mempty
              , cfgSamples = mempty
              , cfgSummaryFile = mempty
              , cfgCompareFile = mempty
              , cfgTemplate = mempty
              , cfgVerbosity = mempty
              }

appendConfig :: Config -> Config -> Config
appendConfig a b =
    Config {
      cfgBanner = app cfgBanner a b
    , 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
    , cfgCompareFile = app cfgCompareFile a b
    , cfgTemplate = app cfgTemplate a b
    , cfgVerbosity = app cfgVerbosity a b
    }
  where app f = mappend `on` f
Something went wrong with that request. Please try again.