packages feed

hspec-core 2.8.3 → 2.8.4

raw patch · 20 files changed

+756/−435 lines, 20 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

hspec-core.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:             hspec-core-version:          2.8.3+version:          2.8.4 license:          MIT license-file:     LICENSE copyright:        (c) 2011-2021 Simon Hengel,@@ -31,7 +31,7 @@   hs-source-dirs:       src       vendor-  ghc-options: -Wall+  ghc-options: -Wall -fno-warn-incomplete-uni-patterns   build-depends:       HUnit ==1.6.*     , QuickCheck >=2.13.1@@ -61,11 +61,16 @@       Test.Hspec.Core.QuickCheck       Test.Hspec.Core.Util   other-modules:+      GetOpt.Declarative+      GetOpt.Declarative.Environment+      GetOpt.Declarative.Interpret+      GetOpt.Declarative.Types+      GetOpt.Declarative.Util       Test.Hspec.Core.Clock       Test.Hspec.Core.Compat       Test.Hspec.Core.Config+      Test.Hspec.Core.Config.Definition       Test.Hspec.Core.Config.Options-      Test.Hspec.Core.Config.Util       Test.Hspec.Core.Example       Test.Hspec.Core.Example.Location       Test.Hspec.Core.FailureReport@@ -92,7 +97,7 @@       src       vendor       test-  ghc-options: -Wall+  ghc-options: -Wall -fno-warn-incomplete-uni-patterns   cpp-options: -DTEST   build-depends:       HUnit ==1.6.*@@ -119,11 +124,16 @@   build-tool-depends:       hspec-meta:hspec-meta-discover   other-modules:+      GetOpt.Declarative+      GetOpt.Declarative.Environment+      GetOpt.Declarative.Interpret+      GetOpt.Declarative.Types+      GetOpt.Declarative.Util       Test.Hspec.Core.Clock       Test.Hspec.Core.Compat       Test.Hspec.Core.Config+      Test.Hspec.Core.Config.Definition       Test.Hspec.Core.Config.Options-      Test.Hspec.Core.Config.Util       Test.Hspec.Core.Example       Test.Hspec.Core.Example.Location       Test.Hspec.Core.FailureReport@@ -150,12 +160,14 @@       Control.Concurrent.Async       Data.Algorithm.Diff       All+      GetOpt.Declarative.EnvironmentSpec+      GetOpt.Declarative.UtilSpec       Helper       Mock       Test.Hspec.Core.ClockSpec       Test.Hspec.Core.CompatSpec+      Test.Hspec.Core.Config.DefinitionSpec       Test.Hspec.Core.Config.OptionsSpec-      Test.Hspec.Core.Config.UtilSpec       Test.Hspec.Core.ConfigSpec       Test.Hspec.Core.Example.LocationSpec       Test.Hspec.Core.ExampleSpec
+ src/GetOpt/Declarative.hs view
@@ -0,0 +1,5 @@+module GetOpt.Declarative (module GetOpt.Declarative) where+import           Prelude ()+import           GetOpt.Declarative.Types as GetOpt.Declarative+import           GetOpt.Declarative.Interpret as GetOpt.Declarative+import           GetOpt.Declarative.Environment as GetOpt.Declarative
+ src/GetOpt/Declarative/Environment.hs view
@@ -0,0 +1,51 @@+module GetOpt.Declarative.Environment (+  InvalidValue(..)+, parseEnvironmentOptions+, parseEnvironmentOption+) where++import           Prelude ()+import           Test.Hspec.Core.Compat+import           Data.Char++import           GetOpt.Declarative.Types++data InvalidValue = InvalidValue String String+  deriving (Eq, Show)++parseEnvironmentOptions :: String -> [(String, String)] -> config -> [Option config] -> ([InvalidValue], config)+parseEnvironmentOptions prefix env = foldr f . (,) []+  where+    f :: Option config -> ([InvalidValue], config) -> ([InvalidValue], config)+    f option (errs, config) = case parseEnvironmentOption prefix env config option of+        Left err -> (err : errs, config)+        Right c -> (errs, c)++parseEnvironmentOption :: String -> [(String, String)] -> config -> Option config -> Either InvalidValue config+parseEnvironmentOption prefix env config option = case lookup name env of+  Nothing -> Right config+  Just value -> case optionSetter option of+    NoArg setter -> case value of+      "yes" -> Right $ setter config+      _ -> invalidValue+    Flag setter -> case value of+      "yes" -> Right $ setter True config+      "no" -> Right $ setter False config+      _ -> invalidValue+    OptArg _ setter -> case setter (Just value) config of+      Just c -> Right c+      Nothing -> invalidValue+    Arg _ setter -> case setter value config of+      Just c -> Right c+      Nothing -> invalidValue+    where+      invalidValue = Left (InvalidValue name value)+  where+    name = envVarName prefix option++envVarName :: String -> Option config -> String+envVarName prefix option = prefix ++ '_' : map f (optionName option)+  where+    f c = case c of+      '-' -> '_'+      _ -> toUpper c
+ src/GetOpt/Declarative/Interpret.hs view
@@ -0,0 +1,97 @@+module GetOpt.Declarative.Interpret (+  ParseResult(..)+, parseCommandLineOptions+, parse+, interpretOptions+) where++import           Prelude ()+import           Test.Hspec.Core.Compat+import           Data.Maybe++import           System.Console.GetOpt (OptDescr, ArgOrder(..), getOpt)+import qualified System.Console.GetOpt as GetOpt++import           GetOpt.Declarative.Types+import           GetOpt.Declarative.Util (mkUsageInfo, mapOptDescr)++data InvalidArgument = InvalidArgument String String++data ParseResult config = Help String | Failure String | Success config++parseCommandLineOptions :: [(String, [Option config])] -> String -> [String] -> config -> ParseResult config+parseCommandLineOptions opts prog args config = case parseWithHelp (concatMap snd options) config args of+  Nothing -> Help usage+  Just (Right c) -> Success c+  Just (Left err) -> Failure $ prog ++ ": " ++ err ++ "\nTry `" ++ prog ++ " --help' for more information.\n"+  where+    options = addHelpFlag $ map (fmap interpretOptions) opts++    documentedOptions = addHelpFlag $ map (fmap $ interpretOptions . filter optionDocumented) opts++    usage :: String+    usage = "Usage: " ++ prog ++ " [OPTION]...\n\n"+      ++ (intercalate "\n" $ map (uncurry mkUsageInfo) documentedOptions)++addHelpFlag :: [(a, [OptDescr a1])] -> [(a, [OptDescr (Maybe a1)])]+addHelpFlag opts = case opts of+  (section, xs) : ys -> (section, GetOpt.Option [] ["help"] (GetOpt.NoArg help) "display this help and exit" : noHelp xs) : map (fmap noHelp) ys+  [] -> []+  where+    help = Nothing++    noHelp :: [OptDescr a] -> [OptDescr (Maybe a)]+    noHelp = map (mapOptDescr Just)++parseWithHelp :: [OptDescr (Maybe (config -> Either InvalidArgument config))] -> config -> [String] -> Maybe (Either String config)+parseWithHelp options config args = case getOpt Permute options args of+  (opts, [], []) | _ : _ <- [() | Nothing <- opts] -> Nothing+  (opts, xs, ys) -> Just $ interpretResult config (catMaybes opts, xs, ys)++parse :: [OptDescr (config -> Either InvalidArgument config)] -> config -> [String] -> Either String config+parse options config = interpretResult config . getOpt Permute options++interpretResult :: config -> ([config -> Either InvalidArgument config], [String], [String]) -> Either String config+interpretResult config = interpretGetOptResult >=> foldResult config++foldResult :: config -> [config -> Either InvalidArgument config] -> Either String config+foldResult config opts = either (Left . renderInvalidArgument) return $ foldlM (flip id) config opts++renderInvalidArgument :: InvalidArgument -> String+renderInvalidArgument (InvalidArgument name value) = "invalid argument `" ++ value ++ "' for `--" ++ name ++ "'"++interpretGetOptResult :: ([a], [String], [String]) -> Either String [a]+interpretGetOptResult result = case result of+  (opts, [], []) -> Right opts+  (_, _, err:_) -> Left (init err)+  (_, arg:_, _) -> Left ("unexpected argument `" ++ arg ++ "'")++interpretOptions :: [Option config] -> [OptDescr (config -> Either InvalidArgument config)]+interpretOptions = concatMap interpretOption++interpretOption :: Option config -> [OptDescr (config -> Either InvalidArgument config)]+interpretOption (Option name shortcut argDesc help _) = case argDesc of+  NoArg setter -> [option $ GetOpt.NoArg (Right . setter)]++  Flag setter -> [+      option (arg True)+    , GetOpt.Option [] ["no-" ++ name] (arg False) ("do not " ++ help)+    ]+    where+      arg v = GetOpt.NoArg (Right . setter v)++  OptArg argName setter -> [option $ GetOpt.OptArg arg argName]+    where+      arg mInput c = case setter mInput c of+        Just c_ -> Right c_+        Nothing -> case mInput of+          Just input -> invalid input+          Nothing -> Right c++  Arg argName setter -> [option (GetOpt.ReqArg arg argName)]+    where+      arg input = maybe (invalid input) Right . setter input++  where+    invalid = Left . InvalidArgument name+    option arg = GetOpt.Option (maybeToList shortcut) [name] arg help
+ src/GetOpt/Declarative/Types.hs view
@@ -0,0 +1,18 @@+module GetOpt.Declarative.Types where++import           Prelude ()+import           Test.Hspec.Core.Compat++data Option config = Option {+  optionName :: String+, optionShortcut :: Maybe Char+, optionSetter :: OptionSetter config+, optionHelp :: String+, optionDocumented :: Bool+}++data OptionSetter config =+    NoArg (config -> config)+  | Flag (Bool -> config -> config)+  | OptArg String (Maybe String -> config -> Maybe config)+  | Arg String (String -> config -> Maybe config)
+ src/GetOpt/Declarative/Util.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE CPP #-}+module GetOpt.Declarative.Util (mkUsageInfo, mapOptDescr) where++import           Prelude ()+import           Test.Hspec.Core.Compat++import           System.Console.GetOpt++import           Test.Hspec.Core.Util++modifyHelp :: (String -> String) -> OptDescr a -> OptDescr a+modifyHelp modify (Option s n a help) = Option s n a (modify help)++mkUsageInfo :: String -> [OptDescr a] -> String+mkUsageInfo title = usageInfo title . addLineBreaksForHelp . condenseNoOptions++addLineBreaksForHelp :: [OptDescr a] -> [OptDescr a]+addLineBreaksForHelp options = map (modifyHelp addLineBreaks) options+  where+    withoutHelpWidth = maxLength . usageInfo "" . map removeHelp+    helpWidth = 80 - withoutHelpWidth options++    addLineBreaks = unlines . lineBreaksAt helpWidth++    maxLength = maximum . map length . lines+    removeHelp = modifyHelp (const "")++condenseNoOptions :: [OptDescr a] -> [OptDescr a]+condenseNoOptions options = case options of+  Option "" [optionA] arg help : Option "" [optionB] _ _ : ys | optionB == ("no-" ++ optionA) ->+    Option "" ["[no-]" ++ optionA] arg help : condenseNoOptions ys+  x : xs -> x : condenseNoOptions xs+  [] -> []++mapOptDescr :: (a -> b) -> OptDescr a -> OptDescr b+#if MIN_VERSION_base(4,7,0)+mapOptDescr = fmap+#else+mapOptDescr f opt = case opt of+  Option short long arg help -> Option short long (mapArgDescr f arg) help++mapArgDescr :: (a -> b) -> ArgDescr a -> ArgDescr b+mapArgDescr f arg = case arg of+  NoArg a -> NoArg (f a)+  ReqArg parse name -> ReqArg (fmap f parse) name+  OptArg parse name -> OptArg (fmap f parse) name+#endif
src/Test/Hspec/Core/Config.hs view
@@ -24,11 +24,12 @@ import           System.Exit import           System.FilePath import           System.Directory-import           System.Environment (getProgName)+import           System.Environment (getProgName, getEnvironment) import qualified Test.QuickCheck as QC  import           Test.Hspec.Core.Util import           Test.Hspec.Core.Config.Options+import           Test.Hspec.Core.Config.Definition (Config(..), ColorMode(..), defaultConfig, filterOr) import           Test.Hspec.Core.FailureReport import           Test.Hspec.Core.QuickCheckUtil (mkGen) import           Test.Hspec.Core.Example (Params(..), defaultParams)@@ -117,10 +118,13 @@     case ignore of       True -> return []       False -> readConfigFiles-  envVar <- fmap words <$> lookupEnv envVarName-  case parseOptions opts_ prog configFiles envVar args of+  env <- getEnvironment+  let envVar = words <$> lookup envVarName env+  case parseOptions opts_ prog configFiles envVar env args of     Left (err, msg) -> exitWithMessage err msg-    Right opts -> return opts+    Right (warnings, opts) -> do+      mapM_ (hPutStrLn stderr) warnings+      return opts  readFailureReportOnRerun :: Config -> IO (Maybe FailureReport) readFailureReportOnRerun config
+ src/Test/Hspec/Core/Config/Definition.hs view
@@ -0,0 +1,281 @@+{-# LANGUAGE CPP #-}+module Test.Hspec.Core.Config.Definition (+  Config(..)+, ColorMode(..)+, filterOr+, defaultConfig++, commandLineOnlyOptions+, formatterOptions+, smallCheckOptions+, quickCheckOptions+, runnerOptions++#ifdef TEST+, formatOrList+#endif+) where++import           Prelude ()+import           Test.Hspec.Core.Compat++import           Test.Hspec.Core.Example (Params(..), defaultParams)+import           Test.Hspec.Core.Format (Format, FormatConfig)+import qualified Test.Hspec.Core.Formatters.V1 as V1+import qualified Test.Hspec.Core.Formatters.V2 as V2+import           Test.Hspec.Core.Util++import           GetOpt.Declarative+++data ColorMode = ColorAuto | ColorNever | ColorAlways+  deriving (Eq, Show)++data Config = Config {+  configIgnoreConfigFile :: Bool+, configDryRun :: Bool+, configFocusedOnly :: Bool+, configFailOnFocused :: Bool+, configPrintSlowItems :: Maybe Int+, configPrintCpuTime :: Bool+, configFastFail :: Bool+, configRandomize :: Bool+, configFailureReport :: Maybe FilePath+, configRerun :: Bool+, configRerunAllOnSuccess :: Bool++-- |+-- A predicate that is used to filter the spec before it is run.  Only examples+-- that satisfy the predicate are run.+, configFilterPredicate :: Maybe (Path -> Bool)+, configSkipPredicate :: Maybe (Path -> Bool)+, configQuickCheckSeed :: Maybe Integer+, configQuickCheckMaxSuccess :: Maybe Int+, configQuickCheckMaxDiscardRatio :: Maybe Int+, configQuickCheckMaxSize :: Maybe Int+, configQuickCheckMaxShrinks :: Maybe Int+, configSmallCheckDepth :: Int+, configColorMode :: ColorMode+, configDiff :: Bool+, configTimes :: Bool+, configFormat :: Maybe (FormatConfig -> IO Format)+, configFormatter :: Maybe V1.Formatter -- ^ deprecated, use `configFormat` instead+, configHtmlOutput :: Bool+, configConcurrentJobs :: Maybe Int+}++defaultConfig :: Config+defaultConfig = Config {+  configIgnoreConfigFile = False+, configDryRun = False+, configFocusedOnly = False+, configFailOnFocused = False+, configPrintSlowItems = Nothing+, configPrintCpuTime = False+, configFastFail = False+, configRandomize = False+, configFailureReport = Nothing+, configRerun = False+, configRerunAllOnSuccess = False+, configFilterPredicate = Nothing+, configSkipPredicate = Nothing+, configQuickCheckSeed = Nothing+, configQuickCheckMaxSuccess = Nothing+, configQuickCheckMaxDiscardRatio = Nothing+, configQuickCheckMaxSize = Nothing+, configQuickCheckMaxShrinks = Nothing+, configSmallCheckDepth = paramsSmallCheckDepth defaultParams+, configColorMode = ColorAuto+, configDiff = True+, configTimes = False+, configFormat = Nothing+, configFormatter = Nothing+, configHtmlOutput = False+, configConcurrentJobs = Nothing+}++option :: String -> OptionSetter config -> String -> Option config+option name arg help = Option name Nothing arg help True++mkFlag :: String -> (Bool -> Config -> Config) -> String -> Option Config+mkFlag name setter = option name (Flag setter)++mkOptionNoArg :: String -> Maybe Char -> (Config -> Config) -> String -> Option Config+mkOptionNoArg name shortcut setter help = Option name shortcut (NoArg setter) help True++mkOption :: String -> Maybe Char -> OptionSetter Config -> String -> Option Config+mkOption name shortcut arg help = Option name shortcut arg help True++undocumented :: Option config -> Option config+undocumented opt = opt {optionDocumented = False}++argument :: String -> (String -> Maybe a) -> (a -> Config -> Config) -> OptionSetter Config+argument name parser setter = Arg name $ \ input c -> flip setter c <$> parser input++formatterOptions :: [Option Config]+formatterOptions = [+    mkOption "format" (Just 'f') (argument "FORMATTER" readFormatter setFormatter) helpForFormat+  , mkFlag "color" setColor "colorize the output"+  , mkFlag "diff" setDiff "show colorized diffs"+  , mkFlag "times" setTimes "report times for individual spec items"+  , mkOptionNoArg "print-cpu-time" Nothing setPrintCpuTime "include used CPU time in summary"+  , printSlowItemsOption++    -- undocumented for now, as we probably want to change this to produce a+    -- standalone HTML report in the future+  , undocumented $ mkOptionNoArg "html" Nothing setHtml "produce HTML output"+  ]+  where+    setHtml config = config {configHtmlOutput = True}++    formatters :: [(String, FormatConfig -> IO Format)]+    formatters = map (fmap V2.formatterToFormat) [+        ("checks", V2.checks)+      , ("specdoc", V2.specdoc)+      , ("progress", V2.progress)+      , ("failed-examples", V2.failed_examples)+      , ("silent", V2.silent)+      ]++    helpForFormat :: String+    helpForFormat = "use a custom formatter; this can be one of " ++ (formatOrList $ map fst formatters)++    readFormatter :: String -> Maybe (FormatConfig -> IO Format)+    readFormatter = (`lookup` formatters)++    setFormatter :: (FormatConfig -> IO Format) -> Config -> Config+    setFormatter f c = c {configFormat = Just f}++    setColor :: Bool -> Config -> Config+    setColor v config = config {configColorMode = if v then ColorAlways else ColorNever}++    setDiff :: Bool -> Config -> Config+    setDiff v config = config {configDiff = v}++    setTimes :: Bool -> Config -> Config+    setTimes v config = config {configTimes = v}++    setPrintCpuTime config = config {configPrintCpuTime = True}++printSlowItemsOption :: Option Config+printSlowItemsOption = Option name (Just 'p') (OptArg "N" arg) "print the N slowest spec items (default: 10)" True+  where+    name = "print-slow-items"++    setter :: Maybe Int -> Config -> Config+    setter v c = c {configPrintSlowItems = v}++    arg :: Maybe String -> Config -> Maybe Config+    arg = maybe (Just . (setter $ Just 10)) parseArg++    parseArg :: String -> Config -> Maybe Config+    parseArg input c = case readMaybe input of+      Just 0 -> Just (setter Nothing c)+      Just n -> Just (setter (Just n) c)+      Nothing -> Nothing++smallCheckOptions :: [Option Config]+smallCheckOptions = [+    option "depth" (argument "N" readMaybe setDepth) "maximum depth of generated test values for SmallCheck properties"+  ]++setDepth :: Int -> Config -> Config+setDepth n c = c {configSmallCheckDepth = n}++quickCheckOptions :: [Option Config]+quickCheckOptions = [+    Option "qc-max-success" (Just 'a') (argument "N" readMaybe setMaxSuccess) "maximum number of successful tests before a QuickCheck property succeeds" True+  , option "qc-max-discard" (argument "N" readMaybe setMaxDiscardRatio) "maximum number of discarded tests per successful test before giving up"+  , option "qc-max-size" (argument "N" readMaybe setMaxSize) "size to use for the biggest test cases"+  , option "qc-max-shrinks" (argument "N" readMaybe setMaxShrinks) "maximum number of shrinks to perform before giving up (a value of 0 turns shrinking off)"+  , option "seed" (argument "N" readMaybe setSeed) "used seed for QuickCheck properties"++    -- for compatibility with test-framework+  , undocumented $ option "maximum-generated-tests" (argument "NUMBER" readMaybe setMaxSuccess) "how many automated tests something like QuickCheck should try, by default"+  ]++setMaxSuccess :: Int -> Config -> Config+setMaxSuccess n c = c {configQuickCheckMaxSuccess = Just n}++setMaxDiscardRatio :: Int -> Config -> Config+setMaxDiscardRatio n c = c {configQuickCheckMaxDiscardRatio = Just n}++setMaxSize :: Int -> Config -> Config+setMaxSize n c = c {configQuickCheckMaxSize = Just n}++setMaxShrinks :: Int -> Config -> Config+setMaxShrinks n c = c {configQuickCheckMaxShrinks = Just n}++setSeed :: Integer -> Config -> Config+setSeed n c = c {configQuickCheckSeed = Just n}++runnerOptions :: [Option Config]+runnerOptions = [+    mkFlag "dry-run" setDryRun "pretend that everything passed; don't verify anything"+  , mkFlag "focused-only" setFocusedOnly "do not run anything, unless there are focused spec items"+  , mkFlag "fail-on-focused" setFailOnFocused "fail on focused spec items"+  , mkFlag "fail-fast" setFastFail "abort on first failure"+  , mkFlag "randomize" setRandomize "randomize execution order"+  , mkOptionNoArg "rerun" (Just 'r') setRerun "rerun all examples that failed in the previous test run (only works in combination with --failure-report or in GHCi)"+  , option "failure-report" (argument "FILE" return setFailureReport) "read/write a failure report for use with --rerun"+  , mkOptionNoArg "rerun-all-on-success" Nothing setRerunAllOnSuccess "run the whole test suite after a previously failing rerun succeeds for the first time (only works in combination with --rerun)"+  , mkOption "jobs" (Just 'j') (argument "N" readMaxJobs setMaxJobs) "run at most N parallelizable tests simultaneously (default: number of available processors)"+  ]+  where+    readMaxJobs :: String -> Maybe Int+    readMaxJobs s = do+      n <- readMaybe s+      guard $ n > 0+      return n++    setFailureReport :: String -> Config -> Config+    setFailureReport file c = c {configFailureReport = Just file}++    setMaxJobs :: Int -> Config -> Config+    setMaxJobs n c = c {configConcurrentJobs = Just n}++    setDryRun :: Bool -> Config -> Config+    setDryRun value config = config {configDryRun = value}++    setFocusedOnly :: Bool -> Config -> Config+    setFocusedOnly value config = config {configFocusedOnly = value}++    setFailOnFocused :: Bool -> Config -> Config+    setFailOnFocused value config = config {configFailOnFocused = value}++    setFastFail :: Bool -> Config -> Config+    setFastFail value config = config {configFastFail = value}++    setRandomize :: Bool -> Config -> Config+    setRandomize value config = config {configRandomize = value}++    setRerun config = config {configRerun = True}+    setRerunAllOnSuccess config = config {configRerunAllOnSuccess = True}++commandLineOnlyOptions :: [Option Config]+commandLineOnlyOptions = [+    mkOptionNoArg "ignore-dot-hspec" Nothing setIgnoreConfigFile "do not read options from ~/.hspec and .hspec"+  , mkOption "match" (Just 'm') (argument "PATTERN" return addMatch) "only run examples that match given PATTERN"+  , option "skip" (argument "PATTERN" return addSkip) "skip examples that match given PATTERN"+  ]+  where+    setIgnoreConfigFile config = config {configIgnoreConfigFile = True}++addMatch :: String -> Config -> Config+addMatch s c = c {configFilterPredicate = Just (filterPredicate s) `filterOr` configFilterPredicate c}++addSkip :: String -> Config -> Config+addSkip s c = c {configSkipPredicate = Just (filterPredicate s) `filterOr` configSkipPredicate c}++filterOr :: Maybe (Path -> Bool) -> Maybe (Path -> Bool) -> Maybe (Path -> Bool)+filterOr p1_ p2_ = case (p1_, p2_) of+  (Just p1, Just p2) -> Just $ \path -> p1 path || p2 path+  _ -> p1_ <|> p2_++formatOrList :: [String] -> String+formatOrList xs = case xs of+  [] -> ""+  x : ys -> (case ys of+    [] -> x+    _ : [] -> x ++ " or "+    _ : _ : _ -> x ++ ", ") ++ formatOrList ys
src/Test/Hspec/Core/Config/Options.hs view
@@ -1,356 +1,92 @@+{-# LANGUAGE CPP #-} module Test.Hspec.Core.Config.Options (-  Config(..)-, ColorMode (..)-, defaultConfig-, filterOr-, parseOptions-, ConfigFile-, ignoreConfigFile+  ConfigFile , envVarName+, ignoreConfigFile+, parseOptions ) where  import           Prelude () import           Test.Hspec.Core.Compat  import           System.Exit-import           System.Console.GetOpt -import           Test.Hspec.Core.Format (Format, FormatConfig)-import qualified Test.Hspec.Core.Formatters.V1 as V1-import qualified Test.Hspec.Core.Formatters.V2 as V2-import           Test.Hspec.Core.Config.Util-import           Test.Hspec.Core.Util-import           Test.Hspec.Core.Example (Params(..), defaultParams)-import           Data.Functor.Identity-import           Data.Maybe+import           Test.Hspec.Core.Config.Definition+import qualified GetOpt.Declarative as Declarative+import           GetOpt.Declarative.Interpret (parse, interpretOptions, ParseResult(..))  type ConfigFile = (FilePath, [String])- type EnvVar = [String]  envVarName :: String envVarName = "HSPEC_OPTIONS" -data Config = Config {-  configIgnoreConfigFile :: Bool-, configDryRun :: Bool-, configFocusedOnly :: Bool-, configFailOnFocused :: Bool-, configPrintSlowItems :: Maybe Int-, configPrintCpuTime :: Bool-, configFastFail :: Bool-, configRandomize :: Bool-, configFailureReport :: Maybe FilePath-, configRerun :: Bool-, configRerunAllOnSuccess :: Bool---- |--- A predicate that is used to filter the spec before it is run.  Only examples--- that satisfy the predicate are run.-, configFilterPredicate :: Maybe (Path -> Bool)-, configSkipPredicate :: Maybe (Path -> Bool)-, configQuickCheckSeed :: Maybe Integer-, configQuickCheckMaxSuccess :: Maybe Int-, configQuickCheckMaxDiscardRatio :: Maybe Int-, configQuickCheckMaxSize :: Maybe Int-, configQuickCheckMaxShrinks :: Maybe Int-, configSmallCheckDepth :: Int-, configColorMode :: ColorMode-, configDiff :: Bool-, configTimes :: Bool-, configFormat :: Maybe (FormatConfig -> IO Format)-, configFormatter :: Maybe V1.Formatter -- ^ deprecated, use `configFormat` instead-, configHtmlOutput :: Bool-, configConcurrentJobs :: Maybe Int-}--defaultConfig :: Config-defaultConfig = Config {-  configIgnoreConfigFile = False-, configDryRun = False-, configFocusedOnly = False-, configFailOnFocused = False-, configPrintSlowItems = Nothing-, configPrintCpuTime = False-, configFastFail = False-, configRandomize = False-, configFailureReport = Nothing-, configRerun = False-, configRerunAllOnSuccess = False-, configFilterPredicate = Nothing-, configSkipPredicate = Nothing-, configQuickCheckSeed = Nothing-, configQuickCheckMaxSuccess = Nothing-, configQuickCheckMaxDiscardRatio = Nothing-, configQuickCheckMaxSize = Nothing-, configQuickCheckMaxShrinks = Nothing-, configSmallCheckDepth = paramsSmallCheckDepth defaultParams-, configColorMode = ColorAuto-, configDiff = True-, configTimes = False-, configFormat = Nothing-, configFormatter = Nothing-, configHtmlOutput = False-, configConcurrentJobs = Nothing-}--filterOr :: Maybe (Path -> Bool) -> Maybe (Path -> Bool) -> Maybe (Path -> Bool)-filterOr p1_ p2_ = case (p1_, p2_) of-  (Just p1, Just p2) -> Just $ \path -> p1 path || p2 path-  _ -> p1_ <|> p2_--addMatch :: String -> Config -> Config-addMatch s c = c {configFilterPredicate = Just (filterPredicate s) `filterOr` configFilterPredicate c}--addSkip :: String -> Config -> Config-addSkip s c = c {configSkipPredicate = Just (filterPredicate s) `filterOr` configSkipPredicate c}--setDepth :: Int -> Config -> Config-setDepth n c = c {configSmallCheckDepth = n}--setMaxSuccess :: Int -> Config -> Config-setMaxSuccess n c = c {configQuickCheckMaxSuccess = Just n}--setMaxDiscardRatio :: Int -> Config -> Config-setMaxDiscardRatio n c = c {configQuickCheckMaxDiscardRatio = Just n}--setMaxSize :: Int -> Config -> Config-setMaxSize n c = c {configQuickCheckMaxSize = Just n}--setMaxShrinks :: Int -> Config -> Config-setMaxShrinks n c = c {configQuickCheckMaxShrinks = Just n}--setSeed :: Integer -> Config -> Config-setSeed n c = c {configQuickCheckSeed = Just n}--data ColorMode = ColorAuto | ColorNever | ColorAlways-  deriving (Eq, Show)--type Result m = Either InvalidArgument (m Config)--data InvalidArgument = InvalidArgument String String--data Arg a = Arg {-  _argumentName   :: String-, _argumentParser :: String -> Maybe a-, _argumentSetter :: a -> Config -> Config-}--mkOption :: Monad m => [Char] -> String -> Arg a -> String -> OptDescr (Result m -> Result m)-mkOption shortcut name (Arg argName parser setter) help = Option shortcut [name] (ReqArg arg argName) help-  where-    arg input x = x >>= \c -> case parser input of-      Just n -> Right (setter n `liftM` c)-      Nothing -> Left (InvalidArgument name input)--printSlowItemsOption :: Monad m => OptDescr (Result m -> Result m)-printSlowItemsOption = Option "p" [name] (OptArg arg "N") "print the N slowest spec items (default: 10)"-  where-    name = "print-slow-items"-    setter v c = c {configPrintSlowItems = v}-    arg = maybe (set (setter $ Just 10)) parseArg-    parseArg input x = x >>= \ c -> case readMaybe input of-      Just 0 -> Right (setter Nothing `liftM` c)-      Just n -> Right (setter (Just n) `liftM` c)-      Nothing -> Left (InvalidArgument name input)--mkFlag :: Monad m => String -> (Bool -> Config -> Config) -> String -> [OptDescr (Result m -> Result m)]-mkFlag name setter help = [-    Option [] [name] (NoArg $ set $ setter True) help-  , Option [] ["no-" ++ name] (NoArg $ set $ setter False) ("do not " ++ help)-  ]--commandLineOptions :: [OptDescr (Result Maybe -> Result Maybe)]-commandLineOptions = [-    Option [] ["help"] (NoArg (const $ Right Nothing)) "display this help and exit"-  , Option [] ["ignore-dot-hspec"] (NoArg setIgnoreConfigFile) "do not read options from ~/.hspec and .hspec"-  , mkOption "m" "match" (Arg "PATTERN" return addMatch) "only run examples that match given PATTERN"-  , mkOption [] "skip" (Arg "PATTERN" return addSkip) "skip examples that match given PATTERN"-  ]-  where-    setIgnoreConfigFile = set $ \config -> config {configIgnoreConfigFile = True}--formatterOptions :: Monad m => [OptDescr (Result m -> Result m)]-formatterOptions = concat [-    [mkOption "f" "format" (Arg "FORMATTER" readFormatter setFormatter) helpForFormat]-  , mkFlag "color" setColor "colorize the output"-  , mkFlag "diff" setDiff "show colorized diffs"-  , mkFlag "times" setTimes "report times for individual spec items"-  , [Option [] ["print-cpu-time"] (NoArg setPrintCpuTime) "include used CPU time in summary"]-  , [printSlowItemsOption]-  ]-  where-    formatters :: [(String, FormatConfig -> IO Format)]-    formatters = map (fmap V2.formatterToFormat) [-        ("checks", V2.checks)-      , ("specdoc", V2.specdoc)-      , ("progress", V2.progress)-      , ("failed-examples", V2.failed_examples)-      , ("silent", V2.silent)-      ]--    helpForFormat :: String-    helpForFormat = "use a custom formatter; this can be one of " ++ (formatOrList $ map fst formatters)--    readFormatter :: String -> Maybe (FormatConfig -> IO Format)-    readFormatter = (`lookup` formatters)--    setFormatter :: (FormatConfig -> IO Format) -> Config -> Config-    setFormatter f c = c {configFormat = Just f}--    setColor :: Bool -> Config -> Config-    setColor v config = config {configColorMode = if v then ColorAlways else ColorNever}--    setDiff :: Bool -> Config -> Config-    setDiff v config = config {configDiff = v}--    setTimes :: Bool -> Config -> Config-    setTimes v config = config {configTimes = v}--    setPrintCpuTime = set $ \config -> config {configPrintCpuTime = True}--smallCheckOptions :: Monad m => [OptDescr (Result m -> Result m)]-smallCheckOptions = [-    mkOption [] "depth" (Arg "N" readMaybe setDepth) "maximum depth of generated test values for SmallCheck properties"-  ]--quickCheckOptions :: Monad m => [OptDescr (Result m -> Result m)]-quickCheckOptions = [-    mkOption "a" "qc-max-success" (Arg "N" readMaybe setMaxSuccess) "maximum number of successful tests before a QuickCheck property succeeds"-  , mkOption "" "qc-max-discard" (Arg "N" readMaybe setMaxDiscardRatio) "maximum number of discarded tests per successful test before giving up"-  , mkOption "" "qc-max-size" (Arg "N" readMaybe setMaxSize) "size to use for the biggest test cases"-  , mkOption "" "qc-max-shrinks" (Arg "N" readMaybe setMaxShrinks) "maximum number of shrinks to perform before giving up (a value of 0 turns shrinking off)"-  , mkOption [] "seed" (Arg "N" readMaybe setSeed) "used seed for QuickCheck properties"-  ]--runnerOptions :: Monad m => [OptDescr (Result m -> Result m)]-runnerOptions = concat [-    mkFlag "dry-run" setDryRun "pretend that everything passed; don't verify anything"-  , mkFlag "focused-only" setFocusedOnly "do not run anything, unless there are focused spec items"-  , mkFlag "fail-on-focused" setFailOnFocused "fail on focused spec items"-  , mkFlag "fail-fast" setFastFail "abort on first failure"-  , mkFlag "randomize" setRandomize "randomize execution order"-  ] ++ [-    Option "r" ["rerun"] (NoArg  setRerun) "rerun all examples that failed in the previous test run (only works in combination with --failure-report or in GHCi)"-  , mkOption [] "failure-report" (Arg "FILE" return setFailureReport) "read/write a failure report for use with --rerun"-  , Option [] ["rerun-all-on-success"] (NoArg setRerunAllOnSuccess) "run the whole test suite after a previously failing rerun succeeds for the first time (only works in combination with --rerun)"---  , mkOption "j" "jobs" (Arg "N" readMaxJobs setMaxJobs) "run at most N parallelizable tests simultaneously (default: number of available processors)"-  ]-  where-    readMaxJobs :: String -> Maybe Int-    readMaxJobs s = do-      n <- readMaybe s-      guard $ n > 0-      return n--    setFailureReport :: String -> Config -> Config-    setFailureReport file c = c {configFailureReport = Just file}--    setMaxJobs :: Int -> Config -> Config-    setMaxJobs n c = c {configConcurrentJobs = Just n}--    setDryRun :: Bool -> Config -> Config-    setDryRun value config = config {configDryRun = value}--    setFocusedOnly :: Bool -> Config -> Config-    setFocusedOnly value config = config {configFocusedOnly = value}--    setFailOnFocused :: Bool -> Config -> Config-    setFailOnFocused value config = config {configFailOnFocused = value}--    setFastFail :: Bool -> Config -> Config-    setFastFail value config = config {configFastFail = value}--    setRandomize :: Bool -> Config -> Config-    setRandomize value config = config {configRandomize = value}--    setRerun        = set $ \config -> config {configRerun = True}-    setRerunAllOnSuccess = set $ \config -> config {configRerunAllOnSuccess = True}+commandLineOptions :: [(String, [Declarative.Option Config])]+commandLineOptions =+    ("OPTIONS", commandLineOnlyOptions)+  : otherOptions -documentedConfigFileOptions :: Monad m => [(String, [OptDescr (Result m -> Result m)])]-documentedConfigFileOptions = [+otherOptions :: [(String, [Declarative.Option Config])]+otherOptions = [     ("RUNNER OPTIONS", runnerOptions)   , ("FORMATTER OPTIONS", formatterOptions)   , ("OPTIONS FOR QUICKCHECK", quickCheckOptions)   , ("OPTIONS FOR SMALLCHECK", smallCheckOptions)   ] -documentedOptions :: [(String, [OptDescr (Result Maybe -> Result Maybe)])]-documentedOptions = ("OPTIONS", commandLineOptions) : documentedConfigFileOptions--configFileOptions :: Monad m => [OptDescr (Result m -> Result m)]-configFileOptions = (concat . map snd) documentedConfigFileOptions--set :: Monad m => (Config -> Config) -> Either a (m Config) -> Either a (m Config)-set = liftM . liftM--undocumentedOptions :: Monad m => [OptDescr (Result m -> Result m)]-undocumentedOptions = [-    -- for compatibility with test-framework-    mkOption [] "maximum-generated-tests" (Arg "NUMBER" readMaybe setMaxSuccess) "how many automated tests something like QuickCheck should try, by default"--    -- undocumented for now, as we probably want to change this to produce a-    -- standalone HTML report in the future-  , Option []  ["html"]                    (NoArg setHtml)                    "produce HTML output"-  ]-  where-    setHtml = set $ \config -> config {configHtmlOutput = True}--recognizedOptions :: [OptDescr (Result Maybe -> Result Maybe)]-recognizedOptions = commandLineOptions ++ configFileOptions ++ undocumentedOptions+ignoreConfigFile :: Config -> [String] -> IO Bool+ignoreConfigFile config args = do+  ignore <- lookupEnv "IGNORE_DOT_HSPEC"+  case ignore of+    Just _ -> return True+    Nothing -> case parseCommandLineOptions "" args config of+      Right c -> return (configIgnoreConfigFile c)+      _ -> return False -parseOptions :: Config -> String -> [ConfigFile] -> Maybe EnvVar -> [String] -> Either (ExitCode, String) Config-parseOptions config prog configFiles envVar args = do+parseOptions :: Config -> String -> [ConfigFile] -> Maybe EnvVar -> [(String, String)] -> [String] -> Either (ExitCode, String) ([String], Config)+parseOptions config prog configFiles envVar env args = do       foldM (parseFileOptions prog) config configFiles-  >>= parseEnvVarOptions prog envVar-  >>= parseCommandLineOptions prog args+  >>= maybe return (parseEnvVarOptions prog) envVar+  >>= parseEnvironmentOptions env+  >>= traverseTuple (parseCommandLineOptions prog args) +traverseTuple :: Applicative f => (a -> f b) -> (c, a) -> f (c, b)+#if MIN_VERSION_base(4,7,0)+traverseTuple = traverse+#else+traverseTuple f (c, a) = (,) c <$> f a+#endif+ parseCommandLineOptions :: String -> [String] -> Config -> Either (ExitCode, String) Config-parseCommandLineOptions prog args config = case parse recognizedOptions config args of-  Right Nothing -> Left (ExitSuccess, usage)-  Right (Just c) -> Right c-  Left err -> failure err-  where-    failure err = Left (ExitFailure 1, prog ++ ": " ++ err ++ "\nTry `" ++ prog ++ " --help' for more information.\n")+parseCommandLineOptions prog args config = case Declarative.parseCommandLineOptions commandLineOptions prog args config of+  Success c -> Right c+  Help message -> Left (ExitSuccess, message)+  Failure message -> Left (ExitFailure 1, message) -    usage :: String-    usage = "Usage: " ++ prog ++ " [OPTION]...\n\n"-      ++ (intercalate "\n" $ map (uncurry mkUsageInfo) documentedOptions)+parseEnvironmentOptions :: [(String, String)] -> Config -> Either (ExitCode, String) ([String], Config)+parseEnvironmentOptions env config = case Declarative.parseEnvironmentOptions "HSPEC" env config (concatMap snd commandLineOptions) of+  (warnings, c) -> Right (map formatWarning warnings, c)+  where+    formatWarning (Declarative.InvalidValue name value) = "invalid value `" ++ value ++ "' for environment variable " ++ name  parseFileOptions :: String -> Config -> ConfigFile -> Either (ExitCode, String) Config parseFileOptions prog config (name, args) =   parseOtherOptions prog ("in config file " ++ name) args config -parseEnvVarOptions :: String -> (Maybe EnvVar) -> Config -> Either (ExitCode, String) Config-parseEnvVarOptions prog args =-  parseOtherOptions prog ("from environment variable " ++ envVarName) (fromMaybe [] args)+parseEnvVarOptions :: String -> EnvVar -> Config -> Either (ExitCode, String) Config+parseEnvVarOptions prog =+  parseOtherOptions prog ("from environment variable " ++ envVarName)  parseOtherOptions :: String -> String -> [String] -> Config -> Either (ExitCode, String) Config-parseOtherOptions prog source args config = case parse configFileOptions config args of-  Right (Identity c) -> Right c+parseOtherOptions prog source args config = case parse (interpretOptions options) config args of+  Right c -> Right c   Left err -> failure err   where+    options :: [Declarative.Option Config]+    options = filter Declarative.optionDocumented $ concatMap snd otherOptions+     failure err = Left (ExitFailure 1, prog ++ ": " ++ message)       where         message = unlines $ case lines err of           [x] -> [x ++ " " ++ source]           xs -> xs ++ [source]--parse :: Monad m => [OptDescr (Result m -> Result m)] -> Config -> [String] -> Either String (m Config)-parse options config args = case getOpt Permute options args of-  (opts, [], []) -> case foldl' (flip id) (Right $ return config) opts of-    Left (InvalidArgument name value) -> Left ("invalid argument `" ++ value ++ "' for `--" ++ name ++ "'")-    Right x -> Right x-  (_, _, err:_) -> Left (init err)-  (_, arg:_, _) -> Left ("unexpected argument `" ++ arg ++ "'")--ignoreConfigFile :: Config -> [String] -> IO Bool-ignoreConfigFile config args = do-  ignore <- lookupEnv "IGNORE_DOT_HSPEC"-  case ignore of-    Just _ -> return True-    Nothing -> case parse recognizedOptions config args of-      Right (Just c) -> return (configIgnoreConfigFile c)-      _ -> return False
− src/Test/Hspec/Core/Config/Util.hs 
@@ -1,40 +0,0 @@-module Test.Hspec.Core.Config.Util where--import           Prelude ()-import           Test.Hspec.Core.Compat--import           System.Console.GetOpt--import           Test.Hspec.Core.Util--modifyHelp :: (String -> String) -> OptDescr a -> OptDescr a-modifyHelp modify (Option s n a help) = Option s n a (modify help)--mkUsageInfo :: String -> [OptDescr a] -> String-mkUsageInfo title = usageInfo title . addLineBreaksForHelp . condenseNoOptions--addLineBreaksForHelp :: [OptDescr a] -> [OptDescr a]-addLineBreaksForHelp options = map (modifyHelp addLineBreaks) options-  where-    withoutHelpWidth = maxLength . usageInfo "" . map removeHelp-    helpWidth = 80 - withoutHelpWidth options--    addLineBreaks = unlines . lineBreaksAt helpWidth--    maxLength = maximum . map length . lines-    removeHelp = modifyHelp (const "")--condenseNoOptions :: [OptDescr a] -> [OptDescr a]-condenseNoOptions options = case options of-  Option "" [optionA] arg help : Option "" [optionB] _ _ : ys | optionB == ("no-" ++ optionA) ->-    Option "" ["[no-]" ++ optionA] arg help : condenseNoOptions ys-  x : xs -> x : condenseNoOptions xs-  [] -> []--formatOrList :: [String] -> String-formatOrList xs = case xs of-  [] -> ""-  x : ys -> (case ys of-    [] -> x-    _ : [] -> x ++ " or "-    _ : _ : _ -> x ++ ", ") ++ formatOrList ys
src/Test/Hspec/Core/Example/Location.hs view
@@ -76,7 +76,11 @@  fromPatternMatchFailureInDoExpression :: String -> Maybe Location fromPatternMatchFailureInDoExpression input =+#if MIN_VERSION_base(4,16,0)+  stripPrefix "Pattern match failure in 'do' block at " input >>= parseSourceSpan+#else   stripPrefix "Pattern match failure in do expression at " input >>= parseSourceSpan+#endif  parseCallStack :: String -> Maybe Location parseCallStack input = case reverse (lines input) of
src/Test/Hspec/Core/FailureReport.hs view
@@ -15,7 +15,7 @@ import           System.IO import           System.Directory import           Test.Hspec.Core.Util (Path)-import           Test.Hspec.Core.Config.Options (Config(..))+import           Test.Hspec.Core.Config.Definition (Config(..))  data FailureReport = FailureReport {   failureReportSeed :: Integer
+ test/GetOpt/Declarative/EnvironmentSpec.hs view
@@ -0,0 +1,70 @@+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+module GetOpt.Declarative.EnvironmentSpec (spec) where++import           Prelude ()+import           Helper++import           GetOpt.Declarative.Types+import           GetOpt.Declarative.Environment++spec :: Spec+spec = do+  describe "parseEnvironmentOption" $ do+    context "with NoArg" $ do+      let+        option :: Option Bool+        option = Option {+          optionName = "some-flag"+        , optionSetter = NoArg $ const True+        }+      it "accepts 'yes'" $ do+        parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "yes")] False option `shouldBe` Right True++      it "rejects other values" $ do+        parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "no")] False option `shouldBe` invalidValue "FOO_SOME_FLAG" "no"++    context "with Flag" $ do+      let+        option :: Option Bool+        option = Option {+          optionName = "some-flag"+        , optionSetter = Flag $ \ value _ -> value+        }+      it "accepts 'yes'" $ do+        parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "yes")] False option `shouldBe` Right True++      it "accepts 'no'" $ do+        parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "no")] True option `shouldBe` Right False++      it "rejects other values" $ do+        parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "nay")] True option `shouldBe` invalidValue "FOO_SOME_FLAG" "nay"++    context "with OptArg" $ do+      let+        option :: Option String+        option = Option {+          optionName = "some-flag"+        , optionSetter = OptArg undefined $ \ (Just arg) _ -> guard (arg == "yes") >> Just arg+        }++      it "accepts valid values" $ do+        parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "yes")] "" option `shouldBe` Right "yes"++      it "rejects invalid values" $ do+        parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "no")] "" option `shouldBe` invalidValue "FOO_SOME_FLAG" "no"++    context "with Arg" $ do+      let+        option :: Option String+        option = Option {+          optionName = "some-flag"+        , optionSetter = Arg undefined $ \ arg _ -> guard (arg == "yes") >> Just arg+        }++      it "accepts valid values" $ do+        parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "yes")] "" option `shouldBe` Right "yes"++      it "rejects invalid values" $ do+        parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "no")] "" option `shouldBe` invalidValue "FOO_SOME_FLAG" "no"+  where+    invalidValue name = Left . InvalidValue name
+ test/GetOpt/Declarative/UtilSpec.hs view
@@ -0,0 +1,31 @@+module GetOpt.Declarative.UtilSpec (spec) where++import           Prelude ()+import           Helper++import           System.Console.GetOpt++import           GetOpt.Declarative.Util++spec :: Spec+spec = do+  describe "mkUsageInfo" $ do+    it "restricts output size to 80 characters" $ do+      let options = [+              Option "" ["color"] (NoArg ()) (unwords $ replicate 3 "some very long and verbose help text")+            ]+      mkUsageInfo "" options `shouldBe` unlines [+          ""+        , "    --color  some very long and verbose help text some very long and verbose"+        , "             help text some very long and verbose help text"+        ]++    it "condenses help for --no-options" $ do+      let options = [+              Option "" ["color"] (NoArg ()) "some help"+            , Option "" ["no-color"] (NoArg ()) "some other help"+            ]+      mkUsageInfo "" options `shouldBe` unlines [+          ""+        , "    --[no-]color  some help"+        ]
+ test/Test/Hspec/Core/Config/DefinitionSpec.hs view
@@ -0,0 +1,12 @@+module Test.Hspec.Core.Config.DefinitionSpec (spec) where++import           Prelude ()+import           Helper++import           Test.Hspec.Core.Config.Definition++spec :: Spec+spec = do+  describe "formatOrList" $ do+    it "formats a list of or-options" $ do+      formatOrList ["foo", "bar", "baz"] `shouldBe` "foo, bar or baz"
test/Test/Hspec/Core/Config/OptionsSpec.hs view
@@ -17,97 +17,101 @@ spec = do   describe "parseOptions" $ do -    let parseOptions = Options.parseOptions defaultConfig "my-spec"+    let parseOptions configFiles envVar env args = snd <$> Options.parseOptions defaultConfig "my-spec" configFiles envVar env args      it "rejects unexpected arguments" $ do-      fromLeft (parseOptions [] Nothing ["foo"]) `shouldBe` (ExitFailure 1, "my-spec: unexpected argument `foo'\nTry `my-spec --help' for more information.\n")+      fromLeft (parseOptions [] Nothing [] ["foo"]) `shouldBe` (ExitFailure 1, "my-spec: unexpected argument `foo'\nTry `my-spec --help' for more information.\n")      it "rejects unrecognized options" $ do-      fromLeft (parseOptions [] Nothing ["--foo"]) `shouldBe` (ExitFailure 1, "my-spec: unrecognized option `--foo'\nTry `my-spec --help' for more information.\n")+      fromLeft (parseOptions [] Nothing [] ["--foo"]) `shouldBe` (ExitFailure 1, "my-spec: unrecognized option `--foo'\nTry `my-spec --help' for more information.\n")      it "sets configColorMode to ColorAuto" $ do-      configColorMode <$> parseOptions [] Nothing [] `shouldBe` Right ColorAuto+      configColorMode <$> parseOptions [] Nothing [] [] `shouldBe` Right ColorAuto +    context "when the same option is specified multiple times" $ do+      it "gives later occurrences precedence" $ do+        configColorMode <$> parseOptions [] Nothing [] ["--color", "--no-color"] `shouldBe` Right ColorNever+     context "with --help" $ do-      let Left (code, output) = parseOptions [] Nothing ["--help"]-          help = lines output+      let Left (code, help) = Options.parseOptions defaultConfig "spec" [] Nothing [] ["--help"]        it "returns ExitSuccess" $ do         code `shouldBe` ExitSuccess        it "prints help" $ do-        help `shouldStartWith` ["Usage: my-spec [OPTION]..."]+        expected <- readFile "help.txt"+        help `shouldBe` expected      context "with --color" $ do       it "sets configColorMode to ColorAlways" $ do-        configColorMode <$> parseOptions [] Nothing ["--color"] `shouldBe` Right ColorAlways+        configColorMode <$> parseOptions [] Nothing [] ["--color"] `shouldBe` Right ColorAlways      context "with --no-color" $ do       it "sets configColorMode to ColorNever" $ do-        configColorMode <$> parseOptions [] Nothing ["--no-color"] `shouldBe` Right ColorNever+        configColorMode <$> parseOptions [] Nothing [] ["--no-color"] `shouldBe` Right ColorNever      context "with --diff" $ do       it "sets configDiff to True" $ do-        configDiff <$> parseOptions [] Nothing ["--diff"] `shouldBe` Right True+        configDiff <$> parseOptions [] Nothing [] ["--diff"] `shouldBe` Right True      context "with --no-diff" $ do       it "sets configDiff to False" $ do-        configDiff <$> parseOptions [] Nothing ["--no-diff"] `shouldBe` Right False+        configDiff <$> parseOptions [] Nothing [] ["--no-diff"] `shouldBe` Right False      context "with --print-slow-items" $ do       it "sets configPrintSlowItems to N" $ do-        configPrintSlowItems <$> parseOptions [] Nothing ["--print-slow-items=5"] `shouldBe` Right (Just 5)+        configPrintSlowItems <$> parseOptions [] Nothing [] ["--print-slow-items=5"] `shouldBe` Right (Just 5)        it "defaults N to 10" $ do-        configPrintSlowItems <$> parseOptions [] Nothing ["--print-slow-items"] `shouldBe` Right (Just 10)+        configPrintSlowItems <$> parseOptions [] Nothing [] ["--print-slow-items"] `shouldBe` Right (Just 10)        it "rejects invalid values" $ do         let msg = "my-spec: invalid argument `foo' for `--print-slow-items'\nTry `my-spec --help' for more information.\n"-        void (parseOptions [] Nothing ["--print-slow-items=foo"]) `shouldBe` Left (ExitFailure 1, msg)+        void (parseOptions [] Nothing [] ["--print-slow-items=foo"]) `shouldBe` Left (ExitFailure 1, msg)        context "when N is 0" $ do         it "disables the option" $ do-          configPrintSlowItems <$> parseOptions [] Nothing ["-p0"] `shouldBe` Right Nothing+          configPrintSlowItems <$> parseOptions [] Nothing [] ["-p0"] `shouldBe` Right Nothing      context "with --qc-max-success" $ do       it "sets QuickCheck maxSuccess" $ do-        maxSuccess . configQuickCheckArgs <$> (parseOptions [] Nothing ["--qc-max-success", "23"]) `shouldBe`  Right 23+        maxSuccess . configQuickCheckArgs <$> (parseOptions [] Nothing [] ["--qc-max-success", "23"]) `shouldBe`  Right 23        context "when given an invalid argument" $ do         it "returns an error message" $ do-          fromLeft (parseOptions [] Nothing ["--qc-max-success", "foo"]) `shouldBe` (ExitFailure 1, "my-spec: invalid argument `foo' for `--qc-max-success'\nTry `my-spec --help' for more information.\n")+          fromLeft (parseOptions [] Nothing [] ["--qc-max-success", "foo"]) `shouldBe` (ExitFailure 1, "my-spec: invalid argument `foo' for `--qc-max-success'\nTry `my-spec --help' for more information.\n")      context "with --qc-max-shrinks" $ do       it "sets QuickCheck maxShrinks" $ do-        maxShrinks . configQuickCheckArgs <$> (parseOptions [] Nothing ["--qc-max-shrinks", "23"]) `shouldBe`  Right 23+        maxShrinks . configQuickCheckArgs <$> (parseOptions [] Nothing [] ["--qc-max-shrinks", "23"]) `shouldBe`  Right 23      context "with --depth" $ do       it "sets depth parameter for SmallCheck" $ do-        configSmallCheckDepth <$> parseOptions [] Nothing ["--depth", "23"] `shouldBe` Right 23+        configSmallCheckDepth <$> parseOptions [] Nothing [] ["--depth", "23"] `shouldBe` Right 23      context "with --jobs" $ do       it "sets number of concurrent jobs" $ do-        configConcurrentJobs <$> parseOptions [] Nothing ["--jobs=23"] `shouldBe` Right (Just 23)+        configConcurrentJobs <$> parseOptions [] Nothing [] ["--jobs=23"] `shouldBe` Right (Just 23)        it "rejects values < 1" $ do         let msg = "my-spec: invalid argument `0' for `--jobs'\nTry `my-spec --help' for more information.\n"-        void (parseOptions [] Nothing ["--jobs=0"]) `shouldBe` Left (ExitFailure 1, msg)+        void (parseOptions [] Nothing [] ["--jobs=0"]) `shouldBe` Left (ExitFailure 1, msg)      context "when given a config file" $ do       it "uses options from config file" $ do-        configColorMode <$> parseOptions [("~/.hspec", ["--no-color"])] Nothing [] `shouldBe` Right ColorNever+        configColorMode <$> parseOptions [("~/.hspec", ["--no-color"])] Nothing [] [] `shouldBe` Right ColorNever        it "gives command-line options precedence" $ do-        configColorMode <$> parseOptions [("~/.hspec", ["--no-color"])] Nothing ["--color"] `shouldBe` Right ColorAlways+        configColorMode <$> parseOptions [("~/.hspec", ["--no-color"])] Nothing [] ["--color"] `shouldBe` Right ColorAlways        it "rejects --help" $ do-        fromLeft (parseOptions [("~/.hspec", ["--help"])] Nothing []) `shouldBe` (ExitFailure 1, "my-spec: unrecognized option `--help' in config file ~/.hspec\n")+        fromLeft (parseOptions [("~/.hspec", ["--help"])] Nothing [] []) `shouldBe` (ExitFailure 1, "my-spec: unrecognized option `--help' in config file ~/.hspec\n")        it "rejects unrecognized options" $ do-        fromLeft (parseOptions [("~/.hspec", ["--invalid"])] Nothing []) `shouldBe` (ExitFailure 1, "my-spec: unrecognized option `--invalid' in config file ~/.hspec\n")+        fromLeft (parseOptions [("~/.hspec", ["--invalid"])] Nothing [] []) `shouldBe` (ExitFailure 1, "my-spec: unrecognized option `--invalid' in config file ~/.hspec\n")        it "rejects ambiguous options" $ do-        fromLeft (parseOptions [("~/.hspec", ["--fail"])] Nothing []) `shouldBe` (ExitFailure 1,+        fromLeft (parseOptions [("~/.hspec", ["--fail"])] Nothing [] []) `shouldBe` (ExitFailure 1,           unlines [             "my-spec: option `--fail' is ambiguous; could be one of:"           , "    --fail-on-focused      fail on focused spec items"@@ -117,19 +121,33 @@           ]           ) +      context "when the same option is specified multiple times" $ do+        it "gives later occurrences precedence" $ do+          configColorMode <$> parseOptions [("~/.hspec", ["--color", "--no-color"])] Nothing [] [] `shouldBe` Right ColorNever+     context "when given multiple config files" $ do       it "gives later config files precedence" $ do-        configColorMode <$> parseOptions [("~/.hspec", ["--no-color"]), (".hspec", ["--color"])] Nothing [] `shouldBe` Right ColorAlways+        configColorMode <$> parseOptions [("~/.hspec", ["--no-color"]), (".hspec", ["--color"])] Nothing [] [] `shouldBe` Right ColorAlways -    context "when given an environment variable" $ do-      it "uses options from environment variable" $ do-        configColorMode <$> parseOptions [] (Just ["--no-color"]) [] `shouldBe` Right ColorNever+    context "when given HSPEC_OPTIONS (deprecated)" $ do+      it "uses options from HSPEC_OPTIONS" $ do+        configColorMode <$> parseOptions [] (Just ["--no-color"]) [] [] `shouldBe` Right ColorNever        it "gives command-line options precedence" $ do-        configColorMode <$> parseOptions [] (Just ["--no-color"]) ["--color"] `shouldBe` Right ColorAlways+        configColorMode <$> parseOptions [] (Just ["--no-color"]) [] ["--color"] `shouldBe` Right ColorAlways        it "rejects unrecognized options" $ do-        fromLeft (parseOptions [] (Just ["--invalid"]) []) `shouldBe` (ExitFailure 1, "my-spec: unrecognized option `--invalid' from environment variable HSPEC_OPTIONS\n")+        fromLeft (parseOptions [] (Just ["--invalid"]) [] []) `shouldBe` (ExitFailure 1, "my-spec: unrecognized option `--invalid' from environment variable HSPEC_OPTIONS\n")++    context "when given an option as an environment variable" $ do+      it "sets config value from environment variable" $ do+        configColorMode <$> parseOptions [] Nothing [("HSPEC_COLOR", "no")] [] `shouldBe` Right ColorNever++      it "gives command-line options precedence" $ do+        configColorMode <$> parseOptions [] Nothing [("HSPEC_COLOR", "no")] ["--color"] `shouldBe` Right ColorAlways++      it "warns on unrecognized option values" $ do+        fmap configColorMode <$> Options.parseOptions defaultConfig "my-spec" [] Nothing [("HSPEC_COLOR", "foo")] [] `shouldBe` Right (["invalid value `foo' for environment variable HSPEC_COLOR"], ColorAuto)    describe "ignoreConfigFile" $ around_ (withEnvironment []) $ do     context "by default" $ do
− test/Test/Hspec/Core/Config/UtilSpec.hs 
@@ -1,35 +0,0 @@-module Test.Hspec.Core.Config.UtilSpec (spec) where--import           Prelude ()-import           Helper--import           System.Console.GetOpt--import           Test.Hspec.Core.Config.Util--spec :: Spec-spec = do-  describe "mkUsageInfo" $ do-    it "restricts output size to 80 characters" $ do-      let options = [-              Option "" ["color"] (NoArg ()) (unwords $ replicate 3 "some very long and verbose help text")-            ]-      mkUsageInfo "" options `shouldBe` unlines [-          ""-        , "    --color  some very long and verbose help text some very long and verbose"-        , "             help text some very long and verbose help text"-        ]--    it "condenses help for --no-options" $ do-      let options = [-              Option "" ["color"] (NoArg ()) "some help"-            , Option "" ["no-color"] (NoArg ()) "some other help"-            ]-      mkUsageInfo "" options `shouldBe` unlines [-          ""-        , "    --[no-]color  some help"-        ]--  describe "formatOrList" $ do-    it "formats a list of or-options" $ do-      formatOrList ["foo", "bar", "baz"] `shouldBe` "foo, bar or baz"
test/Test/Hspec/Core/ConfigSpec.hs view
@@ -9,8 +9,17 @@ import           Test.Hspec.Core.Config  spec :: Spec-spec = do-  describe "readConfigFiles" $ around_ inTempDirectory $ around_ (withEnvironment [("HOME", "/foo")]) $ do+spec = around_ inTempDirectory $ around_ (withEnvironment [("HOME", "foo")]) $ do+  describe "readConfig" $ do+    it "recognizes options from HSPEC_OPTIONS" $ do+      withEnvironment [("HSPEC_OPTIONS", "--color")] $ do+        configColorMode <$> readConfig defaultConfig [] `shouldReturn` ColorAlways++    it "recognizes options from HSPEC_*" $ do+      withEnvironment [("HSPEC_COLOR", "yes")] $ do+        configColorMode <$> readConfig defaultConfig [] `shouldReturn` ColorAlways++  describe "readConfigFiles" $ do     it "reads .hspec" $ do       dir <- getCurrentDirectory       let name = dir </> ".hspec"
vendor/Data/Algorithm/Diff.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveFunctor #-}+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Algorithm.Diff
version.yaml view
@@ -1,1 +1,1 @@-&version 2.8.3+&version 2.8.4