module Wrecker.Options where
import Control.Exception
import Data.Monoid
import Options.Applicative
import Wrecker.Logger
data RunType
= RunCount Int
| RunTimed Int
deriving (Show, Eq)
data DisplayMode
= Interactive
| NonInteractive
deriving (Show, Eq, Read)
data URLDisplay
= Path
| Full
deriving (Show, Eq, Read)
data Options = Options
{ concurrency :: Int
, binCount :: Int
, runStyle :: RunType
, timeoutTime :: Int
, displayMode :: DisplayMode
, logLevel :: LogLevel
, match :: String
, requestNameColumnSize :: Maybe Int
, outputFilePath :: Maybe FilePath
, silent :: Bool
, urlDisplay :: URLDisplay
, recordQuery :: Bool
, listTestGroups :: Bool
} deriving (Show, Eq)
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
, recordQuery = False
, listTestGroups = False
}
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
, mRecordQuery :: Maybe Bool
, mListTestGroups :: Maybe Bool
} 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
, mRecordQuery = Just $ recordQuery defaultOptions
, mListTestGroups = Just $ listTestGroups 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
, mRecordQuery = mRecordQuery x <|> mRecordQuery y
, mListTestGroups = mListTestGroups x <|> mListTestGroups 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
, mRecordQuery = Just recordQuery
, mListTestGroups = Just listTestGroups
} -> 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
(NonInteractive <$ switch (long "non-interactive") <|>
Interactive <$ switch (long "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")) <*>
optionalSwitch
(long "record-query" <> help "Take in consideration the query string for the report") <*>
optionalSwitch (long "list-test-groups" <> help "Shows the list of tests to run and exit")
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