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)
data Verbosity = Quiet
| Normal
| Verbose
deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable)
data PrintExit = Nada
| List
| Version
| Help
deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable, Data)
instance Monoid PrintExit where
mempty = Nada
mappend = max
data Config = Config {
cfgBanner :: Last String
, cfgConfInterval :: Last Double
, cfgPerformGC :: Last Bool
, cfgPrintExit :: PrintExit
, cfgResamples :: Last Int
, cfgReport :: Last FilePath
, cfgSamples :: Last Int
, cfgSummaryFile :: Last FilePath
, cfgCompareFile :: Last FilePath
, cfgTemplate :: Last FilePath
, cfgVerbosity :: Last Verbosity
} deriving (Eq, Read, Show, Typeable)
instance Monoid Config where
mempty = emptyConfig
mappend = appendConfig
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
}
ljust :: a -> Last a
ljust = Last . Just
fromLJ :: (Config -> Last a)
-> Config
-> 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