diff --git a/CHANGES.markdown b/CHANGES.markdown
--- a/CHANGES.markdown
+++ b/CHANGES.markdown
@@ -1,3 +1,52 @@
+## Changes in 2.5.5
+  - Use `module[line:column]` instead of `module:line:column` as default label
+    for `describe`/`it` (fixes #366)
+
+## Changes in 2.5.4
+  - Show how to rerun individual spec items on test failures (see #205)
+
+## Changes in 2.5.3
+  - Treat character escapes like `\NUL` as single tokens on `--diff` (see #351)
+  - Allow a `/` at the beginning and at the end of an absolute path that is
+    passed to `--match` or `--skip`
+
+## Changes in 2.5.2
+  - Use module:line:column as default label for describe/it (see #250)
+  - Warn if user is affected by https://ghc.haskell.org/trac/ghc/ticket/13285 (see #329)
+
+## Changes in 2.5.1
+  - Disable tests for Test.Hspec.Core.Timer (see #352)
+
+## Changes in 2.5.0
+  - Add `sequential` (see #311)
+  - Add support for `--diff` when `shouldBe` is uesd with
+    `QuickCheck`-properties
+  - Add source locations when `shouldBe` is uesd with `QuickCheck` properties
+  - Print `QuickCheck` labels on success (see #297)
+  - Retain output of `verbose`, `label`, `collect`, `classify`, etc. for
+    `QuickCheck` properties (see #257)
+  - Extract source location from error / undefined (see #316)
+  - Parse source locations from pattern match failures
+  - Include source column when formatting source locations
+  - Colorize whitespaces with background color instead of foreground color with
+    `--diff`
+  - Run `Test.Hspec.Core.Formatters.exampleProgress` in `FormatM` instead of
+    `IO`
+  - Make sure that progress output is always cleared (fixes #301)
+  - Add location information to `pending` (not used by any formatter yet)
+  - Include duration for each spec item in new formatter API (see #315) (not yet exposed)
+  - Removed deprecated module `Test.Hspec.HUnit`, use
+    `Test.Hspec.Contrib.HUnit` instead
+  - Deprecate `--out`
+  - Remove `BestEffort` source locations
+
+## Changes in 2.4.8
+  - compatibility with GHC 8.4.1-alpha3
+
+## Changes in 2.4.7
+  - compatibility with `QuickCheck-2.11.3` and up (note that `QuickCheck`
+    versions `2.11` to `2.11.2` are not fully supported)
+
 ## Changes in 2.4.6
   - compatibility with the upcoming version `4.11.0.0` of `base`
 
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright (c) 2011-2017 Simon Hengel <sol@typeful.net>
+Copyright (c) 2011-2018 Simon Hengel <sol@typeful.net>
 Copyright (c) 2011-2012 Trystan Spangler <trystan.s@comcast.net>
 Copyright (c) 2011-2011 Greg Weber <greg@gregweber.info>
 
diff --git a/hspec-core/src/Test/Hspec/Core/Clock.hs b/hspec-core/src/Test/Hspec/Core/Clock.hs
new file mode 100644
--- /dev/null
+++ b/hspec-core/src/Test/Hspec/Core/Clock.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Test.Hspec.Core.Clock (
+  Seconds(..)
+, toMicroseconds
+, getMonotonicTime
+, measure
+, sleep
+) where
+
+import           Text.Printf
+import           System.Clock
+import           Control.Concurrent
+
+newtype Seconds = Seconds Double
+  deriving (Eq, Show, Num, Fractional, PrintfArg)
+
+toMicroseconds :: Seconds -> Int
+toMicroseconds (Seconds s) = floor (s * 1000000)
+
+getMonotonicTime :: IO Seconds
+getMonotonicTime = do
+  t <- getTime Monotonic
+  return $ Seconds ((fromIntegral . toNanoSecs $ t) / 1000000000)
+
+measure :: IO a -> IO (Seconds, a)
+measure action = do
+  t0 <- getMonotonicTime
+  a <- action
+  t1 <- getMonotonicTime
+  return (t1 - t0, a)
+
+sleep :: Seconds -> IO ()
+sleep = threadDelay . toMicroseconds
diff --git a/hspec-core/src/Test/Hspec/Core/Compat.hs b/hspec-core/src/Test/Hspec/Core/Compat.hs
--- a/hspec-core/src/Test/Hspec/Core/Compat.hs
+++ b/hspec-core/src/Test/Hspec/Core/Compat.hs
@@ -9,19 +9,33 @@
 
 , module Prelude
 , module Control.Applicative
+, module Control.Monad
 , module Data.Foldable
 , module Data.Traversable
 , module Data.Monoid
+, module Data.List
 
 #if !MIN_VERSION_base(4,6,0)
 , modifyIORef'
+, atomicWriteIORef
 #endif
+, interruptible
 ) where
 
 import           Control.Applicative
+import           Control.Monad hiding (
+    mapM
+  , mapM_
+  , forM
+  , forM_
+  , msum
+  , sequence
+  , sequence_
+  )
 import           Data.Foldable
 import           Data.Traversable
 import           Data.Monoid
+import           Data.List (intercalate)
 
 import           Prelude hiding (
     all
@@ -54,6 +68,12 @@
 import           Data.Typeable (tyConModule, tyConName)
 import           Control.Concurrent
 
+#if MIN_VERSION_base(4,9,0)
+import           Control.Exception (interruptible)
+#else
+import           GHC.IO
+#endif
+
 #if !MIN_VERSION_base(4,6,0)
 import qualified Text.ParserCombinators.ReadP as P
 
@@ -64,6 +84,11 @@
     let x' = f x
     x' `seq` writeIORef ref x'
 
+atomicWriteIORef :: IORef a -> a -> IO ()
+atomicWriteIORef ref a = do
+    x <- atomicModifyIORef ref (\_ -> (a, ()))
+    x `seq` return ()
+
 -- | Parse a string using the 'Read' instance.
 -- Succeeds if there is exactly one valid result.
 -- A 'Left' value indicates a parse error.
@@ -104,3 +129,13 @@
 
 getDefaultConcurrentJobs :: IO Int
 getDefaultConcurrentJobs = getNumCapabilities
+
+#if !MIN_VERSION_base(4,9,0)
+interruptible :: IO a -> IO a
+interruptible act = do
+  st <- getMaskingState
+  case st of
+    Unmasked              -> act
+    MaskedInterruptible   -> unsafeUnmask act
+    MaskedUninterruptible -> act
+#endif
diff --git a/hspec-core/src/Test/Hspec/Core/Config.hs b/hspec-core/src/Test/Hspec/Core/Config.hs
--- a/hspec-core/src/Test/Hspec/Core/Config.hs
+++ b/hspec-core/src/Test/Hspec/Core/Config.hs
@@ -12,9 +12,9 @@
 ) where
 
 import           Prelude ()
+import           Test.Hspec.Core.Compat
 
 import           Control.Exception
-import           Control.Monad
 import           Data.Maybe
 import           System.IO
 import           System.IO.Error
@@ -24,8 +24,7 @@
 import qualified Test.QuickCheck as QC
 
 import           Test.Hspec.Core.Util
-import           Test.Hspec.Core.Compat
-import           Test.Hspec.Core.Options
+import           Test.Hspec.Core.Config.Options
 import           Test.Hspec.Core.FailureReport
 import           Test.Hspec.Core.QuickCheckUtil (mkGen)
 import           Test.Hspec.Core.Example (Params(..), defaultParams)
diff --git a/hspec-core/src/Test/Hspec/Core/Config/Options.hs b/hspec-core/src/Test/Hspec/Core/Config/Options.hs
new file mode 100644
--- /dev/null
+++ b/hspec-core/src/Test/Hspec/Core/Config/Options.hs
@@ -0,0 +1,311 @@
+module Test.Hspec.Core.Config.Options (
+  Config(..)
+, ColorMode (..)
+, defaultConfig
+, filterOr
+, parseOptions
+, ConfigFile
+, ignoreConfigFile
+, envVarName
+) where
+
+import           Prelude ()
+import           Test.Hspec.Core.Compat
+
+import           System.IO
+import           System.Exit
+import           System.Console.GetOpt
+
+import           Test.Hspec.Core.Formatters
+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
+
+type ConfigFile = (FilePath, [String])
+
+type EnvVar = [String]
+
+envVarName :: String
+envVarName = "HSPEC_OPTIONS"
+
+data Config = Config {
+  configIgnoreConfigFile :: Bool
+, configDryRun :: Bool
+, configPrintCpuTime :: Bool
+, configFastFail :: 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
+, configSmallCheckDepth :: Int
+, configColorMode :: ColorMode
+, configDiff :: Bool
+, configFormatter :: Maybe Formatter
+, configHtmlOutput :: Bool
+, configOutputFile :: Either Handle FilePath
+, configConcurrentJobs :: Maybe Int
+}
+
+defaultConfig :: Config
+defaultConfig = Config {
+  configIgnoreConfigFile = False
+, configDryRun = False
+, configPrintCpuTime = False
+, configFastFail = False
+, configFailureReport = Nothing
+, configRerun = False
+, configRerunAllOnSuccess = False
+, configFilterPredicate = Nothing
+, configSkipPredicate = Nothing
+, configQuickCheckSeed = Nothing
+, configQuickCheckMaxSuccess = Nothing
+, configQuickCheckMaxDiscardRatio = Nothing
+, configQuickCheckMaxSize = Nothing
+, configSmallCheckDepth = paramsSmallCheckDepth defaultParams
+, configColorMode = ColorAuto
+, configDiff = True
+, configFormatter = Nothing
+, configHtmlOutput = False
+, configOutputFile = Left stdout
+, 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}
+
+setMaxSize :: Int -> Config -> Config
+setMaxSize n c = c {configQuickCheckMaxSize = Just n}
+
+setMaxDiscardRatio :: Int -> Config -> Config
+setMaxDiscardRatio n c = c {configQuickCheckMaxDiscardRatio = 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)
+
+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"
+  , [Option [] ["print-cpu-time"] (NoArg setPrintCpuTime) "include used CPU time in summary"]
+  ]
+  where
+    formatters :: [(String, Formatter)]
+    formatters = [
+        ("specdoc", specdoc)
+      , ("progress", progress)
+      , ("failed-examples", failed_examples)
+      , ("silent", silent)
+      ]
+
+    helpForFormat :: String
+    helpForFormat = "use a custom formatter; this can be one of " ++ (formatOrList $ map fst formatters)
+
+    readFormatter :: String -> Maybe Formatter
+    readFormatter = (`lookup` formatters)
+
+    setFormatter :: Formatter -> Config -> Config
+    setFormatter f c = c {configFormatter = 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}
+
+    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-size" (Arg "N" readMaybe setMaxSize) "size to use for the biggest test cases"
+  , mkOption "" "qc-max-discard" (Arg "N" readMaybe setMaxDiscardRatio) "maximum number of discarded tests per successful test before giving up"
+  , mkOption [] "seed" (Arg "N" readMaybe setSeed) "used seed for QuickCheck properties"
+  ]
+
+runnerOptions :: Monad m => [OptDescr (Result m -> Result m)]
+runnerOptions = [
+    Option [] ["dry-run"] (NoArg setDryRun) "pretend that everything passed; don't verify anything"
+  , Option [] ["fail-fast"] (NoArg setFastFail) "abort on first failure"
+  , 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       = set $ \config -> config {configDryRun = True}
+    setFastFail     = set $ \config -> config {configFastFail = True}
+    setRerun        = set $ \config -> config {configRerun = True}
+    setRerunAllOnSuccess = set $ \config -> config {configRerunAllOnSuccess = True}
+
+documentedConfigFileOptions :: Monad m => [(String, [OptDescr (Result m -> Result m)])]
+documentedConfigFileOptions = [
+    ("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"
+
+  , mkOption "o"  "out"                    (Arg "FILE" return setOutputFile)  "write output to a file instead of STDOUT"
+
+    -- now a noop
+  , Option "v" ["verbose"]                 (NoArg id)                         "do not suppress output to stdout when evaluating examples"
+  ]
+  where
+    setHtml = set $ \config -> config {configHtmlOutput = True}
+
+    setOutputFile :: String -> Config -> Config
+    setOutputFile file c = c {configOutputFile = Right file}
+
+recognizedOptions :: [OptDescr (Result Maybe -> Result Maybe)]
+recognizedOptions = commandLineOptions ++ configFileOptions ++ undocumentedOptions
+
+parseOptions :: Config -> String -> [ConfigFile] -> Maybe EnvVar -> [String] -> Either (ExitCode, String) Config
+parseOptions config prog configFiles envVar args = do
+      foldM (parseFileOptions prog) config configFiles
+  >>= parseEnvVarOptions prog envVar
+  >>= parseCommandLineOptions prog args
+
+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")
+
+    usage :: String
+    usage = "Usage: " ++ prog ++ " [OPTION]...\n\n"
+      ++ (intercalate "\n" $ map (uncurry mkUsageInfo) documentedOptions)
+
+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)
+
+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
+  Left err -> failure err
+  where
+    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
diff --git a/hspec-core/src/Test/Hspec/Core/Config/Util.hs b/hspec-core/src/Test/Hspec/Core/Config/Util.hs
new file mode 100644
--- /dev/null
+++ b/hspec-core/src/Test/Hspec/Core/Config/Util.hs
@@ -0,0 +1,37 @@
+module Test.Hspec.Core.Config.Util where
+
+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
diff --git a/hspec-core/src/Test/Hspec/Core/Example.hs b/hspec-core/src/Test/Hspec/Core/Example.hs
--- a/hspec-core/src/Test/Hspec/Core/Example.hs
+++ b/hspec-core/src/Test/Hspec/Core/Example.hs
@@ -1,4 +1,9 @@
-{-# LANGUAGE CPP, TypeFamilies, FlexibleInstances, TypeSynonymInstances, DeriveDataTypeable #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 module Test.Hspec.Core.Example (
   Example (..)
 , Params (..)
@@ -6,33 +11,30 @@
 , ActionWith
 , Progress
 , ProgressCallback
-, Result (..)
+, Result(..)
+, ResultStatus (..)
 , Location (..)
-, LocationAccuracy (..)
 , FailureReason (..)
 , safeEvaluateExample
 ) where
 
-import           Data.Maybe (fromMaybe)
-import           Data.List (isPrefixOf)
 import qualified Test.HUnit.Lang as HUnit
 
-#if MIN_VERSION_HUnit(1,4,0)
 import           Data.CallStack
-#endif
 
-import qualified Control.Exception as E
+import           Control.Exception
 import           Control.DeepSeq
 import           Data.Typeable (Typeable)
 import qualified Test.QuickCheck as QC
 import           Test.Hspec.Expectations (Expectation)
 
-import qualified Test.QuickCheck.State as QC
+import qualified Test.QuickCheck.State as QC (numSuccessTests, maxSuccessTests)
 import qualified Test.QuickCheck.Property as QCP
 
 import           Test.Hspec.Core.QuickCheckUtil
 import           Test.Hspec.Core.Util
 import           Test.Hspec.Core.Compat
+import           Test.Hspec.Core.Example.Location
 
 -- | A type class for examples
 class Example e where
@@ -58,49 +60,49 @@
 type ActionWith a = a -> IO ()
 
 -- | The result of running an example
-data Result = Success | Pending (Maybe String) | Failure (Maybe Location) FailureReason
-  deriving (Eq, Show, Read, Typeable)
+data Result = Result {
+  resultInfo :: String
+, resultStatus :: ResultStatus
+} deriving (Show, Typeable)
 
-data FailureReason = NoReason | Reason String | ExpectedButGot (Maybe String) String String
-    deriving (Eq, Show, Read, Typeable)
+data ResultStatus =
+    Success
+  | Pending (Maybe Location) (Maybe String)
+  | Failure (Maybe Location) FailureReason
+  deriving (Show, Typeable)
 
+data FailureReason =
+    NoReason
+  | Reason String
+  | ExpectedButGot (Maybe String) String String
+  | Error (Maybe String) SomeException
+  deriving (Show, Typeable)
+
 instance NFData FailureReason where
   rnf reason = case reason of
     NoReason -> ()
     Reason r -> r `deepseq` ()
     ExpectedButGot p e a  -> p `deepseq` e `deepseq` a `deepseq` ()
-
-instance E.Exception Result
-
--- | @Location@ is used to represent source locations.
-data Location = Location {
-  locationFile :: FilePath
-, locationLine :: Int
-, locationColumn :: Int
-, locationAccuracy :: LocationAccuracy
-} deriving (Eq, Show, Read)
+    Error m e -> m `deepseq` e `seq` ()
 
--- | A marker for source locations
-data LocationAccuracy =
-  -- | The source location is accurate
-  ExactLocation |
-  -- | The source location was determined on a best-effort basis and my be
-  -- wrong or inaccurate
-  BestEffort
-  deriving (Eq, Show, Read)
+instance Exception ResultStatus
 
-safeEvaluateExample :: Example e => e -> Params -> (ActionWith (Arg e) -> IO ()) -> ProgressCallback -> IO (Either E.SomeException Result)
+safeEvaluateExample :: Example e => e -> Params -> (ActionWith (Arg e) -> IO ()) -> ProgressCallback -> IO Result
 safeEvaluateExample example params around progress = do
   r <- safeTry $ forceResult <$> evaluateExample example params around progress
   return $ case r of
-    Left e | Just result <- E.fromException e -> Right result
-    Left e | Just hunit <- E.fromException e -> Right (hunitFailureToResult hunit)
-    _ -> r
+    Left e | Just result <- fromException e -> Result "" result
+    Left e | Just hunit <- fromException e -> Result "" $ hunitFailureToResult Nothing hunit
+    Left e -> Result "" $ Failure Nothing $ Error Nothing e
+    Right result -> result
   where
     forceResult :: Result -> Result
-    forceResult r = case r of
+    forceResult r@(Result info status) = info `deepseq` (forceResultStatus status) `seq` r
+
+    forceResultStatus :: ResultStatus -> ResultStatus
+    forceResultStatus r = case r of
       Success -> r
-      Pending m -> m `deepseq` r
+      Pending _ m -> m `deepseq` r
       Failure _ m -> m `deepseq` r
 
 instance Example Result where
@@ -110,8 +112,8 @@
 instance Example (a -> Result) where
   type Arg (a -> Result) = a
   evaluateExample example _params action _callback = do
-    ref <- newIORef Success
-    action (writeIORef ref . example)
+    ref <- newIORef (Result "" Success)
+    action (evaluate . example >=> writeIORef ref)
     readIORef ref
 
 instance Example Bool where
@@ -121,44 +123,42 @@
 instance Example (a -> Bool) where
   type Arg (a -> Bool) = a
   evaluateExample p _params action _callback = do
-    ref <- newIORef Success
-    action $ \a -> example a >>= writeIORef ref
+    ref <- newIORef (Result "" Success)
+    action (evaluate . example >=> writeIORef ref)
     readIORef ref
     where
       example a
-        | p a = return Success
-        | otherwise = return (Failure Nothing NoReason)
+        | p a = Result "" Success
+        | otherwise = Result "" $ Failure Nothing NoReason
 
 instance Example Expectation where
   type Arg Expectation = ()
   evaluateExample e = evaluateExample (\() -> e)
 
-hunitFailureToResult :: HUnit.HUnitFailure -> Result
-hunitFailureToResult e = case e of
-#if MIN_VERSION_HUnit(1,3,0)
+hunitFailureToResult :: Maybe String -> HUnit.HUnitFailure -> ResultStatus
+hunitFailureToResult pre e = case e of
   HUnit.HUnitFailure mLoc err ->
-#if MIN_VERSION_HUnit(1,5,0)
       case err of
-        HUnit.Reason reason -> Failure location (Reason reason)
-        HUnit.ExpectedButGot preface expected actual -> Failure location (ExpectedButGot preface expected actual)
-#else
-      Failure location (Reason err)
-#endif
+        HUnit.Reason reason -> Failure location (Reason $ addPre reason)
+        HUnit.ExpectedButGot preface expected actual -> Failure location (ExpectedButGot (addPreMaybe preface) expected actual)
+          where
+            addPreMaybe :: Maybe String -> Maybe String
+            addPreMaybe xs = case (pre, xs) of
+              (Just x, Just y) -> Just (x ++ "\n" ++ y)
+              _ -> pre <|> xs
     where
       location = case mLoc of
         Nothing -> Nothing
-#if MIN_VERSION_HUnit(1,4,0)
-        Just loc -> Just $ Location (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc) ExactLocation
-#else
-        Just loc -> Just $ Location (HUnit.locationFile loc) (HUnit.locationLine loc) (HUnit.locationColumn loc) ExactLocation
-#endif
-#else
-  HUnit.HUnitFailure err -> Failure Nothing (Reason err)
-#endif
+        Just loc -> Just $ Location (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc)
+  where
+    addPre :: String -> String
+    addPre xs = case pre of
+      Just x -> x ++ "\n" ++ xs
+      Nothing -> xs
 
 instance Example (a -> Expectation) where
   type Arg (a -> Expectation) = a
-  evaluateExample e _ action _ = action e >> return Success
+  evaluateExample e _ action _ = action e >> return (Result "" Success)
 
 instance Example QC.Property where
   type Arg QC.Property = ()
@@ -168,51 +168,41 @@
   type Arg (a -> QC.Property) = a
   evaluateExample p c action progressCallback = do
     r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) {QC.chatty = False} (QCP.callback qcProgressCallback $ aroundProperty action p)
-    return $
-      case r of
-        QC.Success {}               -> Success
-        QC.Failure {QC.output = m}  -> fromMaybe (Failure Nothing . Reason $ sanitizeFailureMessage r) (parsePending m)
-        QC.GaveUp {QC.numTests = n} -> Failure Nothing (Reason $ "Gave up after " ++ pluralize n "test" )
-        QC.NoExpectedFailure {}     -> Failure Nothing (Reason $ "No expected failure")
-#if MIN_VERSION_QuickCheck(2,8,0)
-        QC.InsufficientCoverage {}  -> Failure Nothing (Reason $ "Insufficient coverage")
-#endif
+    return $ fromQuickCheckResult r
     where
       qcProgressCallback = QCP.PostTest QCP.NotCounterexample $
         \st _ -> progressCallback (QC.numSuccessTests st, QC.maxSuccessTests st)
 
-      sanitizeFailureMessage :: QC.Result -> String
-      sanitizeFailureMessage r = let m = QC.output r in strip $
-#if MIN_VERSION_QuickCheck(2,7,0)
-        case QC.theException r of
-          Just e -> case E.fromException e :: Maybe (HUnit.HUnitFailure) of
-            Just _ -> (addFalsifiable . stripFailed) m
-            Nothing -> let numbers = formatNumbers r in
-              "uncaught exception: " ++ formatException e ++ " " ++ numbers ++ "\n" ++ case lines m of
-                x:xs | x == (exceptionPrefix ++ show e ++ "' " ++ numbers ++ ": ") -> unlines xs
-                _ -> m
-          Nothing ->
-#endif
-            (addFalsifiable . stripFailed) m
+fromQuickCheckResult :: QC.Result -> Result
+fromQuickCheckResult r = case parseQuickCheckResult r of
+  QuickCheckResult _ info (QuickCheckOtherFailure err) -> Result info $ Failure Nothing (Reason err)
+  QuickCheckResult _ info QuickCheckSuccess -> Result info Success
+  QuickCheckResult n info (QuickCheckFailure QCFailure{..}) -> case quickCheckFailureException of
+    Just e | Just result <- fromException e -> Result info result
+    Just e | Just hunit <- fromException e -> Result info $ hunitFailureToResult (Just hunitAssertion) hunit
+    Just e -> failure (uncaughtException e)
+    Nothing -> failure falsifiable
+    where
+      failure = Result info . Failure Nothing . Reason
 
-      addFalsifiable :: String -> String
-      addFalsifiable m
-        | "(after " `isPrefixOf` m = "Falsifiable " ++ m
-        | otherwise = m
+      numbers = formatNumbers n quickCheckFailureNumShrinks
 
-      stripFailed :: String -> String
-      stripFailed m
-        | prefix `isPrefixOf` m = drop n m
-        | otherwise = m
-        where
-          prefix = "*** Failed! "
-          n = length prefix
+      hunitAssertion :: String
+      hunitAssertion = intercalate "\n" [
+          "Falsifiable " ++ numbers ++ ":"
+        , indent (unlines quickCheckFailureCounterexample)
+        ]
 
-      parsePending :: String -> Maybe Result
-      parsePending m
-        | exceptionPrefix `isPrefixOf` m = (readMaybe . takeWhile (/= '\'') . drop n) m
-        | otherwise = Nothing
-        where
-          n = length exceptionPrefix
+      uncaughtException e = intercalate "\n" [
+          "uncaught exception: " ++ formatException e
+        , numbers
+        , indent (unlines quickCheckFailureCounterexample)
+        ]
 
-      exceptionPrefix = "*** Failed! Exception: '"
+      falsifiable = intercalate "\n" [
+          quickCheckFailureReason ++ " " ++ numbers ++ ":"
+        , indent (unlines quickCheckFailureCounterexample)
+        ]
+
+indent :: String -> String
+indent = intercalate "\n" . map ("  " ++) . lines
diff --git a/hspec-core/src/Test/Hspec/Core/Example/Location.hs b/hspec-core/src/Test/Hspec/Core/Example/Location.hs
new file mode 100644
--- /dev/null
+++ b/hspec-core/src/Test/Hspec/Core/Example/Location.hs
@@ -0,0 +1,88 @@
+{-# LANGUAGE CPP #-}
+module Test.Hspec.Core.Example.Location (
+  Location(..)
+, extractLocation
+
+-- for testing
+, parseCallStack
+, parseLocation
+, parseSourceSpan
+) where
+
+import           Prelude ()
+import           Test.Hspec.Core.Compat
+
+import           Control.Exception
+import           Data.List
+import           Data.Char
+import           Data.Maybe
+import           GHC.IO.Exception
+
+-- | @Location@ is used to represent source locations.
+data Location = Location {
+  locationFile :: FilePath
+, locationLine :: Int
+, locationColumn :: Int
+} deriving (Eq, Show, Read)
+
+extractLocation :: SomeException -> Maybe Location
+extractLocation e = locationFromErrorCall e <|> locationFromPatternMatchFail e <|> locationFromIOException e
+
+locationFromErrorCall :: SomeException -> Maybe Location
+locationFromErrorCall e = case fromException e of
+#if MIN_VERSION_base(4,9,0)
+  Just (ErrorCallWithLocation err loc) ->
+    parseCallStack loc <|>
+#else
+  Just (ErrorCall err) ->
+#endif
+    fromPatternMatchFailureInDoExpression err
+  Nothing -> Nothing
+
+locationFromPatternMatchFail :: SomeException -> Maybe Location
+locationFromPatternMatchFail e = case fromException e of
+  Just (PatternMatchFail s) -> listToMaybe (words s) >>= parseSourceSpan
+  Nothing -> Nothing
+
+locationFromIOException :: SomeException -> Maybe Location
+locationFromIOException e = case fromException e of
+  Just (IOError {ioe_type = UserError, ioe_description = xs}) -> fromPatternMatchFailureInDoExpression xs
+  Just _ -> Nothing
+  Nothing -> Nothing
+
+fromPatternMatchFailureInDoExpression :: String -> Maybe Location
+fromPatternMatchFailureInDoExpression input =
+  stripPrefix "Pattern match failure in do expression at " input >>= parseSourceSpan
+
+parseCallStack :: String -> Maybe Location
+parseCallStack input = case reverse (lines input) of
+  [] -> Nothing
+  line : _ -> findLocation line
+  where
+    findLocation xs = case xs of
+      [] -> Nothing
+      _ : ys -> case stripPrefix prefix xs of
+        Just zs -> parseLocation (takeWhile (not . isSpace) zs)
+        Nothing -> findLocation ys
+    prefix = ", called at "
+
+parseLocation :: String -> Maybe Location
+parseLocation input = case fmap breakColon (breakColon input) of
+  (file, (line, column)) -> Location file <$> readMaybe line <*> readMaybe column
+
+parseSourceSpan :: String -> Maybe Location
+parseSourceSpan input = case breakColon input of
+  (file, xs) -> (uncurry $ Location file) <$> (tuple <|> colonSeparated)
+    where
+      lineAndColumn :: String
+      lineAndColumn = takeWhile (/= '-') xs
+
+      tuple :: Maybe (Int, Int)
+      tuple = readMaybe lineAndColumn
+
+      colonSeparated :: Maybe (Int, Int)
+      colonSeparated = case breakColon lineAndColumn of
+        (l, c) -> (,) <$> readMaybe l <*> readMaybe c
+
+breakColon :: String -> (String, String)
+breakColon = fmap (drop 1) . break (== ':')
diff --git a/hspec-core/src/Test/Hspec/Core/FailureReport.hs b/hspec-core/src/Test/Hspec/Core/FailureReport.hs
--- a/hspec-core/src/Test/Hspec/Core/FailureReport.hs
+++ b/hspec-core/src/Test/Hspec/Core/FailureReport.hs
@@ -5,16 +5,17 @@
 , readFailureReport
 ) where
 
+import           Prelude ()
+import           Test.Hspec.Core.Compat
+
 #ifndef __GHCJS__
 import           System.SetEnv
 import           Test.Hspec.Core.Util (safeTry)
 #endif
-import           Control.Monad
 import           System.IO
 import           System.Directory
-import           Test.Hspec.Core.Compat
 import           Test.Hspec.Core.Util (Path)
-import           Test.Hspec.Core.Options (Config(..))
+import           Test.Hspec.Core.Config.Options (Config(..))
 
 data FailureReport = FailureReport {
   failureReportSeed :: Integer
diff --git a/hspec-core/src/Test/Hspec/Core/Format.hs b/hspec-core/src/Test/Hspec/Core/Format.hs
new file mode 100644
--- /dev/null
+++ b/hspec-core/src/Test/Hspec/Core/Format.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE RankNTypes #-}
+module Test.Hspec.Core.Format (
+  Format(..)
+, Progress
+, Path
+, Location(..)
+, Seconds(..)
+, Item(..)
+, Result(..)
+, FailureReason(..)
+) where
+
+import           Test.Hspec.Core.Spec (Progress, Location(..))
+import           Test.Hspec.Core.Example (FailureReason(..))
+import           Test.Hspec.Core.Util (Path)
+import           Test.Hspec.Core.Clock
+
+data Item = Item {
+  itemLocation :: Maybe Location
+, itemDuration :: Seconds
+, itemInfo :: String
+, itemResult :: Result
+}
+
+data Result =
+    Success
+  | Pending (Maybe String)
+  | Failure FailureReason
+
+data Format m = Format {
+  formatRun :: forall a. m a -> IO a
+, formatGroupStarted :: Path -> m ()
+, formatGroupDone :: Path -> m ()
+, formatProgress :: Path -> Progress -> m ()
+, formatItem :: Path -> Item -> m ()
+}
diff --git a/hspec-core/src/Test/Hspec/Core/Formatters.hs b/hspec-core/src/Test/Hspec/Core/Formatters.hs
--- a/hspec-core/src/Test/Hspec/Core/Formatters.hs
+++ b/hspec-core/src/Test/Hspec/Core/Formatters.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 -- |
 -- Stability: experimental
 --
@@ -32,12 +33,14 @@
 , getFailMessages
 , usedSeed
 
+, Seconds(..)
 , getCPUTime
 , getRealTime
 
--- ** Appending to the gerenated report
+-- ** Appending to the generated report
 , write
 , writeLine
+, writeTransient
 
 -- ** Dealing with colors
 , withInfoColor
@@ -57,10 +60,8 @@
 
 import           Data.Maybe
 import           Test.Hspec.Core.Util
-import           Test.Hspec.Core.Spec (Location(..), LocationAccuracy(..))
+import           Test.Hspec.Core.Spec (Location(..))
 import           Text.Printf
-import           Control.Monad (when, unless)
-import           System.IO (hPutStr, hFlush)
 
 -- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make
 -- sure, that we only use the public API to implement formatters.
@@ -86,6 +87,7 @@
 
   , write
   , writeLine
+  , writeTransient
 
   , withInfoColor
   , withSuccessColor
@@ -96,6 +98,8 @@
   , missingChunk
   )
 
+import           Test.Hspec.Core.Clock (Seconds(..))
+
 import           Test.Hspec.Core.Formatters.Diff
 
 silent :: Formatter
@@ -103,10 +107,10 @@
   headerFormatter     = return ()
 , exampleGroupStarted = \_ _ -> return ()
 , exampleGroupDone    = return ()
-, exampleProgress     = \_ _ _ -> return ()
-, exampleSucceeded    = \_ -> return ()
-, exampleFailed       = \_ _ -> return ()
-, examplePending      = \_ _  -> return ()
+, exampleProgress     = \_ _ -> return ()
+, exampleSucceeded    = \ _ _ -> return ()
+, exampleFailed       = \_ _ _ -> return ()
+, examplePending      = \_ _ _ -> return ()
 , failedFormatter     = return ()
 , footerFormatter     = return ()
 }
@@ -120,19 +124,25 @@
 , exampleGroupStarted = \nesting name -> do
     writeLine (indentationFor nesting ++ name)
 
-, exampleProgress = \h _ p -> do
-    hPutStr h (formatProgress p)
-    hFlush h
+, exampleProgress = \_ p -> do
+    writeTransient (formatProgress p)
 
-, exampleSucceeded = \(nesting, requirement) -> withSuccessColor $ do
+, exampleSucceeded = \(nesting, requirement) info -> withSuccessColor $ do
     writeLine $ indentationFor nesting ++ requirement
+    forM_ (lines info) $ \ s ->
+      writeLine $ indentationFor ("" : nesting) ++ s
 
-, exampleFailed = \(nesting, requirement) _ -> withFailColor $ do
+, exampleFailed = \(nesting, requirement) info _ -> withFailColor $ do
     n <- getFailCount
     writeLine $ indentationFor nesting ++ requirement ++ " FAILED [" ++ show n ++ "]"
+    forM_ (lines info) $ \ s ->
+      writeLine $ indentationFor ("" : nesting) ++ s
 
-, examplePending = \(nesting, requirement) reason -> withPendingColor $ do
-    writeLine $ indentationFor nesting ++ requirement ++ "\n     # PENDING: " ++ fromMaybe "No reason given" reason
+, examplePending = \(nesting, requirement) info reason -> withPendingColor $ do
+    writeLine $ indentationFor nesting ++ requirement
+    forM_ (lines info) $ \ s ->
+      writeLine $ indentationFor ("" : nesting) ++ s
+    writeLine $ indentationFor ("" : nesting) ++ "# PENDING: " ++ fromMaybe "No reason given" reason
 
 , failedFormatter = defaultFailedFormatter
 
@@ -140,15 +150,15 @@
 } where
     indentationFor nesting = replicate (length nesting * 2) ' '
     formatProgress (current, total)
-      | total == 0 = show current ++ "\r"
-      | otherwise  = show current ++ "/" ++ show total ++ "\r"
+      | total == 0 = show current
+      | otherwise  = show current ++ "/" ++ show total
 
 
 progress :: Formatter
 progress = silent {
-  exampleSucceeded = \_   -> withSuccessColor $ write "."
-, exampleFailed    = \_ _ -> withFailColor    $ write "F"
-, examplePending   = \_ _ -> withPendingColor $ write "."
+  exampleSucceeded = \_ _ -> withSuccessColor $ write "."
+, exampleFailed    = \_ _ _ -> withFailColor    $ write "F"
+, examplePending   = \_ _ _ -> withPendingColor $ write "."
 , failedFormatter  = defaultFailedFormatter
 , footerFormatter  = defaultFooter
 }
@@ -174,19 +184,19 @@
       formatFailure x
       writeLine ""
 
-    when (hasBestEffortLocations failures) $ do
-      withInfoColor $ writeLine "Source locations marked with \"best-effort\" are calculated heuristically and may be incorrect."
+#if __GLASGOW_HASKELL__ == 800
+    withFailColor $ do
+      writeLine "WARNING:"
+      writeLine "  Your version of GHC is affected by https://ghc.haskell.org/trac/ghc/ticket/13285."
+      writeLine "  Source locations may not work as expected."
       writeLine ""
+      writeLine "  Please consider upgrading GHC!"
+      writeLine ""
+#endif
 
     write "Randomized with seed " >> usedSeed >>= writeLine . show
     writeLine ""
   where
-    hasBestEffortLocations :: [FailureRecord] -> Bool
-    hasBestEffortLocations = any p
-      where
-        p :: FailureRecord -> Bool
-        p failure = (locationAccuracy <$> failureRecordLocation failure) == Just BestEffort
-
     formatFailure :: (Int, FailureRecord) -> FormatM ()
     formatFailure (n, FailureRecord mLoc path reason) = do
       forM_ mLoc $ \loc -> do
@@ -194,10 +204,9 @@
       write ("  " ++ show n ++ ") ")
       writeLine (formatRequirement path)
       case reason of
-        Left e -> withFailColor . indent $ (("uncaught exception: " ++) . formatException) e
-        Right NoReason -> return ()
-        Right (Reason err) -> withFailColor $ indent err
-        Right (ExpectedButGot preface expected actual) -> do
+        NoReason -> return ()
+        Reason err -> withFailColor $ indent err
+        ExpectedButGot preface expected actual -> do
           mapM_ indent preface
 
           let chunks = diff expected actual
@@ -219,19 +228,16 @@
             indented output text = case break (== '\n') text of
               (xs, "") -> output xs
               (xs, _ : ys) -> output (xs ++ "\n") >> write (indentation ++ "          ") >> indented output ys
+        Error _ e -> withFailColor . indent $ (("uncaught exception: " ++) . formatException) e
+
+      writeLine ""
+      writeLine ("  To rerun use: --match " ++ show (joinPath path))
       where
         indentation = "       "
         indent message = do
           forM_ (lines message) $ \line -> do
             writeLine (indentation ++ line)
-        formatLoc (Location file line _column accuracy) = "  " ++ file ++ ":" ++ show line ++ ":" ++ message
-          where
-            message = case accuracy of
-              ExactLocation -> " " -- NOTE: Vim's default 'errorformat'
-                                   -- requires a non-empty message.  This is
-                                   -- why we use a single space as message
-                                   -- here.
-              BestEffort -> " (best-effort)"
+        formatLoc (Location file line column) = "  " ++ file ++ ":" ++ show line ++ ":" ++ show column ++ ": "
 
 defaultFooter :: FormatM ()
 defaultFooter = do
diff --git a/hspec-core/src/Test/Hspec/Core/Formatters/Diff.hs b/hspec-core/src/Test/Hspec/Core/Formatters/Diff.hs
--- a/hspec-core/src/Test/Hspec/Core/Formatters/Diff.hs
+++ b/hspec-core/src/Test/Hspec/Core/Formatters/Diff.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE ViewPatterns #-}
 module Test.Hspec.Core.Formatters.Diff (
   Diff (..)
 , diff
@@ -8,17 +9,21 @@
 #endif
 ) where
 
+import           Prelude ()
+import           Test.Hspec.Core.Compat
+
 import           Data.Char
+import           Data.List (stripPrefix)
 import           Data.Algorithm.Diff
 
 diff :: String -> String -> [Diff String]
 diff expected actual = map (fmap concat) $ getGroupedDiff (partition expected) (partition actual)
 
 partition :: String -> [String]
-partition = mergeBackslashes . breakList isAlphaNum
+partition = filter (not . null) . mergeBackslashes . breakList isAlphaNum
   where
     mergeBackslashes xs = case xs of
-      ['\\'] : (y : ys) : zs -> ['\\', y] : ys : mergeBackslashes zs
+      ['\\'] : (splitEscape -> Just (escape, ys)) : zs -> ("\\" ++ escape) : ys : mergeBackslashes zs
       z : zs -> z : mergeBackslashes zs
       [] -> []
 
@@ -31,3 +36,55 @@
     cons x
       | null x = id
       | otherwise = (x :)
+
+splitEscape :: String -> Maybe (String, String)
+splitEscape xs = splitNumericEscape xs <|> (msum $ map split escapes)
+  where
+    split :: String -> Maybe (String, String)
+    split escape = (,) escape <$> stripPrefix escape xs
+
+splitNumericEscape :: String -> Maybe (String, String)
+splitNumericEscape xs = case span isDigit xs of
+  ("", _) -> Nothing
+  r -> Just r
+
+escapes :: [String]
+escapes = [
+    "ACK"
+  , "CAN"
+  , "DC1"
+  , "DC2"
+  , "DC3"
+  , "DC4"
+  , "DEL"
+  , "DLE"
+  , "ENQ"
+  , "EOT"
+  , "ESC"
+  , "ETB"
+  , "ETX"
+  , "NAK"
+  , "NUL"
+  , "SOH"
+  , "STX"
+  , "SUB"
+  , "SYN"
+  , "EM"
+  , "FS"
+  , "GS"
+  , "RS"
+  , "SI"
+  , "SO"
+  , "US"
+  , "a"
+  , "b"
+  , "f"
+  , "n"
+  , "r"
+  , "t"
+  , "v"
+  , "&"
+  , "'"
+  , "\""
+  , "\\"
+  ]
diff --git a/hspec-core/src/Test/Hspec/Core/Formatters/Internal.hs b/hspec-core/src/Test/Hspec/Core/Formatters/Internal.hs
--- a/hspec-core/src/Test/Hspec/Core/Formatters/Internal.hs
+++ b/hspec-core/src/Test/Hspec/Core/Formatters/Internal.hs
@@ -1,13 +1,14 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Test.Hspec.Core.Formatters.Internal (
   FormatM
+, FormatConfig(..)
 , runFormatM
 , interpret
 , increaseSuccessCount
 , increasePendingCount
-, increaseFailCount
 , addFailMessage
 , finally_
+, formatterToFormat
 ) where
 
 import           Prelude ()
@@ -15,31 +16,54 @@
 
 import qualified System.IO as IO
 import           System.IO (Handle)
-import           Control.Monad
-import           Control.Exception (SomeException, AsyncException(..), bracket_, try, throwIO)
+import           Control.Exception (AsyncException(..), bracket_, try, throwIO)
 import           System.Console.ANSI
-import           Control.Monad.Trans.State hiding (gets, modify)
+import           Control.Monad.Trans.State hiding (state, gets, modify)
 import           Control.Monad.IO.Class
+import           Data.Char (isSpace)
 import qualified System.CPUTime as CPUTime
-import           Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)
 
-import           Test.Hspec.Core.Util (Path)
-import           Test.Hspec.Core.Spec (Location)
-import           Test.Hspec.Core.Example (FailureReason(..))
-
 import qualified Test.Hspec.Core.Formatters.Monad as M
 import           Test.Hspec.Core.Formatters.Monad (Environment(..), interpretWith, FailureRecord(..))
+import           Test.Hspec.Core.Format
+import           Test.Hspec.Core.Clock
 
+formatterToFormat :: M.Formatter -> FormatConfig -> Format FormatM
+formatterToFormat formatter config = Format {
+  formatRun = \action -> runFormatM config $ do
+    interpret (M.headerFormatter formatter)
+    a <- action `finally_` interpret (M.failedFormatter formatter)
+    interpret (M.footerFormatter formatter)
+    return a
+, formatGroupStarted = \ (nesting, name) -> interpret $ M.exampleGroupStarted formatter nesting name
+, formatGroupDone = \ _ -> interpret (M.exampleGroupDone formatter)
+, formatProgress = \ path progress -> when useColor $ do
+    interpret $ M.exampleProgress formatter path progress
+, formatItem = \ path (Item loc _duration info result) -> do
+    clearTransientOutput
+    case result of
+      Success -> do
+        increaseSuccessCount
+        interpret $ M.exampleSucceeded formatter path info
+      Pending reason -> do
+        increasePendingCount
+        interpret $ M.examplePending formatter path info reason
+      Failure err -> do
+        addFailMessage loc path err
+        interpret $ M.exampleFailed formatter path info err
+} where
+    useColor = formatConfigUseColor config
+
 interpret :: M.FormatM a -> FormatM a
 interpret = interpretWith Environment {
   environmentGetSuccessCount = getSuccessCount
 , environmentGetPendingCount = getPendingCount
-, environmentGetFailCount = getFailCount
 , environmentGetFailMessages = getFailMessages
 , environmentUsedSeed = usedSeed
 , environmentGetCPUTime = getCPUTime
 , environmentGetRealTime = getRealTime
 , environmentWrite = write
+, environmentWriteTransient = writeTransient
 , environmentWithFailColor = withFailColor
 , environmentWithSuccessColor = withSuccessColor
 , environmentWithPendingColor = withPendingColor
@@ -59,72 +83,89 @@
 modify f = FormatM $ do
   get >>= liftIO . (`modifyIORef'` f)
 
+data FormatConfig = FormatConfig {
+  formatConfigHandle :: Handle
+, formatConfigUseColor :: Bool
+, formatConfigUseDiff :: Bool
+, formatConfigHtmlOutput :: Bool
+, formatConfigPrintCpuTime :: Bool
+, formatConfigUsedSeed :: Integer
+} deriving (Eq, Show)
+
 data FormatterState = FormatterState {
-  stateHandle     :: Handle
-, stateUseColor   :: Bool
-, stateUseDiff    :: Bool
-, produceHTML     :: Bool
-, successCount    :: Int
-, pendingCount    :: Int
-, failCount       :: Int
-, failMessages    :: [FailureRecord]
-, stateUsedSeed   :: Integer
-, cpuStartTime    :: Maybe Integer
-, startTime       :: POSIXTime
+  stateSuccessCount    :: Int
+, statePendingCount    :: Int
+, stateFailMessages    :: [FailureRecord]
+, stateCpuStartTime    :: Maybe Integer
+, stateStartTime       :: Seconds
+, stateTransientOutput :: String
+, stateConfig :: FormatConfig
 }
 
+getConfig :: (FormatConfig -> a) -> FormatM a
+getConfig f = gets (f . stateConfig)
+
+getHandle :: FormatM Handle
+getHandle = getConfig formatConfigHandle
+
 -- | The random seed that is used for QuickCheck.
 usedSeed :: FormatM Integer
-usedSeed = gets stateUsedSeed
+usedSeed = getConfig formatConfigUsedSeed
 
 -- NOTE: We use an IORef here, so that the state persists when UserInterrupt is
 -- thrown.
 newtype FormatM a = FormatM (StateT (IORef FormatterState) IO a)
   deriving (Functor, Applicative, Monad, MonadIO)
 
-runFormatM :: Bool -> Bool -> Bool -> Bool -> Integer -> Handle -> FormatM a -> IO a
-runFormatM useColor useDiff produceHTML_ printCpuTime seed handle (FormatM action) = do
-  time <- getPOSIXTime
-  cpuTime <- if printCpuTime then Just <$> CPUTime.getCPUTime else pure Nothing
-  st <- newIORef (FormatterState handle useColor useDiff produceHTML_ 0 0 0 [] seed cpuTime time)
+runFormatM :: FormatConfig -> FormatM a -> IO a
+runFormatM config (FormatM action) = do
+  time <- getMonotonicTime
+  cpuTime <- if (formatConfigPrintCpuTime config) then Just <$> CPUTime.getCPUTime else pure Nothing
+  st <- newIORef (FormatterState 0 0 [] cpuTime time "" config)
   evalStateT action st
 
 -- | Increase the counter for successful examples
 increaseSuccessCount :: FormatM ()
-increaseSuccessCount = modify $ \s -> s {successCount = succ $ successCount s}
+increaseSuccessCount = modify $ \s -> s {stateSuccessCount = succ $ stateSuccessCount s}
 
 -- | Increase the counter for pending examples
 increasePendingCount :: FormatM ()
-increasePendingCount = modify $ \s -> s {pendingCount = succ $ pendingCount s}
-
--- | Increase the counter for failed examples
-increaseFailCount :: FormatM ()
-increaseFailCount = modify $ \s -> s {failCount = succ $ failCount s}
+increasePendingCount = modify $ \s -> s {statePendingCount = succ $ statePendingCount s}
 
 -- | Get the number of successful examples encountered so far.
 getSuccessCount :: FormatM Int
-getSuccessCount = gets successCount
+getSuccessCount = gets stateSuccessCount
 
 -- | Get the number of pending examples encountered so far.
 getPendingCount :: FormatM Int
-getPendingCount = gets pendingCount
-
--- | Get the number of failed examples encountered so far.
-getFailCount :: FormatM Int
-getFailCount = gets failCount
+getPendingCount = gets statePendingCount
 
 -- | Append to the list of accumulated failure messages.
-addFailMessage :: Maybe Location -> Path -> Either SomeException FailureReason -> FormatM ()
-addFailMessage loc p m = modify $ \s -> s {failMessages = FailureRecord loc p m : failMessages s}
+addFailMessage :: Maybe Location -> Path -> FailureReason -> FormatM ()
+addFailMessage loc p m = modify $ \s -> s {stateFailMessages = FailureRecord loc p m : stateFailMessages s}
 
 -- | Get the list of accumulated failure messages.
 getFailMessages :: FormatM [FailureRecord]
-getFailMessages = reverse `fmap` gets failMessages
+getFailMessages = reverse `fmap` gets stateFailMessages
 
+writeTransient :: String -> FormatM ()
+writeTransient s = do
+  write ("\r" ++ s)
+  modify $ \ state -> state {stateTransientOutput = s}
+  h <- getHandle
+  liftIO $ IO.hFlush h
+
+clearTransientOutput :: FormatM ()
+clearTransientOutput = do
+  n <- length <$> gets stateTransientOutput
+  unless (n == 0) $ do
+    write ("\r" ++ replicate n ' ' ++ "\r")
+    modify $ \ state -> state {stateTransientOutput = ""}
+
 -- | Append some output to the report.
 write :: String -> FormatM ()
 write s = do
-  h <- gets stateHandle
+  h <- getHandle
   liftIO $ IO.hPutStr h s
 
 -- | Set output color to red, run given action, and finally restore the default
@@ -150,16 +191,16 @@
 -- | Set a color, run an action, and finally reset colors.
 withColor :: SGR -> String -> FormatM a -> FormatM a
 withColor color cls action = do
-  r <- gets produceHTML
-  (if r then htmlSpan cls else withColor_ color) action
+  produceHTML <- getConfig formatConfigHtmlOutput
+  (if produceHTML then htmlSpan cls else withColor_ color) action
 
 htmlSpan :: String -> FormatM a -> FormatM a
 htmlSpan cls action = write ("<span class=\"" ++ cls ++ "\">") *> action <* write "</span>"
 
 withColor_ :: SGR -> FormatM a -> FormatM a
 withColor_ color (FormatM action) = do
-  useColor <- gets stateUseColor
-  h        <- gets stateHandle
+  useColor <- getConfig formatConfigUseColor
+  h <- getHandle
 
   FormatM . StateT $ \st -> do
     bracket_
@@ -176,45 +217,61 @@
 -- | Output given chunk in red.
 extraChunk :: String -> FormatM ()
 extraChunk s = do
-  useDiff <- gets stateUseDiff
+  useDiff <- getConfig formatConfigUseDiff
   case useDiff of
-    True -> withFailColor $ write s
+    True -> extra s
     False -> write s
+  where
+    extra :: String -> FormatM ()
+    extra = diffColorize Red "hspec-failure"
 
 -- | Output given chunk in green.
 missingChunk :: String -> FormatM ()
 missingChunk s = do
-  useDiff <- gets stateUseDiff
+  useDiff <- getConfig formatConfigUseDiff
   case useDiff of
-    True -> withSuccessColor $ write s
+    True -> missing s
     False -> write s
+  where
+    missing :: String-> FormatM ()
+    missing = diffColorize Green "hspec-success"
 
+diffColorize :: Color -> String -> String-> FormatM ()
+diffColorize color cls s = withColor (SetColor layer Dull color) cls $ do
+  write s
+  where
+    layer
+      | all isSpace s = Background
+      | otherwise = Foreground
+
 -- |
 -- @finally_ actionA actionB@ runs @actionA@ and then @actionB@.  @actionB@ is
 -- run even when a `UserInterrupt` occurs during @actionA@.
-finally_ :: FormatM () -> FormatM () -> FormatM ()
+finally_ :: FormatM a -> FormatM () -> FormatM a
 finally_ (FormatM actionA) (FormatM actionB) = FormatM . StateT $ \st -> do
-  r <- try (execStateT actionA st)
+  r <- try (runStateT actionA st)
   case r of
     Left e -> do
       when (e == UserInterrupt) $
         runStateT actionB st >> return ()
       throwIO e
-    Right st_ -> do
-      runStateT actionB st_
+    Right (a, st_) -> do
+      runStateT actionB st_ >>= return . replaceValue a
+  where
+    replaceValue a (_, st) = (a, st)
 
 -- | Get the used CPU time since the test run has been started.
-getCPUTime :: FormatM (Maybe Double)
+getCPUTime :: FormatM (Maybe Seconds)
 getCPUTime = do
   t1  <- liftIO CPUTime.getCPUTime
-  mt0 <- gets cpuStartTime
+  mt0 <- gets stateCpuStartTime
   return $ toSeconds <$> ((-) <$> pure t1 <*> mt0)
   where
-    toSeconds x = fromIntegral x / (10.0 ^ (12 :: Integer))
+    toSeconds x = Seconds (fromIntegral x / (10.0 ^ (12 :: Integer)))
 
 -- | Get the passed real time since the test run has been started.
-getRealTime :: FormatM Double
+getRealTime :: FormatM Seconds
 getRealTime = do
-  t1 <- liftIO getPOSIXTime
-  t0 <- gets startTime
-  return (realToFrac $ t1 - t0)
+  t1 <- liftIO getMonotonicTime
+  t0 <- gets stateStartTime
+  return (t1 - t0)
diff --git a/hspec-core/src/Test/Hspec/Core/Formatters/Monad.hs b/hspec-core/src/Test/Hspec/Core/Formatters/Monad.hs
--- a/hspec-core/src/Test/Hspec/Core/Formatters/Monad.hs
+++ b/hspec-core/src/Test/Hspec/Core/Formatters/Monad.hs
@@ -23,6 +23,7 @@
 
 , write
 , writeLine
+, writeTransient
 
 , withInfoColor
 , withSuccessColor
@@ -39,63 +40,59 @@
 import           Prelude ()
 import           Test.Hspec.Core.Compat
 
-import           System.IO (Handle)
-import           Control.Exception
 import           Control.Monad.IO.Class
 
 import           Test.Hspec.Core.Formatters.Free
-
 import           Test.Hspec.Core.Example (FailureReason(..))
 import           Test.Hspec.Core.Util (Path)
 import           Test.Hspec.Core.Spec (Progress, Location)
+import           Test.Hspec.Core.Clock
 
 data Formatter = Formatter {
 
   headerFormatter :: FormatM ()
 
 -- | evaluated before each test group
---
--- The given number indicates the position within the parent group.
 , exampleGroupStarted :: [String] -> String -> FormatM ()
 
-, exampleGroupDone    :: FormatM ()
+, exampleGroupDone :: FormatM ()
 
 -- | used to notify the progress of the currently evaluated example
 --
 -- /Note/: This is only called when interactive/color mode.
-, exampleProgress     :: Handle -> Path -> Progress -> IO ()
+, exampleProgress :: Path -> Progress -> FormatM ()
 
 -- | evaluated after each successful example
-, exampleSucceeded    :: Path -> FormatM ()
+, exampleSucceeded :: Path -> String -> FormatM ()
 
 -- | evaluated after each failed example
-, exampleFailed       :: Path -> Either SomeException FailureReason -> FormatM ()
+, exampleFailed :: Path -> String -> FailureReason -> FormatM ()
 
 -- | evaluated after each pending example
-, examplePending      :: Path -> Maybe String -> FormatM ()
+, examplePending :: Path -> String -> Maybe String -> FormatM ()
 
 -- | evaluated after a test run
-, failedFormatter     :: FormatM ()
+, failedFormatter :: FormatM ()
 
 -- | evaluated after `failuresFormatter`
-, footerFormatter     :: FormatM ()
+, footerFormatter :: FormatM ()
 }
 
 data FailureRecord = FailureRecord {
   failureRecordLocation :: Maybe Location
 , failureRecordPath     :: Path
-, failureRecordMessage  :: Either SomeException FailureReason
+, failureRecordMessage  :: FailureReason
 }
 
 data FormatF next =
     GetSuccessCount (Int -> next)
   | GetPendingCount (Int -> next)
-  | GetFailCount (Int -> next)
   | GetFailMessages ([FailureRecord] -> next)
   | UsedSeed (Integer -> next)
-  | GetCPUTime (Maybe Double -> next)
-  | GetRealTime (Double -> next)
+  | GetCPUTime (Maybe Seconds -> next)
+  | GetRealTime (Seconds -> next)
   | Write String next
+  | WriteTransient String next
   | forall a. WithFailColor (FormatM a) (a -> next)
   | forall a. WithSuccessColor (FormatM a) (a -> next)
   | forall a. WithPendingColor (FormatM a) (a -> next)
@@ -108,12 +105,12 @@
   fmap f x = case x of
     GetSuccessCount next -> GetSuccessCount (fmap f next)
     GetPendingCount next -> GetPendingCount (fmap f next)
-    GetFailCount next -> GetFailCount (fmap f next)
     GetFailMessages next -> GetFailMessages (fmap f next)
     UsedSeed next -> UsedSeed (fmap f next)
     GetCPUTime next -> GetCPUTime (fmap f next)
     GetRealTime next -> GetRealTime (fmap f next)
     Write s next -> Write s (f next)
+    WriteTransient s next -> WriteTransient s (f next)
     WithFailColor action next -> WithFailColor action (fmap f next)
     WithSuccessColor action next -> WithSuccessColor action (fmap f next)
     WithPendingColor action next -> WithPendingColor action (fmap f next)
@@ -130,12 +127,12 @@
 data Environment m = Environment {
   environmentGetSuccessCount :: m Int
 , environmentGetPendingCount :: m Int
-, environmentGetFailCount :: m Int
 , environmentGetFailMessages :: m [FailureRecord]
 , environmentUsedSeed :: m Integer
-, environmentGetCPUTime :: m (Maybe Double)
-, environmentGetRealTime :: m Double
+, environmentGetCPUTime :: m (Maybe Seconds)
+, environmentGetRealTime :: m Seconds
 , environmentWrite :: String -> m ()
+, environmentWriteTransient :: String -> m ()
 , environmentWithFailColor :: forall a. m a -> m a
 , environmentWithSuccessColor :: forall a. m a -> m a
 , environmentWithPendingColor :: forall a. m a -> m a
@@ -154,12 +151,12 @@
       Free action -> case action of
         GetSuccessCount next -> environmentGetSuccessCount >>= go . next
         GetPendingCount next -> environmentGetPendingCount >>= go . next
-        GetFailCount next -> environmentGetFailCount >>= go . next
         GetFailMessages next -> environmentGetFailMessages >>= go . next
         UsedSeed next -> environmentUsedSeed >>= go . next
         GetCPUTime next -> environmentGetCPUTime >>= go . next
         GetRealTime next -> environmentGetRealTime >>= go . next
         Write s next -> environmentWrite s >> go next
+        WriteTransient s next -> environmentWriteTransient s >> go next
         WithFailColor inner next -> environmentWithFailColor (go inner) >>= go . next
         WithSuccessColor inner next -> environmentWithSuccessColor (go inner) >>= go . next
         WithPendingColor inner next -> environmentWithPendingColor (go inner) >>= go . next
@@ -178,7 +175,7 @@
 
 -- | Get the number of failed examples encountered so far.
 getFailCount :: FormatM Int
-getFailCount = liftF (GetFailCount id)
+getFailCount = length <$> getFailMessages
 
 -- | Get the total number of examples encountered so far.
 getTotalCount :: FormatM Int
@@ -193,11 +190,11 @@
 usedSeed = liftF (UsedSeed id)
 
 -- | Get the used CPU time since the test run has been started.
-getCPUTime :: FormatM (Maybe Double)
+getCPUTime :: FormatM (Maybe Seconds)
 getCPUTime = liftF (GetCPUTime id)
 
 -- | Get the passed real time since the test run has been started.
-getRealTime :: FormatM Double
+getRealTime :: FormatM Seconds
 getRealTime = liftF (GetRealTime id)
 
 -- | Append some output to the report.
@@ -207,6 +204,9 @@
 -- | The same as `write`, but adds a newline character.
 writeLine :: String -> FormatM ()
 writeLine s = write s >> write "\n"
+
+writeTransient :: String -> FormatM ()
+writeTransient s = liftF (WriteTransient s ())
 
 -- | Set output color to red, run given action, and finally restore the default
 -- color.
diff --git a/hspec-core/src/Test/Hspec/Core/Hooks.hs b/hspec-core/src/Test/Hspec/Core/Hooks.hs
--- a/hspec-core/src/Test/Hspec/Core/Hooks.hs
+++ b/hspec-core/src/Test/Hspec/Core/Hooks.hs
@@ -57,7 +57,7 @@
       a <- try action
       return (either Failed Memoized a, a)
     Memoized a -> return (ma, Right a)
-    Failed _ -> throwIO (Pending (Just "exception in beforeAll-hook (see previous failure)"))
+    Failed _ -> throwIO (Pending Nothing (Just "exception in beforeAll-hook (see previous failure)"))
   either throwIO return result
 
 -- | Run a custom action after every spec item.
diff --git a/hspec-core/src/Test/Hspec/Core/Options.hs b/hspec-core/src/Test/Hspec/Core/Options.hs
deleted file mode 100644
--- a/hspec-core/src/Test/Hspec/Core/Options.hs
+++ /dev/null
@@ -1,283 +0,0 @@
-module Test.Hspec.Core.Options (
-  Config(..)
-, ColorMode (..)
-, defaultConfig
-, filterOr
-, parseOptions
-, ConfigFile
-, ignoreConfigFile
-, envVarName
-) where
-
-import           Prelude ()
-import           Control.Monad
-import           Test.Hspec.Core.Compat
-
-import           System.IO
-import           System.Exit
-import           System.Console.GetOpt
-
-import           Test.Hspec.Core.Formatters
-import           Test.Hspec.Core.Util
-import           Test.Hspec.Core.Example (Params(..), defaultParams)
-import           Data.Functor.Identity
-import           Data.Maybe
-
-type ConfigFile = (FilePath, [String])
-
-type EnvVar = [String]
-
-envVarName :: String
-envVarName = "HSPEC_OPTIONS"
-
-data Config = Config {
-  configIgnoreConfigFile :: Bool
-, configDryRun :: Bool
-, configPrintCpuTime :: Bool
-, configFastFail :: 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
-, configSmallCheckDepth :: Int
-, configColorMode :: ColorMode
-, configDiff :: Bool
-, configFormatter :: Maybe Formatter
-, configHtmlOutput :: Bool
-, configOutputFile :: Either Handle FilePath
-, configConcurrentJobs :: Maybe Int
-}
-
-defaultConfig :: Config
-defaultConfig = Config {
-  configIgnoreConfigFile = False
-, configDryRun = False
-, configPrintCpuTime = False
-, configFastFail = False
-, configFailureReport = Nothing
-, configRerun = False
-, configRerunAllOnSuccess = False
-, configFilterPredicate = Nothing
-, configSkipPredicate = Nothing
-, configQuickCheckSeed = Nothing
-, configQuickCheckMaxSuccess = Nothing
-, configQuickCheckMaxDiscardRatio = Nothing
-, configQuickCheckMaxSize = Nothing
-, configSmallCheckDepth = paramsSmallCheckDepth defaultParams
-, configColorMode = ColorAuto
-, configDiff = True
-, configFormatter = Nothing
-, configHtmlOutput = False
-, configOutputFile = Left stdout
-, 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}
-
-setMaxSize :: Int -> Config -> Config
-setMaxSize n c = c {configQuickCheckMaxSize = Just n}
-
-setMaxDiscardRatio :: Int -> Config -> Config
-setMaxDiscardRatio n c = c {configQuickCheckMaxDiscardRatio = Just n}
-
-setSeed :: Integer -> Config -> Config
-setSeed n c = c {configQuickCheckSeed = Just n}
-
-data ColorMode = ColorAuto | ColorNever | ColorAlways
-  deriving (Eq, Show)
-
-formatters :: [(String, Formatter)]
-formatters = [
-    ("specdoc", specdoc)
-  , ("progress", progress)
-  , ("failed-examples", failed_examples)
-  , ("silent", silent)
-  ]
-
-formatHelp :: String
-formatHelp = unlines (addLineBreaks "use a custom formatter; this can be one of:" ++ map (("   " ++) . fst) formatters)
-
-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)
-
-addLineBreaks :: String -> [String]
-addLineBreaks = lineBreaksAt 40
-
-h :: String -> String
-h = unlines . addLineBreaks
-
-commandLineOptions :: [OptDescr (Result Maybe -> Result Maybe)]
-commandLineOptions = [
-    Option   []  ["help"]             (NoArg (const $ Right Nothing))     (h "display this help and exit")
-  , Option   []  ["ignore-dot-hspec"] (NoArg setIgnoreConfigFile)         (h "do not read options from ~/.hspec and .hspec")
-  , mkOption "m"  "match"             (Arg "PATTERN" return addMatch)     (h "only run examples that match given PATTERN")
-  , mkOption []   "skip"              (Arg "PATTERN" return addSkip)      (h "skip examples that match given PATTERN")
-  ]
-  where
-    setIgnoreConfigFile = set $ \config -> config {configIgnoreConfigFile = True}
-
-configFileOptions :: Monad m => [OptDescr (Result m -> Result m)]
-configFileOptions = [
-    Option   []  ["color"]            (NoArg setColor)                    (h "colorize the output")
-  , Option   []  ["no-color"]         (NoArg setNoColor)                  (h "do not colorize the output")
-  , Option   []  ["diff"]             (NoArg setDiff)                     (h "show colorized diffs")
-  , Option   []  ["no-diff"]          (NoArg setNoDiff)                   (h "do not show colorized diffs")
-  , mkOption "f"  "format"            (Arg "FORMATTER" readFormatter setFormatter) formatHelp
-  , mkOption "o"  "out"               (Arg "FILE" return setOutputFile)   (h "write output to a file instead of STDOUT")
-  , mkOption []   "depth"             (Arg "N" readMaybe setDepth)        (h "maximum depth of generated test values for SmallCheck properties")
-  , mkOption "a"  "qc-max-success"    (Arg "N" readMaybe setMaxSuccess)   (h "maximum number of successful tests before a QuickCheck property succeeds")
-  , mkOption ""   "qc-max-size"       (Arg "N" readMaybe setMaxSize)      (h "size to use for the biggest test cases")
-  , mkOption ""   "qc-max-discard"    (Arg "N" readMaybe setMaxDiscardRatio) (h "maximum number of discarded tests per successful test before giving up")
-  , mkOption []   "seed"              (Arg "N" readMaybe setSeed)         (h "used seed for QuickCheck properties")
-  , Option   []  ["print-cpu-time"]   (NoArg setPrintCpuTime)             (h "include used CPU time in summary")
-  , Option   []  ["dry-run"]          (NoArg setDryRun)                   (h "pretend that everything passed; don't verify anything")
-  , Option   []  ["fail-fast"]        (NoArg setFastFail)                 (h "abort on first failure")
-  , Option   "r" ["rerun"]            (NoArg  setRerun)                   (h "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)(h "read/write a failure report for use with --rerun")
-  , Option   []  ["rerun-all-on-success"] (NoArg setRerunAllOnSuccess)    (h "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)    (h "run at most N parallelizable tests simultaneously (default: number of available processors)")
-  ]
-  where
-    readFormatter :: String -> Maybe Formatter
-    readFormatter = (`lookup` formatters)
-
-    readMaxJobs :: String -> Maybe Int
-    readMaxJobs s = do
-      n <- readMaybe s
-      guard $ n > 0
-      return n
-
-    setFormatter :: Formatter -> Config -> Config
-    setFormatter f c = c {configFormatter = Just f}
-
-    setOutputFile :: String -> Config -> Config
-    setOutputFile file c = c {configOutputFile = Right file}
-
-    setFailureReport :: String -> Config -> Config
-    setFailureReport file c = c {configFailureReport = Just file}
-
-    setMaxJobs :: Int -> Config -> Config
-    setMaxJobs n c = c {configConcurrentJobs = Just n}
-
-    setPrintCpuTime = set $ \config -> config {configPrintCpuTime = True}
-    setDryRun       = set $ \config -> config {configDryRun = True}
-    setFastFail     = set $ \config -> config {configFastFail = True}
-    setRerun        = set $ \config -> config {configRerun = True}
-    setRerunAllOnSuccess = set $ \config -> config {configRerunAllOnSuccess = True}
-    setColor        = set $ \config -> config {configColorMode = ColorAlways}
-    setNoColor      = set $ \config -> config {configColorMode = ColorNever}
-    setDiff         = set $ \config -> config {configDiff = True}
-    setNoDiff       = set $ \config -> config {configDiff = False}
-
-set :: Monad m => (Config -> Config) -> Either a (m Config) -> Either a (m Config)
-set = liftM . liftM
-
-documentedOptions :: [OptDescr (Result Maybe -> Result Maybe)]
-documentedOptions = commandLineOptions ++ configFileOptions
-
-undocumentedOptions :: [OptDescr (Result Maybe -> Result Maybe)]
-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"
-
-    -- now a noop
-  , Option "v" ["verbose"]                 (NoArg id)                         "do not suppress output to stdout when evaluating examples"
-  ]
-  where
-    setHtml :: Result Maybe -> Result Maybe
-    setHtml = set $ \config -> config {configHtmlOutput = True}
-
-recognizedOptions :: [OptDescr (Result Maybe -> Result Maybe)]
-recognizedOptions = documentedOptions ++ undocumentedOptions
-
-parseOptions :: Config -> String -> [ConfigFile] -> Maybe EnvVar -> [String] -> Either (ExitCode, String) Config
-parseOptions config prog configFiles envVar args = do
-      foldM (parseFileOptions prog) config configFiles
-  >>= parseEnvVarOptions prog envVar
-  >>= parseCommandLineOptions prog args
-
-parseCommandLineOptions :: String -> [String] -> Config -> Either (ExitCode, String) Config
-parseCommandLineOptions prog args config = case parse recognizedOptions config args of
-  Right Nothing -> Left (ExitSuccess, usageInfo ("Usage: " ++ prog ++ " [OPTION]...\n\nOPTIONS") documentedOptions)
-  Right (Just c) -> Right c
-  Left err -> failure err
-  where
-    failure err = Left (ExitFailure 1, prog ++ ": " ++ err ++ "\nTry `" ++ prog ++ " --help' for more information.\n")
-
-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)
-
-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
-  Left err -> failure err
-  where
-    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
diff --git a/hspec-core/src/Test/Hspec/Core/QuickCheckUtil.hs b/hspec-core/src/Test/Hspec/Core/QuickCheckUtil.hs
--- a/hspec-core/src/Test/Hspec/Core/QuickCheckUtil.hs
+++ b/hspec-core/src/Test/Hspec/Core/QuickCheckUtil.hs
@@ -1,32 +1,29 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE RecordWildCards #-}
 module Test.Hspec.Core.QuickCheckUtil where
 
 import           Prelude ()
 import           Test.Hspec.Core.Compat
 
+import           Control.Exception
+import           Data.List
+import           Data.Maybe
 import           Data.Int
-import           Test.QuickCheck hiding (Result(..))
-import           Test.QuickCheck as QC
+import           System.Random
+
+import           Test.QuickCheck
+import           Test.QuickCheck.Text (isOneLine)
+import qualified Test.QuickCheck.Property as QCP
 import           Test.QuickCheck.Property hiding (Result(..))
 import           Test.QuickCheck.Gen
-import qualified Test.QuickCheck.Property as QCP
 import           Test.QuickCheck.IO ()
-
-
-#if MIN_VERSION_QuickCheck(2,7,0)
 import           Test.QuickCheck.Random
-#endif
-
-import           System.Random
+import qualified Test.QuickCheck.Test as QC (showTestCount)
+import           Test.QuickCheck.State (State(..))
 
 import           Test.Hspec.Core.Util
 
 aroundProperty :: ((a -> IO ()) -> IO ()) -> (a -> Property) -> Property
-#if MIN_VERSION_QuickCheck(2,7,0)
 aroundProperty action p = MkProperty . MkGen $ \r n -> aroundProp action $ \a -> (unGen . unProperty $ p a) r n
-#else
-aroundProperty action p = MkGen $ \r n -> aroundProp action $ \a -> (unGen $ p a) r n
-#endif
 
 aroundProp :: ((a -> IO ()) -> IO ()) -> (a -> Prop) -> Prop
 aroundProp action p = MkProp $ aroundRose action (\a -> unProp $ p a)
@@ -37,25 +34,115 @@
   action $ \a -> reduceRose (r a) >>= writeIORef ref
   readIORef ref
 
-formatNumbers :: Result -> String
-formatNumbers r = "(after " ++ pluralize (numTests r) "test" ++ shrinks ++ ")"
-  where
-    shrinks
-      | 0 < numShrinks r = " and " ++ pluralize (numShrinks r) "shrink"
-      | otherwise = ""
-
 newSeed :: IO Int
 newSeed = fst . randomR (0, fromIntegral (maxBound :: Int32)) <$>
-#if MIN_VERSION_QuickCheck(2,7,0)
   newQCGen
-#else
-  newStdGen
-#endif
 
-#if MIN_VERSION_QuickCheck(2,7,0)
 mkGen :: Int -> QCGen
 mkGen = mkQCGen
-#else
-mkGen :: Int -> StdGen
-mkGen = mkStdGen
-#endif
+
+formatNumbers :: Int -> Int -> String
+formatNumbers n shrinks = "(after " ++ pluralize n "test" ++ shrinks_ ++ ")"
+  where
+    shrinks_
+      | shrinks > 0 = " and " ++ pluralize shrinks "shrink"
+      | otherwise = ""
+
+data QuickCheckResult = QuickCheckResult {
+  quickCheckResultNumTests :: Int
+, quickCheckResultInfo :: String
+, quickCheckResultStatus :: Status
+} deriving Show
+
+data Status =
+    QuickCheckSuccess
+  | QuickCheckFailure QuickCheckFailure
+  | QuickCheckOtherFailure String
+  deriving Show
+
+data QuickCheckFailure = QCFailure {
+  quickCheckFailureNumShrinks :: Int
+, quickCheckFailureException :: Maybe SomeException
+, quickCheckFailureReason :: String
+, quickCheckFailureCounterexample :: [String]
+} deriving Show
+
+parseQuickCheckResult :: Result -> QuickCheckResult
+parseQuickCheckResult r = case r of
+  Success {..} -> result output QuickCheckSuccess
+
+  Failure {..} ->
+    case stripSuffix outputWithoutVerbose output of
+      Just xs -> result verboseOutput (QuickCheckFailure $ QCFailure numShrinks theException reason failingTestCase)
+        where
+          verboseOutput
+            | xs == "*** Failed! " = ""
+            | otherwise = maybeStripSuffix "*** Failed!" (strip xs)
+      Nothing -> couldNotParse output
+    where
+      outputWithoutVerbose = reasonAndNumbers ++ unlines failingTestCase
+      reasonAndNumbers
+        | isOneLine reason = reason ++ " " ++ numbers ++ colonNewline
+        | otherwise = numbers ++ colonNewline ++ ensureTrailingNewline reason
+      numbers = formatNumbers numTests numShrinks
+      colonNewline = ":\n"
+
+  GaveUp {..} ->
+    case stripSuffix outputWithoutVerbose output of
+      Just info -> otherFailure info ("Gave up after " ++ numbers ++ "!")
+      Nothing -> couldNotParse output
+    where
+      numbers = showTestCount numTests numDiscarded
+      outputWithoutVerbose = "*** Gave up! Passed only " ++ numbers ++ " tests.\n"
+
+  NoExpectedFailure {..} -> case splitBy "*** Failed! " output of
+    Just (info, err) -> otherFailure info err
+    Nothing -> couldNotParse output
+
+  where
+    result = QuickCheckResult (numTests r) . strip
+    otherFailure info err = result info (QuickCheckOtherFailure $ strip err)
+    couldNotParse = result "" . QuickCheckOtherFailure
+
+showTestCount :: Int -> Int -> String
+showTestCount success discarded = QC.showTestCount state
+  where
+    state = MkState {
+      terminal                  = undefined
+    , maxSuccessTests           = undefined
+    , maxDiscardedRatio         = undefined
+    , coverageConfidence        = undefined
+    , computeSize               = undefined
+    , numTotMaxShrinks          = 0
+    , numSuccessTests           = success
+    , numDiscardedTests         = discarded
+    , numRecentlyDiscardedTests = 0
+    , labels                    = mempty
+    , classes                   = mempty
+    , tables                    = mempty
+    , requiredCoverage          = mempty
+    , expected                  = True
+    , randomSeed                = mkGen 0
+    , numSuccessShrinks         = 0
+    , numTryShrinks             = 0
+    , numTotTryShrinks          = 0
+    }
+
+ensureTrailingNewline :: String -> String
+ensureTrailingNewline = unlines . lines
+
+maybeStripPrefix :: String -> String -> String
+maybeStripPrefix prefix m = fromMaybe m (stripPrefix prefix m)
+
+maybeStripSuffix :: String -> String -> String
+maybeStripSuffix suffix = reverse . maybeStripPrefix (reverse suffix) . reverse
+
+stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
+stripSuffix suffix = fmap reverse . stripPrefix (reverse suffix) . reverse
+
+splitBy :: String -> String -> Maybe (String, String)
+splitBy sep xs = listToMaybe [
+    (x, y) | (x, Just y) <- zip (inits xs) (map stripSep $ tails xs)
+  ]
+  where
+    stripSep = stripPrefix sep
diff --git a/hspec-core/src/Test/Hspec/Core/Runner.hs b/hspec-core/src/Test/Hspec/Core/Runner.hs
--- a/hspec-core/src/Test/Hspec/Core/Runner.hs
+++ b/hspec-core/src/Test/Hspec/Core/Runner.hs
@@ -1,10 +1,5 @@
 {-# LANGUAGE CPP #-}
 
-#if MIN_VERSION_base(4,6,0)
--- Control.Concurrent.QSem is deprecated in base-4.6.0.*
-{-# OPTIONS_GHC -fno-warn-deprecations #-}
-#endif
-
 -- |
 -- Stability: provisional
 module Test.Hspec.Core.Runner (
@@ -30,24 +25,20 @@
 import           Prelude ()
 import           Test.Hspec.Core.Compat
 
-import           Control.Monad
 import           Data.Maybe
 import           System.IO
 import           System.Environment (getProgName, getArgs, withArgs)
 import           System.Exit
 import qualified Control.Exception as E
-import           Control.Concurrent
 
 import           System.Console.ANSI (hHideCursor, hShowCursor)
 import qualified Test.QuickCheck as QC
-import           Control.Monad.IO.Class (liftIO)
 
 import           Test.Hspec.Core.Util (Path)
 import           Test.Hspec.Core.Spec
 import           Test.Hspec.Core.Config
 import           Test.Hspec.Core.Formatters
 import           Test.Hspec.Core.Formatters.Internal
-import qualified Test.Hspec.Core.Formatters.Internal as Formatter
 import           Test.Hspec.Core.FailureReport
 import           Test.Hspec.Core.QuickCheckUtil
 
@@ -83,7 +74,7 @@
   | otherwise = id
   where
     markSuccess :: Item () -> Item ()
-    markSuccess item = item {itemExample = safeEvaluateExample Success}
+    markSuccess item = item {itemExample = safeEvaluateExample (Result "" Success)}
 
     removeCleanup :: SpecTree () -> SpecTree ()
     removeCleanup spec = case spec of
@@ -160,25 +151,43 @@
         seed = (fromJust . configQuickCheckSeed) config
         qcArgs = configQuickCheckArgs config
 
-    jobsSem <- newQSem =<< case configConcurrentJobs config of
+    concurrentJobs <- case configConcurrentJobs config of
       Nothing -> getDefaultConcurrentJobs
-      Just maxJobs -> return maxJobs
+      Just n -> return n
 
     useColor <- doesUseColor h config
 
-    filteredSpec <- filterSpecs config . applyDryRun config <$> runSpecM spec
+    let params = Params (configQuickCheckArgs config) (configSmallCheckDepth config)
 
-    withHiddenCursor useColor h $
-      runFormatM useColor (configDiff config) (configHtmlOutput config) (configPrintCpuTime config) seed h $ do
-        runFormatter jobsSem useColor h config formatter filteredSpec `finally_` do
-          Formatter.interpret $ failedFormatter formatter
+    filteredSpec <- map (toEvalTree params) . filterSpecs config . applyDryRun config <$> runSpecM spec
 
-        Formatter.interpret $ footerFormatter formatter
+    (total, failures) <- withHiddenCursor useColor h $ do
+      let
+        formatConfig = FormatConfig {
+          formatConfigHandle = h
+        , formatConfigUseColor = useColor
+        , formatConfigUseDiff = configDiff config
+        , formatConfigHtmlOutput = configHtmlOutput config
+        , formatConfigPrintCpuTime = configPrintCpuTime config
+        , formatConfigUsedSeed =  seed
+        }
+        evalConfig = EvalConfig {
+          evalConfigFormat = formatterToFormat formatter formatConfig
+        , evalConfigConcurrentJobs = concurrentJobs
+        , evalConfigFastFail = configFastFail config
+        }
+      runFormatter evalConfig filteredSpec
 
-        xs <- map failureRecordPath <$> Formatter.interpret getFailMessages
-        liftIO $ dumpFailureReport config seed qcArgs xs
+    dumpFailureReport config seed qcArgs failures
+    return (Summary total (length failures))
 
-        Summary <$> Formatter.interpret getTotalCount <*> Formatter.interpret getFailCount
+toEvalTree :: Params -> SpecTree () -> EvalTree
+toEvalTree params = go
+  where
+    go t = case t of
+      Node s xs -> Node s (map go xs)
+      NodeWithCleanup c xs -> NodeWithCleanup (c ()) (map go xs)
+      Leaf (Item requirement loc isParallelizable e)  -> Leaf (EvalItem requirement loc (fromMaybe False isParallelizable) (e params $ ($ ())))
 
 dumpFailureReport :: Config -> Integer -> QC.Args -> [Path] -> IO ()
 dumpFailureReport config seed qcArgs xs = do
diff --git a/hspec-core/src/Test/Hspec/Core/Runner/Eval.hs b/hspec-core/src/Test/Hspec/Core/Runner/Eval.hs
--- a/hspec-core/src/Test/Hspec/Core/Runner/Eval.hs
+++ b/hspec-core/src/Test/Hspec/Core/Runner/Eval.hs
@@ -1,157 +1,268 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ConstraintKinds #-}
 
-#if MIN_VERSION_base(4,6,0)
+#if MIN_VERSION_base(4,6,0) && !MIN_VERSION_base(4,7,0)
 -- Control.Concurrent.QSem is deprecated in base-4.6.0.*
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
 #endif
 
-module Test.Hspec.Core.Runner.Eval (runFormatter) where
+module Test.Hspec.Core.Runner.Eval (
+  EvalConfig(..)
+, EvalTree
+, EvalItem(..)
+, runFormatter
+#ifdef TEST
+, runSequentially
+#endif
+) where
 
 import           Prelude ()
-import           Test.Hspec.Core.Compat
+import           Test.Hspec.Core.Compat hiding (Monad)
+import qualified Test.Hspec.Core.Compat as M
 
-import           Control.Monad (unless, when)
 import qualified Control.Exception as E
 import           Control.Concurrent
-import           System.IO (Handle)
+import           Control.Concurrent.Async hiding (cancel)
 
 import           Control.Monad.IO.Class (liftIO)
-import           Data.Time.Clock.POSIX
+import qualified Control.Monad.IO.Class as M
 
+import           Control.Monad.Trans.State hiding (State, state)
+import           Control.Monad.Trans.Class
+
 import           Test.Hspec.Core.Util
-import           Test.Hspec.Core.Spec
-import           Test.Hspec.Core.Config
-import           Test.Hspec.Core.Formatters hiding (FormatM)
-import           Test.Hspec.Core.Formatters.Internal
-import qualified Test.Hspec.Core.Formatters.Internal as Formatter
+import           Test.Hspec.Core.Spec (Tree(..), Progress, FailureReason(..), Result(..), ResultStatus(..), ProgressCallback)
 import           Test.Hspec.Core.Timer
+import           Test.Hspec.Core.Format (Format(..))
+import qualified Test.Hspec.Core.Format as Format
+import           Test.Hspec.Core.Clock
+import           Test.Hspec.Core.Example.Location
 
-type EvalTree = Tree (ActionWith ()) (String, Maybe Location, ProgressCallback -> FormatResult -> IO (FormatM ()))
+-- for compatibility with GHC < 7.10.1
+type Monad m = (Functor m, Applicative m, M.Monad m)
+type MonadIO m = (Monad m, M.MonadIO m)
 
+data EvalConfig m = EvalConfig {
+  evalConfigFormat :: Format m
+, evalConfigConcurrentJobs :: Int
+, evalConfigFastFail :: Bool
+}
+
+data State m = State {
+  stateConfig :: EvalConfig m
+, stateSuccessCount :: Int
+, statePendingCount :: Int
+, stateFailures :: [Path]
+}
+
+type EvalM m = StateT (State m) m
+
+increaseSuccessCount :: Monad m => EvalM m ()
+increaseSuccessCount = modify $ \state -> state {stateSuccessCount = stateSuccessCount state + 1}
+
+increasePendingCount :: Monad m => EvalM m ()
+increasePendingCount = modify $ \state -> state {statePendingCount = statePendingCount state + 1}
+
+addFailure :: Monad m => Path -> EvalM m ()
+addFailure path = modify $ \state -> state {stateFailures = path : stateFailures state}
+
+getFormat :: Monad m => (Format m -> a) -> EvalM m a
+getFormat format = gets (format . evalConfigFormat . stateConfig)
+
+reportItem :: Monad m => Path -> Format.Item -> EvalM m ()
+reportItem path item = do
+  case Format.itemResult item of
+    Format.Success {} -> increaseSuccessCount
+    Format.Pending {} -> increasePendingCount
+    Format.Failure {} -> addFailure path
+  format <- getFormat formatItem
+  lift (format path item)
+
+failureItem :: Maybe Location -> Seconds -> String -> FailureReason -> Format.Item
+failureItem loc duration info err = Format.Item loc duration info (Format.Failure err)
+
+reportResult :: Monad m => Path -> Maybe Location -> (Seconds, Result) -> EvalM m ()
+reportResult path loc (duration, result) = do
+  case result of
+    Result info status -> case status of
+      Success -> reportItem path (Format.Item loc duration info Format.Success)
+      Pending loc_ reason -> reportItem path (Format.Item (loc_ <|> loc) duration info $ Format.Pending reason)
+      Failure loc_ err@(Error _ e) -> reportItem path (failureItem (loc_ <|> extractLocation e <|> loc) duration info err)
+      Failure loc_ err -> reportItem path (failureItem (loc_ <|> loc) duration info err)
+
+groupStarted :: Monad m => Path -> EvalM m ()
+groupStarted path = do
+  format <- getFormat formatGroupStarted
+  lift $ format path
+
+groupDone :: Monad m => Path -> EvalM m ()
+groupDone path = do
+  format <- getFormat formatGroupDone
+  lift $ format path
+
+data EvalItem = EvalItem {
+  evalItemDescription :: String
+, evalItemLocation :: Maybe Location
+, evalItemParallelize :: Bool
+, evalItemAction :: ProgressCallback -> IO Result
+}
+
+type EvalTree = Tree (IO ()) EvalItem
+
+runEvalM :: Monad m => EvalConfig m -> EvalM m () -> m (State m)
+runEvalM config action = execStateT action (State config 0 0 [])
+
 -- | Evaluate all examples of a given spec and produce a report.
-runFormatter :: QSem -> Bool -> Handle -> Config -> Formatter -> [SpecTree ()] -> FormatM ()
-runFormatter jobsSem useColor h c formatter specs = do
-  Formatter.interpret $ headerFormatter formatter
-  chan <- liftIO newChan
-  reportProgress <- liftIO mkReportProgress
-  run chan reportProgress c formatter (toEvalTree specs)
+runFormatter :: forall m. MonadIO m => EvalConfig m -> [EvalTree] -> IO (Int, [Path])
+runFormatter config specs = do
+  let
+    start = parallelizeTree (evalConfigConcurrentJobs config) specs
+    cancel = cancelMany . concatMap toList . map (fmap fst)
+  E.bracket start cancel $ \ runningSpecs -> do
+    withTimer 0.05 $ \ timer -> do
+      state <- formatRun format $ do
+        runEvalM config $
+          run $ map (fmap (fmap (. reportProgress timer) . snd)) runningSpecs
+      let
+        failures = stateFailures state
+        total = stateSuccessCount state + statePendingCount state + length failures
+      return (total, reverse failures)
   where
-    mkReportProgress :: IO (Path -> Progress -> IO ())
-    mkReportProgress
-      | useColor = every 0.05 $ exampleProgress formatter h
-      | otherwise = return $ \_ _ -> return ()
+    format = evalConfigFormat config
 
-    toEvalTree :: [SpecTree ()] -> [EvalTree]
-    toEvalTree = map (fmap f)
-      where
-        f :: Item () -> (String, Maybe Location, ProgressCallback -> FormatResult -> IO (FormatM ()))
-        f (Item requirement loc isParallelizable e) = (requirement, loc, parallelize jobsSem isParallelizable $ e params ($ ()))
+    reportProgress :: IO Bool -> Path -> Progress -> m ()
+    reportProgress timer path progress = do
+      r <- liftIO timer
+      when r (formatProgress format path progress)
 
-    params :: Params
-    params = Params (configQuickCheckArgs c) (configSmallCheckDepth c)
+cancelMany :: [Async a] -> IO ()
+cancelMany asyncs = do
+  mapM_ (killThread . asyncThreadId) asyncs
+  mapM_ waitCatch asyncs
 
--- | Execute given action at most every specified number of seconds.
-every :: POSIXTime -> (a -> b -> IO ()) -> IO (a -> b -> IO ())
-every seconds action = do
-  timer <- newTimer seconds
-  return $ \a b -> do
-    r <- timer
-    when r (action a b)
+data Item a = Item {
+  _itemDescription :: String
+, _itemLocation :: Maybe Location
+, _itemAction :: a
+} deriving Functor
 
-type FormatResult = Either E.SomeException Result -> FormatM ()
+type Job m p a = (p -> m ()) -> m a
 
-parallelize :: QSem -> Bool -> (ProgressCallback -> IO (Either E.SomeException Result)) -> ProgressCallback -> FormatResult -> IO (FormatM ())
-parallelize jobsSem isParallelizable e
-  | isParallelizable = runParallel jobsSem e
-  | otherwise = runSequentially e
+type RunningItem m = Item (Path -> m (Seconds, Result))
+type RunningTree m = Tree (IO ()) (RunningItem m)
 
-runSequentially :: (ProgressCallback -> IO (Either E.SomeException Result)) -> ProgressCallback -> FormatResult -> IO (FormatM ())
-runSequentially e reportProgress formatResult = return $ do
-  result <- liftIO $ e reportProgress
-  formatResult result
+type RunningItem_ m = (Async (), Item (Job m Progress (Seconds, Result)))
+type RunningTree_ m = Tree (IO ()) (RunningItem_ m)
 
-data Report = ReportProgress Progress | ReportResult (Either E.SomeException Result)
+data Semaphore = Semaphore {
+  semaphoreWait :: IO ()
+, semaphoreSignal :: IO ()
+}
 
-runParallel :: QSem -> (ProgressCallback -> IO (Either E.SomeException Result)) -> ProgressCallback -> FormatResult -> IO (FormatM ())
-runParallel jobsSem e reportProgress formatResult = do
+parallelizeTree :: MonadIO m => Int -> [EvalTree] -> IO [RunningTree_ m]
+parallelizeTree n specs = do
+  sem <- newQSem n
+  mapM (traverse $ parallelizeItem sem) specs
+
+parallelizeItem :: MonadIO m => QSem -> EvalItem -> IO (RunningItem_ m)
+parallelizeItem sem EvalItem{..} = do
+  (asyncAction, evalAction) <- parallelize (Semaphore (waitQSem sem) (signalQSem sem)) evalItemParallelize (interruptible . evalItemAction)
+  return (asyncAction, Item evalItemDescription evalItemLocation evalAction)
+
+parallelize :: MonadIO m => Semaphore -> Bool -> Job IO p a -> IO (Async (), Job m p (Seconds, a))
+parallelize sem isParallelizable
+  | isParallelizable = runParallel sem
+  | otherwise = runSequentially
+
+runSequentially :: MonadIO m => Job IO p a -> IO (Async (), Job m p (Seconds, a))
+runSequentially action = do
   mvar <- newEmptyMVar
-  _ <- forkIO $ E.bracket_ (waitQSem jobsSem) (signalQSem jobsSem) $ do
-    let progressCallback = replaceMVar mvar . ReportProgress
-    result <- e progressCallback
-    replaceMVar mvar (ReportResult result)
-  return $ evalReport mvar
+  (asyncAction, evalAction) <- runParallel (Semaphore (takeMVar mvar) (return ())) action
+  return (asyncAction, \ notifyPartial -> liftIO (putMVar mvar ()) >> evalAction notifyPartial)
+
+data Parallel p a = Partial p | Return a
+
+runParallel :: forall m p a. MonadIO m => Semaphore -> Job IO p a -> IO (Async (), Job m p (Seconds, a))
+runParallel Semaphore{..} action = do
+  mvar <- newEmptyMVar
+  asyncAction <- async $ E.bracket_ semaphoreWait semaphoreSignal (worker mvar)
+  return (asyncAction, eval mvar)
   where
-    evalReport :: MVar Report -> FormatM ()
-    evalReport mvar = do
+    worker mvar = do
+      let partialCallback = replaceMVar mvar . Partial
+      result <- measure $ action partialCallback
+      replaceMVar mvar (Return result)
+
+    eval :: MVar (Parallel p (Seconds, a)) -> (p -> m ()) -> m (Seconds, a)
+    eval mvar notifyPartial = do
       r <- liftIO (takeMVar mvar)
       case r of
-        ReportProgress p -> do
-          liftIO $ reportProgress p
-          evalReport mvar
-        ReportResult result -> formatResult result
-
-    replaceMVar :: MVar a -> a -> IO ()
-    replaceMVar mvar p = tryTakeMVar mvar >> putMVar mvar p
+        Partial p -> do
+          notifyPartial p
+          eval mvar notifyPartial
+        Return result -> return result
 
-data Message = Done | Run (FormatM ())
+replaceMVar :: MVar a -> a -> IO ()
+replaceMVar mvar p = tryTakeMVar mvar >> putMVar mvar p
 
-run :: Chan Message -> (Path -> ProgressCallback) -> Config -> Formatter -> [EvalTree] -> FormatM ()
-run chan reportProgress_ c formatter specs = do
-  liftIO $ do
-    forM_ specs (queueSpec [])
-    writeChan chan Done
-  processMessages (readChan chan) (configFastFail c)
+run :: forall m. MonadIO m => [RunningTree m] -> EvalM m ()
+run specs = do
+  fastFail <- gets (evalConfigFastFail . stateConfig)
+  sequenceActions fastFail (concatMap foldSpec specs)
   where
-    defer :: FormatM () -> IO ()
-    defer = writeChan chan . Run
-
-    runCleanup :: IO () -> Path -> FormatM ()
-    runCleanup action path = do
-      r <- liftIO $ safeTry action
-      either (failed Nothing path . Left) return r
+    foldSpec :: RunningTree m -> [EvalM m ()]
+    foldSpec = foldTree FoldTree {
+      onGroupStarted = groupStarted
+    , onGroupDone = groupDone
+    , onCleanup = runCleanup
+    , onLeafe = evalItem
+    }
 
-    queueSpec :: [String] -> EvalTree -> IO ()
-    queueSpec rGroups (Node group xs) = do
-      defer (Formatter.interpret $ exampleGroupStarted formatter (reverse rGroups) group)
-      forM_ xs (queueSpec (group : rGroups))
-      defer (Formatter.interpret $ exampleGroupDone formatter)
-    queueSpec rGroups (NodeWithCleanup action xs) = do
-      forM_ xs (queueSpec rGroups)
-      defer (runCleanup (action ()) (reverse rGroups, "afterAll-hook"))
-    queueSpec rGroups (Leaf e) =
-      queueExample (reverse rGroups) e
+    runCleanup :: [String] -> IO () -> EvalM m ()
+    runCleanup groups action = do
+      (dt, r) <- liftIO $ measure $ safeTry action
+      either (\ e -> reportItem path . failureItem (extractLocation e) dt "" . Error Nothing $ e) return r
+      where
+        path = (groups, "afterAll-hook")
 
-    queueExample :: [String] -> (String, Maybe Location, ProgressCallback -> FormatResult -> IO (FormatM ())) -> IO ()
-    queueExample groups (requirement, loc, e) = e reportProgress formatResult >>= defer
+    evalItem :: [String] -> RunningItem m -> EvalM m ()
+    evalItem groups (Item requirement loc action) = do
+      lift (action path) >>= reportResult path loc
       where
         path :: Path
         path = (groups, requirement)
 
-        reportProgress = reportProgress_ path
-
-        formatResult :: FormatResult
-        formatResult result = do
-          case result of
-            Right Success -> do
-              increaseSuccessCount
-              Formatter.interpret $ exampleSucceeded formatter path
-            Right (Pending reason) -> do
-              increasePendingCount
-              Formatter.interpret $ examplePending formatter path reason
-            Right (Failure loc_ err) -> failed (loc_ <|> loc) path (Right err)
-            Left err         -> failed loc path (Left  err)
+data FoldTree c a r = FoldTree {
+  onGroupStarted :: Path -> r
+, onGroupDone :: Path -> r
+, onCleanup :: [String] -> c -> r
+, onLeafe :: [String] -> a -> r
+}
 
-    failed loc path err = do
-      increaseFailCount
-      addFailMessage loc path err
-      Formatter.interpret $ exampleFailed formatter path err
+foldTree :: FoldTree c a r -> Tree c a -> [r]
+foldTree FoldTree{..} = go []
+  where
+    go rGroups (Node group xs) = start : children ++ [done]
+      where
+        path = (reverse rGroups, group)
+        start = onGroupStarted path
+        children = concatMap (go (group : rGroups)) xs
+        done =  onGroupDone path
+    go rGroups (NodeWithCleanup action xs) = children ++ [cleanup]
+      where
+        children = concatMap (go rGroups) xs
+        cleanup = onCleanup (reverse rGroups) action
+    go rGroups (Leaf a) = [onLeafe (reverse rGroups) a]
 
-processMessages :: IO Message -> Bool -> FormatM ()
-processMessages getMessage fastFail = go
+sequenceActions :: Monad m => Bool -> [EvalM m ()] -> EvalM m ()
+sequenceActions fastFail = go
   where
-    go = liftIO getMessage >>= \m -> case m of
-      Run action -> do
-        action
-        fails <- Formatter.interpret getFailCount
-        unless (fastFail && fails /= 0) go
-      Done -> return ()
+    go [] = return ()
+    go (action : actions) = do
+      () <- action
+      hasFailures <- (not . null) <$> gets stateFailures
+      let stopNow = fastFail && hasFailures
+      unless stopNow (go actions)
diff --git a/hspec-core/src/Test/Hspec/Core/Spec.hs b/hspec-core/src/Test/Hspec/Core/Spec.hs
--- a/hspec-core/src/Test/Hspec/Core/Spec.hs
+++ b/hspec-core/src/Test/Hspec/Core/Spec.hs
@@ -19,6 +19,7 @@
 , xdescribe
 , xcontext
 , parallel
+, sequential
 
 -- * The @SpecM@ monad
 , module Test.Hspec.Core.Spec.Monad
@@ -30,6 +31,9 @@
 , module Test.Hspec.Core.Tree
 ) where
 
+import           Prelude ()
+import           Test.Hspec.Core.Compat
+
 import qualified Control.Exception as E
 import           Data.CallStack
 
@@ -41,22 +45,22 @@
 import           Test.Hspec.Core.Spec.Monad
 
 -- | The @describe@ function combines a list of specs into a larger spec.
-describe :: String -> SpecWith a -> SpecWith a
+describe :: HasCallStack => String -> SpecWith a -> SpecWith a
 describe label spec = runIO (runSpecM spec) >>= fromSpecList . return . specGroup label
 
 -- | @context@ is an alias for `describe`.
-context :: String -> SpecWith a -> SpecWith a
+context :: HasCallStack => String -> SpecWith a -> SpecWith a
 context = describe
 
 -- |
 -- Changing `describe` to `xdescribe` marks all spec items of the corresponding subtree as pending.
 --
 -- This can be used to temporarily disable spec items.
-xdescribe :: String -> SpecWith a -> SpecWith a
-xdescribe label spec = before_ pending $ describe label spec
+xdescribe :: HasCallStack => String -> SpecWith a -> SpecWith a
+xdescribe label spec = before_ pending_ $ describe label spec
 
 -- | @xcontext@ is an alias for `xdescribe`.
-xcontext :: String -> SpecWith a -> SpecWith a
+xcontext :: HasCallStack => String -> SpecWith a -> SpecWith a
 xcontext = xdescribe
 
 -- | The @it@ function creates a spec item.
@@ -82,7 +86,7 @@
 --
 -- This can be used to temporarily disable a spec item.
 xit :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
-xit label action = before_ pending $ it label action
+xit label action = before_ pending_ $ it label action
 
 -- | @xspecify@ is an alias for `xit`.
 xspecify :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
@@ -91,8 +95,15 @@
 -- | `parallel` marks all spec items of the given spec to be safe for parallel
 -- evaluation.
 parallel :: SpecWith a -> SpecWith a
-parallel = mapSpecItem_ $ \item -> item {itemIsParallelizable = True}
+parallel = mapSpecItem_ (setParallelizable True)
 
+-- | `sequential` marks all spec items of the given spec to be evaluated sequentially.
+sequential :: SpecWith a -> SpecWith a
+sequential = mapSpecItem_ (setParallelizable False)
+
+setParallelizable :: Bool -> Item a -> Item a
+setParallelizable value item = item {itemIsParallelizable = itemIsParallelizable item <|> Just value}
+
 -- | `pending` can be used to mark a spec item as pending.
 --
 -- If you want to textually specify a behavior but do not have an example yet,
@@ -101,11 +112,14 @@
 -- > describe "fancyFormatter" $ do
 -- >   it "can format text in a way that everyone likes" $
 -- >     pending
-pending :: Expectation
-pending = E.throwIO (Pending Nothing)
+pending :: HasCallStack => Expectation
+pending = E.throwIO (Pending location Nothing)
 
+pending_ :: Expectation
+pending_ = (E.throwIO (Pending Nothing Nothing))
+
 -- |
 -- `pendingWith` is similar to `pending`, but it takes an additional string
 -- argument that can be used to specify the reason for why the spec item is pending.
-pendingWith :: String -> Expectation
-pendingWith = E.throwIO . Pending . Just
+pendingWith :: HasCallStack => String -> Expectation
+pendingWith = E.throwIO . Pending location . Just
diff --git a/hspec-core/src/Test/Hspec/Core/Spec/Monad.hs b/hspec-core/src/Test/Hspec/Core/Spec/Monad.hs
--- a/hspec-core/src/Test/Hspec/Core/Spec/Monad.hs
+++ b/hspec-core/src/Test/Hspec/Core/Spec/Monad.hs
@@ -7,7 +7,6 @@
 , fromSpecList
 , runIO
 
-, mapSpecTree
 , mapSpecItem
 , mapSpecItem_
 , modifyParams
@@ -16,6 +15,7 @@
 import           Prelude ()
 import           Test.Hspec.Core.Compat
 
+import           Control.Arrow
 import           Control.Monad.Trans.Writer
 import           Control.Monad.IO.Class (liftIO)
 
@@ -49,8 +49,8 @@
 runIO :: IO r -> SpecM a r
 runIO = SpecM . liftIO
 
-mapSpecTree :: (SpecTree a -> SpecTree b) -> SpecWith a -> SpecWith b
-mapSpecTree f spec = runIO (runSpecM spec) >>= fromSpecList . map f
+mapSpecTree :: (SpecTree a -> SpecTree b) -> SpecM a r -> SpecM b r
+mapSpecTree f (SpecM specs) = SpecM (mapWriterT (fmap (second (map f))) specs)
 
 mapSpecItem :: (ActionWith a -> ActionWith b) -> (Item a -> Item b) -> SpecWith a -> SpecWith b
 mapSpecItem g f = mapSpecTree go
diff --git a/hspec-core/src/Test/Hspec/Core/Timer.hs b/hspec-core/src/Test/Hspec/Core/Timer.hs
--- a/hspec-core/src/Test/Hspec/Core/Timer.hs
+++ b/hspec-core/src/Test/Hspec/Core/Timer.hs
@@ -1,14 +1,21 @@
-module Test.Hspec.Core.Timer where
+module Test.Hspec.Core.Timer (withTimer) where
 
-import           Data.IORef
-import           Data.Time.Clock.POSIX
+import           Prelude ()
+import           Test.Hspec.Core.Compat
 
-newTimer :: POSIXTime -> IO (IO Bool)
-newTimer delay = do
-  ref <- getPOSIXTime >>= newIORef
-  return $ do
-    t0 <- readIORef ref
-    t1 <- getPOSIXTime
-    if delay < t1 - t0
-      then writeIORef ref t1 >> return True
-      else return False
+import           Control.Exception
+import           Control.Concurrent.Async
+
+import           Test.Hspec.Core.Clock
+
+withTimer :: Seconds -> (IO Bool -> IO a) -> IO a
+withTimer delay action = do
+  ref <- newIORef False
+  bracket (async $ worker delay ref) cancel $ \_ -> do
+    action $ atomicModifyIORef ref (\a -> (False, a))
+
+worker :: Seconds -> IORef Bool -> IO ()
+worker delay ref = do
+  forever $ do
+    sleep delay
+    atomicWriteIORef ref True
diff --git a/hspec-core/src/Test/Hspec/Core/Tree.hs b/hspec-core/src/Test/Hspec/Core/Tree.hs
--- a/hspec-core/src/Test/Hspec/Core/Tree.hs
+++ b/hspec-core/src/Test/Hspec/Core/Tree.hs
@@ -12,14 +12,15 @@
 , Item (..)
 , specGroup
 , specItem
+, location
 ) where
 
-import           Data.CallStack
-import           Control.Exception
-
 import           Prelude ()
 import           Test.Hspec.Core.Compat
 
+import           Data.CallStack
+import           Data.Maybe
+
 import           Test.Hspec.Core.Example
 
 -- | Internal tree data structure
@@ -50,28 +51,35 @@
 , itemLocation :: Maybe Location
   -- | A flag that indicates whether it is safe to evaluate this spec item in
   -- parallel with other spec items
-, itemIsParallelizable :: Bool
+, itemIsParallelizable :: Maybe Bool
   -- | Example for behavior
-, itemExample :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO (Either SomeException Result)
+, itemExample :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result
 }
 
 -- | The @specGroup@ function combines a list of specs into a larger spec.
-specGroup :: String -> [SpecTree a] -> SpecTree a
+specGroup :: HasCallStack => String -> [SpecTree a] -> SpecTree a
 specGroup s = Node msg
   where
+    msg :: HasCallStack => String
     msg
-      | null s = "(no description given)"
+      | null s = fromMaybe "(no description given)" defaultDescription
       | otherwise = s
 
 -- | The @specItem@ function creates a spec item.
 specItem :: (HasCallStack, Example a) => String -> a -> SpecTree (Arg a)
-specItem s e = Leaf $ Item requirement location False (safeEvaluateExample e)
+specItem s e = Leaf $ Item requirement location Nothing (safeEvaluateExample e)
   where
+    requirement :: HasCallStack => String
     requirement
-      | null s = "(unspecified behavior)"
+      | null s = fromMaybe "(unspecified behavior)" defaultDescription
       | otherwise = s
 
-    location :: Maybe Location
-    location = case reverse callStack of
-      (_, loc) : _ -> Just (Location (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc) ExactLocation)
-      _ -> Nothing
+location :: HasCallStack => Maybe Location
+location = case reverse callStack of
+  (_, loc) : _ -> Just (Location (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc))
+  _ -> Nothing
+
+defaultDescription :: HasCallStack => Maybe String
+defaultDescription = case reverse callStack of
+  (_, loc) : _ -> Just (srcLocModule loc ++ "[" ++ show (srcLocStartLine loc) ++ ":" ++ show (srcLocStartCol loc) ++ "]")
+  _ -> Nothing
diff --git a/hspec-core/src/Test/Hspec/Core/Util.hs b/hspec-core/src/Test/Hspec/Core/Util.hs
--- a/hspec-core/src/Test/Hspec/Core/Util.hs
+++ b/hspec-core/src/Test/Hspec/Core/Util.hs
@@ -7,6 +7,7 @@
 
 -- * Working with paths
 , Path
+, joinPath
 , formatRequirement
 , filterPredicate
 
@@ -68,6 +69,12 @@
 type Path = ([String], String)
 
 -- |
+-- Join a `Path` with slashes.  The result will have a leading and a trailing
+-- slash.
+joinPath :: Path -> String
+joinPath (groups, requirement) = "/" ++ intercalate "/" (groups ++ [requirement]) ++ "/"
+
+-- |
 -- Try to create a proper English sentence from a path by applying some
 -- heuristics.
 formatRequirement :: Path -> String
@@ -83,11 +90,11 @@
 
 -- | A predicate that can be used to filter a spec tree.
 filterPredicate :: String -> Path -> Bool
-filterPredicate pattern path@(groups, requirement) =
+filterPredicate pattern path =
      pattern `isInfixOf` plain
   || pattern `isInfixOf` formatted
   where
-    plain = intercalate "/" (groups ++ [requirement])
+    plain = joinPath path
     formatted = formatRequirement path
 
 -- | The function `formatException` converts an exception to a string.
@@ -100,8 +107,8 @@
 -- For `IOException`s the `IOErrorType` is included, as well.
 formatException :: SomeException -> String
 formatException err@(SomeException e) = case fromException err of
-  Just ioe -> showType ioe ++ " of type " ++ showIOErrorType ioe ++ " (" ++ show ioe ++ ")"
-  Nothing  -> showType e ++ " (" ++ show e ++ ")"
+  Just ioe -> showType ioe ++ " of type " ++ showIOErrorType ioe ++ "\n" ++ show ioe
+  Nothing  -> showType e ++ "\n" ++ show e
   where
     showIOErrorType :: IOException -> String
     showIOErrorType ioe = case ioe_type ioe of
@@ -129,13 +136,4 @@
 -- occurs, the exception is returned instead.  Unlike `try` it is agnostic to
 -- asynchronous exceptions.
 safeTry :: IO a -> IO (Either SomeException a)
-safeTry action = bracket runAction cancelAction waitForAction
-  where
-    runAction = async ((action >>= evaluate))
-    waitForAction = waitCatch
-    cancelAction a = do
-      cancel a
-      -- It is important to wait here to make sure all finalizers in action have
-      -- been run. Otherwise the main thread can exit before they have finished
-      -- and the finalizers are only partially run.
-      waitCatch a -- We use waitCatch to hide the ThreadKilled exception
+safeTry action = withAsync (action >>= evaluate) waitCatch
diff --git a/hspec-core/vendor/Control/Concurrent/Async.hs b/hspec-core/vendor/Control/Concurrent/Async.hs
new file mode 100644
--- /dev/null
+++ b/hspec-core/vendor/Control/Concurrent/Async.hs
@@ -0,0 +1,870 @@
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples, RankNTypes,
+    ExistentialQuantification #-}
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Trustworthy #-}
+#endif
+#if __GLASGOW_HASKELL__ < 710
+{-# LANGUAGE DeriveDataTypeable #-}
+#endif
+{-# OPTIONS -Wall #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Concurrent.Async
+-- Copyright   :  (c) Simon Marlow 2012
+-- License     :  BSD3 (see the file LICENSE)
+--
+-- Maintainer  :  Simon Marlow <marlowsd@gmail.com>
+-- Stability   :  provisional
+-- Portability :  non-portable (requires concurrency)
+--
+-- This module provides a set of operations for running IO operations
+-- asynchronously and waiting for their results.  It is a thin layer
+-- over the basic concurrency operations provided by
+-- "Control.Concurrent".  The main additional functionality it
+-- provides is the ability to wait for the return value of a thread,
+-- but the interface also provides some additional safety and
+-- robustness over using threads and @MVar@ directly.
+--
+-- The basic type is @'Async' a@, which represents an asynchronous
+-- @IO@ action that will return a value of type @a@, or die with an
+-- exception.  An @Async@ corresponds to a thread, and its 'ThreadId'
+-- can be obtained with 'asyncThreadId', although that should rarely
+-- be necessary.
+--
+-- For example, to fetch two web pages at the same time, we could do
+-- this (assuming a suitable @getURL@ function):
+--
+-- >    do a1 <- async (getURL url1)
+-- >       a2 <- async (getURL url2)
+-- >       page1 <- wait a1
+-- >       page2 <- wait a2
+-- >       ...
+--
+-- where 'async' starts the operation in a separate thread, and
+-- 'wait' waits for and returns the result.  If the operation
+-- throws an exception, then that exception is re-thrown by
+-- 'wait'.  This is one of the ways in which this library
+-- provides some additional safety: it is harder to accidentally
+-- forget about exceptions thrown in child threads.
+--
+-- A slight improvement over the previous example is this:
+--
+-- >       withAsync (getURL url1) $ \a1 -> do
+-- >       withAsync (getURL url2) $ \a2 -> do
+-- >       page1 <- wait a1
+-- >       page2 <- wait a2
+-- >       ...
+--
+-- 'withAsync' is like 'async', except that the 'Async' is
+-- automatically killed (using 'uninterruptibleCancel') if the
+-- enclosing IO operation returns before it has completed.  Consider
+-- the case when the first 'wait' throws an exception; then the second
+-- 'Async' will be automatically killed rather than being left to run
+-- in the background, possibly indefinitely.  This is the second way
+-- that the library provides additional safety: using 'withAsync'
+-- means we can avoid accidentally leaving threads running.
+-- Furthermore, 'withAsync' allows a tree of threads to be built, such
+-- that children are automatically killed if their parents die for any
+-- reason.
+--
+-- The pattern of performing two IO actions concurrently and waiting
+-- for their results is packaged up in a combinator 'concurrently', so
+-- we can further shorten the above example to:
+--
+-- >       (page1, page2) <- concurrently (getURL url1) (getURL url2)
+-- >       ...
+--
+-- The 'Functor' instance can be used to change the result of an
+-- 'Async'.  For example:
+--
+-- > ghci> a <- async (return 3)
+-- > ghci> wait a
+-- > 3
+-- > ghci> wait (fmap (+1) a)
+-- > 4
+
+-----------------------------------------------------------------------------
+
+module Control.Concurrent.Async (
+
+    -- * Asynchronous actions
+    Async,
+    -- ** Spawning
+    async, asyncBound, asyncOn, asyncWithUnmask, asyncOnWithUnmask,
+
+    -- ** Spawning with automatic 'cancel'ation
+    withAsync, withAsyncBound, withAsyncOn, withAsyncWithUnmask,
+    withAsyncOnWithUnmask,
+
+    -- ** Querying 'Async's
+    wait, poll, waitCatch, asyncThreadId,
+    cancel, uninterruptibleCancel, cancelWith, AsyncCancelled(..),
+
+    -- ** STM operations
+    waitSTM, pollSTM, waitCatchSTM,
+
+    -- ** Waiting for multiple 'Async's
+    waitAny, waitAnyCatch, waitAnyCancel, waitAnyCatchCancel,
+    waitEither, waitEitherCatch, waitEitherCancel, waitEitherCatchCancel,
+    waitEither_,
+    waitBoth,
+
+    -- ** Waiting for multiple 'Async's in STM
+    waitAnySTM, waitAnyCatchSTM,
+    waitEitherSTM, waitEitherCatchSTM,
+    waitEitherSTM_,
+    waitBothSTM,
+
+    -- ** Linking
+    link, link2, ExceptionInLinkedThread(..),
+
+    -- * Convenient utilities
+    race, race_,
+    concurrently, concurrently_,
+    mapConcurrently, forConcurrently,
+    mapConcurrently_, forConcurrently_,
+    replicateConcurrently, replicateConcurrently_,
+    Concurrently(..),
+    compareAsyncs,
+
+  ) where
+
+import Control.Concurrent.STM
+import Control.Exception
+import Control.Concurrent
+import qualified Data.Foldable as F
+#if !MIN_VERSION_base(4,6,0)
+import Prelude hiding (catch)
+#endif
+import Control.Monad
+import Control.Applicative
+#if !MIN_VERSION_base(4,8,0)
+import Data.Monoid (Monoid(mempty,mappend))
+import Data.Traversable
+#endif
+#if __GLASGOW_HASKELL__ < 710
+import Data.Typeable
+#endif
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup((<>)))
+#endif
+
+import Data.IORef
+
+import GHC.Exts
+import GHC.IO hiding (finally, onException)
+import GHC.Conc
+
+-- -----------------------------------------------------------------------------
+-- STM Async API
+
+
+-- | An asynchronous action spawned by 'async' or 'withAsync'.
+-- Asynchronous actions are executed in a separate thread, and
+-- operations are provided for waiting for asynchronous actions to
+-- complete and obtaining their results (see e.g. 'wait').
+--
+data Async a = Async
+  { asyncThreadId :: {-# UNPACK #-} !ThreadId
+                  -- ^ Returns the 'ThreadId' of the thread running
+                  -- the given 'Async'.
+  , _asyncWait    :: STM (Either SomeException a)
+  }
+
+instance Eq (Async a) where
+  Async a _ == Async b _  =  a == b
+
+instance Ord (Async a) where
+  Async a _ `compare` Async b _  =  a `compare` b
+
+instance Functor Async where
+  fmap f (Async a w) = Async a (fmap (fmap f) w)
+
+-- | Compare two 'Async's that may have different types
+compareAsyncs :: Async a -> Async b -> Ordering
+compareAsyncs (Async t1 _) (Async t2 _) = compare t1 t2
+
+-- | Spawn an asynchronous action in a separate thread.
+async :: IO a -> IO (Async a)
+async = inline asyncUsing rawForkIO
+
+-- | Like 'async' but using 'forkOS' internally.
+asyncBound :: IO a -> IO (Async a)
+asyncBound = asyncUsing forkOS
+
+-- | Like 'async' but using 'forkOn' internally.
+asyncOn :: Int -> IO a -> IO (Async a)
+asyncOn = asyncUsing . rawForkOn
+
+-- | Like 'async' but using 'forkIOWithUnmask' internally.  The child
+-- thread is passed a function that can be used to unmask asynchronous
+-- exceptions.
+asyncWithUnmask :: ((forall b . IO b -> IO b) -> IO a) -> IO (Async a)
+asyncWithUnmask actionWith = asyncUsing rawForkIO (actionWith unsafeUnmask)
+
+-- | Like 'asyncOn' but using 'forkOnWithUnmask' internally.  The
+-- child thread is passed a function that can be used to unmask
+-- asynchronous exceptions.
+asyncOnWithUnmask :: Int -> ((forall b . IO b -> IO b) -> IO a) -> IO (Async a)
+asyncOnWithUnmask cpu actionWith =
+  asyncUsing (rawForkOn cpu) (actionWith unsafeUnmask)
+
+asyncUsing :: (IO () -> IO ThreadId)
+           -> IO a -> IO (Async a)
+asyncUsing doFork = \action -> do
+   var <- newEmptyTMVarIO
+   -- t <- forkFinally action (\r -> atomically $ putTMVar var r)
+   -- slightly faster:
+   t <- mask $ \restore ->
+          doFork $ try (restore action) >>= atomically . putTMVar var
+   return (Async t (readTMVar var))
+
+-- | Spawn an asynchronous action in a separate thread, and pass its
+-- @Async@ handle to the supplied function.  When the function returns
+-- or throws an exception, 'uninterruptibleCancel' is called on the @Async@.
+--
+-- > withAsync action inner = mask $ \restore -> do
+-- >   a <- async (restore action)
+-- >   restore inner `finally` uninterruptibleCancel a
+--
+-- This is a useful variant of 'async' that ensures an @Async@ is
+-- never left running unintentionally.
+--
+-- Note: a reference to the child thread is kept alive until the call
+-- to `withAsync` returns, so nesting many `withAsync` calls requires
+-- linear memory.
+--
+withAsync :: IO a -> (Async a -> IO b) -> IO b
+withAsync = inline withAsyncUsing rawForkIO
+
+-- | Like 'withAsync' but uses 'forkOS' internally.
+withAsyncBound :: IO a -> (Async a -> IO b) -> IO b
+withAsyncBound = withAsyncUsing forkOS
+
+-- | Like 'withAsync' but uses 'forkOn' internally.
+withAsyncOn :: Int -> IO a -> (Async a -> IO b) -> IO b
+withAsyncOn = withAsyncUsing . rawForkOn
+
+-- | Like 'withAsync' but uses 'forkIOWithUnmask' internally.  The
+-- child thread is passed a function that can be used to unmask
+-- asynchronous exceptions.
+withAsyncWithUnmask
+  :: ((forall c. IO c -> IO c) -> IO a) -> (Async a -> IO b) -> IO b
+withAsyncWithUnmask actionWith =
+  withAsyncUsing rawForkIO (actionWith unsafeUnmask)
+
+-- | Like 'withAsyncOn' but uses 'forkOnWithUnmask' internally.  The
+-- child thread is passed a function that can be used to unmask
+-- asynchronous exceptions
+withAsyncOnWithUnmask
+  :: Int -> ((forall c. IO c -> IO c) -> IO a) -> (Async a -> IO b) -> IO b
+withAsyncOnWithUnmask cpu actionWith =
+  withAsyncUsing (rawForkOn cpu) (actionWith unsafeUnmask)
+
+withAsyncUsing :: (IO () -> IO ThreadId)
+               -> IO a -> (Async a -> IO b) -> IO b
+-- The bracket version works, but is slow.  We can do better by
+-- hand-coding it:
+withAsyncUsing doFork = \action inner -> do
+  var <- newEmptyTMVarIO
+  mask $ \restore -> do
+    t <- doFork $ try (restore action) >>= atomically . putTMVar var
+    let a = Async t (readTMVar var)
+    r <- restore (inner a) `catchAll` \e -> do
+      uninterruptibleCancel a
+      throwIO e
+    uninterruptibleCancel a
+    return r
+
+-- | Wait for an asynchronous action to complete, and return its
+-- value.  If the asynchronous action threw an exception, then the
+-- exception is re-thrown by 'wait'.
+--
+-- > wait = atomically . waitSTM
+--
+{-# INLINE wait #-}
+wait :: Async a -> IO a
+wait = atomically . waitSTM
+
+-- | Wait for an asynchronous action to complete, and return either
+-- @Left e@ if the action raised an exception @e@, or @Right a@ if it
+-- returned a value @a@.
+--
+-- > waitCatch = atomically . waitCatchSTM
+--
+{-# INLINE waitCatch #-}
+waitCatch :: Async a -> IO (Either SomeException a)
+waitCatch = tryAgain . atomically . waitCatchSTM
+  where
+    -- See: https://github.com/simonmar/async/issues/14
+    tryAgain f = f `catch` \BlockedIndefinitelyOnSTM -> f
+
+-- | Check whether an 'Async' has completed yet.  If it has not
+-- completed yet, then the result is @Nothing@, otherwise the result
+-- is @Just e@ where @e@ is @Left x@ if the @Async@ raised an
+-- exception @x@, or @Right a@ if it returned a value @a@.
+--
+-- > poll = atomically . pollSTM
+--
+{-# INLINE poll #-}
+poll :: Async a -> IO (Maybe (Either SomeException a))
+poll = atomically . pollSTM
+
+-- | A version of 'wait' that can be used inside an STM transaction.
+--
+waitSTM :: Async a -> STM a
+waitSTM a = do
+   r <- waitCatchSTM a
+   either throwSTM return r
+
+-- | A version of 'waitCatch' that can be used inside an STM transaction.
+--
+{-# INLINE waitCatchSTM #-}
+waitCatchSTM :: Async a -> STM (Either SomeException a)
+waitCatchSTM (Async _ w) = w
+
+-- | A version of 'poll' that can be used inside an STM transaction.
+--
+{-# INLINE pollSTM #-}
+pollSTM :: Async a -> STM (Maybe (Either SomeException a))
+pollSTM (Async _ w) = (Just <$> w) `orElse` return Nothing
+
+-- | Cancel an asynchronous action by throwing the @AsyncCancelled@
+-- exception to it, and waiting for the `Async` thread to quit.
+-- Has no effect if the 'Async' has already completed.
+--
+-- > cancel a = throwTo (asyncThreadId a) AsyncCancelled <* waitCatch a
+--
+-- Note that 'cancel' will not terminate until the thread the 'Async'
+-- refers to has terminated. This means that 'cancel' will block for
+-- as long said thread blocks when receiving an asynchronous exception.
+--
+-- For example, it could block if:
+--
+-- * It's executing a foreign call, and thus cannot receive the asynchronous
+-- exception;
+-- * It's executing some cleanup handler after having received the exception,
+-- and the handler is blocking.
+{-# INLINE cancel #-}
+cancel :: Async a -> IO ()
+cancel a@(Async t _) = throwTo t AsyncCancelled <* waitCatch a
+
+-- | The exception thrown by `cancel` to terminate a thread.
+data AsyncCancelled = AsyncCancelled
+  deriving (Show, Eq
+#if __GLASGOW_HASKELL__ < 710
+    ,Typeable
+#endif
+    )
+
+instance Exception AsyncCancelled where
+#if __GLASGOW_HASKELL__ >= 708
+  fromException = asyncExceptionFromException
+  toException = asyncExceptionToException
+#endif
+
+-- | Cancel an asynchronous action
+--
+-- This is a variant of `cancel`, but it is not interruptible.
+{-# INLINE uninterruptibleCancel #-}
+uninterruptibleCancel :: Async a -> IO ()
+uninterruptibleCancel = uninterruptibleMask_ . cancel
+
+-- | Cancel an asynchronous action by throwing the supplied exception
+-- to it.
+--
+-- > cancelWith a x = throwTo (asyncThreadId a) x
+--
+-- The notes about the synchronous nature of 'cancel' also apply to
+-- 'cancelWith'.
+cancelWith :: Exception e => Async a -> e -> IO ()
+cancelWith a@(Async t _) e = throwTo t e <* waitCatch a
+
+-- | Wait for any of the supplied asynchronous operations to complete.
+-- The value returned is a pair of the 'Async' that completed, and the
+-- result that would be returned by 'wait' on that 'Async'.
+--
+-- If multiple 'Async's complete or have completed, then the value
+-- returned corresponds to the first completed 'Async' in the list.
+--
+{-# INLINE waitAnyCatch #-}
+waitAnyCatch :: [Async a] -> IO (Async a, Either SomeException a)
+waitAnyCatch = atomically . waitAnyCatchSTM
+
+-- | A version of 'waitAnyCatch' that can be used inside an STM transaction.
+--
+-- @since 2.1.0
+waitAnyCatchSTM :: [Async a] -> STM (Async a, Either SomeException a)
+waitAnyCatchSTM asyncs =
+    foldr orElse retry $
+      map (\a -> do r <- waitCatchSTM a; return (a, r)) asyncs
+
+-- | Like 'waitAnyCatch', but also cancels the other asynchronous
+-- operations as soon as one has completed.
+--
+waitAnyCatchCancel :: [Async a] -> IO (Async a, Either SomeException a)
+waitAnyCatchCancel asyncs =
+  waitAnyCatch asyncs `finally` mapM_ cancel asyncs
+
+-- | Wait for any of the supplied @Async@s to complete.  If the first
+-- to complete throws an exception, then that exception is re-thrown
+-- by 'waitAny'.
+--
+-- If multiple 'Async's complete or have completed, then the value
+-- returned corresponds to the first completed 'Async' in the list.
+--
+{-# INLINE waitAny #-}
+waitAny :: [Async a] -> IO (Async a, a)
+waitAny = atomically . waitAnySTM
+
+-- | A version of 'waitAny' that can be used inside an STM transaction.
+--
+-- @since 2.1.0
+waitAnySTM :: [Async a] -> STM (Async a, a)
+waitAnySTM asyncs =
+    foldr orElse retry $
+      map (\a -> do r <- waitSTM a; return (a, r)) asyncs
+
+-- | Like 'waitAny', but also cancels the other asynchronous
+-- operations as soon as one has completed.
+--
+waitAnyCancel :: [Async a] -> IO (Async a, a)
+waitAnyCancel asyncs =
+  waitAny asyncs `finally` mapM_ cancel asyncs
+
+-- | Wait for the first of two @Async@s to finish.
+{-# INLINE waitEitherCatch #-}
+waitEitherCatch :: Async a -> Async b
+                -> IO (Either (Either SomeException a)
+                              (Either SomeException b))
+waitEitherCatch left right =
+  tryAgain $ atomically (waitEitherCatchSTM left right)
+  where
+    -- See: https://github.com/simonmar/async/issues/14
+    tryAgain f = f `catch` \BlockedIndefinitelyOnSTM -> f
+
+-- | A version of 'waitEitherCatch' that can be used inside an STM transaction.
+--
+-- @since 2.1.0
+waitEitherCatchSTM :: Async a -> Async b
+                -> STM (Either (Either SomeException a)
+                               (Either SomeException b))
+waitEitherCatchSTM left right =
+    (Left  <$> waitCatchSTM left)
+      `orElse`
+    (Right <$> waitCatchSTM right)
+
+-- | Like 'waitEitherCatch', but also 'cancel's both @Async@s before
+-- returning.
+--
+waitEitherCatchCancel :: Async a -> Async b
+                      -> IO (Either (Either SomeException a)
+                                    (Either SomeException b))
+waitEitherCatchCancel left right =
+  waitEitherCatch left right `finally` (cancel left >> cancel right)
+
+-- | Wait for the first of two @Async@s to finish.  If the @Async@
+-- that finished first raised an exception, then the exception is
+-- re-thrown by 'waitEither'.
+--
+{-# INLINE waitEither #-}
+waitEither :: Async a -> Async b -> IO (Either a b)
+waitEither left right = atomically (waitEitherSTM left right)
+
+-- | A version of 'waitEither' that can be used inside an STM transaction.
+--
+-- @since 2.1.0
+waitEitherSTM :: Async a -> Async b -> STM (Either a b)
+waitEitherSTM left right =
+    (Left  <$> waitSTM left)
+      `orElse`
+    (Right <$> waitSTM right)
+
+-- | Like 'waitEither', but the result is ignored.
+--
+{-# INLINE waitEither_ #-}
+waitEither_ :: Async a -> Async b -> IO ()
+waitEither_ left right = atomically (waitEitherSTM_ left right)
+
+-- | A version of 'waitEither_' that can be used inside an STM transaction.
+--
+-- @since 2.1.0
+waitEitherSTM_:: Async a -> Async b -> STM ()
+waitEitherSTM_ left right =
+    (void $ waitSTM left)
+      `orElse`
+    (void $ waitSTM right)
+
+-- | Like 'waitEither', but also 'cancel's both @Async@s before
+-- returning.
+--
+waitEitherCancel :: Async a -> Async b -> IO (Either a b)
+waitEitherCancel left right =
+  waitEither left right `finally` (cancel left >> cancel right)
+
+-- | Waits for both @Async@s to finish, but if either of them throws
+-- an exception before they have both finished, then the exception is
+-- re-thrown by 'waitBoth'.
+--
+{-# INLINE waitBoth #-}
+waitBoth :: Async a -> Async b -> IO (a,b)
+waitBoth left right = atomically (waitBothSTM left right)
+
+-- | A version of 'waitBoth' that can be used inside an STM transaction.
+--
+-- @since 2.1.0
+waitBothSTM :: Async a -> Async b -> STM (a,b)
+waitBothSTM left right = do
+    a <- waitSTM left
+           `orElse`
+         (waitSTM right >> retry)
+    b <- waitSTM right
+    return (a,b)
+
+
+-- -----------------------------------------------------------------------------
+-- Linking threads
+
+data ExceptionInLinkedThread =
+  forall a . ExceptionInLinkedThread (Async a) SomeException
+#if __GLASGOW_HASKELL__ < 710
+  deriving Typeable
+#endif
+
+instance Show ExceptionInLinkedThread where
+  show (ExceptionInLinkedThread (Async t _) e) =
+    "ExceptionInLinkedThread " ++ show t ++ " " ++ show e
+
+instance Exception ExceptionInLinkedThread where
+#if __GLASGOW_HASKELL__ >= 708
+  fromException = asyncExceptionFromException
+  toException = asyncExceptionToException
+#endif
+
+-- | Link the given @Async@ to the current thread, such that if the
+-- @Async@ raises an exception, that exception will be re-thrown in
+-- the current thread, wrapped in 'ExceptionInLinkedThread'.
+--
+-- 'link' ignores 'AsyncCancelled' exceptions thrown in the other thread,
+-- so that it's safe to 'cancel' a thread you're linked to.  If you want
+-- different behaviour, use 'linkOnly'.
+--
+link :: Async a -> IO ()
+link = linkOnly (not . isCancel)
+
+-- | Link the given @Async@ to the current thread, such that if the
+-- @Async@ raises an exception, that exception will be re-thrown in
+-- the current thread.  The supplied predicate determines which
+-- exceptions in the target thread should be propagated to the source
+-- thread.
+--
+linkOnly
+  :: (SomeException -> Bool)  -- ^ return 'True' if the exception
+                              -- should be propagated, 'False'
+                              -- otherwise.
+  -> Async a
+  -> IO ()
+linkOnly shouldThrow a = do
+  me <- myThreadId
+  void $ forkRepeat $ do
+    r <- waitCatch a
+    case r of
+      Left e | shouldThrow e -> throwTo me (ExceptionInLinkedThread a e)
+      _otherwise -> return ()
+
+-- | Link two @Async@s together, such that if either raises an
+-- exception, the same exception is re-thrown in the other @Async@,
+-- wrapped in 'ExceptionInLinkedThread'.
+--
+-- 'link2' ignores 'AsyncCancelled' exceptions, so that it's possible
+-- to 'cancel' either thread without cancelling the other.  If you
+-- want different behaviour, use 'link2Only'.
+--
+link2 :: Async a -> Async b -> IO ()
+link2 = link2Only (not . isCancel)
+
+link2Only :: (SomeException -> Bool) -> Async a -> Async b -> IO ()
+link2Only shouldThrow left@(Async tl _)  right@(Async tr _) =
+  void $ forkRepeat $ do
+    r <- waitEitherCatch left right
+    case r of
+      Left  (Left e) | shouldThrow e ->
+        throwTo tr (ExceptionInLinkedThread left e)
+      Right (Left e) | shouldThrow e ->
+        throwTo tl (ExceptionInLinkedThread right e)
+      _ -> return ()
+
+isCancel :: SomeException -> Bool
+isCancel e
+  | Just AsyncCancelled <- fromException e = True
+  | otherwise = False
+
+
+-- -----------------------------------------------------------------------------
+
+-- | Run two @IO@ actions concurrently, and return the first to
+-- finish.  The loser of the race is 'cancel'led.
+--
+-- > race left right =
+-- >   withAsync left $ \a ->
+-- >   withAsync right $ \b ->
+-- >   waitEither a b
+--
+race :: IO a -> IO b -> IO (Either a b)
+
+-- | Like 'race', but the result is ignored.
+--
+race_ :: IO a -> IO b -> IO ()
+
+-- | Run two @IO@ actions concurrently, and return both results.  If
+-- either action throws an exception at any time, then the other
+-- action is 'cancel'led, and the exception is re-thrown by
+-- 'concurrently'.
+--
+-- > concurrently left right =
+-- >   withAsync left $ \a ->
+-- >   withAsync right $ \b ->
+-- >   waitBoth a b
+concurrently :: IO a -> IO b -> IO (a,b)
+
+#define USE_ASYNC_VERSIONS 0
+
+#if USE_ASYNC_VERSIONS
+
+race left right =
+  withAsync left $ \a ->
+  withAsync right $ \b ->
+  waitEither a b
+
+race_ left right =
+  withAsync left $ \a ->
+  withAsync right $ \b ->
+  waitEither_ a b
+
+concurrently left right =
+  withAsync left $ \a ->
+  withAsync right $ \b ->
+  waitBoth a b
+
+#else
+
+-- MVar versions of race/concurrently
+-- More ugly than the Async versions, but quite a bit faster.
+
+-- race :: IO a -> IO b -> IO (Either a b)
+race left right = concurrently' left right collect
+  where
+    collect m = do
+        e <- m
+        case e of
+            Left ex -> throwIO ex
+            Right r -> return r
+
+-- race_ :: IO a -> IO b -> IO ()
+race_ left right = void $ race left right
+
+-- concurrently :: IO a -> IO b -> IO (a,b)
+concurrently left right = concurrently' left right (collect [])
+  where
+    collect [Left a, Right b] _ = return (a,b)
+    collect [Right b, Left a] _ = return (a,b)
+    collect xs m = do
+        e <- m
+        case e of
+            Left ex -> throwIO ex
+            Right r -> collect (r:xs) m
+
+concurrently' :: IO a -> IO b
+             -> (IO (Either SomeException (Either a b)) -> IO r)
+             -> IO r
+concurrently' left right collect = do
+    done <- newEmptyMVar
+    mask $ \restore -> do
+        -- Note: uninterruptibleMask here is because we must not allow
+        -- the putMVar in the exception handler to be interrupted,
+        -- otherwise the parent thread will deadlock when it waits for
+        -- the thread to terminate.
+        lid <- forkIO $ uninterruptibleMask_ $
+          restore (left >>= putMVar done . Right . Left)
+            `catchAll` (putMVar done . Left)
+        rid <- forkIO $ uninterruptibleMask_ $
+          restore (right >>= putMVar done . Right . Right)
+            `catchAll` (putMVar done . Left)
+
+        count <- newIORef (2 :: Int)
+        let takeDone = do
+                r <- takeMVar done      -- interruptible
+                -- Decrement the counter so we know how many takes are left.
+                -- Since only the parent thread is calling this, we can
+                -- use non-atomic modifications.
+                -- NB. do this *after* takeMVar, because takeMVar might be
+                -- interrupted.
+                modifyIORef count (subtract 1)
+                return r
+
+        let tryAgain f = f `catch` \BlockedIndefinitelyOnMVar -> f
+
+            stop = do
+                -- kill right before left, to match the semantics of
+                -- the version using withAsync. (#27)
+                uninterruptibleMask_ $ do
+                  count' <- readIORef count
+                  -- we only need to use killThread if there are still
+                  -- children alive.  Note: forkIO here is because the
+                  -- child thread could be in an uninterruptible
+                  -- putMVar.
+                  when (count' > 0) $
+                    void $ forkIO $ do
+                      throwTo rid AsyncCancelled
+                      throwTo lid AsyncCancelled
+                  -- ensure the children are really dead
+                  replicateM_ count' (tryAgain $ takeMVar done)
+
+        r <- collect (tryAgain $ takeDone) `onException` stop
+        stop
+        return r
+
+#endif
+
+-- | maps an @IO@-performing function over any @Traversable@ data
+-- type, performing all the @IO@ actions concurrently, and returning
+-- the original data structure with the arguments replaced by the
+-- results.
+--
+-- If any of the actions throw an exception, then all other actions are
+-- cancelled and the exception is re-thrown.
+--
+-- For example, @mapConcurrently@ works with lists:
+--
+-- > pages <- mapConcurrently getURL ["url1", "url2", "url3"]
+--
+mapConcurrently :: Traversable t => (a -> IO b) -> t a -> IO (t b)
+mapConcurrently f = runConcurrently . traverse (Concurrently . f)
+
+-- | `forConcurrently` is `mapConcurrently` with its arguments flipped
+--
+-- > pages <- forConcurrently ["url1", "url2", "url3"] $ \url -> getURL url
+--
+-- @since 2.1.0
+forConcurrently :: Traversable t => t a -> (a -> IO b) -> IO (t b)
+forConcurrently = flip mapConcurrently
+
+-- | `mapConcurrently_` is `mapConcurrently` with the return value discarded,
+-- just like @mapM_
+mapConcurrently_ :: F.Foldable f => (a -> IO b) -> f a -> IO ()
+mapConcurrently_ f = runConcurrently . F.foldMap (Concurrently . void . f)
+
+-- | `forConcurrently_` is `forConcurrently` with the return value discarded,
+-- just like @forM_
+forConcurrently_ :: F.Foldable f => f a -> (a -> IO b) -> IO ()
+forConcurrently_ = flip mapConcurrently_
+
+-- | 'concurrently', but ignore the result values
+--
+-- @since 2.1.1
+concurrently_ :: IO a -> IO b -> IO ()
+concurrently_ left right = concurrently' left right (collect 0)
+  where
+    collect 2 _ = return ()
+    collect i m = do
+        e <- m
+        case e of
+            Left ex -> throwIO ex
+            Right _ -> collect (i + 1 :: Int) m
+
+-- | Perform the action in the given number of threads.
+--
+-- @since 2.1.1
+replicateConcurrently :: Int -> IO a -> IO [a]
+replicateConcurrently cnt = runConcurrently . sequenceA . replicate cnt . Concurrently
+
+-- | Same as 'replicateConcurrently', but ignore the results.
+--
+-- @since 2.1.1
+replicateConcurrently_ :: Int -> IO a -> IO ()
+replicateConcurrently_ cnt = runConcurrently . F.fold . replicate cnt . Concurrently . void
+
+-- -----------------------------------------------------------------------------
+
+-- | A value of type @Concurrently a@ is an @IO@ operation that can be
+-- composed with other @Concurrently@ values, using the @Applicative@
+-- and @Alternative@ instances.
+--
+-- Calling @runConcurrently@ on a value of type @Concurrently a@ will
+-- execute the @IO@ operations it contains concurrently, before
+-- delivering the result of type @a@.
+--
+-- For example
+--
+-- > (page1, page2, page3)
+-- >     <- runConcurrently $ (,,)
+-- >     <$> Concurrently (getURL "url1")
+-- >     <*> Concurrently (getURL "url2")
+-- >     <*> Concurrently (getURL "url3")
+--
+newtype Concurrently a = Concurrently { runConcurrently :: IO a }
+
+instance Functor Concurrently where
+  fmap f (Concurrently a) = Concurrently $ f <$> a
+
+instance Applicative Concurrently where
+  pure = Concurrently . return
+  Concurrently fs <*> Concurrently as =
+    Concurrently $ (\(f, a) -> f a) <$> concurrently fs as
+
+instance Alternative Concurrently where
+  empty = Concurrently $ forever (threadDelay maxBound)
+  Concurrently as <|> Concurrently bs =
+    Concurrently $ either id id <$> race as bs
+
+#if MIN_VERSION_base(4,9,0)
+-- | Only defined by @async@ for @base >= 4.9@
+--
+-- @since 2.1.0
+instance Semigroup a => Semigroup (Concurrently a) where
+  (<>) = liftA2 (<>)
+
+-- | @since 2.1.0
+instance (Semigroup a, Monoid a) => Monoid (Concurrently a) where
+  mempty = pure mempty
+  mappend = (<>)
+#else
+-- | @since 2.1.0
+instance Monoid a => Monoid (Concurrently a) where
+  mempty = pure mempty
+  mappend = liftA2 mappend
+#endif
+
+-- ----------------------------------------------------------------------------
+
+-- | Fork a thread that runs the supplied action, and if it raises an
+-- exception, re-runs the action.  The thread terminates only when the
+-- action runs to completion without raising an exception.
+forkRepeat :: IO a -> IO ThreadId
+forkRepeat action =
+  mask $ \restore ->
+    let go = do r <- tryAll (restore action)
+                case r of
+                  Left _ -> go
+                  _      -> return ()
+    in forkIO go
+
+catchAll :: IO a -> (SomeException -> IO a) -> IO a
+catchAll = catch
+
+tryAll :: IO a -> IO (Either SomeException a)
+tryAll = try
+
+-- A version of forkIO that does not include the outer exception
+-- handler: saves a bit of time when we will be installing our own
+-- exception handler.
+{-# INLINE rawForkIO #-}
+rawForkIO :: IO () -> IO ThreadId
+rawForkIO action = IO $ \ s ->
+   case (fork# action s) of (# s1, tid #) -> (# s1, ThreadId tid #)
+
+{-# INLINE rawForkOn #-}
+rawForkOn :: Int -> IO () -> IO ThreadId
+rawForkOn (I# cpu) action = IO $ \ s ->
+   case (forkOn# cpu action s) of (# s1, tid #) -> (# s1, ThreadId tid #)
diff --git a/hspec-meta.cabal b/hspec-meta.cabal
--- a/hspec-meta.cabal
+++ b/hspec-meta.cabal
@@ -1,19 +1,20 @@
--- This file has been generated from package.yaml by hpack version 0.21.2.
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.30.0.
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: a127653a989c7ff69649480ddd6226dd61f3e9eded4419b7214fa6deb0da8f7c
+-- hash: b9089eec6ed9c224790a988a565a1089609beb176824d8eafe653098556dc71c
 
 name:             hspec-meta
-version:          2.4.6
+version:          2.5.6
 license:          MIT
 license-file:     LICENSE
-copyright:        (c) 2011-2017 Simon Hengel,
+copyright:        (c) 2011-2018 Simon Hengel,
                   (c) 2011-2012 Trystan Spangler,
                   (c) 2011 Greg Weber
 maintainer:       Simon Hengel <sol@typeful.net>
 build-type:       Simple
-cabal-version:    >= 1.10
 category:         Testing
 stability:        experimental
 bug-reports:      https://github.com/hspec/hspec/issues
@@ -21,7 +22,6 @@
 synopsis:         A version of Hspec which is used to test Hspec itself
 description:      A stable version of Hspec which is used to test the
                   in-development version of Hspec.
-
 extra-source-files:
     CHANGES.markdown
 
@@ -30,28 +30,6 @@
   location: https://github.com/hspec/hspec
 
 library
-  ghc-options: -Wall
-  hs-source-dirs:
-      src
-      hspec-core/src
-      hspec-core/vendor/
-  build-depends:
-      HUnit
-    , QuickCheck >=2.5.1
-    , ansi-terminal
-    , array
-    , async
-    , base ==4.*
-    , call-stack
-    , deepseq
-    , directory
-    , filepath
-    , hspec-expectations >=0.8.0
-    , quickcheck-io
-    , random
-    , setenv
-    , time
-    , transformers >=0.2.2.0
   exposed-modules:
       Test.Hspec.Meta
   other-modules:
@@ -59,20 +37,23 @@
       Test.Hspec.Core
       Test.Hspec.Discover
       Test.Hspec.Formatters
-      Test.Hspec.HUnit
       Test.Hspec.QuickCheck
       Test.Hspec.Runner
+      Test.Hspec.Core.Clock
       Test.Hspec.Core.Compat
       Test.Hspec.Core.Config
+      Test.Hspec.Core.Config.Options
+      Test.Hspec.Core.Config.Util
       Test.Hspec.Core.Example
+      Test.Hspec.Core.Example.Location
       Test.Hspec.Core.FailureReport
+      Test.Hspec.Core.Format
       Test.Hspec.Core.Formatters
       Test.Hspec.Core.Formatters.Diff
       Test.Hspec.Core.Formatters.Free
       Test.Hspec.Core.Formatters.Internal
       Test.Hspec.Core.Formatters.Monad
       Test.Hspec.Core.Hooks
-      Test.Hspec.Core.Options
       Test.Hspec.Core.QuickCheck
       Test.Hspec.Core.QuickCheckUtil
       Test.Hspec.Core.Runner
@@ -82,8 +63,32 @@
       Test.Hspec.Core.Timer
       Test.Hspec.Core.Tree
       Test.Hspec.Core.Util
+      Control.Concurrent.Async
       Data.Algorithm.Diff
       Paths_hspec_meta
+  ghc-options: -Wall
+  hs-source-dirs:
+      src
+      hspec-core/src
+      hspec-core/vendor
+  build-depends:
+      HUnit
+    , QuickCheck >=2.5.1
+    , ansi-terminal
+    , array
+    , base ==4.*
+    , call-stack
+    , clock
+    , deepseq
+    , directory
+    , filepath
+    , hspec-expectations >=0.8.0
+    , quickcheck-io
+    , random
+    , setenv
+    , stm >=2.2
+    , time
+    , transformers >=0.2.2.0
   default-language: Haskell2010
 
 executable hspec-meta-discover
@@ -97,9 +102,9 @@
     , QuickCheck >=2.5.1
     , ansi-terminal
     , array
-    , async
     , base ==4.*
     , call-stack
+    , clock
     , deepseq
     , directory
     , filepath
@@ -107,6 +112,7 @@
     , quickcheck-io
     , random
     , setenv
+    , stm >=2.2
     , time
     , transformers >=0.2.2.0
   other-modules:
diff --git a/src/Test/Hspec/Discover.hs b/src/Test/Hspec/Discover.hs
--- a/src/Test/Hspec/Discover.hs
+++ b/src/Test/Hspec/Discover.hs
@@ -11,16 +11,10 @@
 ) where
 
 import           Prelude hiding (mapM)
-import           Control.Applicative
-import           Data.Maybe
-import           Data.List
-import           Data.Traversable
-import           Control.Monad.Trans.State
 
 import           Test.Hspec.Core.Spec
 import           Test.Hspec.Core.Runner
 import           Test.Hspec.Formatters
-import           Test.Hspec.Core.Util (safeTry)
 
 class IsFormatter a where
   toFormatter :: a -> IO Formatter
@@ -37,62 +31,4 @@
   hspecWith defaultConfig {configFormatter = Just f} spec
 
 postProcessSpec :: FilePath -> Spec -> Spec
-postProcessSpec = locationHeuristicFromFile
-
-locationHeuristicFromFile :: FilePath -> Spec -> Spec
-locationHeuristicFromFile file spec = do
-  mInput <- either (const Nothing) Just <$> (runIO . safeTry . readFile) file
-  let lookupLoc = maybe (\_ _ _ -> Nothing) (lookupLocation file)  mInput
-  runIO (runSpecM spec) >>= fromSpecList . addLoctions lookupLoc
-
-addLoctions :: (Int -> Int -> String -> Maybe Location) -> [SpecTree a] -> [SpecTree a]
-addLoctions lookupLoc = map (fmap f) . enumerate
-  where
-    f :: ((Int, Int), Item a) -> Item a
-    f ((n, total), item) = item {itemLocation = itemLocation item <|> lookupLoc n total (itemRequirement item)}
-
-type EnumerateM = State [(String, Int)]
-
-enumerate :: [SpecTree a] -> [Tree (ActionWith a) ((Int, Int), (Item a))]
-enumerate tree = (mapM (traverse addPosition) tree >>= mapM (traverse addTotal)) `evalState` []
-  where
-    addPosition :: Item a -> EnumerateM (Int, Item a)
-    addPosition item = (,) <$> getOccurrence (itemRequirement item) <*> pure item
-
-    addTotal :: (Int, Item a) -> EnumerateM ((Int, Int), Item a)
-    addTotal (n, item) = do
-      total <- getTotal (itemRequirement item)
-      return ((n, total), item)
-
-    getTotal :: String -> EnumerateM Int
-    getTotal requirement = do
-      gets $ fromMaybe err . lookup requirement
-      where
-        err = error ("Test.Hspec.Discover.getTotal: No entry for requirement " ++ show requirement ++ "!")
-
-    getOccurrence :: String -> EnumerateM Int
-    getOccurrence requirement = do
-      xs <- get
-      let n = maybe 1 succ (lookup requirement xs)
-      put ((requirement, n) : filter ((/= requirement) . fst) xs)
-      return n
-
-lookupLocation :: FilePath -> String -> Int -> Int -> String -> Maybe Location
-lookupLocation file input n total requirement = loc
-  where
-    loc :: Maybe Location
-    loc = Location file <$> line <*> pure 0 <*> pure BestEffort
-
-    line :: Maybe Int
-    line = case occurrences of
-      xs | length xs == total -> Just (xs !! pred n)
-      _ -> Nothing
-
-    occurrences :: [Int]
-    occurrences = map fst (filter p inputLines)
-      where
-        p :: (Int, String) -> Bool
-        p = isInfixOf (show requirement) . snd
-
-    inputLines :: [(Int, String)]
-    inputLines = zip [1..] (lines input)
+postProcessSpec _ = id
diff --git a/src/Test/Hspec/HUnit.hs b/src/Test/Hspec/HUnit.hs
deleted file mode 100644
--- a/src/Test/Hspec/HUnit.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-module Test.Hspec.HUnit {-# DEPRECATED "use \"Test.Hspec.Contrib.HUnit\" from package @hspec-contrib@ instead" #-}
-(
--- * Interoperability with HUnit
-  fromHUnitTest
-) where
-
-import           Test.Hspec.Core.Spec
-import           Test.HUnit (Test (..))
-
--- |
--- Convert a HUnit test suite to a spec.  This can be used to run existing
--- HUnit tests with Hspec.
-fromHUnitTest :: Test -> Spec
-fromHUnitTest t = case t of
-  TestList xs -> mapM_ go xs
-  x -> go x
-  where
-    go :: Test -> Spec
-    go t_ = case t_ of
-      TestLabel s (TestCase e) -> it s e
-      TestLabel s (TestList xs) -> describe s (mapM_ go xs)
-      TestLabel s x -> describe s (go x)
-      TestList xs -> describe "<unlabeled>" (mapM_ go xs)
-      TestCase e -> it "<unlabeled>" e