{-# LANGUAGE RecordWildCards, CPP #-} module Wrecker.Options where import Options.Applicative.Builder import Options.Applicative import Control.Exception import Wrecker.Logger import Data.Monoid {- | There are two typical ways to invoke 'wrecker'. 'RunCount' will execute each a script 'n' times on each thread. So a run count of 100 and a concurrency of 10 will run the script a total of 1000 times. Alternatively, 'wrecker' can run for specified number of seconds with 'RunTimed'. -} data RunType = RunCount Int | RunTimed Int deriving (Show, Eq) {- | 'DisplayMode' controls how results are displayed in the console. The default is 'NonInterative' which returns the final results at the end of the program. 'Interactive' will show partial results as the program updates. -} data DisplayMode = Interactive | NonInteractive deriving (Show, Eq, Read) data URLDisplay = Path | Full deriving (Show, Eq, Read) data Options = Options { concurrency :: Int -- ^ The number of simulatanous connections , binCount :: Int -- ^ The number of bins for the histogram , runStyle :: RunType -- ^ runStyle determines if the 'wrecker' runs for a specified -- time period or for a specified number of runs. , timeoutTime :: Int -- ^ How long to wait after the first benchmark for the other threads -- to finish , displayMode :: DisplayMode -- ^ This controls the command line display. It can be either Interactive -- of NonInteractive , logLevel :: LogLevel -- ^ , match :: String -- ^ Set this to filter the benchmarks using a pattern , requestNameColumnSize :: Maybe Int -- ^ Limit the request name column to the given size , outputFilePath :: Maybe FilePath -- ^ Dump the results to JSON file , silent :: Bool -- ^ Set 'silent' to true to disable all output. , urlDisplay :: URLDisplay } deriving (Show, Eq) -- | 'defaultOptions' provides sensible default for the 'Options' -- types defaultOptions :: Options defaultOptions = Options { concurrency = 10 , binCount = 20 , runStyle = RunTimed 10 , timeoutTime = 100000000 , displayMode = NonInteractive , logLevel = LevelError , match = "" , requestNameColumnSize = Nothing , outputFilePath = Nothing , silent = False , urlDisplay = Path } data PartialOptions = PartialOptions { mConcurrency :: Maybe Int , mBinCount :: Maybe Int , mRunStyle :: Maybe RunType , mTimeoutTime :: Maybe Int , mDisplayMode :: Maybe DisplayMode , mLogLevel :: Maybe LogLevel , mMatch :: Maybe String , mRequestNameColumnSize :: Maybe Int , mOutputFilePath :: Maybe FilePath , mSilent :: Maybe Bool , murlDisplay :: Maybe URLDisplay } deriving (Show, Eq) instance Monoid PartialOptions where mempty = PartialOptions { mConcurrency = Just $ concurrency defaultOptions , mBinCount = Just $ binCount defaultOptions , mRunStyle = Just $ runStyle defaultOptions , mTimeoutTime = Just $ timeoutTime defaultOptions , mDisplayMode = Just $ displayMode defaultOptions , mLogLevel = Just $ logLevel defaultOptions , mMatch = Just $ match defaultOptions , mRequestNameColumnSize = requestNameColumnSize defaultOptions , mOutputFilePath = outputFilePath defaultOptions , mSilent = Just $ silent defaultOptions , murlDisplay = Just $ urlDisplay defaultOptions } mappend x y = PartialOptions { mConcurrency = mConcurrency x <|> mConcurrency y , mBinCount = mBinCount x <|> mBinCount y , mRunStyle = mRunStyle x <|> mRunStyle y , mTimeoutTime = mTimeoutTime x <|> mTimeoutTime y , mDisplayMode = mDisplayMode x <|> mDisplayMode y , mLogLevel = mLogLevel x <|> mLogLevel y , mMatch = mMatch x <|> mMatch y , mRequestNameColumnSize = mRequestNameColumnSize x <|> mRequestNameColumnSize y , mOutputFilePath = mOutputFilePath x <|> mOutputFilePath y , mSilent = mSilent x <|> mSilent y , murlDisplay = murlDisplay x <|> murlDisplay y } completeOptions :: PartialOptions -> Maybe Options completeOptions options = case options <> mempty of PartialOptions { mConcurrency = Just concurrency , mBinCount = Just binCount , mRunStyle = Just runStyle , mTimeoutTime = Just timeoutTime , mDisplayMode = Just displayMode , mLogLevel = Just logLevel , mMatch = Just match , mRequestNameColumnSize = requestNameColumnSize , mOutputFilePath = outputFilePath , mSilent = Just silent , murlDisplay = Just urlDisplay } -> Just $ Options {..} _ -> Nothing optionalOption :: Read a => Mod OptionFields a -> Parser (Maybe a) optionalOption = optional . option auto optionalStrOption :: Mod OptionFields String -> Parser (Maybe String) optionalStrOption = optional . strOption optionalSwitch :: Mod FlagFields Bool -> Parser (Maybe Bool) optionalSwitch = optional . switch pPartialOptions :: Parser PartialOptions pPartialOptions = PartialOptions <$> optionalOption ( long "concurrency" <> help "Number of threads for concurrent requests" ) <*> optionalOption ( long "bin-count" <> help "Number of bins for latency histogram" ) <*> optional ( RunCount <$> option auto ( long "run-count" <> help "number of times to repeat " ) <|> RunTimed <$> option auto ( long "run-timed" <> help "number of seconds to repeat " ) ) <*> optionalOption ( long "timeout-time" <> help "How long to wait for all requests to finish" ) <*> optional ( Interactive <$ switch (long "interactive") <|> NonInteractive <$ switch (long "non-interactive") ) <*> optionalOption ( long "log-level" <> help "Log to stderr events of criticality greater than the LOG_LEVEL" ) <*> optionalStrOption ( long "match" <> help "Only run tests that match the glob" ) <*> optionalOption ( long "request-name-size" <> help "Request name size for the terminal display" ) <*> optionalStrOption ( long "output-path" <> help "Save a JSON file of the the statistics to given path" ) <*> optionalSwitch ( long "silent" <> help "Disable all output" ) <*> optional ( Path <$ switch (long "relative-url-display") <|> Full <$ switch (long "absolute-url-display") ) {- | Run the command line parse and return the 'Options' 'runParser' can parse the following options > $ wrecker-based-app --help > > wrecker - HTTP stress tester and benchmarker > > Usage: example [--concurrency ARG] [--bin-count ARG] ([--run-count ARG] | > [--run-timed ARG]) [--timeout-time ARG] [--display-mode ARG] > [--log-level ARG] [--match ARG] [--request-name-size ARG] > [--output-path ARG] [--silent] > Welcome to wrecker > > Available options: > -h,--help Show this help text > --concurrency ARG Number of threads for concurrent requests > --bin-count ARG Number of bins for latency histogram > --run-count ARG number of times to repeat > --run-timed ARG number of seconds to repeat > --timeout-time ARG How long to wait for all requests to finish > --display-mode ARG Display results interactively > --log-level ARG Display results interactively > --match ARG Only run tests that match the glob > --request-name-size ARG Request name size for the terminal display > --output-path ARG Save a JSON file of the the statistics to given path > --silent Disable all output -} runParser :: IO Options runParser = do let opts = info (helper <*> pPartialOptions) ( fullDesc <> progDesc "Welcome to wrecker" <> header "wrecker - HTTP stress tester and benchmarker" ) partialOptions <- execParser opts case completeOptions partialOptions of Nothing -> throwIO $ userError "" Just x -> return x