{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
module Config where
import ParseArgs
import Data.Label
import Data.Maybe
import Data.Monoid
import System.Exit
import qualified Test.Framework as TestFramework
import qualified Criterion.Main as Criterion
import qualified Criterion.Config as Criterion
data Config
= Config
{
-- Standard options
_configBackend :: Backend
, _configHelp :: Bool
, _configBenchmark :: Bool
, _configQuickCheck :: Bool
-- Which QuickCheck test types to enable?
, _configDouble :: Bool
, _configFloat :: Bool
, _configInt64 :: Bool
, _configInt32 :: Bool
, _configInt16 :: Bool
, _configInt8 :: Bool
, _configWord64 :: Bool
, _configWord32 :: Bool
, _configWord16 :: Bool
, _configWord8 :: Bool
}
deriving Show
$(mkLabels [''Config])
defaults :: Config
defaults = Config
{
_configBackend = maxBound
, _configHelp = False
, _configBenchmark = True
, _configQuickCheck = True
, _configDouble = False
, _configFloat = False
, _configInt64 = True
, _configInt32 = True
, _configInt16 = False
, _configInt8 = False
, _configWord64 = False
, _configWord32 = False
, _configWord16 = False
, _configWord8 = False
}
options :: [OptDescr (Config -> Config)]
options =
[ Option [] ["no-quickcheck"]
(NoArg (set configQuickCheck False))
"disable QuickCheck tests"
, Option [] ["no-benchmark"]
(NoArg (set configBenchmark False))
"disable Criterion benchmarks"
, Option [] ["double"]
(OptArg (set configDouble . read . fromMaybe "True") "BOOL")
(describe configDouble "enable double-precision tests")
, Option [] ["float"]
(OptArg (set configFloat . read . fromMaybe "True") "BOOL")
(describe configDouble "enable single-precision tests")
, Option [] ["int64"]
(OptArg (set configInt64 . read . fromMaybe "True") "BOOL")
(describe configInt64 "enable 64-bit integer tests")
, Option [] ["int32"]
(OptArg (set configInt32 . read . fromMaybe "True") "BOOL")
(describe configInt32 "enable 32-bit integer tests")
, Option [] ["int16"]
(OptArg (set configInt16 . read . fromMaybe "True") "BOOL")
(describe configInt16 "enable 16-bit integer tests")
, Option [] ["int8"]
(OptArg (set configInt8 . read . fromMaybe "True") "BOOL")
(describe configInt8 "enable 8-bit integer tests")
, Option [] ["word64"]
(OptArg (set configWord64 . read . fromMaybe "True") "BOOL")
(describe configWord64 "enable 64-bit unsigned integer tests")
, Option [] ["word32"]
(OptArg (set configWord32 . read . fromMaybe "True") "BOOL")
(describe configWord32 "enable 32-bit unsigned integer tests")
, Option [] ["word16"]
(OptArg (set configWord16 . read . fromMaybe "True") "BOOL")
(describe configWord16 "enable 16-bit unsigned integer tests")
, Option [] ["word8"]
(OptArg (set configWord8 . read . fromMaybe "True") "BOOL")
(describe configWord8 "enable 8-bit unsigned integer tests")
, Option ['h', '?'] ["help"]
(NoArg (set configHelp True))
"show this help message"
]
where
describe f msg
= msg ++ " (" ++ show (get f defaults) ++ ")"
header :: [String]
header =
[ "accelerate-nofib (c) [2013] The Accelerate Team"
, ""
, "Usage: accelerate-nofib [OPTIONS]"
, ""
]
footer :: [String]
footer = []
-- | Same as 'parseArgs', but also return options for test-framework.
--
-- Since Criterion and test-framework both bail if they encounter unrecognised
-- options, we run getOpt' ourselves. This means error messages might be a bit
-- different.
--
-- We split this out of the common ParseArgs infrastructure so we don't add an
-- unnecessary dependency on test-framework to all the other example programs.
--
parseArgs' :: (config :-> Bool) -- ^ access a help flag from the options structure
-> (config :-> Backend) -- ^ access the chosen backend from the options structure
-> [OptDescr (config -> config)] -- ^ the option descriptions
-> config -- ^ default option set
-> [String] -- ^ header text
-> [String] -- ^ footer text
-> [String] -- ^ command line arguments
-> IO (config, Criterion.Config, TestFramework.RunnerOptions, [String])
parseArgs' help backend (withBackends backend -> options) config header footer (takeWhile (/= "--") -> argv) =
let
criterionOptions = stripShortOpts Criterion.defaultOptions
testframeworkOptions = stripShortOpts TestFramework.optionsDescription
helpMsg err = concat err
++ usageInfo (unlines header) options
++ usageInfo "\nGeneric criterion options:" criterionOptions
++ usageInfo "\nGeneric test-framework options:" testframeworkOptions
in do
-- In the first round process options for the main program. Any non-options
-- will be split out here so we can ignore them later. Unrecognised options
-- get passed to criterion and test-framework.
--
(conf,non,u) <- case getOpt' Permute options argv of
(opts,n,u,[]) -> case foldr id config opts of
conf | False <- get help conf
-> putStrLn (fancyHeader backend conf header footer) >> return (conf,n,u)
_ -> putStrLn (helpMsg []) >> exitSuccess
--
(_,_,_,err) -> error (helpMsg err)
-- Test Framework
(tfconf, u') <- case getOpt' Permute testframeworkOptions u of
(oas,_,u',[]) | Just os <- sequence oas
-> return (mconcat os, u')
(_,_,_,err) -> error (helpMsg err)
-- Criterion
(cconf, _) <- Criterion.parseArgs Criterion.defaultConfig criterionOptions u'
return (conf, cconf, tfconf, non)