diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright (c) 2011-2022 Simon Hengel <sol@typeful.net>
+Copyright (c) 2011-2023 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/GetOpt/Declarative/Interpret.hs b/hspec-core/src/GetOpt/Declarative/Interpret.hs
--- a/hspec-core/src/GetOpt/Declarative/Interpret.hs
+++ b/hspec-core/src/GetOpt/Declarative/Interpret.hs
@@ -7,13 +7,12 @@
 
 import           Prelude ()
 import           Test.Hspec.Core.Compat
-import           Data.Maybe
 
 import           System.Console.GetOpt (OptDescr, ArgOrder(..), getOpt)
 import qualified System.Console.GetOpt as GetOpt
 
 import           GetOpt.Declarative.Types
-import           GetOpt.Declarative.Util (mkUsageInfo, mapOptDescr)
+import           GetOpt.Declarative.Util (mkUsageInfo)
 
 data InvalidArgument = InvalidArgument String String
 
@@ -31,7 +30,7 @@
 
     usage :: String
     usage = "Usage: " ++ prog ++ " [OPTION]...\n\n"
-      ++ (intercalate "\n" $ map (uncurry mkUsageInfo) documentedOptions)
+      ++ intercalate "\n" (map (uncurry mkUsageInfo) documentedOptions)
 
 addHelpFlag :: [(a, [OptDescr a1])] -> [(a, [OptDescr (Maybe a1)])]
 addHelpFlag opts = case opts of
@@ -41,7 +40,7 @@
     help = Nothing
 
     noHelp :: [OptDescr a] -> [OptDescr (Maybe a)]
-    noHelp = map (mapOptDescr Just)
+    noHelp = map (fmap Just)
 
 parseWithHelp :: [OptDescr (Maybe (config -> Either InvalidArgument config))] -> config -> [String] -> Maybe (Either String config)
 parseWithHelp options config args = case getOpt Permute options args of
diff --git a/hspec-core/src/GetOpt/Declarative/Util.hs b/hspec-core/src/GetOpt/Declarative/Util.hs
--- a/hspec-core/src/GetOpt/Declarative/Util.hs
+++ b/hspec-core/src/GetOpt/Declarative/Util.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP #-}
-module GetOpt.Declarative.Util (mkUsageInfo, mapOptDescr) where
+module GetOpt.Declarative.Util (mkUsageInfo) where
 
 import           Prelude ()
 import           Test.Hspec.Core.Compat
@@ -31,17 +31,3 @@
     Option "" ["[no-]" ++ optionA] arg help : condenseNoOptions ys
   x : xs -> x : condenseNoOptions xs
   [] -> []
-
-mapOptDescr :: (a -> b) -> OptDescr a -> OptDescr b
-#if MIN_VERSION_base(4,7,0)
-mapOptDescr = fmap
-#else
-mapOptDescr f opt = case opt of
-  Option short long arg help -> Option short long (mapArgDescr f arg) help
-
-mapArgDescr :: (a -> b) -> ArgDescr a -> ArgDescr b
-mapArgDescr f arg = case arg of
-  NoArg a -> NoArg (f a)
-  ReqArg parse name -> ReqArg (fmap f parse) name
-  OptArg parse name -> OptArg (fmap f parse) name
-#endif
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
@@ -4,6 +4,7 @@
 , module Test.Hspec.Core.Compat
 ) where
 
+import           Control.Exception as Imports
 import           Control.Arrow as Imports ((>>>), (&&&), first, second)
 import           Control.Applicative as Imports
 import           Control.Monad as Imports hiding (
@@ -15,10 +16,16 @@
   , sequence
   , sequence_
   )
+import           Data.Maybe as Imports
 import           Data.Foldable as Imports
+import           Data.CallStack as Imports (HasCallStack)
 
+import           System.IO
+import           System.Exit
+import           System.Environment
+
 #if MIN_VERSION_base(4,11,0)
-import           Data.Functor as Imports
+import           Data.Functor as Imports ((<&>))
 #endif
 
 import           Data.Traversable as Imports
@@ -27,13 +34,12 @@
     stripPrefix
   , isPrefixOf
   , isInfixOf
+  , isSuffixOf
   , intercalate
   , inits
   , tails
   , sortBy
-#if MIN_VERSION_base(4,8,0)
   , sortOn
-#endif
   )
 
 import           Prelude as Imports hiding (
@@ -57,21 +63,22 @@
   , sequence
   , sequence_
   , sum
-#if !MIN_VERSION_base(4,6,0)
-  , catch
-#endif
   )
 
-import           Data.Typeable (Typeable, typeOf, typeRepTyCon)
+import           Data.Typeable (Typeable, typeOf, typeRepTyCon, tyConModule, tyConName)
 import           Data.IORef as Imports
 
+#if MIN_VERSION_base(4,12,0)
+import           GHC.ResponseFile as Imports (unescapeArgs)
+#else
+import           Data.Char
+#endif
+
 #if MIN_VERSION_base(4,6,0)
 import           Text.Read as Imports (readMaybe)
 import           System.Environment as Imports (lookupEnv)
 #else
-import           Control.Exception
 import           Text.Read
-import           System.Environment
 import qualified Text.ParserCombinators.ReadP as P
 #endif
 
@@ -79,12 +86,13 @@
 import           Data.Ord (comparing)
 #endif
 
-import           Data.Typeable (tyConModule, tyConName)
+#if MIN_VERSION_base(4,7,0)
+import           Data.Bool as Imports (bool)
+#endif
+
 import           Control.Concurrent
 
-#if MIN_VERSION_base(4,9,0)
-import           Control.Exception as Imports (interruptible)
-#else
+#if !MIN_VERSION_base(4,9,0)
 import           GHC.IO
 #endif
 
@@ -104,7 +112,7 @@
 atomicWriteIORef :: IORef a -> a -> IO ()
 atomicWriteIORef ref a = do
     x <- atomicModifyIORef ref (\_ -> (a, ()))
-    x `seq` return ()
+    x `seq` pass
 
 -- | Parse a string using the 'Read' instance.
 -- Succeeds if there is exactly one valid result.
@@ -160,14 +168,53 @@
 guarded :: Alternative m => (a -> Bool) -> a -> m a
 guarded p a = if p a then pure a else empty
 
-#if !MIN_VERSION_base(4,8,0)
-sortOn :: Ord b => (a -> b) -> [a] -> [a]
-sortOn f =
-  map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))
-#endif
-
 #if !MIN_VERSION_base(4,11,0)
 infixl 1 <&>
 (<&>) :: Functor f => f a -> (a -> b) -> f b
 (<&>) = flip (<$>)
+#endif
+
+endsWith :: Eq a => [a] -> [a] -> Bool
+endsWith = flip isSuffixOf
+
+pass :: Applicative m => m ()
+pass = pure ()
+
+die :: String -> IO a
+die err = do
+  name <- getProgName
+  hPutStrLn stderr $ name <> ": " <> err
+  exitFailure
+
+#if !MIN_VERSION_base(4,12,0)
+unescapeArgs :: String -> [String]
+unescapeArgs = filter (not . null) . unescape
+
+data Quoting = NoneQ | SngQ | DblQ
+
+unescape :: String -> [String]
+unescape args = reverse . map reverse $ go args NoneQ False [] []
+    where
+      -- n.b., the order of these cases matters; these are cribbed from gcc
+      -- case 1: end of input
+      go []     _q    _bs   a as = a:as
+      -- case 2: back-slash escape in progress
+      go (c:cs) q     True  a as = go cs q     False (c:a) as
+      -- case 3: no back-slash escape in progress, but got a back-slash
+      go (c:cs) q     False a as
+        | '\\' == c              = go cs q     True  a     as
+      -- case 4: single-quote escaping in progress
+      go (c:cs) SngQ  False a as
+        | '\'' == c              = go cs NoneQ False a     as
+        | otherwise              = go cs SngQ  False (c:a) as
+      -- case 5: double-quote escaping in progress
+      go (c:cs) DblQ  False a as
+        | '"' == c               = go cs NoneQ False a     as
+        | otherwise              = go cs DblQ  False (c:a) as
+      -- case 6: no escaping is in progress
+      go (c:cs) NoneQ False a as
+        | isSpace c              = go cs NoneQ False []    (a:as)
+        | '\'' == c              = go cs SngQ  False a     as
+        | '"'  == c              = go cs DblQ  False a     as
+        | otherwise              = go cs NoneQ False (c:a) as
 #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
@@ -18,8 +18,7 @@
 import           Prelude ()
 import           Test.Hspec.Core.Compat
 
-import           Control.Exception
-import           Data.Maybe
+import           GHC.IO.Exception (IOErrorType(UnsupportedOperation))
 import           System.IO
 import           System.IO.Error
 import           System.Exit
@@ -30,11 +29,21 @@
 
 import           Test.Hspec.Core.Util
 import           Test.Hspec.Core.Config.Options
-import           Test.Hspec.Core.Config.Definition (Config(..), ColorMode(..), UnicodeMode(..), defaultConfig, filterOr)
+import           Test.Hspec.Core.Config.Definition (Config(..), ColorMode(..), UnicodeMode(..), mkDefaultConfig, filterOr)
 import           Test.Hspec.Core.FailureReport
 import           Test.Hspec.Core.QuickCheckUtil (mkGen)
 import           Test.Hspec.Core.Example (Params(..), defaultParams)
+import qualified Test.Hspec.Core.Formatters.V2 as V2
 
+defaultConfig :: Config
+defaultConfig = mkDefaultConfig $ map (fmap V2.formatterToFormat) [
+    ("checks", V2.checks)
+  , ("specdoc", V2.specdoc)
+  , ("progress", V2.progress)
+  , ("failed-examples", V2.failed_examples)
+  , ("silent", V2.silent)
+  ]
+
 -- | Add a filter predicate to config.  If there is already a filter predicate,
 -- then combine them with `||`.
 configAddFilter :: (Path -> Bool) -> Config -> Config
@@ -95,7 +104,7 @@
 --
 -- 1. @~/.hspec@ (a config file in the user's home directory)
 -- 1. @.hspec@ (a config file in the current working directory)
--- 1. the environment variable @HSPEC_OPTIONS@
+-- 1. [environment variables starting with @HSPEC_@](https://hspec.github.io/options.html#specifying-options-through-environment-variables)
 -- 1. the provided list of command-line options (the second argument to @readConfig@)
 --
 -- (precedence from low to high)
@@ -140,10 +149,13 @@
 
 readGlobalConfigFile :: IO (Maybe ConfigFile)
 readGlobalConfigFile = do
-  mHome <- tryJust (guard . isDoesNotExistError) getHomeDirectory
+  mHome <- tryJust (guard . isPotentialHomeDirError) getHomeDirectory
   case mHome of
     Left _ -> return Nothing
     Right home -> readConfigFile (home </> ".hspec")
+  where
+    isPotentialHomeDirError e =
+      isDoesNotExistError e || ioeGetErrorType e == UnsupportedOperation
 
 readLocalConfigFile :: IO (Maybe ConfigFile)
 readLocalConfigFile = do
@@ -155,7 +167,7 @@
 readConfigFile :: FilePath -> IO (Maybe ConfigFile)
 readConfigFile name = do
   exists <- doesFileExist name
-  if exists then Just . (,) name . words <$> readFile name else return Nothing
+  if exists then Just . (,) name . unescapeArgs <$> readFile name else return Nothing
 
 exitWithMessage :: ExitCode -> String -> IO a
 exitWithMessage err msg = do
diff --git a/hspec-core/src/Test/Hspec/Core/Config/Definition.hs b/hspec-core/src/Test/Hspec/Core/Config/Definition.hs
--- a/hspec-core/src/Test/Hspec/Core/Config/Definition.hs
+++ b/hspec-core/src/Test/Hspec/Core/Config/Definition.hs
@@ -4,7 +4,7 @@
 , ColorMode(..)
 , UnicodeMode(..)
 , filterOr
-, defaultConfig
+, mkDefaultConfig
 
 , commandLineOnlyOptions
 , formatterOptions
@@ -20,11 +20,14 @@
 import           Prelude ()
 import           Test.Hspec.Core.Compat
 
+import           System.Directory (getTemporaryDirectory, removeFile)
+import           System.IO (openTempFile, hClose)
+import           System.Process (system)
+
 import           Test.Hspec.Core.Example (Params(..), defaultParams)
 import           Test.Hspec.Core.Format (Format, FormatConfig)
 import           Test.Hspec.Core.Formatters.Pretty (pretty2)
-import qualified Test.Hspec.Core.Formatters.V1 as V1
-import qualified Test.Hspec.Core.Formatters.V2 as V2
+import qualified Test.Hspec.Core.Formatters.V1.Monad as V1
 import           Test.Hspec.Core.Util
 
 import           GetOpt.Declarative
@@ -43,6 +46,7 @@
 , configFailOnEmpty :: Bool
 , configFailOnFocused :: Bool
 , configFailOnPending :: Bool
+, configFailOnEmptyDescription :: Bool
 , configPrintSlowItems :: Maybe Int
 , configPrintCpuTime :: Bool
 , configFailFast :: Bool
@@ -65,24 +69,37 @@
 , configColorMode :: ColorMode
 , configUnicodeMode :: UnicodeMode
 , configDiff :: Bool
+, configDiffContext :: Maybe Int
+
+-- |
+-- An action that is used to print diffs.  The first argument is the value of
+-- `configDiffContext`.  The remaining two arguments are the @expected@ and
+-- @actual@ value.
+--
+-- @since 2.10.6
+, configExternalDiff :: Maybe (Maybe Int -> String -> String -> IO ())
+
 , configPrettyPrint :: Bool
 , configPrettyPrintFunction :: Bool -> String -> String -> (String, String)
 , configTimes :: Bool
-, configAvailableFormatters :: [(String, FormatConfig -> IO Format)]
+, configExpertMode :: Bool -- ^ @since 2.11.2
+, configAvailableFormatters :: [(String, FormatConfig -> IO Format)] -- ^ @since 2.9.0
 , configFormat :: Maybe (FormatConfig -> IO Format)
-, configFormatter :: Maybe V1.Formatter -- ^ deprecated, use `configFormat` instead
+, configFormatter :: Maybe V1.Formatter
 , configHtmlOutput :: Bool
 , configConcurrentJobs :: Maybe Int
 }
+{-# DEPRECATED configFormatter "Use [@useFormatter@](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Formatters-V1.html#v:useFormatter) instead." #-}
 
-defaultConfig :: Config
-defaultConfig = Config {
+mkDefaultConfig :: [(String, FormatConfig -> IO Format)] -> Config
+mkDefaultConfig formatters = Config {
   configIgnoreConfigFile = False
 , configDryRun = False
 , configFocusedOnly = False
 , configFailOnEmpty = False
 , configFailOnFocused = False
 , configFailOnPending = False
+, configFailOnEmptyDescription = False
 , configPrintSlowItems = Nothing
 , configPrintCpuTime = False
 , configFailFast = False
@@ -101,22 +118,36 @@
 , configColorMode = ColorAuto
 , configUnicodeMode = UnicodeAuto
 , configDiff = True
+, configDiffContext = Just defaultDiffContext
+, configExternalDiff = Nothing
 , configPrettyPrint = True
 , configPrettyPrintFunction = pretty2
 , configTimes = False
-, configAvailableFormatters = map (fmap V2.formatterToFormat) [
-    ("checks", V2.checks)
-  , ("specdoc", V2.specdoc)
-  , ("progress", V2.progress)
-  , ("failed-examples", V2.failed_examples)
-  , ("silent", V2.silent)
-  ]
+, configExpertMode = False
+, configAvailableFormatters = formatters
 , configFormat = Nothing
 , configFormatter = Nothing
 , configHtmlOutput = False
 , configConcurrentJobs = Nothing
 }
 
+defaultDiffContext :: Int
+defaultDiffContext = 3
+
+externalDiff :: String -> String -> String -> IO ()
+externalDiff command expected actual = do
+  tmp <- getTemporaryDirectory
+  withTempFile tmp "hspec-expected" expected $ \ expectedFile -> do
+    withTempFile tmp "hspec-actual" actual $ \ actualFile -> do
+      void . system $ unwords [command, expectedFile, actualFile]
+
+withTempFile :: FilePath -> FilePath -> String -> (FilePath -> IO a) -> IO a
+withTempFile dir file contents action = do
+  bracket (openTempFile dir file) (removeFile . fst) $ \ (path, h) -> do
+    hClose h
+    writeFile path contents
+    action path
+
 option :: String -> OptionSetter config -> String -> Option config
 option name arg help = Option name Nothing arg help True
 
@@ -137,20 +168,33 @@
 
 formatterOptions :: [(String, FormatConfig -> IO Format)] -> [Option Config]
 formatterOptions formatters = [
-    mkOption "format" (Just 'f') (argument "FORMATTER" readFormatter setFormatter) helpForFormat
+    mkOption "format" (Just 'f') (argument "NAME" readFormatter setFormatter) helpForFormat
   , mkFlag "color" setColor "colorize the output"
   , mkFlag "unicode" setUnicode "output unicode"
   , mkFlag "diff" setDiff "show colorized diffs"
+  , option "diff-context" (argument "N" readDiffContext setDiffContext) $ unlines [
+        "output N lines of diff context (default: " <> show defaultDiffContext <> ")"
+      , "use a value of 'full' to see the full context"
+      ]
+  , option "diff-command" (argument "CMD" return setDiffCommand) "use an external diff command\nexample: --diff-command=\"git diff\""
   , mkFlag "pretty" setPretty "try to pretty-print diff values"
   , mkFlag "times" setTimes "report times for individual spec items"
   , mkOptionNoArg "print-cpu-time" Nothing setPrintCpuTime "include used CPU time in summary"
   , printSlowItemsOption
+  , mkFlag "expert" setExpertMode "be less verbose"
 
     -- undocumented for now, as we probably want to change this to produce a
     -- standalone HTML report in the future
   , undocumented $ mkOptionNoArg "html" Nothing setHtml "produce HTML output"
   ]
   where
+    setDiffCommand :: String -> Config -> Config
+    setDiffCommand command config = config {
+      configExternalDiff = case strip command of
+        "" -> Nothing
+        _ -> Just $ \ _context -> externalDiff command
+    }
+
     setHtml config = config {configHtmlOutput = True}
 
     helpForFormat :: String
@@ -171,6 +215,16 @@
     setDiff :: Bool -> Config -> Config
     setDiff v config = config {configDiff = v}
 
+    readDiffContext :: String -> Maybe (Maybe Int)
+    readDiffContext input = case input of
+      "full" -> Just Nothing
+      _ -> case readMaybe input of
+        Nothing -> Nothing
+        mn -> Just (find (>= 0) mn)
+
+    setDiffContext :: Maybe Int -> Config -> Config
+    setDiffContext value c = c { configDiffContext = value }
+
     setPretty :: Bool -> Config -> Config
     setPretty v config = config {configPrettyPrint = v}
 
@@ -179,6 +233,9 @@
 
     setPrintCpuTime config = config {configPrintCpuTime = True}
 
+    setExpertMode :: Bool -> Config -> Config
+    setExpertMode v config = config {configExpertMode = v}
+
 printSlowItemsOption :: Option Config
 printSlowItemsOption = Option name (Just 'p') (OptArg "N" arg) "print the N slowest spec items (default: 10)" True
   where
@@ -192,9 +249,8 @@
 
     parseArg :: String -> Config -> Maybe Config
     parseArg input c = case readMaybe input of
-      Just 0 -> Just (setter Nothing c)
-      Just n -> Just (setter (Just n) c)
       Nothing -> Nothing
+      mn -> Just (setter (find (> 0) mn) c)
 
 smallCheckOptions :: [Option Config]
 smallCheckOptions = [
@@ -235,6 +291,7 @@
     FailOnEmpty
   | FailOnFocused
   | FailOnPending
+  | FailOnEmptyDescription
   deriving (Bounded, Enum)
 
 allFailOnItems :: [FailOn]
@@ -245,6 +302,7 @@
   FailOnEmpty -> "empty"
   FailOnFocused -> "focused"
   FailOnPending -> "pending"
+  FailOnEmptyDescription -> "empty-description"
 
 readFailOn :: String -> Maybe FailOn
 readFailOn = (`lookup` items)
@@ -279,7 +337,7 @@
   , mkOption "jobs" (Just 'j') (argument "N" readMaxJobs setMaxJobs) "run at most N parallelizable tests simultaneously (default: number of available processors)"
   ]
   where
-    strict = allFailOnItems
+    strict = [FailOnFocused, FailOnPending]
 
     readFailOnItems :: String -> Maybe [FailOn]
     readFailOnItems = mapM readFailOn . splitOn ','
@@ -292,9 +350,10 @@
       showFailOn item <> ": " <> help item
       where
         help item = case item of
-          FailOnEmpty -> "fail if no spec items have been run"
+          FailOnEmpty -> "fail if all spec items have been filtered"
           FailOnFocused -> "fail on focused spec items"
           FailOnPending -> "fail on pending spec items"
+          FailOnEmptyDescription -> "fail on empty descriptions"
 
     setFailOnItems :: Bool -> [FailOn] -> Config -> Config
     setFailOnItems value = flip $ foldr (`setItem` value)
@@ -303,6 +362,7 @@
           FailOnEmpty -> setFailOnEmpty
           FailOnFocused -> setFailOnFocused
           FailOnPending -> setFailOnPending
+          FailOnEmptyDescription -> setFailOnEmptyDescription
 
     readMaxJobs :: String -> Maybe Int
     readMaxJobs s = do
@@ -330,6 +390,9 @@
 
     setFailOnPending :: Bool -> Config -> Config
     setFailOnPending value config = config {configFailOnPending = value}
+
+    setFailOnEmptyDescription :: Bool -> Config -> Config
+    setFailOnEmptyDescription value config = config {configFailOnEmptyDescription = value}
 
     setStrict :: Bool -> Config -> Config
     setStrict = (`setFailOnItems` strict)
diff --git a/hspec-core/src/Test/Hspec/Core/Config/Options.hs b/hspec-core/src/Test/Hspec/Core/Config/Options.hs
--- a/hspec-core/src/Test/Hspec/Core/Config/Options.hs
+++ b/hspec-core/src/Test/Hspec/Core/Config/Options.hs
@@ -49,14 +49,7 @@
       foldM (parseFileOptions prog) config configFiles
   >>= maybe return (parseEnvVarOptions prog) envVar
   >>= parseEnvironmentOptions env
-  >>= traverseTuple (parseCommandLineOptions prog args)
-
-traverseTuple :: Applicative f => (a -> f b) -> (c, a) -> f (c, b)
-#if MIN_VERSION_base(4,7,0)
-traverseTuple = traverse
-#else
-traverseTuple f (c, a) = (,) c <$> f a
-#endif
+  >>= traverse (parseCommandLineOptions prog args)
 
 parseCommandLineOptions :: String -> [String] -> Config -> Either (ExitCode, String) Config
 parseCommandLineOptions prog args config = case Declarative.parseCommandLineOptions (commandLineOptions formatters) prog args config of
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,6 +1,5 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeSynonymInstances #-}
@@ -21,6 +20,8 @@
 , safeEvaluateExample
 -- END RE-EXPORTED from Test.Hspec.Core.Spec
 , safeEvaluateResultStatus
+, exceptionToResultStatus
+, toLocation
 ) where
 
 import           Prelude ()
@@ -28,11 +29,9 @@
 
 import qualified Test.HUnit.Lang as HUnit
 
-import           Data.CallStack
+import           Data.CallStack (SrcLoc(..))
 
-import           Control.Exception
 import           Control.DeepSeq
-import           Data.Typeable (Typeable)
 import qualified Test.QuickCheck as QC
 import           Test.Hspec.Expectations (Expectation)
 
@@ -70,57 +69,66 @@
 data Result = Result {
   resultInfo :: String
 , resultStatus :: ResultStatus
-} deriving (Show, Typeable)
+} deriving Show
 
 data ResultStatus =
     Success
   | Pending (Maybe Location) (Maybe String)
   | Failure (Maybe Location) FailureReason
-  deriving (Show, Typeable)
+  deriving Show
 
 data FailureReason =
     NoReason
   | Reason String
+  | ColorizedReason String
   | ExpectedButGot (Maybe String) String String
   | Error (Maybe String) SomeException
-  deriving (Show, Typeable)
+  deriving Show
 
 instance NFData FailureReason where
   rnf reason = case reason of
     NoReason -> ()
     Reason r -> r `deepseq` ()
+    ColorizedReason r -> r `deepseq` ()
     ExpectedButGot p e a  -> p `deepseq` e `deepseq` a `deepseq` ()
-    Error m e -> m `deepseq` e `seq` ()
+    Error m e -> m `deepseq` show e `deepseq` ()
 
 instance Exception ResultStatus
 
-safeEvaluateExample :: Example e => e -> Params -> (ActionWith (Arg e) -> IO ()) -> ProgressCallback -> IO Result
-safeEvaluateExample example params around progress = safeEvaluate $ forceResult <$> evaluateExample example params around progress
-  where
-    forceResult :: Result -> Result
-    forceResult r@(Result info status) = info `deepseq` (forceResultStatus status) `seq` r
+forceResult :: Result -> Result
+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
-      Failure _ m -> m `deepseq` r
+forceResultStatus :: ResultStatus -> ResultStatus
+forceResultStatus r = case r of
+  Success -> r
+  Pending _ m -> m `deepseq` r
+  Failure _ m -> m `deepseq` r
 
+safeEvaluateExample :: Example e => e -> Params -> (ActionWith (Arg e) -> IO ()) -> ProgressCallback -> IO Result
+safeEvaluateExample example params around progress = safeEvaluate $ evaluateExample example params around progress
+
 safeEvaluate :: IO Result -> IO Result
 safeEvaluate action = do
-  r <- safeTry action
-  return $ case r of
-    Left e -> Result "" (toResultStatus e)
-    Right result -> result
+  r <- safeTry $ forceResult <$> action
+  case r of
+    Left e -> Result "" <$> exceptionToResultStatus e
+    Right result -> return result
 
 safeEvaluateResultStatus :: IO ResultStatus -> IO ResultStatus
-safeEvaluateResultStatus action = either toResultStatus id <$> safeTry action
+safeEvaluateResultStatus action = do
+  r <- safeTry $ forceResultStatus <$> action
+  case r of
+    Left e -> exceptionToResultStatus e
+    Right status -> return status
 
-toResultStatus :: SomeException -> ResultStatus
-toResultStatus e
-  | Just result <- fromException e = result
-  | Just hunit <- fromException e = hunitFailureToResult Nothing hunit
-  | otherwise = Failure Nothing $ Error Nothing e
+exceptionToResultStatus :: SomeException -> IO ResultStatus
+exceptionToResultStatus = safeEvaluateResultStatus . pure . toResultStatus
+  where
+    toResultStatus :: SomeException -> ResultStatus
+    toResultStatus e
+      | Just result <- fromException e = result
+      | Just hunit <- fromException e = hunitFailureToResult Nothing hunit
+      | otherwise = Failure Nothing $ Error Nothing e
 
 instance Example Result where
   type Arg Result = ()
@@ -128,10 +136,8 @@
 
 instance Example (a -> Result) where
   type Arg (a -> Result) = a
-  evaluateExample example _params action _callback = do
-    ref <- newIORef (Result "" Success)
-    action (evaluate . example >=> writeIORef ref)
-    readIORef ref
+  evaluateExample example _params hook _callback = do
+    liftHook (Result "" Success) hook (evaluate . example)
 
 instance Example Bool where
   type Arg Bool = ()
@@ -139,10 +145,8 @@
 
 instance Example (a -> Bool) where
   type Arg (a -> Bool) = a
-  evaluateExample p _params action _callback = do
-    ref <- newIORef (Result "" Success)
-    action (evaluate . example >=> writeIORef ref)
-    readIORef ref
+  evaluateExample p _params hook _callback = do
+    liftHook (Result "" Success) hook (evaluate . example)
     where
       example a
         | p a = Result "" Success
@@ -166,16 +170,19 @@
     where
       location = case mLoc of
         Nothing -> Nothing
-        Just loc -> Just $ Location (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc)
+        Just loc -> Just $ toLocation loc
   where
     addPre :: String -> String
     addPre xs = case pre of
       Just x -> x ++ "\n" ++ xs
       Nothing -> xs
 
+toLocation :: SrcLoc -> Location
+toLocation loc = Location (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc)
+
 instance Example (a -> Expectation) where
   type Arg (a -> Expectation) = a
-  evaluateExample e _ action _ = action e >> return (Result "" Success)
+  evaluateExample e _ hook _ = hook e >> return (Result "" Success)
 
 instance Example QC.Property where
   type Arg QC.Property = ()
@@ -183,8 +190,8 @@
 
 instance Example (a -> QC.Property) where
   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)
+  evaluateExample p c hook progressCallback = do
+    r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) {QC.chatty = False} (QCP.callback qcProgressCallback $ aroundProperty hook p)
     return $ fromQuickCheckResult r
     where
       qcProgressCallback = QCP.PostTest QCP.NotCounterexample $
diff --git a/hspec-core/src/Test/Hspec/Core/Example/Location.hs b/hspec-core/src/Test/Hspec/Core/Example/Location.hs
--- a/hspec-core/src/Test/Hspec/Core/Example/Location.hs
+++ b/hspec-core/src/Test/Hspec/Core/Example/Location.hs
@@ -16,9 +16,7 @@
 import           Prelude ()
 import           Test.Hspec.Core.Compat
 
-import           Control.Exception
 import           Data.Char
-import           Data.Maybe
 import           GHC.IO.Exception
 
 #ifdef mingw32_HOST_OS
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
@@ -9,7 +9,7 @@
 import           Test.Hspec.Core.Compat
 
 #ifndef __GHCJS__
-import           System.SetEnv (setEnv)
+import           System.Environment (setEnv)
 import           Test.Hspec.Core.Util (safeTry)
 #endif
 import           System.IO
@@ -35,7 +35,7 @@
     -- into the environment is a non-essential feature we just disable this to be
     -- able to run hspec test-suites with ghcjs at all. Should be reverted once
     -- the issue is fixed.
-    return ()
+    pass
 #else
     -- on Windows this can throw an exception when the input is too large, hence
     -- we use `safeTry` here
diff --git a/hspec-core/src/Test/Hspec/Core/Format.hs b/hspec-core/src/Test/Hspec/Core/Format.hs
--- a/hspec-core/src/Test/Hspec/Core/Format.hs
+++ b/hspec-core/src/Test/Hspec/Core/Format.hs
@@ -1,8 +1,14 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ExistentialQuantification #-}
 -- |
--- Stability: experimental
-module Test.Hspec.Core.Format (
+-- Stability: unstable
+--
+-- This is an unstable API.  Use
+-- [Test.Hspec.Api.Format.V2](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Format-V2.html)
+-- instead.
+module Test.Hspec.Core.Format
+-- {-# WARNING "Use [Test.Hspec.Api.Format.V2](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Format-V2.html) instead." #-}
+(
   Format
 , FormatConfig(..)
 , Event(..)
@@ -19,9 +25,8 @@
 import           Prelude ()
 import           Test.Hspec.Core.Compat
 
-import           Control.Exception
 import           Control.Concurrent
-import           Control.Concurrent.Async (async)
+import           Control.Concurrent.Async (Async, async)
 import qualified Control.Concurrent.Async as Async
 import           Control.Monad.IO.Class
 
@@ -59,15 +64,20 @@
 , formatConfigReportProgress :: Bool
 , formatConfigOutputUnicode :: Bool
 , formatConfigUseDiff :: Bool
-, formatConfigPrettyPrint :: Bool -- ^ Deprecated: use `formatConfigPrettyPrintFunction` instead
+, formatConfigDiffContext :: Maybe Int
+, formatConfigExternalDiff :: Maybe (String -> String -> IO ())
+, formatConfigPrettyPrint :: Bool
 , formatConfigPrettyPrintFunction :: Maybe (String -> String -> (String, String))
 , formatConfigPrintTimes :: Bool
 , formatConfigHtmlOutput :: Bool
 , formatConfigPrintCpuTime :: Bool
 , formatConfigUsedSeed :: Integer
 , formatConfigExpectedTotalCount :: Int
+, formatConfigExpertMode :: Bool
 }
 
+{-# DEPRECATED formatConfigPrettyPrint "Use `formatConfigPrettyPrintFunction` instead" #-}
+
 data Signal = Ok | NotOk SomeException
 
 monadic :: MonadIO m => (m () -> IO ()) -> (Event -> m ()) -> IO Format
@@ -92,23 +102,24 @@
       event <- takeEvent
       format event
       case event of
-        Done {} -> return ()
+        Done {} -> pass
         _ -> do
           signal Ok
           go
 
-  t <- async $ do
+  worker <- async $ do
     (run go >> signal Ok) `catch` (signal . NotOk)
 
   return $ \ event -> do
-    running <- Async.poll t
-    case running of
-      Just _ -> return ()
-      Nothing -> do
-        putEvent event
-        r <- wait
-        case r of
-          Ok -> return ()
-          NotOk err -> do
-            Async.wait t
-            throwIO err
+    running <- asyncRunning worker
+    when running $ do
+      putEvent event
+      r <- wait
+      case r of
+        Ok -> pass
+        NotOk err -> do
+          Async.wait worker
+          throwIO err
+
+asyncRunning :: Async () -> IO Bool
+asyncRunning worker = maybe True (const False) <$> Async.poll worker
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,6 +1,5 @@
--- |
--- Deprecated\: Use "Test.Hspec.Core.Formatters.V1" instead.
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
 module Test.Hspec.Core.Formatters
--- {-# DEPRECATED "Use \"Test.Hspec.Core.Formatters.V1\" instead." #-}
+{-# DEPRECATED "Use [Test.Hspec.Api.Formatters.V1](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Formatters-V1.html) instead." #-}
 (module V1) where
 import           Test.Hspec.Core.Formatters.V1 as V1
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
@@ -15,12 +15,74 @@
 import           Data.Char
 import qualified Data.Algorithm.Diff as Diff
 
-data Diff = First String | Second String | Both String
+data Diff = First String | Second String | Both String | Omitted Int
   deriving (Eq, Show)
 
-diff :: String -> String -> [Diff]
-diff expected actual = map (toDiff . fmap concat) $ Diff.getGroupedDiff (partition expected) (partition actual)
+-- |
+-- Split a string at line boundaries.
+--
+-- >>> splitLines "foo\nbar\nbaz"
+-- ["foo\n","bar\n","baz"]
+--
+-- prop> concat (splitLines xs) == xs
+splitLines :: String -> [String]
+splitLines = go
+  where
+    go xs = case break (== '\n') xs of
+      (ys, '\n' : zs) -> (ys ++ ['\n']) : go zs
+      ("", "") -> []
+      _ -> [xs]
 
+data TrimMode = FirstChunck | Chunck | LastChunck
+
+trim :: Int -> [Diff] -> [Diff]
+trim context = \ chunks -> case chunks of
+  [] -> []
+  x : xs -> trimChunk FirstChunck x (go xs)
+  where
+    omitThreshold = 3
+
+    go chunks = case chunks of
+      [] -> []
+      [x] -> trimChunk LastChunck x []
+      x : xs -> trimChunk Chunck x (go xs)
+
+    trimChunk mode chunk = case chunk of
+      Both xs | omitted >= omitThreshold -> keep start . (Omitted omitted :) . keep end
+        where
+          omitted :: Int
+          omitted = n - keepStart - keepEnd
+
+          keepStart :: Int
+          keepStart = case mode of
+            FirstChunck -> 0
+            _ -> succ context
+
+          keepEnd :: Int
+          keepEnd = case mode of
+            LastChunck -> 0
+            _ -> if xs `endsWith` "\n" then context else succ context
+
+          n :: Int
+          n = length allLines
+
+          allLines :: [String]
+          allLines = splitLines xs
+
+          start :: [String]
+          start = take keepStart allLines
+
+          end :: [String]
+          end = drop (keepStart + omitted) allLines
+      _ -> (chunk :)
+
+    keep xs
+      | null xs = id
+      | otherwise = (Both (concat xs) :)
+
+diff :: Maybe Int -> String -> String -> [Diff]
+diff context expected actual = maybe id trim context $ map (toDiff . fmap concat) $ Diff.getGroupedDiff (partition expected) (partition actual)
+
 toDiff :: Diff.Diff String -> Diff
 toDiff d = case d of
   Diff.First xs -> First xs
@@ -47,7 +109,7 @@
       | otherwise = (x :)
 
 splitEscape :: String -> Maybe (String, String)
-splitEscape xs = splitNumericEscape xs <|> (msum $ map split escapes)
+splitEscape xs = splitNumericEscape xs <|> msum (map split escapes)
   where
     split :: String -> Maybe (String, String)
     split escape = (,) escape <$> stripPrefix escape xs
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,6 +1,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE LambdaCase #-}
 module Test.Hspec.Core.Formatters.Internal (
   Formatter(..)
 , Item(..)
@@ -35,11 +36,15 @@
 , outputUnicode
 
 , useDiff
+, diffContext
+, externalDiffAction
 , prettyPrint
 , prettyPrintFunction
 , extraChunk
 , missingChunk
 
+, unlessExpert
+
 #ifdef TEST
 , runFormatM
 , splitLines
@@ -50,16 +55,14 @@
 import           Test.Hspec.Core.Compat
 
 import qualified System.IO as IO
-import           System.IO (Handle, stdout)
-import           Control.Exception (bracket_, bracket)
+import           System.IO (stdout)
 import           System.Console.ANSI
-import           Control.Monad.Trans.State hiding (state, gets, modify)
+import           Control.Monad.Trans.Reader (ReaderT(..), ask)
 import           Control.Monad.IO.Class
 import           Data.Char (isSpace)
 import           Data.List (groupBy)
 import qualified System.CPUTime as CPUTime
 
-import           Test.Hspec.Core.Formatters.V1.Monad (FailureRecord(..))
 import           Test.Hspec.Core.Format
 import           Test.Hspec.Core.Clock
 
@@ -86,8 +89,14 @@
 , formatterDone :: FormatM ()
 }
 
+data FailureRecord = FailureRecord {
+  failureRecordLocation :: Maybe Location
+, failureRecordPath     :: Path
+, failureRecordMessage  :: FailureReason
+}
+
 formatterToFormat :: Formatter -> FormatConfig -> IO Format
-formatterToFormat Formatter{..} config = monadic (runFormatM config) $ \ event -> case event of
+formatterToFormat Formatter{..} config = monadic (runFormatM config) $ \ case
   Started -> formatterStarted
   GroupStarted path -> formatterGroupStarted path
   GroupDone path -> formatterGroupDone path
@@ -111,6 +120,33 @@
 useDiff :: FormatM Bool
 useDiff = getConfig formatConfigUseDiff
 
+-- | Do nothing on `--expert`, otherwise run the given action.
+--
+-- @since 2.11.2
+unlessExpert :: FormatM () -> FormatM ()
+unlessExpert action = getConfig formatConfigExpertMode >>= \ case
+  False -> action
+  True -> return ()
+
+-- |
+-- Return the value of `Test.Hspec.Core.Runner.configDiffContext`.
+--
+-- @since 2.10.6
+diffContext :: FormatM (Maybe Int)
+diffContext = getConfig formatConfigDiffContext
+
+-- | An action for printing diffs.
+--
+-- The action takes @expected@ and @actual@ as arguments.
+--
+-- When this is a `Just`-value then it should be used instead of any built-in
+-- diff implementation.  A `Just`-value also implies that `useDiff` returns
+-- `True`.
+--
+-- @since 2.10.6
+externalDiffAction :: FormatM (Maybe (String -> String -> IO ()))
+externalDiffAction = getConfig formatConfigExternalDiff
+
 -- | Return `True` if the user requested pretty diffs, `False` otherwise.
 prettyPrint :: FormatM Bool
 prettyPrint = maybe False (const True) <$> getConfig formatConfigPrettyPrintFunction
@@ -124,6 +160,8 @@
 prettyPrintFunction = getConfig formatConfigPrettyPrintFunction
 
 -- | Return `True` if the user requested unicode output, `False` otherwise.
+--
+-- @since 2.9.0
 outputUnicode :: FormatM Bool
 outputUnicode = getConfig formatConfigOutputUnicode
 
@@ -143,12 +181,12 @@
 -- | A lifted version of `Control.Monad.Trans.State.gets`
 gets :: (FormatterState -> a) -> FormatM a
 gets f = FormatM $ do
-  f <$> (get >>= liftIO . readIORef)
+  f <$> (ask >>= liftIO . readIORef)
 
 -- | A lifted version of `Control.Monad.Trans.State.modify`
 modify :: (FormatterState -> FormatterState) -> FormatM ()
 modify f = FormatM $ do
-  get >>= liftIO . (`modifyIORef'` f)
+  ask >>= liftIO . (`modifyIORef'` f)
 
 data FormatterState = FormatterState {
   stateSuccessCount    :: !Int
@@ -163,22 +201,19 @@
 getConfig :: (FormatConfig -> a) -> FormatM a
 getConfig f = gets (f . stateConfig)
 
-getHandle :: FormatM Handle
-getHandle = return stdout
-
 -- | The random seed that is used for QuickCheck.
 usedSeed :: FormatM Integer
 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)
+newtype FormatM a = FormatM (ReaderT (IORef FormatterState) IO a)
   deriving (Functor, Applicative, Monad, MonadIO)
 
 runFormatM :: FormatConfig -> FormatM a -> IO a
 runFormatM config (FormatM action) = withLineBuffering $ do
   time <- getMonotonicTime
-  cpuTime <- if (formatConfigPrintCpuTime config) then Just <$> CPUTime.getCPUTime else pure Nothing
+  cpuTime <- if formatConfigPrintCpuTime config then Just <$> CPUTime.getCPUTime else pure Nothing
 
   let
     progress = formatConfigReportProgress config && not (formatConfigHtmlOutput config)
@@ -191,7 +226,7 @@
     , stateConfig = config { formatConfigReportProgress = progress }
     , stateColor = Nothing
     }
-  newIORef state >>= evalStateT action
+  newIORef state >>= runReaderT action
 
 withLineBuffering :: IO a -> IO a
 withLineBuffering action = bracket (IO.hGetBuffering stdout) (IO.hSetBuffering stdout) $ \ _ -> do
@@ -219,16 +254,17 @@
 
 -- | Get the number of spec items that will have been encountered when this run
 -- completes (if it is not terminated early).
+--
+-- @since 2.9.0
 getExpectedTotalCount :: FormatM Int
 getExpectedTotalCount = getConfig formatConfigExpectedTotalCount
 
 writeTransient :: String -> FormatM ()
 writeTransient new = do
   reportProgress <- getConfig formatConfigReportProgress
-  when (reportProgress) $ do
-    h <- getHandle
-    write $ new
-    liftIO $ IO.hFlush h
+  when reportProgress $ do
+    write new
+    liftIO $ IO.hFlush stdout
     write $ "\r" ++ replicate (length new) ' ' ++ "\r"
 
 -- | Append some output to the report.
@@ -242,10 +278,9 @@
 
 writeChunk :: String -> FormatM ()
 writeChunk str = do
-  h <- getHandle
   let
-    plainOutput = IO.hPutStr h str
-    colorOutput color = bracket_ (hSetSGR h [color]) (hSetSGR h [Reset]) plainOutput
+    plainOutput = IO.hPutStr stdout str
+    colorOutput color = bracket_ (hSetSGR stdout [color]) (hSetSGR stdout [Reset]) plainOutput
   mColor <- gets stateColor
   liftIO $ case mColor of
     Just (SetColor Foreground _ _) | all isSpace str -> plainOutput
@@ -327,7 +362,7 @@
 getCPUTime = do
   t1  <- liftIO CPUTime.getCPUTime
   mt0 <- gets stateCpuStartTime
-  return $ toSeconds <$> ((-) <$> pure t1 <*> mt0)
+  return $ toSeconds <$> ((t1 -) <$> mt0)
   where
     toSeconds x = Seconds (fromIntegral x / (10.0 ^ (12 :: Integer)))
 
diff --git a/hspec-core/src/Test/Hspec/Core/Formatters/Pretty.hs b/hspec-core/src/Test/Hspec/Core/Formatters/Pretty.hs
--- a/hspec-core/src/Test/Hspec/Core/Formatters/Pretty.hs
+++ b/hspec-core/src/Test/Hspec/Core/Formatters/Pretty.hs
@@ -5,6 +5,7 @@
 #ifdef TEST
 , pretty
 , recoverString
+, recoverMultiLineString
 #endif
 ) where
 
@@ -20,49 +21,46 @@
 import           Test.Hspec.Core.Formatters.Pretty.Parser
 
 pretty2 :: Bool -> String -> String -> (String, String)
-pretty2 unicode expected actual = case (recoverString unicode expected, recoverString unicode actual) of
+pretty2 unicode expected actual = case (recoverMultiLineString unicode expected, recoverMultiLineString unicode actual) of
   (Just expected_, Just actual_) -> (expected_, actual_)
   _ -> case (pretty unicode expected, pretty unicode actual) of
-    (Just expected_, Just actual_) -> (expected_, actual_)
-#if __GLASGOW_HASKELL__ >= 802
+    (Just expected_, Just actual_) | expected_ /= actual_ -> (expected_, actual_)
     _ -> (expected, actual)
-#else
-    _ -> (rec expected, rec actual)
-  where
-    rec = if unicode then urecover else id
 
-    urecover :: String -> String
-    urecover xs = maybe xs ushow $ readMaybe xs
-#endif
+recoverString :: String -> Maybe String
+recoverString xs = case xs of
+  '"' : _ -> case reverse xs of
+    '"' : _ -> readMaybe xs
+    _ -> Nothing
+  _ -> Nothing
 
-recoverString :: Bool -> String -> Maybe String
-recoverString unicode input = case readMaybe input of
+recoverMultiLineString :: Bool -> String -> Maybe String
+recoverMultiLineString unicode input = case recoverString input of
   Just r | shouldParseBack r -> Just r
   _ -> Nothing
   where
     shouldParseBack = (&&) <$> all isSafe <*> isMultiLine
     isMultiLine = lines >>> length >>> (> 1)
-    isSafe c = (unicode || isAscii c) && (not $ isControl c) || c == '\n'
+    isSafe c = (unicode || isAscii c) && not (isControl c) || c == '\n'
 
 pretty :: Bool -> String -> Maybe String
-pretty unicode = parseExpression >=> render_
+pretty unicode = parseValue >=> render_
   where
-    render_ :: Expression -> Maybe String
-    render_ expr = guard (shouldParseBack expr) >> Just (renderExpression unicode expr)
+    render_ :: Value -> Maybe String
+    render_ value = guard (shouldParseBack value) >> Just (renderValue unicode value)
 
-    shouldParseBack :: Expression -> Bool
+    shouldParseBack :: Value -> Bool
     shouldParseBack = go
       where
-        go expr = case expr of
-          Literal (String _) -> True
-          Literal _ -> False
-          Id _ -> False
-          App (Id _) e -> go e
-          App _ _ -> False
-          Parentheses e -> go e
+        go value = case value of
+          Char _ -> False
+          String _ -> True
+          Rational _ _ -> False
+          Number _ -> False
+          Record _ _ -> True
+          Constructor _ xs -> any go xs
           Tuple xs -> any go xs
           List xs -> any go xs
-          Record _ _ -> True
 
 newtype Builder = Builder ShowS
 
@@ -91,24 +89,19 @@
 instance IsString Builder where
   fromString = Builder . showString
 
-renderExpression :: Bool -> Expression -> String
-renderExpression unicode = runBuilder . render
+renderValue :: Bool -> Value -> String
+renderValue unicode = runBuilder . render
   where
-    renderLiteral lit = case lit of
+    render :: Value -> Builder
+    render value = case value of
       Char c -> shows c
       String str -> if unicode then Builder $ ushows str else shows str
-      Integer n -> shows n
-      Rational n -> fromString n
-
-    render :: Expression -> Builder
-    render expr = case expr of
-      Literal lit -> renderLiteral lit
-      Id name -> fromString name
-      App a b -> render a <> " " <> render b
-      Parentheses e@Record{} -> render e
-      Parentheses e -> "(" <> render e <> ")"
+      Rational n d -> render n <> " % " <> render d
+      Number n -> fromString n
+      Record name fields -> fromString name <> " {\n  " <> (intercalate ",\n  " $ map renderField fields) <> "\n}"
+      Constructor name values -> intercalate " " (fromString name : map render values)
+      Tuple [e@Record{}] -> render e
       Tuple xs -> "(" <> intercalate ", " (map render xs) <> ")"
       List xs -> "[" <> intercalate ", " (map render xs) <> "]"
-      Record name fields -> fromString name <> " {\n  " <> (intercalate ",\n  " $ map renderField fields) <> "\n}"
 
     renderField (name, value) = fromString name <> " = " <> render value
diff --git a/hspec-core/src/Test/Hspec/Core/Formatters/Pretty/Parser.hs b/hspec-core/src/Test/Hspec/Core/Formatters/Pretty/Parser.hs
--- a/hspec-core/src/Test/Hspec/Core/Formatters/Pretty/Parser.hs
+++ b/hspec-core/src/Test/Hspec/Core/Formatters/Pretty/Parser.hs
@@ -1,395 +1,107 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE FlexibleInstances #-}
-#if __GLASGOW_HASKELL__ >= 810
-{-# LANGUAGE EmptyCase #-}
-#endif
 module Test.Hspec.Core.Formatters.Pretty.Parser (
-  Expression(..)
-, Literal(..)
-, parseExpression
-, unsafeParseExpression
+  Value(..)
+, parseValue
 ) where
 
 import           Prelude ()
-import           Test.Hspec.Core.Compat hiding (fail)
-import           Test.Hspec.Core.Formatters.Pretty.Parser.Types
-
-#ifndef __GHCJS__
-#if __GLASGOW_HASKELL__ >= 802 && __GLASGOW_HASKELL__ <= 904
-#define PRETTY_PRINTING_SUPPORTED
-#endif
-#endif
-
-#ifndef PRETTY_PRINTING_SUPPORTED
-
-parseExpression :: String -> Maybe Expression
-parseExpression _ = Nothing
-
-unsafeParseExpression :: String -> Maybe Expression
-unsafeParseExpression _ = Nothing
-
-#else
-
-import           GHC.Stack
-import           GHC.Exception (throw, errorCallWithCallStackException)
-
-#if __GLASGOW_HASKELL__ >= 904
-import           GHC.Utils.Error
-import           GHC.Utils.Outputable
-#endif
-
-#if __GLASGOW_HASKELL__ >= 804 && __GLASGOW_HASKELL__ < 904
-import           GHC.LanguageExtensions.Type
-#endif
-
-#if __GLASGOW_HASKELL__ >= 902
-import           GHC.Types.SourceText
-#elif __GLASGOW_HASKELL__ >= 900
-import           GHC.Types.Basic
-import           GHC.Unit.Types
-#endif
-
-#if __GLASGOW_HASKELL__ >= 900
-import qualified GHC.Parser as GHC
-import           GHC.Parser.Lexer
-import           GHC.Data.StringBuffer
-import           GHC.Data.FastString
-import           GHC.Types.SrcLoc
-import           GHC.Types.Name
-import           GHC.Types.Name.Reader
-import           GHC.Parser.PostProcess hiding (Tuple)
-#else
-import           Lexer
-import qualified Parser as GHC
-import           StringBuffer
-import           FastString
-import           SrcLoc
-import           Name
-import           RdrName
-import           BasicTypes
-import           Module
-#endif
-
-#if __GLASGOW_HASKELL__ >= 804 && __GLASGOW_HASKELL__ < 904
-#if __GLASGOW_HASKELL__ >= 900
-import qualified GHC.Data.EnumSet as EnumSet
-#else
-import qualified EnumSet
-#endif
-#endif
-
-#if __GLASGOW_HASKELL__ == 810
-import           RdrHsSyn hiding (Tuple)
-#endif
-
-#if __GLASGOW_HASKELL__ >= 810
-import           GHC.Hs
-#else
-import           HsSyn
-#endif
-
-#if __GLASGOW_HASKELL__ <= 806
-import           Data.Bits
-import           Control.Exception
-#endif
-
-parseExpression :: String -> Maybe Expression
-parseExpression = parseWith (const Nothing)
-
-unsafeParseExpression :: String -> Maybe Expression
-unsafeParseExpression = parseWith throwError
-
-parseWith :: (Error -> Maybe Expression) -> String -> Maybe Expression
-parseWith err = parse >=> either err Just . toExpression
-
-data Error = Error CallStack String
-
-throwError :: Error -> a
-throwError (Error stack err) = throw $ errorCallWithCallStackException err stack
-
-fail :: HasCallStack => String -> Either Error a
-fail = Left . Error callStack
-
-class ToExpression a where
-  toExpression :: a -> Either Error Expression
-
-#if __GLASGOW_HASKELL__ < 806
-#define _x
-#endif
-
-#if __GLASGOW_HASKELL__ >= 900
-#define X(name, expr)
-#elif __GLASGOW_HASKELL__ == 810
-#define X(name, expr) name none -> case none of
-#elif __GLASGOW_HASKELL__ >= 806
-#define X(name, expr) name none -> case none of NoExt -> expr
-#else
-#define X(name, expr)
-#endif
-
-#if __GLASGOW_HASKELL__ >= 804
-#define GhcPsHsLit GhcPs
-#else
-type GhcPs = RdrName
-#define GhcPsHsLit
-#endif
-
-#if __GLASGOW_HASKELL__ >= 902
-#define _listSynExpr
-#endif
-
-#if __GLASGOW_HASKELL__ >= 806
-#define RecCon(name, fields) RecordCon _ (L _ name) fields
-#else
-#define RecCon(name, fields) RecordCon (L _ name) _ _ fields
-#endif
+import           Test.Hspec.Core.Compat
 
-#define REJECT(name) name{} -> fail "name"
+import           Test.Hspec.Core.Formatters.Pretty.Parser.Parser hiding (Parser)
+import qualified Test.Hspec.Core.Formatters.Pretty.Parser.Parser as P
 
-instance ToExpression (HsExpr GhcPs) where
-  toExpression expr = case expr of
-    HsVar _x name -> toExpression name
-    HsLit _x lit -> toExpression lit
-    HsOverLit _x lit -> toExpression lit
-    HsApp _x f x -> App <$> toExpression f <*> toExpression x
-    NegApp _x e _ -> toExpression e >>= \ x -> case x of
-      Literal (Rational n) -> return $ Literal (Rational $ '-' : n)
-      Literal (Integer n) -> return $ Literal (Integer $ negate n)
-      _ -> fail "NegApp"
+import           Language.Haskell.Lexer hiding (Pos(..))
 
-    HsPar _x
-#if __GLASGOW_HASKELL__ >= 904
-      _ e _ ->
-#else
-      e ->
-#endif
-        Parentheses <$> toExpression e
-    ExplicitTuple _x xs _ -> Tuple <$> mapM toExpression xs
-    ExplicitList _ _listSynExpr xs -> List <$> mapM toExpression xs
-    RecCon(name, fields) -> Record (showRdrName name) <$> (recordFields $ rec_flds fields)
-      where
-#if __GLASGOW_HASKELL__ >= 904
-        hsRecFieldLbl = hfbLHS
-        hsRecFieldArg = hfbRHS
-#endif
-        fieldName = showFieldLabel . unLoc . hsRecFieldLbl
-        recordFields = mapM (recordField . unLoc)
-        recordField field = (,) (fieldName field) <$> toExpression (hsRecFieldArg field)
+type Name = String
 
-    REJECT(HsUnboundVar)
-    REJECT(HsOverLabel)
-    REJECT(HsIPVar)
-    REJECT(HsLam)
-    REJECT(HsLamCase)
-    REJECT(HsAppType)
-    REJECT(OpApp)
-    REJECT(SectionL)
-    REJECT(SectionR)
-    REJECT(ExplicitSum)
-    REJECT(HsCase)
-    REJECT(HsIf)
-    REJECT(HsMultiIf)
-    REJECT(HsLet)
-    REJECT(HsDo)
-    REJECT(RecordUpd)
-    REJECT(ExprWithTySig)
-    REJECT(ArithSeq)
-    REJECT(HsSpliceE)
-    REJECT(HsProc)
-    REJECT(HsStatic)
+data Value =
+    Char Char
+  | String String
+  | Rational Value Value
+  | Number String
+  | Record Name [(Name, Value)]
+  | Constructor Name [Value]
+  | Tuple [Value]
+  | List [Value]
+  deriving (Eq, Show)
 
-#if __GLASGOW_HASKELL__ >= 904
-    REJECT(HsRecSel)
-    REJECT(HsTypedBracket)
-    REJECT(HsUntypedBracket)
-#endif
-#if __GLASGOW_HASKELL__ >= 902
-    REJECT(HsGetField)
-    REJECT(HsProjection)
-#endif
-#if __GLASGOW_HASKELL__ >= 900
-    REJECT(HsPragE)
-#endif
+type Parser = P.Parser (Token, String)
 
-#if __GLASGOW_HASKELL__ < 904
-    REJECT(HsConLikeOut)
-    REJECT(HsRecFld)
-    REJECT(HsBracket)
-    REJECT(HsRnBracketOut)
-    REJECT(HsTcBracketOut)
-    REJECT(HsTick)
-    REJECT(HsBinTick)
-#endif
-#if __GLASGOW_HASKELL__ < 900
-    REJECT(HsSCC)
-    REJECT(HsCoreAnn)
-    REJECT(HsTickPragma)
-    REJECT(HsWrap)
-#endif
-#if __GLASGOW_HASKELL__ < 810
-    REJECT(HsArrApp)
-    REJECT(HsArrForm)
-    REJECT(EWildPat)
-    REJECT(EAsPat)
-    REJECT(EViewPat)
-    REJECT(ELazyPat)
-#endif
-#if __GLASGOW_HASKELL__ < 806
-    REJECT(HsAppTypeOut)
-    REJECT(ExplicitPArr)
-    REJECT(ExprWithTySigOut)
-    REJECT(PArrSeq)
-#endif
-    X(XExpr, fail "XExpr")
+parseValue :: String -> Maybe Value
+parseValue input = case runParser value (tokenize input) of
+  Just (v, []) -> Just v
+  _ -> Nothing
 
-instance ToExpression RdrName where
-  toExpression = return . Id . showRdrName
+value :: Parser Value
+value =
+      char
+  <|> string
+  <|> rational
+  <|> number
+  <|> record
+  <|> constructor
+  <|> tuple
+  <|> list
 
-instance ToExpression (HsTupArg GhcPs) where
-  toExpression t = case t of
-    Present _x expr -> toExpression expr
-    Missing _ -> fail "Missing (tuple section)"
-    X(XTupArg, fail "XTupArg")
+char :: Parser Value
+char = Char <$> (token CharLit >>= readA)
 
-instance ToExpression e => ToExpression (GenLocated l e) where
-  toExpression (L _ e) = toExpression e
+string :: Parser Value
+string = String <$> (token StringLit >>= readA)
 
-instance ToExpression (HsOverLit GhcPs) where
-  toExpression = toExpression . ol_val
+rational :: Parser Value
+rational = Rational <$> (number <|> tuple) <* require (Varsym, "%") <*> number
 
-#if __GLASGOW_HASKELL__ > 802
-#define _integralSource
+number :: Parser Value
+number = integer <|> float
+  where
+    integer :: Parser Value
+    integer = Number <$> token IntLit
 
-instance ToExpression IntegralLit where
-  toExpression il = toExpression (il_value il)
-#endif
+    float :: Parser Value
+    float = Number <$> token FloatLit
 
-instance ToExpression OverLitVal where
-  toExpression lit = case lit of
-    HsIntegral _integralSource il -> toExpression il
-    HsFractional fl -> toExpression fl
-    HsIsString _ str -> toExpression str
+record :: Parser Value
+record = Record <$> token Conid <* special "{" <*> fields <* special "}"
+  where
+    fields :: Parser [(Name, Value)]
+    fields = field `sepBy1` comma
 
-instance ToExpression FractionalLit where
-  toExpression fl = case fl_text fl of
-#if __GLASGOW_HASKELL__ > 802
-    REJECT(NoSourceText)
-    SourceText n
-#else
-    n
-#endif
-      -> return . Literal $ Rational n
+    field :: Parser (Name, Value)
+    field = (,) <$> token Varid <* equals <*> value
 
-instance ToExpression FastString where
-  toExpression = return . Literal . String . unpackFS
+constructor :: Parser Value
+constructor = Constructor <$> token Conid <*> many value
 
-instance ToExpression Integer where
-  toExpression = return . Literal . Integer
+tuple :: Parser Value
+tuple = Tuple <$> (special "(" *> items) <* special ")"
 
-instance ToExpression Char where
-  toExpression = return . Literal . Char
+list :: Parser Value
+list = List <$> (special "[" *> items) <* special "]"
 
-instance ToExpression (HsLit GhcPsHsLit) where
-  toExpression lit = case lit of
-    HsChar _ c -> toExpression c
-    HsString _ str -> toExpression str
-    REJECT(HsCharPrim)
-    REJECT(HsStringPrim)
-    REJECT(HsInt)
-    REJECT(HsIntPrim)
-    REJECT(HsWordPrim)
-    REJECT(HsInt64Prim)
-    REJECT(HsWord64Prim)
-    REJECT(HsInteger)
-    REJECT(HsRat)
-    REJECT(HsFloatPrim)
-    REJECT(HsDoublePrim)
-    X(XLit, fail "XLit")
+items :: Parser [Value]
+items = value `sepBy` comma
 
-showFieldLabel :: FieldOcc GhcPs -> String
-showFieldLabel label = case label of
-#if __GLASGOW_HASKELL__ >= 806
-  FieldOcc _ (L _ name) -> showRdrName name
-#else
-  FieldOcc (L _ name) _ -> showRdrName name
-#endif
-  X(XFieldOcc, "")
+special :: String -> Parser ()
+special s = require (Special, s)
 
-showRdrName :: RdrName -> String
-showRdrName n = case n of
-  Unqual name -> showOccName name
-  Qual _ name -> showOccName name
-  Orig _ name -> showOccName name
-  Exact name -> showOccName (nameOccName name)
+comma :: Parser ()
+comma = special ","
 
-showOccName :: OccName -> String
-showOccName = unpackFS . occNameFS
+equals :: Parser ()
+equals = require (Reservedop, "=")
 
-parse :: String -> Maybe (HsExpr GhcPs)
-parse input = case runParser input pHsExpr of
-  POk _ (L _ x) -> Just x
-  PFailed {} -> Nothing
-  where
-    pHsExpr = do
-      r <- GHC.parseExpression
-      runPV (unECP r)
+token :: Token -> Parser String
+token t = snd <$> satisfy (fst >>> (== t))
 
-#if __GLASGOW_HASKELL__ <= 900
-#if __GLASGOW_HASKELL__ >= 810
-    unECP = runECP_PV
-#else
-    unECP = return
-    runPV = id
-#endif
-#endif
+require :: (Token, String) -> Parser ()
+require t = void $ satisfy (== t)
 
-runParser :: String -> P a -> ParseResult a
-runParser str parser = unP parser parseState
+tokenize :: String -> [(Token, String)]
+tokenize = go . map (fmap snd) . rmSpace . lexerPass0
   where
-    location = mkRealSrcLoc "" 1 1
-    input = stringToStringBuffer str
-    parseState = initParserState opts input location
-    opts = mkParserOpts warn
-#if __GLASGOW_HASKELL__ >= 904
-      (DiagOpts mempty mempty False False Nothing defaultSDocContext)
-#endif
-      extensions False False False True
-
-#if __GLASGOW_HASKELL__ >= 804 && __GLASGOW_HASKELL__ < 904
-    warn = EnumSet.empty
-#else
-    warn = mempty
-#endif
-
-#if __GLASGOW_HASKELL__ >= 904
-    extensions = ["TraditionalRecordSyntax"]
-#elif __GLASGOW_HASKELL__ >= 804
-    extensions = EnumSet.fromList [TraditionalRecordSyntax]
-#else
-    extensions = mempty
-#endif
-
-#if __GLASGOW_HASKELL__ <= 900
-    initParserState = mkPStatePure
-    mkParserOpts warningFlags extensionFlags = mkParserFlags' warningFlags extensionFlags unit
-#if __GLASGOW_HASKELL__ == 900
-    unit = UnitId ""
-#else
-    unit = fsToUnitId ""
-#endif
-#endif
-
-#if __GLASGOW_HASKELL__ <= 806
-    mkParserFlags' ws es u _ _ _ _ = assert (traditionalRecordSyntaxEnabled extensionsBitmap) $
-      ParserFlags ws es u extensionsBitmap
-    extensionsBitmap = shift 1 traditionalRecordSyntaxBit
-#if __GLASGOW_HASKELL__ == 806
-    traditionalRecordSyntaxBit = 28
-#else
-    traditionalRecordSyntaxBit = 29
-#endif
-#endif
-
-#endif
+    go :: [(Token, String)] -> [(Token, String)]
+    go tokens = case tokens of
+      [] -> []
+      (Varsym, "-") : (IntLit, n) : xs -> (IntLit, "-" ++ n) : go xs
+      (Varsym, "-") : (FloatLit, n) : xs -> (FloatLit, "-" ++ n) : go xs
+      x : xs -> x : go xs
diff --git a/hspec-core/src/Test/Hspec/Core/Formatters/Pretty/Parser/Parser.hs b/hspec-core/src/Test/Hspec/Core/Formatters/Pretty/Parser/Parser.hs
new file mode 100644
--- /dev/null
+++ b/hspec-core/src/Test/Hspec/Core/Formatters/Pretty/Parser/Parser.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE DeriveFunctor #-}
+module Test.Hspec.Core.Formatters.Pretty.Parser.Parser where
+
+import           Prelude ()
+import           Test.Hspec.Core.Compat
+
+newtype Parser token a = Parser { runParser :: [token] -> Maybe (a, [token]) }
+  deriving Functor
+
+instance Applicative (Parser token) where
+  pure a = Parser $ \ input -> Just (a, input)
+  (<*>) = ap
+
+instance Monad (Parser token) where
+  return = pure
+  p1 >>= p2 = Parser $ runParser p1 >=> uncurry (runParser . p2)
+
+instance Alternative (Parser token) where
+  empty = Parser $ const Nothing
+  p1 <|> p2 = Parser $ \ input -> runParser p1 input <|> runParser p2 input
+
+satisfy :: (token -> Bool) -> Parser token token
+satisfy p = Parser $ \ input -> case input of
+  t : ts | p t -> Just (t, ts)
+  _ -> Nothing
+
+sepBy :: Alternative m => m a -> m sep -> m [a]
+sepBy p sep = sepBy1 p sep <|> pure []
+
+sepBy1 :: Alternative m => m a -> m sep -> m [a]
+sepBy1 p sep = (:) <$> p <*> many (sep *> p)
+
+readA :: (Alternative m, Read a) => String -> m a
+readA = maybe empty pure . readMaybe
diff --git a/hspec-core/src/Test/Hspec/Core/Formatters/Pretty/Parser/Types.hs b/hspec-core/src/Test/Hspec/Core/Formatters/Pretty/Parser/Types.hs
deleted file mode 100644
--- a/hspec-core/src/Test/Hspec/Core/Formatters/Pretty/Parser/Types.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-module Test.Hspec.Core.Formatters.Pretty.Parser.Types where
-
-import           Prelude ()
-import           Test.Hspec.Core.Compat
-
-data Expression =
-    Literal Literal
-  | Id String
-  | App Expression Expression
-  | Parentheses Expression
-  | Tuple [Expression]
-  | List [Expression]
-  | Record String [(String, Expression)]
-  deriving (Eq, Show)
-
-data Literal =
-    Char Char
-  | String String
-  | Integer Integer
-  | Rational String
-  deriving (Eq, Show)
diff --git a/hspec-core/src/Test/Hspec/Core/Formatters/V1.hs b/hspec-core/src/Test/Hspec/Core/Formatters/V1.hs
--- a/hspec-core/src/Test/Hspec/Core/Formatters/V1.hs
+++ b/hspec-core/src/Test/Hspec/Core/Formatters/V1.hs
@@ -1,12 +1,11 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE RecordWildCards #-}
 -- |
 -- Stability: deprecated
 --
 -- This module contains formatters that can be used with
 -- `Test.Hspec.Core.Runner.hspecWith`.
-module Test.Hspec.Core.Formatters.V1 (
-
+module Test.Hspec.Core.Formatters.V1
+{-# DEPRECATED "Use [Test.Hspec.Api.Formatters.V1](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Formatters-V1.html) instead." #-}
+(
 -- * Formatters
   silent
 , checks
@@ -60,290 +59,4 @@
 ) where
 
 import           Prelude ()
-import           Test.Hspec.Core.Compat hiding (First)
-
-import           Data.Maybe
-import           Test.Hspec.Core.Util
-import           Test.Hspec.Core.Clock
-import           Test.Hspec.Core.Example (Location(..))
-import           Text.Printf
-import           Control.Monad.IO.Class
-import           Control.Exception
-
--- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make
--- sure, that we only use the public API to implement formatters.
---
--- Everything imported here has to be re-exported, so that users can implement
--- their own formatters.
-import Test.Hspec.Core.Formatters.V1.Monad (
-    Formatter(..)
-  , FailureReason(..)
-  , FormatM
-
-  , getSuccessCount
-  , getPendingCount
-  , getFailCount
-  , getTotalCount
-
-  , FailureRecord(..)
-  , getFailMessages
-  , usedSeed
-
-  , getCPUTime
-  , getRealTime
-
-  , write
-  , writeLine
-  , writeTransient
-
-  , withInfoColor
-  , withSuccessColor
-  , withPendingColor
-  , withFailColor
-
-  , useDiff
-  , extraChunk
-  , missingChunk
-  )
-
-import           Test.Hspec.Core.Format (FormatConfig, Format)
-
-import           Test.Hspec.Core.Formatters.Diff
-import qualified Test.Hspec.Core.Formatters.V2 as V2
-import           Test.Hspec.Core.Formatters.V1.Monad (Item(..), Result(..), Environment(..), interpretWith)
-
-formatterToFormat :: Formatter -> FormatConfig -> IO Format
-formatterToFormat = V2.formatterToFormat . legacyFormatterToFormatter
-
-legacyFormatterToFormatter :: Formatter -> V2.Formatter
-legacyFormatterToFormatter Formatter{..} = V2.Formatter {
-  V2.formatterStarted = interpret headerFormatter
-, V2.formatterGroupStarted = interpret . uncurry exampleGroupStarted
-, V2.formatterGroupDone = interpret . const exampleGroupDone
-, V2.formatterProgress = \ path -> interpret . exampleProgress path
-, V2.formatterItemStarted = interpret . exampleStarted
-, V2.formatterItemDone = \ path item -> interpret $ do
-    case itemResult item of
-      Success -> exampleSucceeded path (itemInfo item)
-      Pending _ reason -> examplePending path (itemInfo item) reason
-      Failure _ reason -> exampleFailed path (itemInfo item) reason
-, V2.formatterDone = interpret $ failedFormatter >> footerFormatter
-}
-
-interpret :: FormatM a -> V2.FormatM a
-interpret = interpretWith Environment {
-  environmentGetSuccessCount = V2.getSuccessCount
-, environmentGetPendingCount = V2.getPendingCount
-, environmentGetFailMessages = V2.getFailMessages
-, environmentUsedSeed = V2.usedSeed
-, environmentPrintTimes = V2.printTimes
-, environmentGetCPUTime = V2.getCPUTime
-, environmentGetRealTime = V2.getRealTime
-, environmentWrite = V2.write
-, environmentWriteTransient = V2.writeTransient
-, environmentWithFailColor = V2.withFailColor
-, environmentWithSuccessColor = V2.withSuccessColor
-, environmentWithPendingColor = V2.withPendingColor
-, environmentWithInfoColor = V2.withInfoColor
-, environmentUseDiff = V2.useDiff
-, environmentExtraChunk = V2.extraChunk
-, environmentMissingChunk = V2.missingChunk
-, environmentLiftIO = liftIO
-}
-
-silent :: Formatter
-silent = Formatter {
-  headerFormatter     = return ()
-, exampleGroupStarted = \_ _ -> return ()
-, exampleGroupDone    = return ()
-, exampleStarted      = \_ -> return ()
-, exampleProgress     = \_ _ -> return ()
-, exampleSucceeded    = \ _ _ -> return ()
-, exampleFailed       = \_ _ _ -> return ()
-, examplePending      = \_ _ _ -> return ()
-, failedFormatter     = return ()
-, footerFormatter     = return ()
-}
-
-checks :: Formatter
-checks = specdoc {
-  exampleStarted = \(nesting, requirement) -> do
-    writeTransient $ indentationFor nesting ++ requirement ++ " [ ]"
-
-, exampleProgress = \(nesting, requirement) p -> do
-    writeTransient $ indentationFor nesting ++ requirement ++ " [" ++ (formatProgress p) ++ "]"
-
-, exampleSucceeded = \(nesting, requirement) info -> do
-    writeResult nesting requirement info $ withSuccessColor $ write "✔"
-
-, exampleFailed = \(nesting, requirement) info _ -> do
-    writeResult nesting requirement info $ withFailColor $ write "✘"
-
-, examplePending = \(nesting, requirement) info reason -> do
-    writeResult nesting requirement info $ withPendingColor $ write "‐"
-
-    withPendingColor $ do
-      writeLine $ indentationFor ("" : nesting) ++ "# PENDING: " ++ fromMaybe "No reason given" reason
-} where
-    indentationFor nesting = replicate (length nesting * 2) ' '
-
-    writeResult :: [String] -> String -> String -> FormatM () -> FormatM ()
-    writeResult nesting requirement info action = do
-      write $ indentationFor nesting ++ requirement ++ " ["
-      action
-      writeLine "]"
-      forM_ (lines info) $ \ s ->
-        writeLine $ indentationFor ("" : nesting) ++ s
-
-    formatProgress (current, total)
-      | total == 0 = show current
-      | otherwise  = show current ++ "/" ++ show total
-
-specdoc :: Formatter
-specdoc = silent {
-
-  headerFormatter = do
-    writeLine ""
-
-, exampleGroupStarted = \nesting name -> do
-    writeLine (indentationFor nesting ++ name)
-
-, exampleProgress = \_ p -> do
-    writeTransient (formatProgress p)
-
-, exampleSucceeded = \(nesting, requirement) info -> withSuccessColor $ do
-    writeLine $ indentationFor nesting ++ requirement
-    forM_ (lines info) $ \ s ->
-      writeLine $ indentationFor ("" : nesting) ++ s
-
-, 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) 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
-
-, footerFormatter = defaultFooter
-} where
-    indentationFor nesting = replicate (length nesting * 2) ' '
-    formatProgress (current, total)
-      | total == 0 = show current
-      | otherwise  = show current ++ "/" ++ show total
-
-
-progress :: Formatter
-progress = silent {
-  exampleSucceeded = \_ _ -> withSuccessColor $ write "."
-, exampleFailed    = \_ _ _ -> withFailColor    $ write "F"
-, examplePending   = \_ _ _ -> withPendingColor $ write "."
-, failedFormatter  = defaultFailedFormatter
-, footerFormatter  = defaultFooter
-}
-
-
-failed_examples :: Formatter
-failed_examples   = silent {
-  failedFormatter = defaultFailedFormatter
-, footerFormatter = defaultFooter
-}
-
-defaultFailedFormatter :: FormatM ()
-defaultFailedFormatter = do
-  writeLine ""
-
-  failures <- getFailMessages
-
-  unless (null failures) $ do
-    writeLine "Failures:"
-    writeLine ""
-
-    forM_ (zip [1..] failures) $ \x -> do
-      formatFailure x
-      writeLine ""
-
-    write "Randomized with seed " >> usedSeed >>= writeLine . show
-    writeLine ""
-  where
-    formatFailure :: (Int, FailureRecord) -> FormatM ()
-    formatFailure (n, FailureRecord mLoc path reason) = do
-      forM_ mLoc $ \loc -> do
-        withInfoColor $ writeLine (formatLoc loc)
-      write ("  " ++ show n ++ ") ")
-      writeLine (formatRequirement path)
-      case reason of
-        NoReason -> return ()
-        Reason err -> withFailColor $ indent err
-        ExpectedButGot preface expected actual -> do
-          mapM_ indent preface
-
-          b <- useDiff
-
-          let threshold = 2 :: Seconds
-
-          mchunks <- liftIO $ if b
-            then timeout threshold (evaluate $ diff expected actual)
-            else return Nothing
-
-          case mchunks of
-            Just chunks -> do
-              writeDiff chunks extraChunk missingChunk
-            Nothing -> do
-              writeDiff [First expected, Second actual] write write
-          where
-            indented output text = case break (== '\n') text of
-              (xs, "") -> output xs
-              (xs, _ : ys) -> output (xs ++ "\n") >> write (indentation ++ "          ") >> indented output ys
-
-            writeDiff chunks extra missing = do
-              withFailColor $ write (indentation ++ "expected: ")
-              forM_ chunks $ \ chunk -> case chunk of
-                Both a -> indented write a
-                First a -> indented extra a
-                Second _ -> return ()
-              writeLine ""
-
-              withFailColor $ write (indentation ++ " but got: ")
-              forM_ chunks $ \ chunk -> case chunk of
-                Both a -> indented write a
-                First _ -> return ()
-                Second a -> indented missing a
-              writeLine ""
-
-        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) = "  " ++ file ++ ":" ++ show line ++ ":" ++ show column ++ ": "
-
-defaultFooter :: FormatM ()
-defaultFooter = do
-
-  writeLine =<< (++)
-    <$> (printf "Finished in %1.4f seconds" <$> getRealTime)
-    <*> (maybe "" (printf ", used %1.4f seconds of CPU time") <$> getCPUTime)
-
-  fails   <- getFailCount
-  pending <- getPendingCount
-  total   <- getTotalCount
-
-  let
-    output =
-         pluralize total   "example"
-      ++ ", " ++ pluralize fails "failure"
-      ++ if pending == 0 then "" else ", " ++ show pending ++ " pending"
-    c | fails /= 0   = withFailColor
-      | pending /= 0 = withPendingColor
-      | otherwise    = withSuccessColor
-  c $ writeLine output
+import           Test.Hspec.Core.Formatters.V1.Internal
diff --git a/hspec-core/src/Test/Hspec/Core/Formatters/V1/Internal.hs b/hspec-core/src/Test/Hspec/Core/Formatters/V1/Internal.hs
new file mode 100644
--- /dev/null
+++ b/hspec-core/src/Test/Hspec/Core/Formatters/V1/Internal.hs
@@ -0,0 +1,359 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE LambdaCase #-}
+module Test.Hspec.Core.Formatters.V1.Internal (
+-- * Formatters
+  silent
+, checks
+, specdoc
+, progress
+, failed_examples
+
+-- * Implementing a custom Formatter
+-- |
+-- A formatter is a set of actions.  Each action is evaluated when a certain
+-- situation is encountered during a test run.
+--
+-- Actions live in the `FormatM` monad.  It provides access to the runner state
+-- and primitives for appending to the generated report.
+, Formatter (..)
+, FailureReason (..)
+, FormatM
+, formatterToFormat
+
+-- ** Accessing the runner state
+, getSuccessCount
+, getPendingCount
+, getFailCount
+, getTotalCount
+
+, FailureRecord (..)
+, getFailMessages
+, usedSeed
+
+, Seconds(..)
+, getCPUTime
+, getRealTime
+
+-- ** Appending to the generated report
+, write
+, writeLine
+, writeTransient
+
+-- ** Dealing with colors
+, withInfoColor
+, withSuccessColor
+, withPendingColor
+, withFailColor
+
+, useDiff
+, extraChunk
+, missingChunk
+
+-- ** Helpers
+, formatException
+) where
+
+import           Prelude ()
+import           Test.Hspec.Core.Compat hiding (First)
+
+import           Test.Hspec.Core.Util
+import           Test.Hspec.Core.Clock
+import           Test.Hspec.Core.Example (Location(..))
+import           Text.Printf
+import           Control.Monad.IO.Class
+
+-- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make
+-- sure, that we only use the public API to implement formatters.
+--
+-- Everything imported here has to be re-exported, so that users can implement
+-- their own formatters.
+import Test.Hspec.Core.Formatters.V1.Monad (
+    Formatter(..)
+  , FailureReason(..)
+  , FormatM
+
+  , getSuccessCount
+  , getPendingCount
+  , getFailCount
+  , getTotalCount
+
+  , FailureRecord(..)
+  , getFailMessages
+  , usedSeed
+
+  , getCPUTime
+  , getRealTime
+
+  , write
+  , writeLine
+  , writeTransient
+
+  , withInfoColor
+  , withSuccessColor
+  , withPendingColor
+  , withFailColor
+
+  , useDiff
+  , extraChunk
+  , missingChunk
+  )
+
+import           Test.Hspec.Core.Format (FormatConfig, Format)
+
+import           Test.Hspec.Core.Formatters.Diff
+import qualified Test.Hspec.Core.Formatters.V2 as V2
+import           Test.Hspec.Core.Formatters.V1.Monad (Item(..), Result(..), Environment(..), interpretWith)
+
+formatterToFormat :: Formatter -> FormatConfig -> IO Format
+formatterToFormat = V2.formatterToFormat . legacyFormatterToFormatter
+
+legacyFormatterToFormatter :: Formatter -> V2.Formatter
+legacyFormatterToFormatter Formatter{..} = V2.Formatter {
+  V2.formatterStarted = interpret headerFormatter
+, V2.formatterGroupStarted = interpret . uncurry exampleGroupStarted
+, V2.formatterGroupDone = interpret . const exampleGroupDone
+, V2.formatterProgress = \ path -> interpret . exampleProgress path
+, V2.formatterItemStarted = interpret . exampleStarted
+, V2.formatterItemDone = \ path item -> interpret $ do
+    case itemResult item of
+      Success -> exampleSucceeded path (itemInfo item)
+      Pending _ reason -> examplePending path (itemInfo item) reason
+      Failure _ reason -> exampleFailed path (itemInfo item) (unliftFailureReason reason)
+, V2.formatterDone = interpret $ failedFormatter >> footerFormatter
+}
+
+unliftFailureRecord :: V2.FailureRecord -> FailureRecord
+unliftFailureRecord V2.FailureRecord{..} = FailureRecord {
+  failureRecordLocation
+, failureRecordPath
+, failureRecordMessage = unliftFailureReason failureRecordMessage
+}
+
+unliftFailureReason :: V2.FailureReason -> FailureReason
+unliftFailureReason = \ case
+  V2.NoReason -> NoReason
+  V2.Reason reason -> Reason reason
+  V2.ColorizedReason reason -> Reason (stripAnsi reason)
+  V2.ExpectedButGot preface expected actual -> ExpectedButGot preface expected actual
+  V2.Error info e -> Error info e
+
+interpret :: FormatM a -> V2.FormatM a
+interpret = interpretWith Environment {
+  environmentGetSuccessCount = V2.getSuccessCount
+, environmentGetPendingCount = V2.getPendingCount
+, environmentGetFailMessages = map unliftFailureRecord <$> V2.getFailMessages
+, environmentUsedSeed = V2.usedSeed
+, environmentPrintTimes = V2.printTimes
+, environmentGetCPUTime = V2.getCPUTime
+, environmentGetRealTime = V2.getRealTime
+, environmentWrite = V2.write
+, environmentWriteTransient = V2.writeTransient
+, environmentWithFailColor = V2.withFailColor
+, environmentWithSuccessColor = V2.withSuccessColor
+, environmentWithPendingColor = V2.withPendingColor
+, environmentWithInfoColor = V2.withInfoColor
+, environmentUseDiff = V2.useDiff
+, environmentExtraChunk = V2.extraChunk
+, environmentMissingChunk = V2.missingChunk
+, environmentLiftIO = liftIO
+}
+
+silent :: Formatter
+silent = Formatter {
+  headerFormatter     = pass
+, exampleGroupStarted = \_ _ -> pass
+, exampleGroupDone    = pass
+, exampleStarted      = \_ -> pass
+, exampleProgress     = \_ _ -> pass
+, exampleSucceeded    = \ _ _ -> pass
+, exampleFailed       = \_ _ _ -> pass
+, examplePending      = \_ _ _ -> pass
+, failedFormatter     = pass
+, footerFormatter     = pass
+}
+
+checks :: Formatter
+checks = specdoc {
+  exampleStarted = \(nesting, requirement) -> do
+    writeTransient $ indentationFor nesting ++ requirement ++ " [ ]"
+
+, exampleProgress = \(nesting, requirement) p -> do
+    writeTransient $ indentationFor nesting ++ requirement ++ " [" ++ (formatProgress p) ++ "]"
+
+, exampleSucceeded = \(nesting, requirement) info -> do
+    writeResult nesting requirement info $ withSuccessColor $ write "✔"
+
+, exampleFailed = \(nesting, requirement) info _ -> do
+    writeResult nesting requirement info $ withFailColor $ write "✘"
+
+, examplePending = \(nesting, requirement) info reason -> do
+    writeResult nesting requirement info $ withPendingColor $ write "‐"
+
+    withPendingColor $ do
+      writeLine $ indentationFor ("" : nesting) ++ "# PENDING: " ++ fromMaybe "No reason given" reason
+} where
+    indentationFor nesting = replicate (length nesting * 2) ' '
+
+    writeResult :: [String] -> String -> String -> FormatM () -> FormatM ()
+    writeResult nesting requirement info action = do
+      write $ indentationFor nesting ++ requirement ++ " ["
+      action
+      writeLine "]"
+      forM_ (lines info) $ \ s ->
+        writeLine $ indentationFor ("" : nesting) ++ s
+
+    formatProgress (current, total)
+      | total == 0 = show current
+      | otherwise  = show current ++ "/" ++ show total
+
+specdoc :: Formatter
+specdoc = silent {
+
+  headerFormatter = do
+    writeLine ""
+
+, exampleGroupStarted = \nesting name -> do
+    writeLine (indentationFor nesting ++ name)
+
+, exampleProgress = \_ p -> do
+    writeTransient (formatProgress p)
+
+, exampleSucceeded = \(nesting, requirement) info -> withSuccessColor $ do
+    writeLine $ indentationFor nesting ++ requirement
+    forM_ (lines info) $ \ s ->
+      writeLine $ indentationFor ("" : nesting) ++ s
+
+, 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) 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
+
+, footerFormatter = defaultFooter
+} where
+    indentationFor nesting = replicate (length nesting * 2) ' '
+    formatProgress (current, total)
+      | total == 0 = show current
+      | otherwise  = show current ++ "/" ++ show total
+
+
+progress :: Formatter
+progress = silent {
+  exampleSucceeded = \_ _ -> withSuccessColor $ write "."
+, exampleFailed    = \_ _ _ -> withFailColor    $ write "F"
+, examplePending   = \_ _ _ -> withPendingColor $ write "."
+, failedFormatter  = defaultFailedFormatter
+, footerFormatter  = defaultFooter
+}
+
+
+failed_examples :: Formatter
+failed_examples   = silent {
+  failedFormatter = defaultFailedFormatter
+, footerFormatter = defaultFooter
+}
+
+defaultFailedFormatter :: FormatM ()
+defaultFailedFormatter = do
+  writeLine ""
+
+  failures <- getFailMessages
+
+  unless (null failures) $ do
+    writeLine "Failures:"
+    writeLine ""
+
+    forM_ (zip [1..] failures) $ \x -> do
+      formatFailure x
+      writeLine ""
+
+    write "Randomized with seed " >> usedSeed >>= writeLine . show
+    writeLine ""
+  where
+    formatFailure :: (Int, FailureRecord) -> FormatM ()
+    formatFailure (n, FailureRecord mLoc path reason) = do
+      forM_ mLoc $ \loc -> do
+        withInfoColor $ writeLine (formatLoc loc)
+      write ("  " ++ show n ++ ") ")
+      writeLine (formatRequirement path)
+      case reason of
+        NoReason -> pass
+        Reason err -> withFailColor $ indent err
+        ExpectedButGot preface expected actual -> do
+          mapM_ indent preface
+
+          b <- useDiff
+
+          let threshold = 2 :: Seconds
+
+          mchunks <- liftIO $ if b
+            then timeout threshold (evaluate $ diff Nothing expected actual)
+            else return Nothing
+
+          case mchunks of
+            Just chunks -> do
+              writeDiff chunks extraChunk missingChunk
+            Nothing -> do
+              writeDiff [First expected, Second actual] write write
+          where
+            indented output text = case break (== '\n') text of
+              (xs, "") -> output xs
+              (xs, _ : ys) -> output (xs ++ "\n") >> write (indentation ++ "          ") >> indented output ys
+
+            writeDiff chunks extra missing = do
+              withFailColor $ write (indentation ++ "expected: ")
+              forM_ chunks $ \ case
+                Both a -> indented write a
+                First a -> indented extra a
+                Second _ -> pass
+                Omitted _ -> pass
+              writeLine ""
+
+              withFailColor $ write (indentation ++ " but got: ")
+              forM_ chunks $ \ case
+                Both a -> indented write a
+                First _ -> pass
+                Second a -> indented missing a
+                Omitted _ -> pass
+              writeLine ""
+
+        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) = "  " ++ file ++ ":" ++ show line ++ ":" ++ show column ++ ": "
+
+defaultFooter :: FormatM ()
+defaultFooter = do
+
+  writeLine =<< (++)
+    <$> (printf "Finished in %1.4f seconds" <$> getRealTime)
+    <*> (maybe "" (printf ", used %1.4f seconds of CPU time") <$> getCPUTime)
+
+  fails   <- getFailCount
+  pending <- getPendingCount
+  total   <- getTotalCount
+
+  let
+    output =
+         pluralize total   "example"
+      ++ ", " ++ pluralize fails "failure"
+      ++ if pending == 0 then "" else ", " ++ show pending ++ " pending"
+    c | fails /= 0   = withFailColor
+      | pending /= 0 = withPendingColor
+      | otherwise    = withSuccessColor
+  c $ writeLine output
diff --git a/hspec-core/src/Test/Hspec/Core/Formatters/V1/Monad.hs b/hspec-core/src/Test/Hspec/Core/Formatters/V1/Monad.hs
--- a/hspec-core/src/Test/Hspec/Core/Formatters/V1/Monad.hs
+++ b/hspec-core/src/Test/Hspec/Core/Formatters/V1/Monad.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE ExistentialQuantification #-}
 module Test.Hspec.Core.Formatters.V1.Monad (
   Formatter(..)
@@ -48,7 +47,14 @@
 
 import           Test.Hspec.Core.Formatters.V1.Free
 import           Test.Hspec.Core.Clock
-import           Test.Hspec.Core.Format
+import           Test.Hspec.Core.Format hiding (FailureReason)
+
+data FailureReason =
+    NoReason
+  | Reason String
+  | ExpectedButGot (Maybe String) String String
+  | Error (Maybe String) SomeException
+  deriving Show
 
 data Formatter = Formatter {
 
diff --git a/hspec-core/src/Test/Hspec/Core/Formatters/V2.hs b/hspec-core/src/Test/Hspec/Core/Formatters/V2.hs
--- a/hspec-core/src/Test/Hspec/Core/Formatters/V2.hs
+++ b/hspec-core/src/Test/Hspec/Core/Formatters/V2.hs
@@ -1,11 +1,14 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
 -- |
--- Stability: experimental
+-- Stability: unstable
 --
--- This module contains formatters that can be used with
--- `Test.Hspec.Core.Runner.hspecWith`.
-module Test.Hspec.Core.Formatters.V2 (
-
+-- This is an unstable API.  Use
+-- [Test.Hspec.Api.Formatters.V3](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Formatters-V3.html)
+-- instead.
+module Test.Hspec.Core.Formatters.V2
+-- {-# WARNING "Use [Test.Hspec.Api.Formatters.V3](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Formatters-V3.html) instead." #-}
+(
 -- * Formatters
   silent
 , checks
@@ -21,6 +24,9 @@
 -- Actions live in the `FormatM` monad.  It provides access to the runner state
 -- and primitives for appending to the generated report.
 , Formatter (..)
+, Path
+, Progress
+, Location(..)
 , Item(..)
 , Result(..)
 , FailureReason (..)
@@ -58,11 +64,16 @@
 , outputUnicode
 
 , useDiff
+, diffContext
+, externalDiffAction
 , prettyPrint
 , prettyPrintFunction
 , extraChunk
 , missingChunk
 
+-- ** expert mode
+, unlessExpert
+
 -- ** Helpers
 , formatLocation
 , formatException
@@ -76,16 +87,15 @@
 
 import           Prelude ()
 import           Test.Hspec.Core.Compat hiding (First)
+import           System.IO (hFlush, stdout)
 
 import           Data.Char
-import           Data.Maybe
 import           Test.Hspec.Core.Util
 import           Test.Hspec.Core.Clock
-import           Test.Hspec.Core.Example (Location(..))
+import           Test.Hspec.Core.Example (Location(..), Progress)
 import           Text.Printf
 import           Test.Hspec.Core.Formatters.Pretty.Unicode (ushow)
 import           Control.Monad.IO.Class
-import           Control.Exception
 
 -- We use an explicit import list for "Test.Hspec.Formatters.Monad", to make
 -- sure, that we only use the public API to implement formatters.
@@ -126,29 +136,33 @@
   , outputUnicode
 
   , useDiff
+  , diffContext
+  , externalDiffAction
   , prettyPrint
   , prettyPrintFunction
   , extraChunk
   , missingChunk
+
+  , unlessExpert
   )
 
 import           Test.Hspec.Core.Formatters.Diff
 
 silent :: Formatter
 silent = Formatter {
-  formatterStarted      = return ()
-, formatterGroupStarted = \ _ -> return ()
-, formatterGroupDone    = \ _ -> return ()
-, formatterProgress     = \ _ _ -> return ()
-, formatterItemStarted  = \ _ -> return ()
-, formatterItemDone     = \ _ _ -> return ()
-, formatterDone         = return ()
+  formatterStarted      = pass
+, formatterGroupStarted = \ _ -> pass
+, formatterGroupDone    = \ _ -> pass
+, formatterProgress     = \ _ _ -> pass
+, formatterItemStarted  = \ _ -> pass
+, formatterItemDone     = \ _ _ -> pass
+, formatterDone         = pass
 }
 
 checks :: Formatter
 checks = specdoc {
   formatterProgress = \(nesting, requirement) p -> do
-    writeTransient $ indentationFor nesting ++ requirement ++ " [" ++ (formatProgress p) ++ "]"
+    writeTransient $ indentationFor nesting ++ requirement ++ " [" ++ formatProgress p ++ "]"
 
 , formatterItemStarted = \(nesting, requirement) -> do
     writeTransient $ indentationFor nesting ++ requirement ++ " [ ]"
@@ -161,8 +175,8 @@
       Pending {} -> (withPendingColor, fallback "‐" "-")
       Failure {} -> (withFailColor,    fallback "✘" "x")
     case itemResult item of
-      Success {} -> return ()
-      Failure {} -> return ()
+      Success {} -> pass
+      Failure {} -> pass
       Pending _ reason -> withPendingColor $ do
         writeLine $ indentationFor ("" : nesting) ++ "# PENDING: " ++ fromMaybe "No reason given" reason
 } where
@@ -237,10 +251,12 @@
 
 progress :: Formatter
 progress = failed_examples {
-  formatterItemDone = \ _ item -> case itemResult item of
-    Success{} -> withSuccessColor $ write "."
-    Pending{} -> withPendingColor $ write "."
-    Failure{} -> withFailColor $ write "F"
+  formatterItemDone = \ _ item -> do
+    case itemResult item of
+      Success{} -> withSuccessColor $ write "."
+      Pending{} -> withPendingColor $ write "."
+      Failure{} -> withFailColor $ write "F"
+    liftIO $ hFlush stdout
 }
 
 failed_examples :: Formatter
@@ -273,8 +289,9 @@
       write ("  " ++ show n ++ ") ")
       writeLine (formatRequirement path)
       case reason of
-        NoReason -> return ()
+        NoReason -> pass
         Reason err -> withFailColor $ indent err
+        ColorizedReason err -> indent err
         ExpectedButGot preface expected_ actual_ -> do
           pretty <- prettyPrintFunction
           let
@@ -288,15 +305,24 @@
 
           let threshold = 2 :: Seconds
 
-          mchunks <- liftIO $ if b
-            then timeout threshold (evaluate $ diff expected actual)
-            else return Nothing
 
-          case mchunks of
-            Just chunks -> do
-              writeDiff chunks extraChunk missingChunk
+          mExternalDiff <- externalDiffAction
+
+          case mExternalDiff of
+            Just externalDiff -> do
+              liftIO $ externalDiff expected actual
+
             Nothing -> do
-              writeDiff [First expected, Second actual] write write
+              context <- diffContext
+              mchunks <- liftIO $ if b
+                then timeout threshold (evaluate $ diff context expected actual)
+                else return Nothing
+
+              case mchunks of
+                Just chunks -> do
+                  writeDiff chunks extraChunk missingChunk
+                Nothing -> do
+                  writeDiff [First expected, Second actual] write write
           where
             writeDiff chunks extra missing = do
               writeChunks "expected: " (expectedChunks chunks) extra
@@ -305,9 +331,10 @@
             writeChunks :: String -> [Chunk] -> (String -> FormatM ()) -> FormatM ()
             writeChunks pre chunks colorize = do
               withFailColor $ write (indentation ++ pre)
-              forM_ (indentChunks indentation_ chunks) $ \ chunk -> case chunk of
+              forM_ (indentChunks indentation_ chunks) $ \ case
                 PlainChunk a -> write a
                 ColorChunk a -> colorize a
+                Informational a -> withInfoColor $ write a
               writeLine ""
               where
                 indentation_ = indentation ++ replicate (length pre) ' '
@@ -316,39 +343,65 @@
           mapM_ indent info
           withFailColor . indent $ "uncaught exception: " ++ formatException e
 
-      writeLine ""
 
-      let path_ = (if unicode then ushow else show) (joinPath path)
-      writeLine ("  To rerun use: --match " ++ path_)
+      unlessExpert $ do
+        let path_ = (if unicode then ushow else show) (joinPath path)
+        writeLine ""
+        writeLine ("  To rerun use: --match " ++ path_)
       where
         indentation = "       "
         indent message = do
           forM_ (lines message) $ \line -> do
             writeLine (indentation ++ line)
 
-data Chunk = Original String | Modified String
+data Chunk = Original String | Modified String | OmittedLines Int
   deriving (Eq, Show)
 
 expectedChunks :: [Diff] -> [Chunk]
-expectedChunks = mapMaybe $ \ chunk -> case chunk of
+expectedChunks = mapMaybe $ \ case
   Both a -> Just $ Original a
   First a -> Just $ Modified a
   Second _ -> Nothing
+  Omitted n -> Just $ OmittedLines n
 
 actualChunks :: [Diff] -> [Chunk]
-actualChunks = mapMaybe $ \ chunk -> case chunk of
+actualChunks = mapMaybe $ \ case
   Both a -> Just $ Original a
   First _ -> Nothing
   Second a -> Just $ Modified a
+  Omitted n -> Just $ OmittedLines n
 
-data ColorChunk = PlainChunk String | ColorChunk String
+data ColorChunk = PlainChunk String | ColorChunk String | Informational String
   deriving (Eq, Show)
 
+data StartsWith = StartsWithNewline | StartsWithNonNewline
+  deriving Eq
+
 indentChunks :: String -> [Chunk] -> [ColorChunk]
-indentChunks indentation = concatMap $ \ chunk -> case chunk of
-  Original y -> [indentOriginal indentation y]
-  Modified y -> indentModified indentation y
+indentChunks indentation = go
+  where
+    go :: [Chunk] -> [ColorChunk]
+    go = \ case
+      Original x : xs -> indentOriginal indentation x : go xs
+      Modified x : xs -> indentModified (startsWith xs) indentation x ++ go xs
+      OmittedLines n : xs -> Informational (formatOmittedLines n) : go xs
+      [] -> []
 
+    startsWith :: [Chunk] -> StartsWith
+    startsWith xs
+      | all isSpace (takeWhile (/= '\n') $ unChunks xs) = StartsWithNewline
+      | otherwise = StartsWithNonNewline
+
+    unChunks :: [Chunk] -> String
+    unChunks = \ case
+      Original x : xs -> x ++ unChunks xs
+      Modified x : xs -> x ++ unChunks xs
+      OmittedLines {} : _ -> ""
+      [] -> ""
+
+    formatOmittedLines :: Int -> String
+    formatOmittedLines n = "@@ " <> show n <> " lines omitted @@\n" <> indentation
+
 indentOriginal :: String -> String -> ColorChunk
 indentOriginal indentation = PlainChunk . go
   where
@@ -356,18 +409,21 @@
       (xs, _ : ys) -> xs ++ "\n" ++ indentation ++ go ys
       (xs, "") -> xs
 
-indentModified :: String -> String -> [ColorChunk]
-indentModified indentation = go
+indentModified :: StartsWith -> String -> String -> [ColorChunk]
+indentModified nextChunk indentation = go
   where
-    go text = case text of
+    go :: String -> [ColorChunk]
+    go = \ case
+      "" -> []
       "\n" -> [PlainChunk "\n", ColorChunk indentation]
       '\n' : ys@('\n' : _) -> PlainChunk "\n" : ColorChunk indentation : go ys
-      _ -> case break (== '\n') text of
-        (xs, _ : ys) -> segment xs ++ PlainChunk ('\n' : indentation) : go ys
-        (xs, "") -> segment xs
+      '\n' : xs -> PlainChunk ('\n' : indentation) : go xs
+      text -> case break (== '\n') text of
+        (xs, "") | nextChunk == StartsWithNonNewline -> [ColorChunk xs]
+        (xs, ys) -> segment xs ++ go ys
 
+    segment :: String -> [ColorChunk]
     segment xs = case span isSpace $ reverse xs of
-      ("", "") -> []
       ("", _) -> [ColorChunk xs]
       (_, "") -> [ColorChunk xs]
       (ys, zs) -> [ColorChunk (reverse zs), ColorChunk (reverse ys)]
@@ -388,10 +444,12 @@
          pluralize total   "example"
       ++ ", " ++ pluralize fails "failure"
       ++ if pending == 0 then "" else ", " ++ show pending ++ " pending"
-    c | fails /= 0   = withFailColor
+
+    color
+      | fails /= 0   = withFailColor
       | pending /= 0 = withPendingColor
       | otherwise    = withSuccessColor
-  c $ writeLine output
+  color $ writeLine output
 
 formatLocation :: Location -> String
 formatLocation (Location file line column) = file ++ ":" ++ show line ++ ":" ++ show column ++ ": "
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
@@ -4,7 +4,12 @@
 {-# LANGUAGE ConstraintKinds #-}
 -- | Stability: provisional
 module Test.Hspec.Core.Hooks (
-  before
+-- * Types
+  Spec
+, SpecWith
+, ActionWith
+-- * Hooks
+, before
 , before_
 , beforeWith
 , beforeAll
@@ -31,9 +36,7 @@
 
 import           Prelude ()
 import           Test.Hspec.Core.Compat
-import           Data.CallStack (HasCallStack)
 
-import           Control.Exception (SomeException, finally, throwIO, try)
 import           Control.Concurrent
 
 import           Test.Hspec.Core.Example
@@ -111,11 +114,12 @@
 
 -- | Run a custom action before and/or after every spec item.
 aroundWith :: (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
-aroundWith = mapSpecItem_ . modifyAroundAction
+aroundWith = mapSpecItem_ . modifyHook
 
-modifyAroundAction :: (ActionWith a -> ActionWith b) -> Item a -> Item b
-modifyAroundAction action item@Item{itemExample = e} =
-  item{ itemExample = \params aroundAction -> e params (aroundAction . action) }
+modifyHook :: (ActionWith a -> ActionWith b) -> Item a -> Item b
+modifyHook action item = item {
+    itemExample = \ params hook -> itemExample item params (hook . action)
+  }
 
 -- | Wrap an action around the given spec.
 aroundAll :: HasCallStack => (ActionWith a -> IO ()) -> SpecWith a -> Spec
@@ -178,7 +182,7 @@
         signal doCleanupNow
         r <- takeMVar released
         case r of
-          Released -> return ()
+          Released -> pass
           ExceptionDuringRelease err -> throwIO err
 
   return (acquire, release)
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,11 +1,27 @@
 {-# LANGUAGE RecordWildCards #-}
-module Test.Hspec.Core.QuickCheckUtil where
+{-# LANGUAGE CPP #-}
+module Test.Hspec.Core.QuickCheckUtil (
+  liftHook
+, aroundProperty
 
+, QuickCheckResult(..)
+, Status(..)
+, QuickCheckFailure(..)
+, parseQuickCheckResult
+
+, formatNumbers
+
+, mkGen
+, newSeed
+#ifdef TEST
+, stripSuffix
+, splitBy
+#endif
+) where
+
 import           Prelude ()
 import           Test.Hspec.Core.Compat
 
-import           Control.Exception
-import           Data.Maybe
 import           Data.Int
 import           System.Random
 
@@ -21,17 +37,21 @@
 
 import           Test.Hspec.Core.Util
 
+liftHook :: r -> ((a -> IO ()) -> IO ()) -> (a -> IO r) -> IO r
+liftHook def hook inner = do
+  ref <- newIORef def
+  hook $ inner >=> writeIORef ref
+  readIORef ref
+
 aroundProperty :: ((a -> IO ()) -> IO ()) -> (a -> Property) -> Property
-aroundProperty action p = MkProperty . MkGen $ \r n -> aroundProp action $ \a -> (unGen . unProperty $ p a) r n
+aroundProperty hook p = MkProperty . MkGen $ \r n -> aroundProp hook $ \a -> (unGen . unProperty $ p a) r n
 
 aroundProp :: ((a -> IO ()) -> IO ()) -> (a -> Prop) -> Prop
-aroundProp action p = MkProp $ aroundRose action (\a -> unProp $ p a)
+aroundProp hook p = MkProp $ aroundRose hook (\a -> unProp $ p a)
 
 aroundRose :: ((a -> IO ()) -> IO ()) -> (a -> Rose QCP.Result) -> Rose QCP.Result
-aroundRose action r = ioRose $ do
-  ref <- newIORef (return QCP.succeeded)
-  action $ \a -> reduceRose (r a) >>= writeIORef ref
-  readIORef ref
+aroundRose hook r = ioRose $ do
+  liftHook (return QCP.succeeded) hook $ \ a -> reduceRose (r a)
 
 newSeed :: IO Int
 newSeed = fst . randomR (0, fromIntegral (maxBound :: Int32)) <$>
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,9 +1,22 @@
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 -- |
 -- Stability: provisional
 module Test.Hspec.Core.Runner (
+-- * Simple interface
+  hspec
+, hspecWith
+, hspecResult
+, hspecWithResult
+
+-- ** Summary
+, Summary (..)
+, isSuccess
+, evaluateSummary
+
 -- * Running a spec
 {- |
 To run a spec `hspec` performs a sequence of steps:
@@ -16,7 +29,8 @@
 The four primitives `evalSpec`, `readConfig`, `runSpecForest` and
 `evaluateResult` each perform one of these steps respectively.
 
-`hspec` is defined in terms of these primitives:
+`hspec` is defined in terms of these primitives. Loosely speaking, a definition
+for @hspec@ is:
 
 @
 hspec = `evalSpec` `defaultConfig` >=> \\ (config, spec) ->
@@ -26,55 +40,57 @@
   >>= `evaluateResult`
 @
 
-If you need more control over how a spec is run use these primitives individually.
+Loosely speaking in the sense that this definition of @hspec@ ignores
+@--rerun-all-on-success@.
 
+Using these primitives individually gives you more control over how a spec is
+run.  However, if you need support for @--rerun-all-on-success@ then you should
+try hard to solve your use case with one of `hspec`, `hspecWith`, `hspecResult`
+or `hspecWithResult`.
+
 -}
-  hspec
 , evalSpec
 , runSpecForest
 , evaluateResult
 
--- * Config
-, Config (..)
-, ColorMode (..)
-, UnicodeMode(..)
-, Path
-, defaultConfig
-, registerFormatter
-, registerDefaultFormatter
-, configAddFilter
-, readConfig
-
--- * Result
+-- ** Result
 
--- ** Spec Result
+-- *** Spec Result
 , Test.Hspec.Core.Runner.Result.SpecResult
 , Test.Hspec.Core.Runner.Result.specResultItems
 , Test.Hspec.Core.Runner.Result.specResultSuccess
+, toSummary
 
--- ** Result Item
+-- *** Result Item
 , Test.Hspec.Core.Runner.Result.ResultItem
 , Test.Hspec.Core.Runner.Result.resultItemPath
 , Test.Hspec.Core.Runner.Result.resultItemStatus
 , Test.Hspec.Core.Runner.Result.resultItemIsFailure
 
--- ** Result Item Status
+-- *** Result Item Status
 , Test.Hspec.Core.Runner.Result.ResultItemStatus(..)
 
+-- * Config
+, Config (..)
+, ColorMode (..)
+, UnicodeMode(..)
+, Path
+, defaultConfig
+, registerFormatter
+, registerDefaultFormatter
+, configAddFilter
+, readConfig
+
 -- * Legacy
--- | The following primitives are deprecated.  Use `runSpecForest` instead.
-, hspecWith
-, hspecResult
-, hspecWithResult
 , runSpec
 
--- ** Summary
-, Summary (..)
-, toSummary
-, isSuccess
-, evaluateSummary
+-- * Re-exports
+, Spec
+, SpecWith
 
 #ifdef TEST
+, UseColor(..)
+, ProgressReporting(..)
 , rerunAll
 , specToEvalForest
 , colorOutputSupported
@@ -85,12 +101,10 @@
 import           Prelude ()
 import           Test.Hspec.Core.Compat
 
-import           Data.Maybe
 import           NonEmpty (nonEmpty)
 import           System.IO
 import           System.Environment (getArgs, withArgs)
-import           System.Exit
-import qualified Control.Exception as E
+import           System.Exit (exitFailure)
 import           System.Random
 import           Control.Monad.ST
 import           Data.STRef
@@ -99,7 +113,9 @@
 import qualified Test.QuickCheck as QC
 
 import           Test.Hspec.Core.Util (Path)
+import           Test.Hspec.Core.Clock
 import           Test.Hspec.Core.Spec hiding (pruneTree, pruneForest)
+import           Test.Hspec.Core.Tree (formatDefaultDescription)
 import           Test.Hspec.Core.Config
 import           Test.Hspec.Core.Format (Format, FormatConfig(..))
 import qualified Test.Hspec.Core.Formatters.V1 as V1
@@ -109,18 +125,24 @@
 import           Test.Hspec.Core.Shuffle
 
 import           Test.Hspec.Core.Runner.PrintSlowSpecItems
-import           Test.Hspec.Core.Runner.Eval hiding (Tree(..))
+import           Test.Hspec.Core.Runner.Eval hiding (ColorMode(..), Tree(..))
 import qualified Test.Hspec.Core.Runner.Eval as Eval
 import           Test.Hspec.Core.Runner.Result
 
 -- |
 -- Make a formatter available for use with @--format@.
+--
+-- @since 2.10.5
 registerFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config
+{-# DEPRECATED registerFormatter "Use [@registerFormatter@](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Format-V2.html#v:registerFormatter) instead." #-}
 registerFormatter formatter config = config { configAvailableFormatters = formatter : configAvailableFormatters config }
 
 -- |
 -- Make a formatter available for use with @--format@ and use it by default.
+--
+-- @since 2.10.5
 registerDefaultFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config
+{-# DEPRECATED registerDefaultFormatter "Use [@useFormatter@](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Format-V2.html#v:useFormatter) instead." #-}
 registerDefaultFormatter formatter@(_, format) config = (registerFormatter formatter config) { configFormat = Just format }
 
 applyFilterPredicates :: Config -> [Tree c EvalItem] -> [Tree c EvalItem]
@@ -143,10 +165,10 @@
   | otherwise = id
   where
     removeCleanup :: IO () -> IO ()
-    removeCleanup _ = return ()
+    removeCleanup _ = pass
 
     markSuccess :: EvalItem -> EvalItem
-    markSuccess item = item {evalItemAction = \ _ -> return $ Result "" Success}
+    markSuccess item = item {evalItemAction = \ _ -> return (0, Result "" Success)}
 
 -- | Run a given spec and write a report to `stdout`.
 -- Exit with `exitFailure` if at least one spec item fails.
@@ -155,11 +177,7 @@
 -- is not always desirable.  Use `evalSpec` and `runSpecForest` if you need
 -- more control over these aspects.
 hspec :: Spec -> IO ()
-hspec = evalSpec defaultConfig >=> \ (config, spec) ->
-      getArgs
-  >>= readConfig config
-  >>= doNotLeakCommandLineArgumentsToExamples . runSpecForest spec
-  >>= evaluateResult
+hspec = hspecWith defaultConfig
 
 -- |
 -- Evaluate a `Spec` to a forest of `SpecTree`s.  This does not execute any
@@ -187,12 +205,7 @@
 -- | Run given spec with custom options.
 -- This is similar to `hspec`, but more flexible.
 hspecWith :: Config -> Spec -> IO ()
-hspecWith defaults = hspecWithResult defaults >=> evaluateSummary
-
--- | `True` if the given `Summary` indicates that there were no
--- failures, `False` otherwise.
-isSuccess :: Summary -> Bool
-isSuccess summary = summaryFailures summary == 0
+hspecWith defaults = hspecWithSpecResult defaults >=> evaluateResult
 
 -- | Exit with `exitFailure` if the given `Summary` indicates that there was at
 -- least one failure.
@@ -216,11 +229,39 @@
 -- items.  If you need this, you have to check the `Summary` yourself and act
 -- accordingly.
 hspecWithResult :: Config -> Spec -> IO Summary
-hspecWithResult defaults = evalSpec defaults >=> \ (config, spec) ->
-      getArgs
-  >>= readConfig config
-  >>= doNotLeakCommandLineArgumentsToExamples . fmap toSummary . runSpecForest spec
+hspecWithResult config = fmap toSummary . hspecWithSpecResult config
 
+hspecWithSpecResult :: Config -> Spec -> IO SpecResult
+hspecWithSpecResult defaults spec = do
+  (c, forest) <- evalSpec defaults spec
+  config <- getArgs >>= readConfig c
+  oldFailureReport <- readFailureReportOnRerun config
+
+  let
+    normalMode :: IO SpecResult
+    normalMode = doNotLeakCommandLineArgumentsToExamples $ runSpecForest_ oldFailureReport forest config
+
+    rerunAllMode :: IO SpecResult
+    rerunAllMode = do
+      result <- normalMode
+      if rerunAll config oldFailureReport result then
+        hspecWithSpecResult defaults spec
+      else
+        return result
+
+  -- With --rerun-all we may run the spec twice. For that reason GHC can not
+  -- optimize away the spec tree. That means that the whole spec tree has to
+  -- be constructed in memory and we loose constant space behavior.
+  --
+  -- By separating between rerunAllMode and normalMode here, we retain
+  -- constant space behavior in normalMode.
+  --
+  -- see: https://github.com/hspec/hspec/issues/169
+  if configRerunAllOnSuccess config then do
+    rerunAllMode
+  else do
+    normalMode
+
 -- |
 -- /Note/: `runSpec` is deprecated. It ignores any modifications applied
 -- through `modifyConfig`.  Use `evalSpec` and `runSpecForest` instead.
@@ -241,62 +282,65 @@
 --
 -- @since 2.10.0
 runSpecForest :: [SpecTree ()] -> Config -> IO SpecResult
-runSpecForest spec c_ = do
-  oldFailureReport <- readFailureReportOnRerun c_
+runSpecForest spec config = do
+  oldFailureReport <- readFailureReportOnRerun config
+  runSpecForest_ oldFailureReport spec config
 
-  c <- ensureSeed (applyFailureReport oldFailureReport c_)
+mapItem :: (Item a -> Item b) -> [SpecTree a] -> [SpecTree b]
+mapItem f = map (fmap f)
 
-  if configRerunAllOnSuccess c
-    -- With --rerun-all we may run the spec twice. For that reason GHC can not
-    -- optimize away the spec tree. That means that the whole spec tree has to
-    -- be constructed in memory and we loose constant space behavior.
-    --
-    -- By separating between rerunAllMode and normalMode here, we retain
-    -- constant space behavior in normalMode.
-    --
-    -- see: https://github.com/hspec/hspec/issues/169
-    then rerunAllMode c oldFailureReport
-    else normalMode c
-  where
-    normalMode c = runSpecForest_ c spec
-    rerunAllMode c oldFailureReport = do
-      result <- runSpecForest_ c spec
-      if rerunAll c oldFailureReport result
-        then runSpecForest spec c_
-        else return result
+mapItemIf :: (Item a -> Bool) -> (Item a -> Item a) -> [SpecTree a] -> [SpecTree a]
+mapItemIf p f = mapItem $ \ item -> if p item then f item else item
 
-runSpecForest_ :: Config -> [SpecTree ()] -> IO SpecResult
-runSpecForest_ config spec = runEvalTree config (specToEvalForest config spec)
+addDefaultDescriptions :: [SpecTree a] -> [SpecTree a]
+addDefaultDescriptions = mapItem addDefaultDescription
+  where
+    addDefaultDescription :: Item a -> Item a
+    addDefaultDescription item
+      | null (itemRequirement item) = item { itemRequirement = defaultRequirement }
+      | otherwise = item
+      where
+        defaultRequirement = maybe "(unspecified behavior)" formatDefaultDescription (itemLocation item)
 
-mapItem :: (Item a -> Item b) -> [SpecTree a] -> [SpecTree b]
-mapItem f = map (fmap f)
+failItemsWithEmptyDescription :: Config -> [SpecTree a] -> [SpecTree a]
+failItemsWithEmptyDescription config
+  | configFailOnEmptyDescription config = mapItemIf condition (failWith failure)
+  | otherwise = id
+  where
+    condition = null . itemRequirement
+    failure = "item has no description; failing due to --fail-on=empty-description"
 
 failFocusedItems :: Config -> [SpecTree a] -> [SpecTree a]
 failFocusedItems config
-  | configFailOnFocused config = mapItem failFocused
+  | configFailOnFocused config = mapItemIf condition (failWith failure)
   | otherwise = id
+  where
+    condition = itemIsFocused
+    failure = "item is focused; failing due to --fail-on=focused"
 
-failFocused :: Item a -> Item a
-failFocused item = item {itemExample = example}
+failWith :: forall a. String -> Item a -> Item a
+failWith reason item = item {itemExample = example}
   where
-    failure = Failure Nothing (Reason "item is focused; failing due to --fail-on=focused")
-    example
-      | itemIsFocused item = \ params hook p -> do
-          Result info status <- itemExample item params hook p
-          return $ Result info $ case status of
-            Success -> failure
-            Pending _ _ -> failure
-            Failure{} -> status
-      | otherwise = itemExample item
+    failure :: ResultStatus
+    failure = Failure Nothing (Reason reason)
 
+    example :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result
+    example params hook p = do
+      Result info status <- itemExample item params hook p
+      return $ Result info $ case status of
+        Success -> failure
+        Pending _ _ -> failure
+        Failure{} -> status
+
 failPendingItems :: Config -> [SpecTree a] -> [SpecTree a]
 failPendingItems config
   | configFailOnPending config = mapItem failPending
   | otherwise = id
 
-failPending :: Item a -> Item a
+failPending :: forall a. Item a -> Item a
 failPending item = item {itemExample = example}
   where
+    example :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result
     example params hook p = do
       Result info status <- itemExample item params hook p
       return $ Result info $ case status of
@@ -308,28 +352,35 @@
   | configFocusedOnly config = spec
   | otherwise = focusForest spec
 
-runEvalTree :: Config -> [EvalTree] -> IO SpecResult
-runEvalTree config spec = do
-  let
-      failOnEmpty = configFailOnEmpty config
-      seed = (fromJust . configQuickCheckSeed) config
-      qcArgs = configQuickCheckArgs config
-      !numberOfItems = countSpecItems spec
+runSpecForest_ :: Maybe FailureReport -> [SpecTree ()] -> Config -> IO SpecResult
+runSpecForest_ oldFailureReport spec c_ = do
 
-  concurrentJobs <- case configConcurrentJobs config of
-    Nothing -> getDefaultConcurrentJobs
-    Just n -> return n
+  config <- ensureSeed (applyFailureReport oldFailureReport c_)
 
-  (reportProgress, useColor) <- colorOutputSupported (configColorMode config) (hSupportsANSI stdout)
+  colorMode <- colorOutputSupported (configColorMode config) (hSupportsANSI stdout)
   outputUnicode <- unicodeOutputSupported (configUnicodeMode config) stdout
 
-  results <- fmap (toSpecResult failOnEmpty) . withHiddenCursor reportProgress stdout $ do
+  let
+    filteredSpec = specToEvalForest config spec
+    seed = (fromJust . configQuickCheckSeed) config
+    qcArgs = configQuickCheckArgs config
+    !numberOfItems = countEvalItems filteredSpec
+
+  when (configFailOnEmpty config && numberOfItems == 0) $ do
+    when (countSpecItems spec /= 0) $ do
+      die "all spec items have been filtered; failing due to --fail-on=empty"
+
+  concurrentJobs <- maybe getDefaultConcurrentJobs return $ configConcurrentJobs config
+
+  results <- fmap toSpecResult . withHiddenCursor (progressReporting colorMode) stdout $ do
     let
       formatConfig = FormatConfig {
-        formatConfigUseColor = useColor
-      , formatConfigReportProgress = reportProgress
+        formatConfigUseColor = shouldUseColor colorMode
+      , formatConfigReportProgress = progressReporting colorMode == ProgressReportingEnabled
       , formatConfigOutputUnicode = outputUnicode
       , formatConfigUseDiff = configDiff config
+      , formatConfigDiffContext = configDiffContext config
+      , formatConfigExternalDiff = if configDiff config then ($ configDiffContext config) <$> configExternalDiff config else Nothing
       , formatConfigPrettyPrint = configPrettyPrint config
       , formatConfigPrettyPrintFunction = if configPrettyPrint config then Just (configPrettyPrintFunction config outputUnicode) else Nothing
       , formatConfigPrintTimes = configTimes config
@@ -337,6 +388,7 @@
       , formatConfigPrintCpuTime = configPrintCpuTime config
       , formatConfigUsedSeed = seed
       , formatConfigExpectedTotalCount = numberOfItems
+      , formatConfigExpertMode = configExpertMode config
       }
 
       formatter = fromMaybe (V2.formatterToFormat V2.checks) (configFormat config <|> V1.formatterToFormat <$> configFormatter config)
@@ -348,8 +400,9 @@
         evalConfigFormat = format
       , evalConfigConcurrentJobs = concurrentJobs
       , evalConfigFailFast = configFailFast config
+      , evalConfigColorMode = bool Eval.ColorDisabled Eval.ColorEnabled (shouldUseColor colorMode)
       }
-    runFormatter evalConfig spec
+    runFormatter evalConfig filteredSpec
 
   let
     failures :: [Path]
@@ -359,17 +412,11 @@
 
   return results
 
-toSummary :: SpecResult -> Summary
-toSummary result = Summary {
-  summaryExamples = length items
-, summaryFailures = length failures
-} where
-    items = specResultItems result
-    failures = filter resultItemIsFailure items
-
 specToEvalForest :: Config -> [SpecTree ()] -> [EvalTree]
 specToEvalForest config =
-      failFocusedItems config
+      failItemsWithEmptyDescription config
+  >>> addDefaultDescriptions
+  >>> failFocusedItems config
   >>> failPendingItems config
   >>> focusSpec config
   >>> toEvalItemForest params
@@ -378,8 +425,13 @@
   >>> randomize
   >>> pruneForest
   where
+    seed :: Integer
     seed = (fromJust . configQuickCheckSeed) config
+
+    params :: Params
     params = Params (configQuickCheckArgs config) (configSmallCheckDepth config)
+
+    randomize :: [Tree c a] -> [Tree c a]
     randomize
       | configRandomize config = randomizeForest seed
       | otherwise = id
@@ -401,7 +453,12 @@
 toEvalItemForest params = bimapForest id toEvalItem . filterForest itemIsFocused
   where
     toEvalItem :: Item () -> EvalItem
-    toEvalItem (Item requirement loc isParallelizable _isFocused e) = EvalItem requirement loc (fromMaybe False isParallelizable) (e params withUnit)
+    toEvalItem (Item requirement loc isParallelizable _isFocused e) = EvalItem {
+      evalItemDescription = requirement
+    , evalItemLocation = loc
+    , evalItemConcurrency = if isParallelizable == Just True then Concurrent else Sequential
+    , evalItemAction = \ progress -> measure $ e params withUnit progress
+    }
 
     withUnit :: ActionWith () -> IO ()
     withUnit action = action ()
@@ -419,21 +476,43 @@
 doNotLeakCommandLineArgumentsToExamples :: IO a -> IO a
 doNotLeakCommandLineArgumentsToExamples = withArgs []
 
-withHiddenCursor :: Bool -> Handle -> IO a -> IO a
-withHiddenCursor useColor h
-  | useColor  = E.bracket_ (hHideCursor h) (hShowCursor h)
-  | otherwise = id
+withHiddenCursor :: ProgressReporting -> Handle -> IO a -> IO a
+withHiddenCursor progress h = case progress of
+  ProgressReportingDisabled -> id
+  ProgressReportingEnabled -> bracket_ (hHideCursor h) (hShowCursor h)
 
-colorOutputSupported :: ColorMode -> IO Bool -> IO (Bool, Bool)
+data UseColor = ColorDisabled | ColorEnabled ProgressReporting
+  deriving (Eq, Show)
+
+data ProgressReporting = ProgressReportingDisabled | ProgressReportingEnabled
+  deriving (Eq, Show)
+
+shouldUseColor :: UseColor -> Bool
+shouldUseColor c = case c of
+  ColorDisabled -> False
+  ColorEnabled _ -> True
+
+progressReporting :: UseColor -> ProgressReporting
+progressReporting c = case c of
+  ColorDisabled -> ProgressReportingDisabled
+  ColorEnabled r -> r
+
+colorOutputSupported :: ColorMode -> IO Bool -> IO UseColor
 colorOutputSupported mode isTerminalDevice = do
   github <- githubActions
   buildkite <- lookupEnv "BUILDKITE" <&> (== Just "true")
-  useColor <- case mode of
-    ColorAuto  -> (github ||) <$> colorTerminal
-    ColorNever -> return False
-    ColorAlways -> return True
-  let reportProgress = not github && not buildkite && useColor
-  return (reportProgress, useColor)
+  let
+    progress :: ProgressReporting
+    progress
+      | github || buildkite = ProgressReportingDisabled
+      | otherwise = ProgressReportingEnabled
+
+    colorEnabled :: UseColor
+    colorEnabled = ColorEnabled progress
+  case mode of
+    ColorAuto -> bool ColorDisabled colorEnabled . (github ||) <$> colorTerminal
+    ColorNever -> return ColorDisabled
+    ColorAlways -> return colorEnabled
   where
     githubActions :: IO Bool
     githubActions = lookupEnv "GITHUB_ACTIONS" <&> (== Just "true")
@@ -459,29 +538,13 @@
     && specResultSuccess result
     && (not . null) (failureReportPaths oldFailureReport)
 
--- | Summary of a test run.
-data Summary = Summary {
-  summaryExamples :: !Int
-, summaryFailures :: !Int
-} deriving (Eq, Show)
-
-instance Monoid Summary where
-  mempty = Summary 0 0
-#if MIN_VERSION_base(4,11,0)
-instance Semigroup Summary where
-#endif
-  (Summary x1 x2)
-#if MIN_VERSION_base(4,11,0)
-    <>
-#else
-    `mappend`
-#endif
-    (Summary y1 y2) = Summary (x1 + y1) (x2 + y2)
-
 randomizeForest :: Integer -> [Tree c a] -> [Tree c a]
 randomizeForest seed t = runST $ do
   ref <- newSTRef (mkStdGen $ fromIntegral seed)
   shuffleForest ref t
 
-countSpecItems :: [Eval.Tree c a] -> Int
+countEvalItems :: [Eval.Tree c a] -> Int
+countEvalItems = getSum . foldMap (foldMap . const $ Sum 1)
+
+countSpecItems :: [Tree c a] -> Int
 countSpecItems = getSum . foldMap (foldMap . const $ Sum 1)
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,40 +1,24 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE RankNTypes #-}
-
-#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 (
   EvalConfig(..)
+, ColorMode(..)
 , EvalTree
 , Tree(..)
 , EvalItem(..)
+, Concurrency(..)
 , runFormatter
 #ifdef TEST
 , mergeResults
-, runSequentially
 #endif
 ) where
 
 import           Prelude ()
 import           Test.Hspec.Core.Compat hiding (Monad)
-import qualified Test.Hspec.Core.Compat as M
 
-import qualified Control.Exception as E
-import           Control.Concurrent
-import           Control.Concurrent.Async hiding (cancel)
-
 import           Control.Monad.IO.Class (liftIO)
-import qualified Control.Monad.IO.Class as M
-
 import           Control.Monad.Trans.Reader
 import           Control.Monad.Trans.Class
 
@@ -45,29 +29,31 @@
 import qualified Test.Hspec.Core.Format as Format
 import           Test.Hspec.Core.Clock
 import           Test.Hspec.Core.Example.Location
-import           Test.Hspec.Core.Example (safeEvaluateResultStatus)
+import           Test.Hspec.Core.Example (safeEvaluateResultStatus, exceptionToResultStatus)
 
 import qualified NonEmpty
 import           NonEmpty (NonEmpty(..))
 
+import           Test.Hspec.Core.Runner.JobQueue
+
 data Tree c a =
     Node String (NonEmpty (Tree c a))
   | NodeWithCleanup (Maybe (String, Location)) c (NonEmpty (Tree c a))
   | Leaf a
   deriving (Eq, Show, Functor, Foldable, Traversable)
 
--- 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 = EvalConfig {
   evalConfigFormat :: Format
 , evalConfigConcurrentJobs :: Int
 , evalConfigFailFast :: Bool
+, evalConfigColorMode :: ColorMode
 }
 
+data ColorMode = ColorDisabled | ColorEnabled
+
 data Env = Env {
   envConfig :: EvalConfig
+, envFailed :: IORef Bool
 , envResults :: IORef [(Path, Format.Item)]
 }
 
@@ -78,14 +64,21 @@
 
 type EvalM = ReaderT Env IO
 
+setFailed :: EvalM ()
+setFailed = do
+  ref <- asks envFailed
+  liftIO $ writeIORef ref True
+
+hasFailed :: EvalM Bool
+hasFailed = do
+  ref <- asks envFailed
+  liftIO $ readIORef ref
+
 addResult :: Path -> Format.Item -> EvalM ()
 addResult path item = do
   ref <- asks envResults
   liftIO $ modifyIORef ref ((path, item) :)
 
-getResults :: EvalM [(Path, Format.Item)]
-getResults = reverse <$> (asks envResults >>= liftIO . readIORef)
-
 reportItem :: Path -> Maybe Location -> EvalM (Seconds, Result)  -> EvalM ()
 reportItem path loc action = do
   reportItemStarted path
@@ -96,17 +89,33 @@
 
 reportItemDone :: Path -> Format.Item -> EvalM ()
 reportItemDone path item = do
+  let
+    isFailure = case Format.itemResult item of
+      Format.Success{} -> False
+      Format.Pending{} -> False
+      Format.Failure{} -> True
+  when isFailure setFailed
   addResult path item
   formatEvent $ Format.ItemDone path item
 
 reportResult :: Path -> Maybe Location -> (Seconds, Result) -> EvalM ()
 reportResult path loc (duration, result) = do
+  mode <- asks (evalConfigColorMode . envConfig)
   case result of
     Result info status -> reportItemDone path $ Format.Item loc duration info $ case status of
       Success                      -> Format.Success
       Pending loc_ reason          -> Format.Pending loc_ reason
       Failure loc_ err@(Error _ e) -> Format.Failure (loc_ <|> extractLocation e) err
-      Failure loc_ err             -> Format.Failure loc_ err
+      Failure loc_ err             -> Format.Failure loc_ $ case mode of
+        ColorEnabled -> err
+        ColorDisabled -> case err of
+          NoReason -> err
+          Reason _ -> err
+          ExpectedButGot _ _ _ -> err
+          ColorizedReason r -> Reason (stripAnsi r)
+#if __GLASGOW_HASKELL__ < 900
+          Error _ _ -> err
+#endif
 
 groupStarted :: Path -> EvalM ()
 groupStarted = formatEvent . Format.GroupStarted
@@ -117,62 +126,71 @@
 data EvalItem = EvalItem {
   evalItemDescription :: String
 , evalItemLocation :: Maybe Location
-, evalItemParallelize :: Bool
-, evalItemAction :: ProgressCallback -> IO Result
+, evalItemConcurrency :: Concurrency
+, evalItemAction :: ProgressCallback -> IO (Seconds, Result)
 }
 
 type EvalTree = Tree (IO ()) EvalItem
 
 -- | Evaluate all examples of a given spec and produce a report.
-runFormatter :: EvalConfig -> [EvalTree] -> IO ([(Path, Format.Item)])
+runFormatter :: EvalConfig -> [EvalTree] -> IO [(Path, Format.Item)]
 runFormatter config specs = do
-  ref <- newIORef []
+  withJobQueue (evalConfigConcurrentJobs config) $ \ queue -> do
+    withTimer 0.05 $ \ timer -> do
+      env <- mkEnv
+      runningSpecs_ <- enqueueItems queue specs
 
-  let
-    start = parallelizeTree (evalConfigConcurrentJobs config) specs
-    cancel = cancelMany . concatMap toList . map (fmap fst)
+      let
+        applyReportProgress :: RunningItem_ IO -> RunningItem
+        applyReportProgress item = fmap (. reportProgress timer) item
 
-  E.bracket start cancel $ \ runningSpecs -> do
-    withTimer 0.05 $ \ timer -> do
+        runningSpecs :: [RunningTree ()]
+        runningSpecs = applyCleanup $ map (fmap applyReportProgress) runningSpecs_
 
-      format Format.Started
-      runReaderT (run . applyCleanup $ map (fmap (fmap (. reportProgress timer) . snd)) runningSpecs) (Env config ref) `E.finally` do
-        results <- reverse <$> readIORef ref
-        format (Format.Done results)
+        getResults :: IO [(Path, Format.Item)]
+        getResults = reverse <$> readIORef (envResults env)
 
-      results <- reverse <$> readIORef ref
-      return results
+        formatItems :: IO ()
+        formatItems = runReaderT (eval runningSpecs) env
+
+        formatDone :: IO ()
+        formatDone = getResults >>= format . Format.Done
+
+      format Format.Started
+      formatItems `finally` formatDone
+      getResults
   where
+    mkEnv :: IO Env
+    mkEnv = Env config <$> newIORef False <*> newIORef []
+
+    format :: Format
     format = evalConfigFormat config
 
+    reportProgress :: IO Bool -> Path -> Progress -> IO ()
     reportProgress timer path progress = do
       r <- timer
       when r $ do
         format (Format.Progress path progress)
 
-cancelMany :: [Async a] -> IO ()
-cancelMany asyncs = do
-  mapM_ (killThread . asyncThreadId) asyncs
-  mapM_ waitCatch asyncs
-
 data Item a = Item {
-  _itemDescription :: String
-, _itemLocation :: Maybe Location
+  itemDescription :: String
+, itemLocation :: Maybe Location
 , itemAction :: a
 } deriving Functor
 
-type Job m p a = (p -> m ()) -> m a
-
 type RunningItem = Item (Path -> IO (Seconds, Result))
 type RunningTree c = Tree c RunningItem
 
+type RunningItem_ m = Item (Job m Progress (Seconds, Result))
+type RunningTree_ m = Tree (IO ()) (RunningItem_ m)
+
 applyCleanup :: [RunningTree (IO ())] -> [RunningTree ()]
 applyCleanup = map go
   where
     go t = case t of
-      Leaf a -> Leaf a
       Node label xs -> Node label (go <$> xs)
       NodeWithCleanup loc cleanup xs -> NodeWithCleanup loc () (addCleanupToLastLeaf loc cleanup $ go <$> xs)
+      Leaf a -> Leaf a
 
 addCleanupToLastLeaf :: Maybe (String, Location) -> IO () -> NonEmpty (RunningTree ()) -> NonEmpty (RunningTree ())
 addCleanupToLastLeaf loc cleanup = go
@@ -180,9 +198,9 @@
     go = NonEmpty.reverse . mapHead goNode . NonEmpty.reverse
 
     goNode node = case node of
+      Node description xs -> Node description (go xs)
+      NodeWithCleanup loc_ () xs -> NodeWithCleanup loc_ () (go xs)
       Leaf item -> Leaf (addCleanupToItem loc cleanup item)
-      NodeWithCleanup loc_ () zs -> NodeWithCleanup loc_ () (go zs)
-      Node description zs -> Node description (go zs)
 
 mapHead :: (a -> a) -> NonEmpty a -> NonEmpty a
 mapHead f xs = case xs of
@@ -212,62 +230,23 @@
       Just (name, _) -> Just $ "in " ++ name ++ "-hook:"
       Nothing -> Nothing
 
-type RunningItem_ m = (Async (), Item (Job m Progress (Seconds, Result)))
-type RunningTree_ m = Tree (IO ()) (RunningItem_ m)
-
-data Semaphore = Semaphore {
-  semaphoreWait :: IO ()
-, semaphoreSignal :: IO ()
-}
-
-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
-  (asyncAction, evalAction) <- runParallel (Semaphore (takeMVar mvar) (return ())) action
-  return (asyncAction, \ notifyPartial -> liftIO (putMVar mvar ()) >> evalAction notifyPartial)
-
-data Parallel p a = Partial p | Return a
+enqueueItems :: MonadIO m => JobQueue -> [EvalTree] -> IO [RunningTree_ m]
+enqueueItems queue = mapM (traverse $ enqueueItem queue)
 
-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)
+enqueueItem :: MonadIO m => JobQueue -> EvalItem -> IO (RunningItem_ m)
+enqueueItem queue EvalItem{..} = do
+  job <- enqueueJob queue evalItemConcurrency evalItemAction
+  return Item {
+    itemDescription = evalItemDescription
+  , itemLocation = evalItemLocation
+  , itemAction = job >=> liftIO . either exceptionToResult return
+  }
   where
-    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
-        Partial p -> do
-          notifyPartial p
-          eval mvar notifyPartial
-        Return result -> return result
-
-replaceMVar :: MVar a -> a -> IO ()
-replaceMVar mvar p = tryTakeMVar mvar >> putMVar mvar p
+    exceptionToResult :: SomeException -> IO (Seconds, Result)
+    exceptionToResult err = (,) 0 . Result "" <$> exceptionToResultStatus err
 
-run :: [RunningTree ()] -> EvalM ()
-run specs = do
+eval :: [RunningTree ()] -> EvalM ()
+eval specs = do
   failFast <- asks (evalConfigFailFast . envConfig)
   sequenceActions failFast (concatMap foldSpec specs)
   where
@@ -315,18 +294,10 @@
 sequenceActions failFast = go
   where
     go :: [EvalM ()] -> EvalM ()
-    go [] = return ()
+    go [] = pass
     go (action : actions) = do
       action
       stopNow <- case failFast of
         False -> return False
-        True -> any itemIsFailure <$> getResults
+        True -> hasFailed
       unless stopNow (go actions)
-
-    itemIsFailure :: (Path, Format.Item) -> Bool
-    itemIsFailure = isFailure . Format.itemResult . snd
-      where
-        isFailure r = case r of
-          Format.Success{} -> False
-          Format.Pending{} -> False
-          Format.Failure{} -> True
diff --git a/hspec-core/src/Test/Hspec/Core/Runner/JobQueue.hs b/hspec-core/src/Test/Hspec/Core/Runner/JobQueue.hs
new file mode 100644
--- /dev/null
+++ b/hspec-core/src/Test/Hspec/Core/Runner/JobQueue.hs
@@ -0,0 +1,116 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ConstraintKinds #-}
+
+module Test.Hspec.Core.Runner.JobQueue (
+  MonadIO
+, Job
+, Concurrency(..)
+, JobQueue
+, withJobQueue
+, enqueueJob
+) where
+
+import           Prelude ()
+import           Test.Hspec.Core.Compat hiding (Monad)
+import qualified Test.Hspec.Core.Compat as M
+
+import           Control.Concurrent
+import           Control.Concurrent.Async (Async, AsyncCancelled(..), async, waitCatch, asyncThreadId)
+
+import           Control.Monad.IO.Class (liftIO)
+import qualified Control.Monad.IO.Class as M
+
+-- 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)
+
+type Job m progress a = (progress -> m ()) -> m a
+
+data Concurrency = Sequential | Concurrent
+
+data JobQueue = JobQueue {
+  _semaphore :: Semaphore
+, _cancelQueue :: CancelQueue
+}
+
+data Semaphore = Semaphore {
+  _wait :: IO ()
+, _signal :: IO ()
+}
+
+type CancelQueue = IORef [Async ()]
+
+withJobQueue :: Int -> (JobQueue -> IO a) -> IO a
+withJobQueue concurrency = bracket new cancelAll
+  where
+    new :: IO JobQueue
+    new = JobQueue <$> newSemaphore concurrency <*> newIORef []
+
+    cancelAll :: JobQueue -> IO ()
+    cancelAll (JobQueue _ cancelQueue) = readIORef cancelQueue >>= cancelMany
+
+    cancelMany :: [Async a] -> IO ()
+    cancelMany jobs = do
+      mapM_ notifyCancel jobs
+      mapM_ waitCatch jobs
+
+    notifyCancel :: Async a -> IO ()
+    notifyCancel = flip throwTo AsyncCancelled . asyncThreadId
+
+newSemaphore :: Int -> IO Semaphore
+newSemaphore capacity = do
+  sem <- newQSem capacity
+  return $ Semaphore (waitQSem sem) (signalQSem sem)
+
+enqueueJob :: MonadIO m => JobQueue -> Concurrency -> Job IO progress a -> IO (Job m progress (Either SomeException a))
+enqueueJob (JobQueue sem cancelQueue) concurrency = case concurrency of
+  Sequential -> runSequentially cancelQueue
+  Concurrent -> runConcurrently sem cancelQueue
+
+runSequentially :: forall m progress a. MonadIO m => CancelQueue -> Job IO progress a -> IO (Job m progress (Either SomeException a))
+runSequentially cancelQueue action = do
+  barrier <- newEmptyMVar
+  let
+    wait :: IO ()
+    wait = takeMVar barrier
+
+    signal :: m ()
+    signal = liftIO $ putMVar barrier ()
+
+  job <- runConcurrently (Semaphore wait pass) cancelQueue action
+  return $ \ notifyPartial -> signal >> job notifyPartial
+
+data Partial progress a = Partial progress | Done
+
+runConcurrently :: forall m progress a. MonadIO m => Semaphore -> CancelQueue -> Job IO progress a -> IO (Job m progress (Either SomeException a))
+runConcurrently (Semaphore wait signal) cancelQueue action = do
+  result :: MVar (Partial progress a) <- newEmptyMVar
+  let
+    worker :: IO a
+    worker = bracket_ wait signal $ do
+      interruptible (action partialResult) `finally` done
+      where
+        partialResult :: progress -> IO ()
+        partialResult = replaceMVar result . Partial
+
+        done :: IO ()
+        done = replaceMVar result Done
+
+    pushOnCancelQueue :: Async a -> IO ()
+    pushOnCancelQueue = (modifyIORef cancelQueue . (:) . void)
+
+  job <- bracket (async worker) pushOnCancelQueue return
+
+  let
+    waitForResult :: (progress -> m ()) -> m (Either SomeException a)
+    waitForResult notifyPartial = do
+      r <- liftIO (takeMVar result)
+      case r of
+        Partial progress -> notifyPartial progress >> waitForResult notifyPartial
+        Done -> liftIO $ waitCatch job
+
+  return waitForResult
+
+replaceMVar :: MVar a -> a -> IO ()
+replaceMVar mvar p = tryTakeMVar mvar >> putMVar mvar p
diff --git a/hspec-core/src/Test/Hspec/Core/Runner/PrintSlowSpecItems.hs b/hspec-core/src/Test/Hspec/Core/Runner/PrintSlowSpecItems.hs
--- a/hspec-core/src/Test/Hspec/Core/Runner/PrintSlowSpecItems.hs
+++ b/hspec-core/src/Test/Hspec/Core/Runner/PrintSlowSpecItems.hs
@@ -7,6 +7,8 @@
 import           Prelude ()
 import           Test.Hspec.Core.Compat
 
+import           System.IO (stderr, hPutStrLn)
+
 import           Test.Hspec.Core.Util
 import           Test.Hspec.Core.Format
 
@@ -26,9 +28,9 @@
     Done items -> do
       let xs = slowItems n $ map toSlowItem items
       unless (null xs) $ do
-        putStrLn "\nSlow spec items:"
+        hPutStrLn stderr "\nSlow spec items:"
         mapM_ printSlowSpecItem xs
-    _ -> return ()
+    _ -> pass
 
 toSlowItem :: (Path, Item) -> SlowItem
 toSlowItem (path, item) = SlowItem (itemLocation item)  path (toMilliseconds $ itemDuration item)
@@ -38,4 +40,4 @@
 
 printSlowSpecItem :: SlowItem -> IO ()
 printSlowSpecItem SlowItem{..} = do
-  putStrLn $ "  " ++ maybe "" formatLocation location ++ joinPath path ++ " (" ++ show duration ++ "ms)"
+  hPutStrLn stderr $ "  " ++ maybe "" formatLocation location ++ joinPath path ++ " (" ++ show duration ++ "ms)"
diff --git a/hspec-core/src/Test/Hspec/Core/Runner/Result.hs b/hspec-core/src/Test/Hspec/Core/Runner/Result.hs
--- a/hspec-core/src/Test/Hspec/Core/Runner/Result.hs
+++ b/hspec-core/src/Test/Hspec/Core/Runner/Result.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 module Test.Hspec.Core.Runner.Result (
 -- RE-EXPORTED from Test.Hspec.Core.Runner
   SpecResult(SpecResult)
@@ -10,6 +11,10 @@
 , resultItemIsFailure
 
 , ResultItemStatus(..)
+
+, Summary(..)
+, toSummary
+, isSuccess
 -- END RE-EXPORTED from Test.Hspec.Core.Runner
 
 , toSpecResult
@@ -21,16 +26,32 @@
 import           Test.Hspec.Core.Util
 import qualified Test.Hspec.Core.Format as Format
 
+-- |
+-- @since 2.10.0
 data SpecResult = SpecResult {
+  -- |
+  -- @since 2.10.0
   specResultItems :: [ResultItem]
+
+  -- |
+  -- @since 2.10.0
 , specResultSuccess :: !Bool
 } deriving (Eq, Show)
 
+-- |
+-- @since 2.10.0
 data ResultItem = ResultItem {
+  -- |
+  -- @since 2.10.0
   resultItemPath :: Path
+
+  -- |
+  -- @since 2.10.0
 , resultItemStatus :: ResultItemStatus
 } deriving (Eq, Show)
 
+-- |
+-- @since 2.10.0
 resultItemIsFailure :: ResultItem -> Bool
 resultItemIsFailure item = case resultItemStatus item of
   ResultItemSuccess -> False
@@ -43,11 +64,11 @@
   | ResultItemFailure
   deriving (Eq, Show)
 
-toSpecResult :: Bool -> [(Path, Format.Item)] -> SpecResult
-toSpecResult failOnEmpty results = SpecResult items success
+toSpecResult :: [(Path, Format.Item)] -> SpecResult
+toSpecResult results = SpecResult items success
   where
     items = map toResultItem results
-    success = not (failOnEmpty && null results) && all (not . resultItemIsFailure) items
+    success = all (not . resultItemIsFailure) items
 
 toResultItem :: (Path, Format.Item) -> ResultItem
 toResultItem (path, item) = ResultItem path status
@@ -56,3 +77,35 @@
       Format.Success{} -> ResultItemSuccess
       Format.Pending{} -> ResultItemPending
       Format.Failure{} -> ResultItemFailure
+
+-- | Summary of a test run.
+data Summary = Summary {
+  summaryExamples :: !Int
+, summaryFailures :: !Int
+} deriving (Eq, Show)
+
+instance Monoid Summary where
+  mempty = Summary 0 0
+#if MIN_VERSION_base(4,11,0)
+instance Semigroup Summary where
+#endif
+  (Summary x1 x2)
+#if MIN_VERSION_base(4,11,0)
+    <>
+#else
+    `mappend`
+#endif
+    (Summary y1 y2) = Summary (x1 + y1) (x2 + y2)
+
+toSummary :: SpecResult -> Summary
+toSummary result = Summary {
+  summaryExamples = length items
+, summaryFailures = length failures
+} where
+    items = specResultItems result
+    failures = filter resultItemIsFailure items
+
+-- | `True` if the given `Summary` indicates that there were no
+-- failures, `False` otherwise.
+isSuccess :: Summary -> Bool
+isSuccess summary = summaryFailures summary == 0
diff --git a/hspec-core/src/Test/Hspec/Core/Shuffle.hs b/hspec-core/src/Test/Hspec/Core/Shuffle.hs
--- a/hspec-core/src/Test/Hspec/Core/Shuffle.hs
+++ b/hspec-core/src/Test/Hspec/Core/Shuffle.hs
@@ -16,16 +16,16 @@
 import           Data.STRef
 import           Data.Array.ST
 
-shuffleForest :: STRef s StdGen -> [Tree c a] -> ST s [Tree c a]
+shuffleForest :: STRef st StdGen -> [Tree c a] -> ST st [Tree c a]
 shuffleForest ref xs = (shuffle ref xs >>= mapM (shuffleTree ref))
 
-shuffleTree :: STRef s StdGen -> Tree c a -> ST s (Tree c a)
+shuffleTree :: STRef st StdGen -> Tree c a -> ST st (Tree c a)
 shuffleTree ref t = case t of
   Node d xs -> Node d <$> shuffleForest ref xs
   NodeWithCleanup loc c xs -> NodeWithCleanup loc c <$> shuffleForest ref xs
   Leaf {} -> return t
 
-shuffle :: STRef s StdGen -> [a] -> ST s [a]
+shuffle :: STRef st StdGen -> [a] -> ST st [a]
 shuffle ref xs = do
   arr <- mkArray xs
   bounds@(_, n) <- getBounds arr
@@ -41,5 +41,5 @@
       writeSTRef ref gen
       return a
 
-mkArray :: [a] -> ST s (STArray s Int a)
+mkArray :: [a] -> ST st (STArray st Int a)
 mkArray xs = newListArray (1, length xs) xs
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
@@ -73,13 +73,15 @@
 , Test.Hspec.Core.Tree.location
 
 , focusForest
+
+-- * Re-exports
+, HasCallStack
+, Expectation
 ) where
 
 import           Prelude ()
 import           Test.Hspec.Core.Compat
 
-import qualified Control.Exception as E
-import           Data.CallStack
 import           Control.Monad.Trans.Class (lift)
 import           Control.Monad.Trans.Reader (asks)
 
@@ -188,16 +190,16 @@
 -- >   it "can format text in a way that everyone likes" $
 -- >     pending
 pending :: HasCallStack => Expectation
-pending = E.throwIO (Pending location Nothing)
+pending = throwIO (Pending location Nothing)
 
 pending_ :: Expectation
-pending_ = (E.throwIO (Pending Nothing Nothing))
+pending_ = (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 :: HasCallStack => String -> Expectation
-pendingWith = E.throwIO . Pending location . Just
+pendingWith = throwIO . Pending location . Just
 
 -- | Get the path of `describe` labels, from the root all the way in to the
 -- call-site of this function.
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
@@ -71,6 +71,8 @@
 mapSpecForest :: ([SpecTree a] -> [SpecTree b]) -> SpecM a r -> SpecM b r
 mapSpecForest f (SpecM specs) = SpecM (mapWriterT (fmap (fmap (second f))) specs)
 
+-- {-# DEPRECATED mapSpecItem "Use `mapSpecItem_` instead." #-}
+-- | Deprecated: Use `mapSpecItem_` instead.
 mapSpecItem :: (ActionWith a -> ActionWith b) -> (Item a -> Item b) -> SpecWith a -> SpecWith b
 mapSpecItem _ = mapSpecItem_
 
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
@@ -3,7 +3,6 @@
 import           Prelude ()
 import           Test.Hspec.Core.Compat
 
-import           Control.Exception
 import           Control.Concurrent.Async
 
 import           Test.Hspec.Core.Clock
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
@@ -22,14 +22,16 @@
 , location
 -- END RE-EXPORTED from Test.Hspec.Core.Spec
 , callSite
+, formatDefaultDescription
+, toModuleName
 ) where
 
 import           Prelude ()
 import           Test.Hspec.Core.Compat
 
-import           Data.CallStack (HasCallStack, SrcLoc(..))
+import           Data.Char
+import           System.FilePath
 import qualified Data.CallStack as CallStack
-import           Data.Maybe
 
 import           Test.Hspec.Core.Example
 
@@ -52,7 +54,7 @@
   where
     go spec = case spec of
       Node d xs -> Node d (map go xs)
-      NodeWithCleanup loc cleanup xs -> NodeWithCleanup loc (g cleanup) (map go xs)
+      NodeWithCleanup loc action xs -> NodeWithCleanup loc (g action) (map go xs)
       Leaf item -> Leaf (f item)
 
 filterTree :: (a -> Bool) -> Tree c a -> Maybe (Tree c a)
@@ -122,17 +124,18 @@
   where
     msg :: HasCallStack => String
     msg
-      | null s = fromMaybe "(no description given)" defaultDescription
+      | null s = maybe "(no description given)" formatDefaultDescription location
       | 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 Nothing False (safeEvaluateExample e)
-  where
-    requirement :: HasCallStack => String
-    requirement
-      | null s = fromMaybe "(unspecified behavior)" defaultDescription
-      | otherwise = s
+specItem :: (HasCallStack, Example e) => String -> e -> SpecTree (Arg e)
+specItem s e = Leaf Item {
+    itemRequirement = s
+  , itemLocation = location
+  , itemIsParallelizable = Nothing
+  , itemIsFocused = False
+  , itemExample = safeEvaluateExample e
+  }
 
 location :: HasCallStack => Maybe Location
 location = snd <$> callSite
@@ -140,10 +143,16 @@
 callSite :: HasCallStack => Maybe (String, Location)
 callSite = fmap toLocation <$> CallStack.callSite
 
-defaultDescription :: HasCallStack => Maybe String
-defaultDescription = case CallStack.callSite of
-  Just (_, loc) -> Just (srcLocModule loc ++ "[" ++ show (srcLocStartLine loc) ++ ":" ++ show (srcLocStartCol loc) ++ "]")
-  Nothing -> Nothing
+formatDefaultDescription :: Location -> String
+formatDefaultDescription loc = toModuleName (locationFile loc) ++ "[" ++ show (locationLine loc) ++ ":" ++ show (locationColumn loc) ++ "]"
 
-toLocation :: SrcLoc -> Location
-toLocation loc = Location (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc)
+toModuleName :: FilePath -> String
+toModuleName = intercalate "." . reverse . takeWhile isModuleNameComponent . reverse . splitDirectories . dropExtension
+
+isModuleNameComponent :: String -> Bool
+isModuleNameComponent name = case name of
+  x : xs -> isUpper x && all isIdChar xs
+  _ -> False
+
+isIdChar :: Char -> Bool
+isIdChar c = isAlphaNum c || c == '_' || c == '\''
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
@@ -1,9 +1,11 @@
+{-# LANGUAGE  ViewPatterns #-}
 -- | Stability: unstable
 module Test.Hspec.Core.Util (
 -- * String functions
   pluralize
 , strip
 , lineBreaksAt
+, stripAnsi
 
 -- * Working with paths
 , Path
@@ -21,7 +23,6 @@
 
 import           Data.Char (isSpace)
 import           GHC.IO.Exception
-import           Control.Exception
 import           Control.Concurrent.Async
 
 -- |
@@ -38,17 +39,23 @@
 --
 -- >>> pluralize 2 "example"
 -- "2 examples"
+--
+-- @since 2.0.0
 pluralize :: Int -> String -> String
 pluralize 1 s = "1 " ++ s
 pluralize n s = show n ++ " " ++ s ++ "s"
 
 -- | Strip leading and trailing whitespace
+--
+-- @since 2.0.0
 strip :: String -> String
 strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse
 
 -- |
--- ensure that lines are not longer than given `n`, insert line breaks at word
+-- Ensure that lines are not longer than given `n`, insert line breaks at word
 -- boundaries
+--
+-- @since 2.0.0
 lineBreaksAt :: Int -> String -> [String]
 lineBreaksAt n = concatMap f . lines
   where
@@ -65,20 +72,38 @@
           else s : go (y, ys)
 
 -- |
+-- Remove ANSI color escape sequences.
+--
+-- @since 2.11.0
+stripAnsi :: String -> String
+stripAnsi = go
+  where
+    go input = case input of
+      '\ESC' : '[' : (dropWhile (`elem` "0123456789;") -> 'm' : xs) -> go xs
+      x : xs -> x : go xs
+      [] -> []
+
+-- |
 -- A `Path` describes the location of a spec item within a spec tree.
 --
 -- It consists of a list of group descriptions and a requirement description.
+--
+-- @since 2.0.0
 type Path = ([String], String)
 
 -- |
 -- Join a `Path` with slashes.  The result will have a leading and a trailing
 -- slash.
+--
+-- @since 2.5.4
 joinPath :: Path -> String
 joinPath (groups, requirement) = "/" ++ intercalate "/" (groups ++ [requirement]) ++ "/"
 
 -- |
 -- Try to create a proper English sentence from a path by applying some
 -- heuristics.
+--
+-- @since 2.0.0
 formatRequirement :: Path -> String
 formatRequirement (groups, requirement) = groups_ ++ requirement
   where
@@ -91,6 +116,8 @@
       ys  -> concatMap (++ ", ") ys
 
 -- | A predicate that can be used to filter a spec tree.
+--
+-- @since 2.0.0
 filterPredicate :: String -> Path -> Bool
 filterPredicate pattern path =
      pattern `isInfixOf` plain
@@ -107,6 +134,8 @@
 -- "ArithException\ndivide by zero"
 --
 -- For `IOException`s the `IOErrorType` is included, as well.
+--
+-- @since 2.0.0
 formatException :: SomeException -> String
 formatException err@(SomeException e) = case fromException err of
   Just ioe -> showType ioe ++ " of type " ++ showIOErrorType ioe ++ "\n" ++ show ioe
@@ -137,5 +166,7 @@
 -- | @safeTry@ evaluates given action and returns its result.  If an exception
 -- occurs, the exception is returned instead.  Unlike `try` it is agnostic to
 -- asynchronous exceptions.
+--
+-- @since 2.0.0
 safeTry :: IO a -> IO (Either SomeException a)
 safeTry action = withAsync (action >>= evaluate) waitCatch
diff --git a/hspec-core/vendor/Control/Concurrent/Async.hs b/hspec-core/vendor/Control/Concurrent/Async.hs
deleted file mode 100644
--- a/hspec-core/vendor/Control/Concurrent/Async.hs
+++ /dev/null
@@ -1,963 +0,0 @@
-{-# LANGUAGE CPP, MagicHash, UnboxedTuples, RankNTypes,
-    ExistentialQuantification #-}
-#if __GLASGOW_HASKELL__ >= 701
-{-# LANGUAGE Trustworthy #-}
-#endif
-#if __GLASGOW_HASKELL__ < 710
-{-# LANGUAGE DeriveDataTypeable #-}
-#endif
-{-# OPTIONS -Wall -fno-warn-implicit-prelude -fno-warn-unused-imports #-}
-
------------------------------------------------------------------------------
--- |
--- 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 'forkIO' threads and @MVar@ directly.
---
--- == High-level API
---
--- @async@'s high-level API spawns /lexically scoped/ threads,
--- ensuring the following key poperties that make it safer to use
--- than using plain 'forkIO':
---
--- 1. No exception is swallowed (waiting for results propagates exceptions).
--- 2. No thread is leaked (left running unintentionally).
---
--- (This is done using the 'Control.Exception.bracket' pattern to work in presence
--- of synchornous and asynchronous exceptions.)
---
--- __Most practical/production code should only use the high-level API__.
---
--- 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' is a wrapper around a low-level 'forkIO' thread.
---
--- The fundamental function to spawn threads with the high-level API is
--- 'withAsync'.
---
--- For example, to fetch two web pages at the same time, we could do
--- this (assuming a suitable @getURL@ function):
---
--- > withAsync (getURL url1) $ \a1 -> do
--- >   withAsync (getURL url2) $ \a2 -> do
--- >     page1 <- wait a1
--- >     page2 <- wait a2
--- >     ...
---
--- where 'withAsync' 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 ensures property (1): No exception is swallowed.
--- * If an exception bubbles up through a 'withAsync', then the 'Async'
---   it spawned is 'cancel'ed. This ensures property (2): No thread is leaked.
---
--- Often we do not care to work manually with 'Async' handles like
--- @a1@ and @a2@. Instead, we want to express high-level objectives like
--- performing two or more tasks concurrently, and waiting for one or all
--- of them to finish.
---
--- For example, the pattern of performing two IO actions concurrently and
--- waiting for both 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 section __/High-level utilities/__ covers the most
--- common high-level objectives, including:
---
--- * Waiting for 2 results ('concurrently').
--- * Waiting for many results ('mapConcurrently' / 'forConcurrently').
--- * Waiting for the first of 2 results ('race').
--- * Waiting for arbitrary nestings of "all of /N/" and "the first of /N/"
---   results with the 'Concurrently' newtype and its 'Applicative' and
---   'Alternative' instances.
---
--- Click here to scroll to that section:
--- "Control.Concurrent.Async#high-level-utilities".
---
--- == Low-level API
---
--- Some use cases require parallelism that is not lexically scoped.
---
--- For those, the low-level function 'async' can be used as a direct
--- equivalent of 'forkIO':
---
--- > -- Do NOT use this code in production, it has a flaw (explained below).
--- > do
--- >   a1 <- async (getURL url1)
--- >   a2 <- async (getURL url2)
--- >   page1 <- wait a1
--- >   page2 <- wait a2
--- >   ...
---
--- In contrast to 'withAsync', this code has a problem.
---
--- It still fulfills property (1) in that an exception arising from
--- @getUrl@ will be re-thrown by 'wait', but it does not fulfill
--- property (2).
--- Consider the case when the first 'wait' throws an exception; then the
--- second 'wait' will not happen, and the second 'async' may be left
--- running in the background, possibly indefinitely.
---
--- 'withAsync' is like 'async', except that the 'Async' is
--- automatically killed (using 'uninterruptibleCancel') if the
--- enclosing IO operation returns before it has completed.
--- Furthermore, 'withAsync' allows a tree of threads to be built, such
--- that children are automatically killed if their parents die for any
--- reason.
---
--- If you need to use the low-level API, ensure that you gurantee
--- property (2) by other means, such as 'link'ing asyncs that need
--- to die together, and protecting against asynchronous exceptions
--- using 'Control.Exception.bracket', 'Control.Exception.mask',
--- or other functions from "Control.Exception".
---
--- == Miscellaneous
---
--- The 'Functor' instance can be used to change the result of an
--- 'Async'.  For example:
---
--- > ghci> withAsync (return 3) (\a -> wait (fmap (+1) a))
--- > 4
---
--- === Resource exhaustion
---
--- As with all concurrent programming, keep in mind that while
--- Haskell's cooperative ("green") multithreading carries low overhead,
--- spawning too many of them at the same time may lead to resource exhaustion
--- (of memory, file descriptors, or other limited resources), given that the
--- actions running in the threads consume these resources.
-
------------------------------------------------------------------------------
-
-module Control.Concurrent.Async (
-
-    -- * Asynchronous actions
-    Async,
-
-    -- * High-level API
-
-    -- ** Spawning with automatic 'cancel'ation
-    withAsync, withAsyncBound, withAsyncOn, withAsyncWithUnmask,
-    withAsyncOnWithUnmask,
-
-    -- ** Querying 'Async's
-    wait, poll, waitCatch, asyncThreadId,
-    cancel, uninterruptibleCancel, cancelWith, AsyncCancelled(..),
-
-    -- ** #high-level-utilities# High-level utilities
-    race, race_,
-    concurrently, concurrently_,
-    mapConcurrently, forConcurrently,
-    mapConcurrently_, forConcurrently_,
-    replicateConcurrently, replicateConcurrently_,
-    Concurrently(..),
-    compareAsyncs,
-
-    -- ** Specialised operations
-
-    -- *** 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,
-
-    -- * Low-level API
-
-    -- ** Spawning (low-level API)
-    async, asyncBound, asyncOn, asyncWithUnmask, asyncOnWithUnmask,
-
-    -- ** Linking
-    link, linkOnly, link2, link2Only, ExceptionInLinkedThread(..),
-
-  ) where
-
-import Control.Concurrent.STM.TMVar
-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 Asyncs that may have different types by their 'ThreadId'.
-compareAsyncs :: Async a -> Async b -> Ordering
-compareAsyncs (Async t1 _) (Async t2 _) = compare t1 t2
-
--- | Spawn an asynchronous action in a separate thread.
---
--- Like for 'forkIO', the action may be left running unintentinally
--- (see module-level documentation for details).
---
--- __Use 'withAsync' style functions wherever you can instead!__
-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 a) `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 = tryAgain . atomically . waitSTM
-  where
-    -- See: https://github.com/simonmar/async/issues/14
-    tryAgain f = f `catch` \BlockedIndefinitelyOnSTM -> f
-
--- | 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 = tryAgain $ atomically (waitBothSTM left right)
-  where
-    -- See: https://github.com/simonmar/async/issues/14
-    tryAgain f = f `catch` \BlockedIndefinitelyOnSTM -> f
-
--- | 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
-  showsPrec p (ExceptionInLinkedThread (Async t _) e) =
-    showParen (p >= 11) $
-      showString "ExceptionInLinkedThread " .
-      showsPrec 11 t .
-      showString " " .
-      showsPrec 11 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, wrapped in 'ExceptionInLinkedThread'.
---
--- 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)
-
--- | 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'.
---
--- The supplied predicate determines which exceptions in the target
--- thread should be propagated to the source thread.
---
-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)
-
--- | 'concurrently', but ignore the result values
---
--- @since 2.1.1
-concurrently_ :: IO a -> IO b -> IO ()
-
-#define USE_ASYNC_VERSIONS 0
-
-#if USE_ASYNC_VERSIONS
-
-race left right =
-  withAsync left $ \a ->
-  withAsync right $ \b ->
-  waitEither a b
-
-race_ left right = void $ race left right
-
-concurrently left right =
-  withAsync left $ \a ->
-  withAsync right $ \b ->
-  waitBoth a b
-
-concurrently_ left right = void $ concurrently left right
-
-#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
-
-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
-
-
-#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"]
---
--- Take into account that @async@ will try to immediately spawn a thread
--- for each element of the @Traversable@, so running this on large
--- inputs without care may lead to resource exhaustion (of memory,
--- file descriptors, or other limited resources).
-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;
--- a concurrent equivalent of '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;
--- a concurrent equivalent of 'forM_'.
-forConcurrently_ :: F.Foldable f => f a -> (a -> IO b) -> IO ()
-forConcurrently_ = flip mapConcurrently_
-
--- | 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 (IO action) = IO $ \ s ->
-   case (fork# action s) of (# s1, tid #) -> (# s1, ThreadId tid #)
-
-{-# INLINE rawForkOn #-}
-rawForkOn :: Int -> IO () -> IO ThreadId
-rawForkOn (I# cpu) (IO action) = IO $ \ s ->
-   case (forkOn# cpu action s) of (# s1, tid #) -> (# s1, ThreadId tid #)
diff --git a/hspec-core/vendor/Data/Algorithm/Diff.hs b/hspec-core/vendor/Data/Algorithm/Diff.hs
deleted file mode 100644
--- a/hspec-core/vendor/Data/Algorithm/Diff.hs
+++ /dev/null
@@ -1,115 +0,0 @@
-{-# LANGUAGE DeriveFunctor #-}
-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Algorithm.Diff
--- Copyright   :  (c) Sterling Clover 2008-2011, Kevin Charter 2011
--- License     :  BSD 3 Clause
--- Maintainer  :  s.clover@gmail.com
--- Stability   :  experimental
--- Portability :  portable
---
--- This is an implementation of the O(ND) diff algorithm as described in
--- \"An O(ND) Difference Algorithm and Its Variations (1986)\"
--- <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.4.6927>. It is O(mn) in space.
--- The algorithm is the same one used by standared Unix diff.
------------------------------------------------------------------------------
-
-module Data.Algorithm.Diff
-    ( Diff(..)
-    -- * Comparing lists for differences
-    , getDiff
-    , getDiffBy
-
-    -- * Finding chunks of differences
-    , getGroupedDiff
-    , getGroupedDiffBy
-    ) where
-
-import Prelude hiding (pi)
-
-import Data.Array
-
-data DI = F | S | B deriving (Show, Eq)
-
--- | A value is either from the 'First' list, the 'Second' or from 'Both'.
--- 'Both' contains both the left and right values, in case you are using a form
--- of equality that doesn't check all data (for example, if you are using a
--- newtype to only perform equality on side of a tuple).
-data Diff a = First a | Second a | Both a a deriving (Show, Eq, Functor)
-
-data DL = DL {poi :: !Int, poj :: !Int, path::[DI]} deriving (Show, Eq)
-
-instance Ord DL
-        where x <= y = if poi x == poi y
-                then  poj x > poj y
-                else poi x <= poi y
-
-canDiag :: (a -> a -> Bool) -> [a] -> [a] -> Int -> Int -> Int -> Int -> Bool
-canDiag eq as bs lena lenb = \ i j ->
-   if i < lena && j < lenb then (arAs ! i) `eq` (arBs ! j) else False
-    where arAs = listArray (0,lena - 1) as
-          arBs = listArray (0,lenb - 1) bs
-
-dstep :: (Int -> Int -> Bool) -> [DL] -> [DL]
-dstep cd dls = hd:pairMaxes rst
-  where (hd:rst) = nextDLs dls
-        nextDLs [] = []
-        nextDLs (dl:rest) = dl':dl'':nextDLs rest
-          where dl'  = addsnake cd $ dl {poi=poi dl + 1, path=(F : pdl)}
-                dl'' = addsnake cd $ dl {poj=poj dl + 1, path=(S : pdl)}
-                pdl = path dl
-        pairMaxes [] = []
-        pairMaxes [x] = [x]
-        pairMaxes (x:y:rest) = max x y:pairMaxes rest
-
-addsnake :: (Int -> Int -> Bool) -> DL -> DL
-addsnake cd dl
-    | cd pi pj = addsnake cd $
-                 dl {poi = pi + 1, poj = pj + 1, path=(B : path dl)}
-    | otherwise   = dl
-    where pi = poi dl; pj = poj dl
-
-lcs :: (a -> a -> Bool) -> [a] -> [a] -> [DI]
-lcs eq as bs = path . head . dropWhile (\dl -> poi dl /= lena || poj dl /= lenb) .
-            concat . iterate (dstep cd) . (:[]) . addsnake cd $
-            DL {poi=0,poj=0,path=[]}
-            where cd = canDiag eq as bs lena lenb
-                  lena = length as; lenb = length bs
-
--- | Takes two lists and returns a list of differences between them. This is
--- 'getDiffBy' with '==' used as predicate.
-getDiff :: (Eq t) => [t] -> [t] -> [Diff t]
-getDiff = getDiffBy (==)
-
--- | Takes two lists and returns a list of differences between them, grouped
--- into chunks. This is 'getGroupedDiffBy' with '==' used as predicate.
-getGroupedDiff :: (Eq t) => [t] -> [t] -> [Diff [t]]
-getGroupedDiff = getGroupedDiffBy (==)
-
--- | A form of 'getDiff' with no 'Eq' constraint. Instead, an equality predicate
--- is taken as the first argument.
-getDiffBy :: (t -> t -> Bool) -> [t] -> [t] -> [Diff t]
-getDiffBy eq a b = markup a b . reverse $ lcs eq a b
-    where markup (x:xs)   ys   (F:ds) = First x  : markup xs ys ds
-          markup   xs   (y:ys) (S:ds) = Second y : markup xs ys ds
-          markup (x:xs) (y:ys) (B:ds) = Both x y : markup xs ys ds
-          markup _ _ _ = []
-
-getGroupedDiffBy :: (t -> t -> Bool) -> [t] -> [t] -> [Diff [t]]
-getGroupedDiffBy eq a b = go $ getDiffBy eq a b
-    where go (First x  : xs) = let (fs, rest) = goFirsts  xs in First  (x:fs)     : go rest
-          go (Second x : xs) = let (fs, rest) = goSeconds xs in Second (x:fs)     : go rest
-          go (Both x y : xs) = let (fs, rest) = goBoth    xs
-                                   (fxs, fys) = unzip fs
-                               in Both (x:fxs) (y:fys) : go rest
-          go [] = []
-
-          goFirsts  (First x  : xs) = let (fs, rest) = goFirsts  xs in (x:fs, rest)
-          goFirsts  xs = ([],xs)
-
-          goSeconds (Second x : xs) = let (fs, rest) = goSeconds xs in (x:fs, rest)
-          goSeconds xs = ([],xs)
-
-          goBoth    (Both x y : xs) = let (fs, rest) = goBoth xs    in ((x,y):fs, rest)
-          goBoth    xs = ([],xs)
diff --git a/hspec-core/vendor/stm-2.5.0.1/Control/Concurrent/STM/TMVar.hs b/hspec-core/vendor/stm-2.5.0.1/Control/Concurrent/STM/TMVar.hs
deleted file mode 100644
--- a/hspec-core/vendor/stm-2.5.0.1/Control/Concurrent/STM/TMVar.hs
+++ /dev/null
@@ -1,168 +0,0 @@
-{-# LANGUAGE CPP, DeriveDataTypeable, MagicHash, UnboxedTuples #-}
-
-#if __GLASGOW_HASKELL__ >= 701
-{-# LANGUAGE Trustworthy #-}
-#endif
-
-{-# OPTIONS -fno-warn-implicit-prelude #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  Control.Concurrent.STM.TMVar
--- Copyright   :  (c) The University of Glasgow 2004
--- License     :  BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (requires STM)
---
--- TMVar: Transactional MVars, for use in the STM monad
--- (GHC only)
---
------------------------------------------------------------------------------
-
-module Control.Concurrent.STM.TMVar (
-#ifdef __GLASGOW_HASKELL__
-        -- * TMVars
-        TMVar,
-        newTMVar,
-        newEmptyTMVar,
-        newTMVarIO,
-        newEmptyTMVarIO,
-        takeTMVar,
-        putTMVar,
-        readTMVar,
-        tryReadTMVar,
-        swapTMVar,
-        tryTakeTMVar,
-        tryPutTMVar,
-        isEmptyTMVar,
-        mkWeakTMVar
-#endif
-  ) where
-
-#ifdef __GLASGOW_HASKELL__
-import GHC.Base
-import GHC.Conc
-import GHC.Weak
-
-import Data.Typeable (Typeable)
-
-newtype TMVar a = TMVar (TVar (Maybe a)) deriving (Eq, Typeable)
-{- ^
-A 'TMVar' is a synchronising variable, used
-for communication between concurrent threads.  It can be thought of
-as a box, which may be empty or full.
--}
-
--- |Create a 'TMVar' which contains the supplied value.
-newTMVar :: a -> STM (TMVar a)
-newTMVar a = do
-  t <- newTVar (Just a)
-  return (TMVar t)
-
--- |@IO@ version of 'newTMVar'.  This is useful for creating top-level
--- 'TMVar's using 'System.IO.Unsafe.unsafePerformIO', because using
--- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't
--- possible.
-newTMVarIO :: a -> IO (TMVar a)
-newTMVarIO a = do
-  t <- newTVarIO (Just a)
-  return (TMVar t)
-
--- |Create a 'TMVar' which is initially empty.
-newEmptyTMVar :: STM (TMVar a)
-newEmptyTMVar = do
-  t <- newTVar Nothing
-  return (TMVar t)
-
--- |@IO@ version of 'newEmptyTMVar'.  This is useful for creating top-level
--- 'TMVar's using 'System.IO.Unsafe.unsafePerformIO', because using
--- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't
--- possible.
-newEmptyTMVarIO :: IO (TMVar a)
-newEmptyTMVarIO = do
-  t <- newTVarIO Nothing
-  return (TMVar t)
-
--- |Return the contents of the 'TMVar'.  If the 'TMVar' is currently
--- empty, the transaction will 'retry'.  After a 'takeTMVar',
--- the 'TMVar' is left empty.
-takeTMVar :: TMVar a -> STM a
-takeTMVar (TMVar t) = do
-  m <- readTVar t
-  case m of
-    Nothing -> retry
-    Just a  -> do writeTVar t Nothing; return a
-
--- | A version of 'takeTMVar' that does not 'retry'.  The 'tryTakeTMVar'
--- function returns 'Nothing' if the 'TMVar' was empty, or @'Just' a@ if
--- the 'TMVar' was full with contents @a@.  After 'tryTakeTMVar', the
--- 'TMVar' is left empty.
-tryTakeTMVar :: TMVar a -> STM (Maybe a)
-tryTakeTMVar (TMVar t) = do
-  m <- readTVar t
-  case m of
-    Nothing -> return Nothing
-    Just a  -> do writeTVar t Nothing; return (Just a)
-
--- |Put a value into a 'TMVar'.  If the 'TMVar' is currently full,
--- 'putTMVar' will 'retry'.
-putTMVar :: TMVar a -> a -> STM ()
-putTMVar (TMVar t) a = do
-  m <- readTVar t
-  case m of
-    Nothing -> do writeTVar t (Just a); return ()
-    Just _  -> retry
-
--- | A version of 'putTMVar' that does not 'retry'.  The 'tryPutTMVar'
--- function attempts to put the value @a@ into the 'TMVar', returning
--- 'True' if it was successful, or 'False' otherwise.
-tryPutTMVar :: TMVar a -> a -> STM Bool
-tryPutTMVar (TMVar t) a = do
-  m <- readTVar t
-  case m of
-    Nothing -> do writeTVar t (Just a); return True
-    Just _  -> return False
-
--- | This is a combination of 'takeTMVar' and 'putTMVar'; ie. it
--- takes the value from the 'TMVar', puts it back, and also returns
--- it.
-readTMVar :: TMVar a -> STM a
-readTMVar (TMVar t) = do
-  m <- readTVar t
-  case m of
-    Nothing -> retry
-    Just a  -> return a
-
--- | A version of 'readTMVar' which does not retry. Instead it
--- returns @Nothing@ if no value is available.
---
--- @since 2.3
-tryReadTMVar :: TMVar a -> STM (Maybe a)
-tryReadTMVar (TMVar t) = readTVar t
-
--- |Swap the contents of a 'TMVar' for a new value.
-swapTMVar :: TMVar a -> a -> STM a
-swapTMVar (TMVar t) new = do
-  m <- readTVar t
-  case m of
-    Nothing -> retry
-    Just old -> do writeTVar t (Just new); return old
-
--- |Check whether a given 'TMVar' is empty.
-isEmptyTMVar :: TMVar a -> STM Bool
-isEmptyTMVar (TMVar t) = do
-  m <- readTVar t
-  case m of
-    Nothing -> return True
-    Just _  -> return False
-
--- | Make a 'Weak' pointer to a 'TMVar', using the second argument as
--- a finalizer to run when the 'TMVar' is garbage-collected.
---
--- @since 2.4.4
-mkWeakTMVar :: TMVar a -> IO () -> IO (Weak (TMVar a))
-mkWeakTMVar tmv@(TMVar (TVar t#)) (IO finalizer) = IO $ \s ->
-    case mkWeak# t# tmv finalizer s of (# s1, w #) -> (# s1, Weak w #)
-#endif
diff --git a/hspec-discover/src/Test/Hspec/Discover/Config.hs b/hspec-discover/src/Test/Hspec/Discover/Config.hs
--- a/hspec-discover/src/Test/Hspec/Discover/Config.hs
+++ b/hspec-discover/src/Test/Hspec/Discover/Config.hs
@@ -1,6 +1,6 @@
 -- |
 -- /NOTE:/ This module is not meant for public consumption.  For user
--- documentation look at http://hspec.github.io/hspec-discover.html.
+-- documentation look at https://hspec.github.io/hspec-discover.html.
 module Test.Hspec.Discover.Config (
   Config (..)
 , defaultConfig
diff --git a/hspec-discover/src/Test/Hspec/Discover/Run.hs b/hspec-discover/src/Test/Hspec/Discover/Run.hs
--- a/hspec-discover/src/Test/Hspec/Discover/Run.hs
+++ b/hspec-discover/src/Test/Hspec/Discover/Run.hs
@@ -3,7 +3,7 @@
 -- | A preprocessor that finds and combines specs.
 --
 -- /NOTE:/ This module is not meant for public consumption.  For user
--- documentation look at http://hspec.github.io/hspec-discover.html.
+-- documentation look at https://hspec.github.io/hspec-discover.html.
 module Test.Hspec.Discover.Run (
   run
 
@@ -149,7 +149,7 @@
     mkModule :: [String] -> String
     mkModule = intercalate "." . reverse
 
--- See `Cabal.Distribution.ModuleName` (http://git.io/bj34)
+-- See `Cabal.Distribution.ModuleName` (https://git.io/bj34)
 isValidModuleName :: String -> Bool
 isValidModuleName [] = False
 isValidModuleName (c:cs) = isUpper c && all isValidModuleChar cs
diff --git a/hspec-discover/src/Test/Hspec/Discover/Sort.hs b/hspec-discover/src/Test/Hspec/Discover/Sort.hs
--- a/hspec-discover/src/Test/Hspec/Discover/Sort.hs
+++ b/hspec-discover/src/Test/Hspec/Discover/Sort.hs
@@ -1,6 +1,6 @@
 -- |
 -- /NOTE:/ This module is not meant for public consumption.  For user
--- documentation look at http://hspec.github.io/hspec-discover.html.
+-- documentation look at https://hspec.github.io/hspec-discover.html.
 module Test.Hspec.Discover.Sort (
   sortNaturallyBy
 , NaturalSortKey
diff --git a/hspec-meta.cabal b/hspec-meta.cabal
--- a/hspec-meta.cabal
+++ b/hspec-meta.cabal
@@ -1,37 +1,38 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.0.
+-- This file has been generated from package.yaml by hpack version 0.35.2.
 --
 -- see: https://github.com/sol/hpack
 
 name:           hspec-meta
-version:        2.10.5
+version:        2.11.2
 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.
 category:       Testing
 stability:      experimental
-homepage:       http://hspec.github.io/
+homepage:       https://hspec.github.io/
 bug-reports:    https://github.com/hspec/hspec/issues
 maintainer:     Simon Hengel <sol@typeful.net>
-copyright:      (c) 2011-2022 Simon Hengel,
+copyright:      (c) 2011-2023 Simon Hengel,
                 (c) 2011-2012 Trystan Spangler,
                 (c) 2011 Greg Weber
 license:        MIT
 license-file:   LICENSE
 build-type:     Simple
-extra-source-files:
-    version.yaml
 
 source-repository head
   type: git
   location: https://github.com/hspec/hspec
+  subdir: hspec-meta
 
 library
   exposed-modules:
       Test.Hspec.Meta
       Test.Hspec.Discover
   other-modules:
+      Control.Concurrent.Async
+      Data.Algorithm.Diff
       Test.Hspec
       Test.Hspec.Formatters
       Test.Hspec.QuickCheck
@@ -56,10 +57,11 @@
       Test.Hspec.Core.Formatters.Internal
       Test.Hspec.Core.Formatters.Pretty
       Test.Hspec.Core.Formatters.Pretty.Parser
-      Test.Hspec.Core.Formatters.Pretty.Parser.Types
+      Test.Hspec.Core.Formatters.Pretty.Parser.Parser
       Test.Hspec.Core.Formatters.Pretty.Unicode
       Test.Hspec.Core.Formatters.V1
       Test.Hspec.Core.Formatters.V1.Free
+      Test.Hspec.Core.Formatters.V1.Internal
       Test.Hspec.Core.Formatters.V1.Monad
       Test.Hspec.Core.Formatters.V2
       Test.Hspec.Core.Hooks
@@ -67,6 +69,7 @@
       Test.Hspec.Core.QuickCheckUtil
       Test.Hspec.Core.Runner
       Test.Hspec.Core.Runner.Eval
+      Test.Hspec.Core.Runner.JobQueue
       Test.Hspec.Core.Runner.PrintSlowSpecItems
       Test.Hspec.Core.Runner.Result
       Test.Hspec.Core.Shuffle
@@ -75,44 +78,32 @@
       Test.Hspec.Core.Timer
       Test.Hspec.Core.Tree
       Test.Hspec.Core.Util
-      Control.Concurrent.Async
-      Data.Algorithm.Diff
-      Test.HUnit
-      Test.HUnit.Base
-      Test.HUnit.Lang
-      Test.HUnit.Terminal
-      Test.HUnit.Text
-      Test.Hspec.Expectations
-      Test.Hspec.Expectations.Contrib
-      Test.Hspec.Expectations.Matcher
       Paths_hspec_meta
   hs-source-dirs:
       src
+      vendor
+      hspec/src
       hspec-core/src
-      hspec-core/vendor
-      vendor/HUnit-1.6.2.0/src/
-      vendor/hspec-expectations-0.8.2/src/
   ghc-options: -Wall -fno-warn-incomplete-uni-patterns
   build-depends:
-      QuickCheck >=2.12
-    , ansi-terminal
+      HUnit ==1.6.*
+    , QuickCheck >=2.13.1
+    , ansi-terminal >=0.6.2
     , array
-    , base ==4.*
-    , call-stack
-    , clock
+    , base >=4.8.2.0 && <5
+    , call-stack >=0.2.0
     , deepseq
     , directory
     , filepath
-    , quickcheck-io
+    , haskell-lexer
+    , hspec-expectations ==0.8.3.*
+    , process
+    , quickcheck-io >=0.2.0
     , random
-    , setenv
+    , tf-random
     , time
     , transformers >=0.2.2.0
   default-language: Haskell2010
-  if impl(ghc >= 8.2.1)
-    build-depends:
-        ghc
-      , ghc-boot-th
   if impl(ghc >= 8.4.1)
     build-depends:
         stm >=2.2
@@ -120,7 +111,7 @@
     other-modules:
         Control.Concurrent.STM.TMVar
     hs-source-dirs:
-        hspec-core/vendor/stm-2.5.0.1/
+        vendor/stm-2.5.0.1/
 
 executable hspec-meta-discover
   main-is: hspec-discover.hs
@@ -134,22 +125,29 @@
       hspec-discover/driver
   ghc-options: -Wall -fno-warn-incomplete-uni-patterns
   build-depends:
-      QuickCheck >=2.12
-    , ansi-terminal
+      HUnit ==1.6.*
+    , QuickCheck >=2.13.1
+    , ansi-terminal >=0.6.2
     , array
-    , base ==4.*
-    , call-stack
-    , clock
+    , base >=4.8.2.0 && <5
+    , call-stack >=0.2.0
     , deepseq
     , directory
     , filepath
-    , quickcheck-io
+    , haskell-lexer
+    , hspec-expectations ==0.8.3.*
+    , process
+    , quickcheck-io >=0.2.0
     , random
-    , setenv
+    , tf-random
     , time
     , transformers >=0.2.2.0
   default-language: Haskell2010
-  if impl(ghc >= 8.2.1)
+  if impl(ghc >= 8.4.1)
     build-depends:
-        ghc
-      , ghc-boot-th
+        stm >=2.2
+  else
+    other-modules:
+        Control.Concurrent.STM.TMVar
+    hs-source-dirs:
+        vendor/stm-2.5.0.1/
diff --git a/hspec/src/Test/Hspec.hs b/hspec/src/Test/Hspec.hs
new file mode 100644
--- /dev/null
+++ b/hspec/src/Test/Hspec.hs
@@ -0,0 +1,96 @@
+-- |
+-- Stability: stable
+--
+-- Hspec is a testing framework for Haskell.
+--
+-- This is the library reference for Hspec.
+-- The <https://hspec.github.io/ User's Manual> contains more in-depth
+-- documentation.
+module Test.Hspec (
+-- * Types
+  Spec
+, SpecWith
+, Arg
+, Example
+
+-- * Setting expectations
+, module Test.Hspec.Expectations
+
+-- * Defining a spec
+, it
+, specify
+, describe
+, context
+, example
+, parallel
+, sequential
+, runIO
+
+-- * Pending spec items
+-- |
+-- During a test run a /pending/ spec item is:
+--
+-- 1. not executed
+--
+-- 1. reported as \"pending\"
+, pending
+, pendingWith
+, xit
+, xspecify
+, xdescribe
+, xcontext
+
+-- * Focused spec items
+-- |
+-- During a test run, when a spec contains /focused/ spec items, all other spec
+-- items are ignored.
+, focus
+, fit
+, fspecify
+, fdescribe
+, fcontext
+
+-- * Hooks
+, ActionWith
+, before
+, before_
+, beforeWith
+, beforeAll
+, beforeAll_
+, beforeAllWith
+, after
+, after_
+, afterAll
+, afterAll_
+, around
+, around_
+, aroundWith
+, aroundAll
+, aroundAll_
+, aroundAllWith
+, mapSubject
+, ignoreSubject
+
+-- * Running a spec
+, hspec
+) where
+
+import           Test.Hspec.Core.Spec
+import           Test.Hspec.Core.Hooks
+import           Test.Hspec.Runner
+import           Test.Hspec.Expectations
+
+-- | @example@ is a type restricted version of `id`.  It can be used to get better
+-- error messages on type mismatches.
+--
+-- Compare e.g.
+--
+-- > it "exposes some behavior" $ example $ do
+-- >   putStrLn
+--
+-- with
+--
+-- > it "exposes some behavior" $ do
+-- >   putStrLn
+example :: Expectation -> Expectation
+example = id
diff --git a/hspec/src/Test/Hspec/Discover.hs b/hspec/src/Test/Hspec/Discover.hs
new file mode 100644
--- /dev/null
+++ b/hspec/src/Test/Hspec/Discover.hs
@@ -0,0 +1,34 @@
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
+{-# LANGUAGE FlexibleInstances #-}
+module Test.Hspec.Discover {-# WARNING
+  "This module is used by @hspec-discover@.  It is not part of the public API and may change at any time."
+  #-} (
+  Spec
+, hspec
+, IsFormatter (..)
+, hspecWithFormatter
+, postProcessSpec
+, describe
+, module Prelude
+) where
+
+import           Test.Hspec.Core.Spec
+import           Test.Hspec.Core.Runner
+import           Test.Hspec.Core.Formatters.V1
+
+class IsFormatter a where
+  toFormatter :: a -> IO Formatter
+
+instance IsFormatter (IO Formatter) where
+  toFormatter = id
+
+instance IsFormatter Formatter where
+  toFormatter = return
+
+hspecWithFormatter :: IsFormatter a => a -> Spec -> IO ()
+hspecWithFormatter formatter spec = do
+  f <- toFormatter formatter
+  hspecWith defaultConfig {configFormatter = Just f} spec
+
+postProcessSpec :: FilePath -> Spec -> Spec
+postProcessSpec _ = id
diff --git a/hspec/src/Test/Hspec/Formatters.hs b/hspec/src/Test/Hspec/Formatters.hs
new file mode 100644
--- /dev/null
+++ b/hspec/src/Test/Hspec/Formatters.hs
@@ -0,0 +1,8 @@
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
+-- |
+-- Stability: deprecated
+module Test.Hspec.Formatters
+{-# DEPRECATED "Use [Test.Hspec.Api.Formatters.V1](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Formatters-V1.html) instead." #-}
+(module Test.Hspec.Core.Formatters.V1)
+where
+import           Test.Hspec.Core.Formatters.V1
diff --git a/hspec/src/Test/Hspec/QuickCheck.hs b/hspec/src/Test/Hspec/QuickCheck.hs
new file mode 100644
--- /dev/null
+++ b/hspec/src/Test/Hspec/QuickCheck.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ConstraintKinds #-}
+module Test.Hspec.QuickCheck (
+-- * Params
+  modifyArgs
+, modifyMaxSuccess
+, modifyMaxDiscardRatio
+, modifyMaxSize
+, modifyMaxShrinks
+
+-- * Shortcuts
+, prop
+, xprop
+, fprop
+) where
+
+import           Test.Hspec
+import           Test.QuickCheck
+import           Test.Hspec.Core.QuickCheck
+
+-- |
+-- > prop ".." $
+-- >   ..
+--
+-- is a shortcut for
+--
+-- @
+-- `it` ".." $ `property` $
+--   ..
+-- @
+prop :: (HasCallStack, Testable prop) => String -> prop -> Spec
+prop s = it s . property
+
+
+-- |
+-- > xprop ".." $
+-- >   ..
+--
+-- is a shortcut for
+--
+-- @
+-- `xit` ".." $ `property` $
+--   ..
+-- @
+xprop :: (HasCallStack, Testable prop) => String -> prop -> Spec
+xprop s = xit s . property
+
+
+-- |
+-- > fprop ".." $
+-- >   ..
+--
+-- is a shortcut for
+--
+-- @
+-- `fit` ".." $ `property` $
+--   ..
+-- @
+fprop :: (HasCallStack, Testable prop) => String -> prop -> Spec
+fprop s = fit s . property
diff --git a/hspec/src/Test/Hspec/Runner.hs b/hspec/src/Test/Hspec/Runner.hs
new file mode 100644
--- /dev/null
+++ b/hspec/src/Test/Hspec/Runner.hs
@@ -0,0 +1,2 @@
+module Test.Hspec.Runner (module Test.Hspec.Core.Runner) where
+import           Test.Hspec.Core.Runner
diff --git a/src/Test/Hspec.hs b/src/Test/Hspec.hs
deleted file mode 100644
--- a/src/Test/Hspec.hs
+++ /dev/null
@@ -1,95 +0,0 @@
--- |
--- Stability: stable
---
--- Hspec is a testing framework for Haskell.
---
--- This is the library reference for Hspec.
--- The <http://hspec.github.io/ User's Manual> contains more in-depth
--- documentation.
-module Test.Hspec (
--- * Types
-  Spec
-, SpecWith
-, Arg
-, Example
-
--- * Setting expectations
-, module Test.Hspec.Expectations
-
--- * Defining a spec
-, it
-, specify
-, describe
-, context
-, example
-, parallel
-, runIO
-
--- * Pending spec items
--- |
--- During a test run a /pending/ spec item is:
---
--- 1. not executed
---
--- 1. reported as \"pending\"
-, pending
-, pendingWith
-, xit
-, xspecify
-, xdescribe
-, xcontext
-
--- * Focused spec items
--- |
--- During a test run, when a spec contains /focused/ spec items, all other spec
--- items are ignored.
-, focus
-, fit
-, fspecify
-, fdescribe
-, fcontext
-
--- * Hooks
-, ActionWith
-, before
-, before_
-, beforeWith
-, beforeAll
-, beforeAll_
-, beforeAllWith
-, after
-, after_
-, afterAll
-, afterAll_
-, around
-, around_
-, aroundWith
-, aroundAll
-, aroundAll_
-, aroundAllWith
-, mapSubject
-, ignoreSubject
-
--- * Running a spec
-, hspec
-) where
-
-import           Test.Hspec.Core.Spec
-import           Test.Hspec.Core.Hooks
-import           Test.Hspec.Runner
-import           Test.Hspec.Expectations
-
--- | @example@ is a type restricted version of `id`.  It can be used to get better
--- error messages on type mismatches.
---
--- Compare e.g.
---
--- > it "exposes some behavior" $ example $ do
--- >   putStrLn
---
--- with
---
--- > it "exposes some behavior" $ do
--- >   putStrLn
-example :: Expectation -> Expectation
-example = id
diff --git a/src/Test/Hspec/Discover.hs b/src/Test/Hspec/Discover.hs
deleted file mode 100644
--- a/src/Test/Hspec/Discover.hs
+++ /dev/null
@@ -1,33 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-module Test.Hspec.Discover {-# WARNING
-  "This module is used by @hspec-discover@.  It is not part of the public API and may change at any time."
-  #-} (
-  Spec
-, hspec
-, IsFormatter (..)
-, hspecWithFormatter
-, postProcessSpec
-, describe
-, module Prelude
-) where
-
-import           Test.Hspec.Core.Spec
-import           Test.Hspec.Core.Runner
-import           Test.Hspec.Core.Formatters.V1
-
-class IsFormatter a where
-  toFormatter :: a -> IO Formatter
-
-instance IsFormatter (IO Formatter) where
-  toFormatter = id
-
-instance IsFormatter Formatter where
-  toFormatter = return
-
-hspecWithFormatter :: IsFormatter a => a -> Spec -> IO ()
-hspecWithFormatter formatter spec = do
-  f <- toFormatter formatter
-  hspecWith defaultConfig {configFormatter = Just f} spec
-
-postProcessSpec :: FilePath -> Spec -> Spec
-postProcessSpec _ = id
diff --git a/src/Test/Hspec/Formatters.hs b/src/Test/Hspec/Formatters.hs
deleted file mode 100644
--- a/src/Test/Hspec/Formatters.hs
+++ /dev/null
@@ -1,7 +0,0 @@
--- |
--- Deprecated\: Use "Test.Hspec.Core.Formatters.V1" instead.
-module Test.Hspec.Formatters
--- {-# DEPRECATED "Use \"Test.Hspec.Core.Formatters.V1\" instead." #-}
-(module Test.Hspec.Core.Formatters.V1)
-where
-import           Test.Hspec.Core.Formatters.V1
diff --git a/src/Test/Hspec/QuickCheck.hs b/src/Test/Hspec/QuickCheck.hs
deleted file mode 100644
--- a/src/Test/Hspec/QuickCheck.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ConstraintKinds #-}
-module Test.Hspec.QuickCheck (
--- * Params
-  modifyArgs
-, modifyMaxSuccess
-, modifyMaxDiscardRatio
-, modifyMaxSize
-, modifyMaxShrinks
-
--- * Shortcuts
-, prop
-) where
-
-import           Test.Hspec
-import           Test.QuickCheck
-import           Test.Hspec.Core.QuickCheck
-
--- |
--- > prop ".." $
--- >   ..
---
--- is a shortcut for
---
--- > it ".." $ property $
--- >   ..
-prop :: (HasCallStack, Testable prop) => String -> prop -> Spec
-prop s = it s . property
diff --git a/src/Test/Hspec/Runner.hs b/src/Test/Hspec/Runner.hs
deleted file mode 100644
--- a/src/Test/Hspec/Runner.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-module Test.Hspec.Runner (module Test.Hspec.Core.Runner) where
-import           Test.Hspec.Core.Runner
diff --git a/vendor/Control/Concurrent/Async.hs b/vendor/Control/Concurrent/Async.hs
new file mode 100644
--- /dev/null
+++ b/vendor/Control/Concurrent/Async.hs
@@ -0,0 +1,963 @@
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples, RankNTypes,
+    ExistentialQuantification #-}
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Trustworthy #-}
+#endif
+#if __GLASGOW_HASKELL__ < 710
+{-# LANGUAGE DeriveDataTypeable #-}
+#endif
+{-# OPTIONS -Wall -fno-warn-implicit-prelude -fno-warn-unused-imports #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- 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 'forkIO' threads and @MVar@ directly.
+--
+-- == High-level API
+--
+-- @async@'s high-level API spawns /lexically scoped/ threads,
+-- ensuring the following key poperties that make it safer to use
+-- than using plain 'forkIO':
+--
+-- 1. No exception is swallowed (waiting for results propagates exceptions).
+-- 2. No thread is leaked (left running unintentionally).
+--
+-- (This is done using the 'Control.Exception.bracket' pattern to work in presence
+-- of synchornous and asynchronous exceptions.)
+--
+-- __Most practical/production code should only use the high-level API__.
+--
+-- 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' is a wrapper around a low-level 'forkIO' thread.
+--
+-- The fundamental function to spawn threads with the high-level API is
+-- 'withAsync'.
+--
+-- For example, to fetch two web pages at the same time, we could do
+-- this (assuming a suitable @getURL@ function):
+--
+-- > withAsync (getURL url1) $ \a1 -> do
+-- >   withAsync (getURL url2) $ \a2 -> do
+-- >     page1 <- wait a1
+-- >     page2 <- wait a2
+-- >     ...
+--
+-- where 'withAsync' 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 ensures property (1): No exception is swallowed.
+-- * If an exception bubbles up through a 'withAsync', then the 'Async'
+--   it spawned is 'cancel'ed. This ensures property (2): No thread is leaked.
+--
+-- Often we do not care to work manually with 'Async' handles like
+-- @a1@ and @a2@. Instead, we want to express high-level objectives like
+-- performing two or more tasks concurrently, and waiting for one or all
+-- of them to finish.
+--
+-- For example, the pattern of performing two IO actions concurrently and
+-- waiting for both 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 section __/High-level utilities/__ covers the most
+-- common high-level objectives, including:
+--
+-- * Waiting for 2 results ('concurrently').
+-- * Waiting for many results ('mapConcurrently' / 'forConcurrently').
+-- * Waiting for the first of 2 results ('race').
+-- * Waiting for arbitrary nestings of "all of /N/" and "the first of /N/"
+--   results with the 'Concurrently' newtype and its 'Applicative' and
+--   'Alternative' instances.
+--
+-- Click here to scroll to that section:
+-- "Control.Concurrent.Async#high-level-utilities".
+--
+-- == Low-level API
+--
+-- Some use cases require parallelism that is not lexically scoped.
+--
+-- For those, the low-level function 'async' can be used as a direct
+-- equivalent of 'forkIO':
+--
+-- > -- Do NOT use this code in production, it has a flaw (explained below).
+-- > do
+-- >   a1 <- async (getURL url1)
+-- >   a2 <- async (getURL url2)
+-- >   page1 <- wait a1
+-- >   page2 <- wait a2
+-- >   ...
+--
+-- In contrast to 'withAsync', this code has a problem.
+--
+-- It still fulfills property (1) in that an exception arising from
+-- @getUrl@ will be re-thrown by 'wait', but it does not fulfill
+-- property (2).
+-- Consider the case when the first 'wait' throws an exception; then the
+-- second 'wait' will not happen, and the second 'async' may be left
+-- running in the background, possibly indefinitely.
+--
+-- 'withAsync' is like 'async', except that the 'Async' is
+-- automatically killed (using 'uninterruptibleCancel') if the
+-- enclosing IO operation returns before it has completed.
+-- Furthermore, 'withAsync' allows a tree of threads to be built, such
+-- that children are automatically killed if their parents die for any
+-- reason.
+--
+-- If you need to use the low-level API, ensure that you gurantee
+-- property (2) by other means, such as 'link'ing asyncs that need
+-- to die together, and protecting against asynchronous exceptions
+-- using 'Control.Exception.bracket', 'Control.Exception.mask',
+-- or other functions from "Control.Exception".
+--
+-- == Miscellaneous
+--
+-- The 'Functor' instance can be used to change the result of an
+-- 'Async'.  For example:
+--
+-- > ghci> withAsync (return 3) (\a -> wait (fmap (+1) a))
+-- > 4
+--
+-- === Resource exhaustion
+--
+-- As with all concurrent programming, keep in mind that while
+-- Haskell's cooperative ("green") multithreading carries low overhead,
+-- spawning too many of them at the same time may lead to resource exhaustion
+-- (of memory, file descriptors, or other limited resources), given that the
+-- actions running in the threads consume these resources.
+
+-----------------------------------------------------------------------------
+
+module Control.Concurrent.Async (
+
+    -- * Asynchronous actions
+    Async,
+
+    -- * High-level API
+
+    -- ** Spawning with automatic 'cancel'ation
+    withAsync, withAsyncBound, withAsyncOn, withAsyncWithUnmask,
+    withAsyncOnWithUnmask,
+
+    -- ** Querying 'Async's
+    wait, poll, waitCatch, asyncThreadId,
+    cancel, uninterruptibleCancel, cancelWith, AsyncCancelled(..),
+
+    -- ** #high-level-utilities# High-level utilities
+    race, race_,
+    concurrently, concurrently_,
+    mapConcurrently, forConcurrently,
+    mapConcurrently_, forConcurrently_,
+    replicateConcurrently, replicateConcurrently_,
+    Concurrently(..),
+    compareAsyncs,
+
+    -- ** Specialised operations
+
+    -- *** 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,
+
+    -- * Low-level API
+
+    -- ** Spawning (low-level API)
+    async, asyncBound, asyncOn, asyncWithUnmask, asyncOnWithUnmask,
+
+    -- ** Linking
+    link, linkOnly, link2, link2Only, ExceptionInLinkedThread(..),
+
+  ) where
+
+import Control.Concurrent.STM.TMVar
+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 Asyncs that may have different types by their 'ThreadId'.
+compareAsyncs :: Async a -> Async b -> Ordering
+compareAsyncs (Async t1 _) (Async t2 _) = compare t1 t2
+
+-- | Spawn an asynchronous action in a separate thread.
+--
+-- Like for 'forkIO', the action may be left running unintentinally
+-- (see module-level documentation for details).
+--
+-- __Use 'withAsync' style functions wherever you can instead!__
+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 a) `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 = tryAgain . atomically . waitSTM
+  where
+    -- See: https://github.com/simonmar/async/issues/14
+    tryAgain f = f `catch` \BlockedIndefinitelyOnSTM -> f
+
+-- | 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 = tryAgain $ atomically (waitBothSTM left right)
+  where
+    -- See: https://github.com/simonmar/async/issues/14
+    tryAgain f = f `catch` \BlockedIndefinitelyOnSTM -> f
+
+-- | 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
+  showsPrec p (ExceptionInLinkedThread (Async t _) e) =
+    showParen (p >= 11) $
+      showString "ExceptionInLinkedThread " .
+      showsPrec 11 t .
+      showString " " .
+      showsPrec 11 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, wrapped in 'ExceptionInLinkedThread'.
+--
+-- 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)
+
+-- | 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'.
+--
+-- The supplied predicate determines which exceptions in the target
+-- thread should be propagated to the source thread.
+--
+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)
+
+-- | 'concurrently', but ignore the result values
+--
+-- @since 2.1.1
+concurrently_ :: IO a -> IO b -> IO ()
+
+#define USE_ASYNC_VERSIONS 0
+
+#if USE_ASYNC_VERSIONS
+
+race left right =
+  withAsync left $ \a ->
+  withAsync right $ \b ->
+  waitEither a b
+
+race_ left right = void $ race left right
+
+concurrently left right =
+  withAsync left $ \a ->
+  withAsync right $ \b ->
+  waitBoth a b
+
+concurrently_ left right = void $ concurrently left right
+
+#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
+
+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
+
+
+#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"]
+--
+-- Take into account that @async@ will try to immediately spawn a thread
+-- for each element of the @Traversable@, so running this on large
+-- inputs without care may lead to resource exhaustion (of memory,
+-- file descriptors, or other limited resources).
+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;
+-- a concurrent equivalent of '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;
+-- a concurrent equivalent of 'forM_'.
+forConcurrently_ :: F.Foldable f => f a -> (a -> IO b) -> IO ()
+forConcurrently_ = flip mapConcurrently_
+
+-- | 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 (IO action) = IO $ \ s ->
+   case (fork# action s) of (# s1, tid #) -> (# s1, ThreadId tid #)
+
+{-# INLINE rawForkOn #-}
+rawForkOn :: Int -> IO () -> IO ThreadId
+rawForkOn (I# cpu) (IO action) = IO $ \ s ->
+   case (forkOn# cpu action s) of (# s1, tid #) -> (# s1, ThreadId tid #)
diff --git a/vendor/Data/Algorithm/Diff.hs b/vendor/Data/Algorithm/Diff.hs
new file mode 100644
--- /dev/null
+++ b/vendor/Data/Algorithm/Diff.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Algorithm.Diff
+-- Copyright   :  (c) Sterling Clover 2008-2011, Kevin Charter 2011
+-- License     :  BSD 3 Clause
+-- Maintainer  :  s.clover@gmail.com
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- This is an implementation of the O(ND) diff algorithm as described in
+-- \"An O(ND) Difference Algorithm and Its Variations (1986)\"
+-- <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.4.6927>. It is O(mn) in space.
+-- The algorithm is the same one used by standared Unix diff.
+-----------------------------------------------------------------------------
+
+module Data.Algorithm.Diff
+    ( Diff(..)
+    -- * Comparing lists for differences
+    , getDiff
+    , getDiffBy
+
+    -- * Finding chunks of differences
+    , getGroupedDiff
+    , getGroupedDiffBy
+    ) where
+
+import Prelude hiding (pi)
+
+import Data.Array
+
+data DI = F | S | B deriving (Show, Eq)
+
+-- | A value is either from the 'First' list, the 'Second' or from 'Both'.
+-- 'Both' contains both the left and right values, in case you are using a form
+-- of equality that doesn't check all data (for example, if you are using a
+-- newtype to only perform equality on side of a tuple).
+data Diff a = First a | Second a | Both a a deriving (Show, Eq, Functor)
+
+data DL = DL {poi :: !Int, poj :: !Int, path::[DI]} deriving (Show, Eq)
+
+instance Ord DL
+        where x <= y = if poi x == poi y
+                then  poj x > poj y
+                else poi x <= poi y
+
+canDiag :: (a -> a -> Bool) -> [a] -> [a] -> Int -> Int -> Int -> Int -> Bool
+canDiag eq as bs lena lenb = \ i j ->
+   if i < lena && j < lenb then (arAs ! i) `eq` (arBs ! j) else False
+    where arAs = listArray (0,lena - 1) as
+          arBs = listArray (0,lenb - 1) bs
+
+dstep :: (Int -> Int -> Bool) -> [DL] -> [DL]
+dstep cd dls = hd:pairMaxes rst
+  where (hd:rst) = nextDLs dls
+        nextDLs [] = []
+        nextDLs (dl:rest) = dl':dl'':nextDLs rest
+          where dl'  = addsnake cd $ dl {poi=poi dl + 1, path=(F : pdl)}
+                dl'' = addsnake cd $ dl {poj=poj dl + 1, path=(S : pdl)}
+                pdl = path dl
+        pairMaxes [] = []
+        pairMaxes [x] = [x]
+        pairMaxes (x:y:rest) = max x y:pairMaxes rest
+
+addsnake :: (Int -> Int -> Bool) -> DL -> DL
+addsnake cd dl
+    | cd pi pj = addsnake cd $
+                 dl {poi = pi + 1, poj = pj + 1, path=(B : path dl)}
+    | otherwise   = dl
+    where pi = poi dl; pj = poj dl
+
+lcs :: (a -> a -> Bool) -> [a] -> [a] -> [DI]
+lcs eq as bs = path . head . dropWhile (\dl -> poi dl /= lena || poj dl /= lenb) .
+            concat . iterate (dstep cd) . (:[]) . addsnake cd $
+            DL {poi=0,poj=0,path=[]}
+            where cd = canDiag eq as bs lena lenb
+                  lena = length as; lenb = length bs
+
+-- | Takes two lists and returns a list of differences between them. This is
+-- 'getDiffBy' with '==' used as predicate.
+getDiff :: (Eq t) => [t] -> [t] -> [Diff t]
+getDiff = getDiffBy (==)
+
+-- | Takes two lists and returns a list of differences between them, grouped
+-- into chunks. This is 'getGroupedDiffBy' with '==' used as predicate.
+getGroupedDiff :: (Eq t) => [t] -> [t] -> [Diff [t]]
+getGroupedDiff = getGroupedDiffBy (==)
+
+-- | A form of 'getDiff' with no 'Eq' constraint. Instead, an equality predicate
+-- is taken as the first argument.
+getDiffBy :: (t -> t -> Bool) -> [t] -> [t] -> [Diff t]
+getDiffBy eq a b = markup a b . reverse $ lcs eq a b
+    where markup (x:xs)   ys   (F:ds) = First x  : markup xs ys ds
+          markup   xs   (y:ys) (S:ds) = Second y : markup xs ys ds
+          markup (x:xs) (y:ys) (B:ds) = Both x y : markup xs ys ds
+          markup _ _ _ = []
+
+getGroupedDiffBy :: (t -> t -> Bool) -> [t] -> [t] -> [Diff [t]]
+getGroupedDiffBy eq a b = go $ getDiffBy eq a b
+    where go (First x  : xs) = let (fs, rest) = goFirsts  xs in First  (x:fs)     : go rest
+          go (Second x : xs) = let (fs, rest) = goSeconds xs in Second (x:fs)     : go rest
+          go (Both x y : xs) = let (fs, rest) = goBoth    xs
+                                   (fxs, fys) = unzip fs
+                               in Both (x:fxs) (y:fys) : go rest
+          go [] = []
+
+          goFirsts  (First x  : xs) = let (fs, rest) = goFirsts  xs in (x:fs, rest)
+          goFirsts  xs = ([],xs)
+
+          goSeconds (Second x : xs) = let (fs, rest) = goSeconds xs in (x:fs, rest)
+          goSeconds xs = ([],xs)
+
+          goBoth    (Both x y : xs) = let (fs, rest) = goBoth xs    in ((x,y):fs, rest)
+          goBoth    xs = ([],xs)
diff --git a/vendor/HUnit-1.6.2.0/src/Test/HUnit.hs b/vendor/HUnit-1.6.2.0/src/Test/HUnit.hs
deleted file mode 100644
--- a/vendor/HUnit-1.6.2.0/src/Test/HUnit.hs
+++ /dev/null
@@ -1,80 +0,0 @@
--- | HUnit is a unit testing framework for Haskell, inspired by the JUnit tool
--- for Java. This guide describes how to use HUnit, assuming you are familiar
--- with Haskell, though not necessarily with JUnit.
---
--- In the Haskell module where your tests will reside, import module
--- @Test.HUnit@:
---
--- @
---    import Test.HUnit
--- @
---
---  Define test cases as appropriate:
---
--- @
---    test1 = TestCase (assertEqual "for (foo 3)," (1,2) (foo 3))
---    test2 = TestCase (do (x,y) <- partA 3
---                         assertEqual "for the first result of partA," 5 x
---                         b <- partB y
---                         assertBool ("(partB " ++ show y ++ ") failed") b)
--- @
---
--- Name the test cases and group them together:
---
--- @
---    tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2]
--- @
---
--- Run the tests as a group. At a Haskell interpreter prompt, apply the function
--- @runTestTT@ to the collected tests. (The /TT/ suggests /T/ext orientation
--- with output to the /T/erminal.)
---
--- @
---    \> runTestTT tests
---    Cases: 2  Tried: 2  Errors: 0  Failures: 0
---    \>
--- @
---
--- If the tests are proving their worth, you might see:
---
--- @
---    \> runTestTT tests
---    ### Failure in: 0:test1
---    for (foo 3),
---    expected: (1,2)
---     but got: (1,3)
---    Cases: 2  Tried: 2  Errors: 0  Failures: 1
---    \>
--- @
---
--- You can specify tests even more succinctly using operators and overloaded
--- functions that HUnit provides:
---
--- @
---    tests = test [ "test1" ~: "(foo 3)" ~: (1,2) ~=? (foo 3),
---                   "test2" ~: do (x, y) <- partA 3
---                                 assertEqual "for the first result of partA," 5 x
---                                 partB y \@? "(partB " ++ show y ++ ") failed" ]
--- @
---
--- Assuming the same test failures as before, you would see:
---
--- @
---    \> runTestTT tests
---    ### Failure in: 0:test1:(foo 3)
---    expected: (1,2)
---     but got: (1,3)
---    Cases: 2  Tried: 2  Errors: 0  Failures: 1
---    \>
--- @
-
-module Test.HUnit
-(
-  module Test.HUnit.Base,
-  module Test.HUnit.Text
-)
-where
-
-import Test.HUnit.Base
-import Test.HUnit.Text
-
diff --git a/vendor/HUnit-1.6.2.0/src/Test/HUnit/Base.hs b/vendor/HUnit-1.6.2.0/src/Test/HUnit/Base.hs
deleted file mode 100644
--- a/vendor/HUnit-1.6.2.0/src/Test/HUnit/Base.hs
+++ /dev/null
@@ -1,361 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleContexts #-}
-
-#if __GLASGOW_HASKELL__ >= 704
-{-# LANGUAGE ConstraintKinds #-}
-#define HasCallStack_ HasCallStack =>
-#else
-#define HasCallStack_
-#endif
-
--- | Basic definitions for the HUnit library.
---
---   This module contains what you need to create assertions and test cases and
---   combine them into test suites.
---
---   This module also provides infrastructure for
---   implementing test controllers (which are used to execute tests).
---   See "Test.HUnit.Text" for a great example of how to implement a test
---   controller.
-
-module Test.HUnit.Base
-(
-  -- ** Declaring tests
-  Test(..),
-  (~=?), (~?=), (~:), (~?),
-
-  -- ** Making assertions
-  assertFailure, {- from Test.HUnit.Lang: -}
-  assertBool, assertEqual, assertString,
-  Assertion, {- from Test.HUnit.Lang: -}
-  (@=?), (@?=), (@?),
-
-  -- ** Extending the assertion functionality
-  Assertable(..), ListAssertable(..),
-  AssertionPredicate, AssertionPredicable(..),
-  Testable(..),
-
-  -- ** Test execution
-  -- $testExecutionNote
-  State(..), Counts(..),
-  Path, Node(..),
-  testCasePaths,
-  testCaseCount,
-  ReportStart, ReportProblem,
-  performTest
-) where
-
-import Control.Monad (unless, foldM)
-import Data.CallStack
-
-
--- Assertion Definition
--- ====================
-
-import Test.HUnit.Lang
-
-
--- Conditional Assertion Functions
--- -------------------------------
-
--- | Asserts that the specified condition holds.
-assertBool :: HasCallStack_
-              String    -- ^ The message that is displayed if the assertion fails
-           -> Bool      -- ^ The condition
-           -> Assertion
-assertBool msg b = unless b (assertFailure msg)
-
--- | Signals an assertion failure if a non-empty message (i.e., a message
--- other than @\"\"@) is passed.
-assertString :: HasCallStack_
-                String    -- ^ The message that is displayed with the assertion failure
-             -> Assertion
-assertString s = unless (null s) (assertFailure s)
-
--- Overloaded `assert` Function
--- ----------------------------
-
--- | Allows the extension of the assertion mechanism.
---
--- Since an 'Assertion' can be a sequence of @Assertion@s and @IO@ actions,
--- there is a fair amount of flexibility of what can be achieved.  As a rule,
--- the resulting @Assertion@ should be the body of a 'TestCase' or part of
--- a @TestCase@; it should not be used to assert multiple, independent
--- conditions.
---
--- If more complex arrangements of assertions are needed, 'Test's and
--- 'Testable' should be used.
-class Assertable t
- where assert :: HasCallStack_ t -> Assertion
-
-instance Assertable ()
- where assert = return
-
-instance Assertable Bool
- where assert = assertBool ""
-
-instance (ListAssertable t) => Assertable [t]
- where assert = listAssert
-
-instance (Assertable t) => Assertable (IO t)
- where assert = (>>= assert)
-
--- | A specialized form of 'Assertable' to handle lists.
-class ListAssertable t
- where listAssert :: HasCallStack_ [t] -> Assertion
-
-instance ListAssertable Char
- where listAssert = assertString
-
-
--- Overloaded `assertionPredicate` Function
--- ----------------------------------------
-
--- | The result of an assertion that hasn't been evaluated yet.
---
--- Most test cases follow the following steps:
---
--- 1. Do some processing or an action.
---
--- 2. Assert certain conditions.
---
--- However, this flow is not always suitable.  @AssertionPredicate@ allows for
--- additional steps to be inserted without the initial action to be affected
--- by side effects.  Additionally, clean-up can be done before the test case
--- has a chance to end.  A potential work flow is:
---
--- 1. Write data to a file.
---
--- 2. Read data from a file, evaluate conditions.
---
--- 3. Clean up the file.
---
--- 4. Assert that the side effects of the read operation meet certain conditions.
---
--- 5. Assert that the conditions evaluated in step 2 are met.
-type AssertionPredicate = IO Bool
-
--- | Used to signify that a data type can be converted to an assertion
--- predicate.
-class AssertionPredicable t
- where assertionPredicate :: t -> AssertionPredicate
-
-instance AssertionPredicable Bool
- where assertionPredicate = return
-
-instance (AssertionPredicable t) => AssertionPredicable (IO t)
- where assertionPredicate = (>>= assertionPredicate)
-
-
--- Assertion Construction Operators
--- --------------------------------
-
-infix  1 @?, @=?, @?=
-
--- | Asserts that the condition obtained from the specified
---   'AssertionPredicable' holds.
-(@?) :: HasCallStack_ AssertionPredicable t
-                                => t          -- ^ A value of which the asserted condition is predicated
-                                -> String     -- ^ A message that is displayed if the assertion fails
-                                -> Assertion
-predi @? msg = assertionPredicate predi >>= assertBool msg
-
--- | Asserts that the specified actual value is equal to the expected value
---   (with the expected value on the left-hand side).
-(@=?) :: HasCallStack_ (Eq a, Show a)
-                        => a -- ^ The expected value
-                        -> a -- ^ The actual value
-                        -> Assertion
-expected @=? actual = assertEqual "" expected actual
-
--- | Asserts that the specified actual value is equal to the expected value
---   (with the actual value on the left-hand side).
-(@?=) :: HasCallStack_ (Eq a, Show a)
-                        => a -- ^ The actual value
-                        -> a -- ^ The expected value
-                        -> Assertion
-actual @?= expected = assertEqual "" expected actual
-
-
-
--- Test Definition
--- ===============
-
--- | The basic structure used to create an annotated tree of test cases.
-data Test
-    -- | A single, independent test case composed.
-    = TestCase Assertion
-    -- | A set of @Test@s sharing the same level in the hierarchy.
-    | TestList [Test]
-    -- | A name or description for a subtree of the @Test@s.
-    | TestLabel String Test
-
-instance Show Test where
-  showsPrec _ (TestCase _)    = showString "TestCase _"
-  showsPrec _ (TestList ts)   = showString "TestList " . showList ts
-  showsPrec p (TestLabel l t) = showString "TestLabel " . showString l
-                                . showChar ' ' . showsPrec p t
-
--- Overloaded `test` Function
--- --------------------------
-
--- | Provides a way to convert data into a @Test@ or set of @Test@.
-class Testable t
- where test :: HasCallStack_ t -> Test
-
-instance Testable Test
- where test = id
-
-instance (Assertable t) => Testable (IO t)
- where test = TestCase . assert
-
-instance (Testable t) => Testable [t]
- where test = TestList . map test
-
-
--- Test Construction Operators
--- ---------------------------
-
-infix  1 ~?, ~=?, ~?=
-infixr 0 ~:
-
--- | Creates a test case resulting from asserting the condition obtained
---   from the specified 'AssertionPredicable'.
-(~?) :: HasCallStack_ AssertionPredicable t
-                                => t       -- ^ A value of which the asserted condition is predicated
-                                -> String  -- ^ A message that is displayed on test failure
-                                -> Test
-predi ~? msg = TestCase (predi @? msg)
-
--- | Shorthand for a test case that asserts equality (with the expected
---   value on the left-hand side, and the actual value on the right-hand
---   side).
-(~=?) :: HasCallStack_ (Eq a, Show a)
-                        => a     -- ^ The expected value
-                        -> a     -- ^ The actual value
-                        -> Test
-expected ~=? actual = TestCase (expected @=? actual)
-
--- | Shorthand for a test case that asserts equality (with the actual
---   value on the left-hand side, and the expected value on the right-hand
---   side).
-(~?=) :: HasCallStack_ (Eq a, Show a)
-                        => a     -- ^ The actual value
-                        -> a     -- ^ The expected value
-                        -> Test
-actual ~?= expected = TestCase (actual @?= expected)
-
--- | Creates a test from the specified 'Testable', with the specified
---   label attached to it.
---
--- Since 'Test' is @Testable@, this can be used as a shorthand way of attaching
--- a 'TestLabel' to one or more tests.
-(~:) :: HasCallStack_ Testable t => String -> t -> Test
-label ~: t = TestLabel label (test t)
-
-
-
--- Test Execution
--- ==============
-
--- $testExecutionNote
--- Note: the rest of the functionality in this module is intended for
--- implementors of test controllers. If you just want to run your tests cases,
--- simply use a test controller, such as the text-based controller in
--- "Test.HUnit.Text".
-
--- | A data structure that hold the results of tests that have been performed
--- up until this point.
-data Counts = Counts { cases, tried, errors, failures :: Int }
-  deriving (Eq, Show, Read)
-
--- | Keeps track of the remaining tests and the results of the performed tests.
--- As each test is performed, the path is removed and the counts are
--- updated as appropriate.
-data State = State { path :: Path, counts :: Counts }
-  deriving (Eq, Show, Read)
-
--- | Report generator for reporting the start of a test run.
-type ReportStart us = State -> us -> IO us
-
--- | Report generator for reporting problems that have occurred during
---   a test run. Problems may be errors or assertion failures.
-type ReportProblem us = Maybe SrcLoc -> String -> State -> us -> IO us
-
--- | Uniquely describes the location of a test within a test hierarchy.
--- Node order is from test case to root.
-type Path = [Node]
-
--- | Composed into 'Path's.
-data Node  = ListItem Int | Label String
-  deriving (Eq, Show, Read)
-
--- | Determines the paths for all 'TestCase's in a tree of @Test@s.
-testCasePaths :: Test -> [Path]
-testCasePaths t0 = tcp t0 []
- where tcp (TestCase _) p = [p]
-       tcp (TestList ts) p =
-         concat [ tcp t (ListItem n : p) | (t,n) <- zip ts [0..] ]
-       tcp (TestLabel l t) p = tcp t (Label l : p)
-
--- | Counts the number of 'TestCase's in a tree of @Test@s.
-testCaseCount :: Test -> Int
-testCaseCount (TestCase _)    = 1
-testCaseCount (TestList ts)   = sum (map testCaseCount ts)
-testCaseCount (TestLabel _ t) = testCaseCount t
-
--- | Performs a test run with the specified report generators.
---
--- This handles the actual running of the tests.  Most developers will want
--- to use @HUnit.Text.runTestTT@ instead.  A developer could use this function
--- to execute tests via another IO system, such as a GUI, or to output the
--- results in a different manner (e.g., upload XML-formatted results to a
--- webservice).
---
--- Note that the counts in a start report do not include the test case
--- being started, whereas the counts in a problem report do include the
--- test case just finished.  The principle is that the counts are sampled
--- only between test case executions.  As a result, the number of test
--- case successes always equals the difference of test cases tried and
--- the sum of test case errors and failures.
-performTest :: ReportStart us   -- ^ report generator for the test run start
-            -> ReportProblem us -- ^ report generator for errors during the test run
-            -> ReportProblem us -- ^ report generator for assertion failures during the test run
-            -> us
-            -> Test             -- ^ the test to be executed
-            -> IO (Counts, us)
-performTest reportStart reportError reportFailure initialUs initialT = do
-  (ss', us') <- pt initState initialUs initialT
-  unless (null (path ss')) $ error "performTest: Final path is nonnull"
-  return (counts ss', us')
- where
-  initState  = State{ path = [], counts = initCounts }
-  initCounts = Counts{ cases = testCaseCount initialT, tried = 0,
-                       errors = 0, failures = 0}
-
-  pt ss us (TestCase a) = do
-    us' <- reportStart ss us
-    r <- performTestCase a
-    case r of
-      Success -> do
-        return (ss', us')
-      Failure loc m -> do
-        usF <- reportFailure loc m ssF us'
-        return (ssF, usF)
-      Error loc m -> do
-        usE <- reportError loc m ssE us'
-        return (ssE, usE)
-   where c@Counts{ tried = n } = counts ss
-         ss' = ss{ counts = c{ tried = n + 1 } }
-         ssF = ss{ counts = c{ tried = n + 1, failures = failures c + 1 } }
-         ssE = ss{ counts = c{ tried = n + 1, errors   = errors   c + 1 } }
-
-  pt ss us (TestList ts) = foldM f (ss, us) (zip ts [0..])
-   where f (ss', us') (t, n) = withNode (ListItem n) ss' us' t
-
-  pt ss us (TestLabel label t) = withNode (Label label) ss us t
-
-  withNode node ss0 us0 t = do (ss2, us1) <- pt ss1 us0 t
-                               return (ss2{ path = path0 }, us1)
-   where path0 = path ss0
-         ss1 = ss0{ path = node : path0 }
diff --git a/vendor/HUnit-1.6.2.0/src/Test/HUnit/Lang.hs b/vendor/HUnit-1.6.2.0/src/Test/HUnit/Lang.hs
deleted file mode 100644
--- a/vendor/HUnit-1.6.2.0/src/Test/HUnit/Lang.hs
+++ /dev/null
@@ -1,104 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-
-#if __GLASGOW_HASKELL__ >= 704
-{-# LANGUAGE ConstraintKinds #-}
-#define HasCallStack_ HasCallStack =>
-#else
-#define HasCallStack_
-#endif
-
-module Test.HUnit.Lang (
-  Assertion,
-  assertFailure,
-  assertEqual,
-
-  Result (..),
-  performTestCase,
--- * Internals
--- |
--- /Note:/ This is not part of the public API!  It is exposed so that you can
--- tinker with the internals of HUnit, but do not expect it to be stable!
-  HUnitFailure (..),
-  FailureReason (..),
-  formatFailureReason
-) where
-
-import           Control.DeepSeq
-import           Control.Exception as E
-import           Control.Monad
-import           Data.List
-import           Data.Typeable
-import           Data.CallStack
-
--- | When an assertion is evaluated, it will output a message if and only if the
--- assertion fails.
---
--- Test cases are composed of a sequence of one or more assertions.
-type Assertion = IO ()
-
-data HUnitFailure = HUnitFailure (Maybe SrcLoc) FailureReason
-    deriving (Eq, Show, Typeable)
-
-instance Exception HUnitFailure
-
-data FailureReason = Reason String | ExpectedButGot (Maybe String) String String
-    deriving (Eq, Show, Typeable)
-
-location :: HasCallStack_ Maybe SrcLoc
-location = case reverse callStack of
-  (_, loc) : _ -> Just loc
-  [] -> Nothing
-
--- | Unconditionally signals that a failure has occurred.
-assertFailure ::
-     HasCallStack_
-     String -- ^ A message that is displayed with the assertion failure
-  -> IO a
-assertFailure msg = msg `deepseq` E.throwIO (HUnitFailure location $ Reason msg)
-
--- | Asserts that the specified actual value is equal to the expected value.
--- The output message will contain the prefix, the expected value, and the
--- actual value.
---
--- If the prefix is the empty string (i.e., @\"\"@), then the prefix is omitted
--- and only the expected and actual values are output.
-assertEqual :: HasCallStack_ (Eq a, Show a)
-                              => String -- ^ The message prefix
-                              -> a      -- ^ The expected value
-                              -> a      -- ^ The actual value
-                              -> Assertion
-assertEqual preface expected actual =
-  unless (actual == expected) $ do
-    (prefaceMsg `deepseq` expectedMsg `deepseq` actualMsg `deepseq` E.throwIO (HUnitFailure location $ ExpectedButGot prefaceMsg expectedMsg actualMsg))
-  where
-    prefaceMsg
-      | null preface = Nothing
-      | otherwise = Just preface
-    expectedMsg = show expected
-    actualMsg = show actual
-
-formatFailureReason :: FailureReason -> String
-formatFailureReason (Reason reason) = reason
-formatFailureReason (ExpectedButGot preface expected actual) = intercalate "\n" . maybe id (:) preface $ ["expected: " ++ expected, " but got: " ++ actual]
-
-data Result = Success | Failure (Maybe SrcLoc) String | Error (Maybe SrcLoc) String
-  deriving (Eq, Show)
-
--- | Performs a single test case.
-performTestCase :: Assertion -- ^ an assertion to be made during the test case run
-                -> IO Result
-performTestCase action =
-  (action >> return Success)
-     `E.catches`
-      [E.Handler (\(HUnitFailure loc reason) -> return $ Failure loc (formatFailureReason reason)),
-
-       -- Re-throw AsyncException, otherwise execution will not terminate on
-       -- SIGINT (ctrl-c).  Currently, all AsyncExceptions are being thrown
-       -- because it's thought that none of them will be encountered during
-       -- normal HUnit operation.  If you encounter an example where this
-       -- is not the case, please email the maintainer.
-       E.Handler (\e -> throw (e :: E.AsyncException)),
-
-       E.Handler (\e -> return $ Error Nothing $ show (e :: E.SomeException))]
diff --git a/vendor/HUnit-1.6.2.0/src/Test/HUnit/Terminal.hs b/vendor/HUnit-1.6.2.0/src/Test/HUnit/Terminal.hs
deleted file mode 100644
--- a/vendor/HUnit-1.6.2.0/src/Test/HUnit/Terminal.hs
+++ /dev/null
@@ -1,42 +0,0 @@
--- | This module handles the complexities of writing information to the
--- terminal, including modifying text in place.
-
-module Test.HUnit.Terminal (
-        terminalAppearance
-    ) where
-
-import Data.Char (isPrint)
-
-
--- | Simplifies the input string by interpreting @\\r@ and @\\b@ characters
--- specially so that the result string has the same final (or /terminal/,
--- pun intended) appearance as would the input string when written to a
--- terminal that overwrites character positions following carriage
--- returns and backspaces.
-
-terminalAppearance :: String -> String
-terminalAppearance str = ta id "" "" str
-
--- | The helper function @ta@ takes an accumulating @ShowS@-style function
--- that holds /committed/ lines of text, a (reversed) list of characters
--- on the current line /before/ the cursor, a (normal) list of characters
--- on the current line /after/ the cursor, and the remaining input.
-
-ta
-    :: ([Char] -> t) -- ^ An accumulating @ShowS@-style function
-                     -- that holds /committed/ lines of text
-    -> [Char] -- ^ A (reversed) list of characters
-              -- on the current line /before/ the cursor
-    -> [Char] -- ^ A (normal) list of characters
-              -- on the current line /after/ the cursor
-    -> [Char] -- ^ The remaining input
-    -> t
-ta f    bs  as ('\n':cs) = ta (\t -> f (reverse bs ++ as ++ '\n' : t)) "" "" cs
-ta f    bs  as ('\r':cs) = ta f "" (reverse bs ++ as) cs
-ta f (b:bs) as ('\b':cs) = ta f bs (b:as) cs
-ta _    ""   _ ('\b': _) = error "'\\b' at beginning of line"
-ta f    bs  as (c:cs)
-    | not (isPrint c)    = error "invalid nonprinting character"
-    | null as            = ta f (c:bs) ""        cs
-    | otherwise          = ta f (c:bs) (tail as) cs
-ta f    bs  as       ""  = f (reverse bs ++ as)
diff --git a/vendor/HUnit-1.6.2.0/src/Test/HUnit/Text.hs b/vendor/HUnit-1.6.2.0/src/Test/HUnit/Text.hs
deleted file mode 100644
--- a/vendor/HUnit-1.6.2.0/src/Test/HUnit/Text.hs
+++ /dev/null
@@ -1,152 +0,0 @@
--- | Text-based test controller for running HUnit tests and reporting
---   results as text, usually to a terminal.
-
-module Test.HUnit.Text
-(
-  PutText(..),
-  putTextToHandle, putTextToShowS,
-  runTestText,
-  showPath, showCounts,
-  runTestTT,
-  runTestTTAndExit
-)
-where
-
-import Test.HUnit.Base
-
-import Data.CallStack
-import Control.Monad (when)
-import System.IO (Handle, stderr, hPutStr, hPutStrLn)
-import System.Exit (exitSuccess, exitFailure)
-
-
--- | As the general text-based test controller ('runTestText') executes a
---   test, it reports each test case start, error, and failure by
---   constructing a string and passing it to the function embodied in a
---   'PutText'.  A report string is known as a \"line\", although it includes
---   no line terminator; the function in a 'PutText' is responsible for
---   terminating lines appropriately.  Besides the line, the function
---   receives a flag indicating the intended \"persistence\" of the line:
---   'True' indicates that the line should be part of the final overall
---   report; 'False' indicates that the line merely indicates progress of
---   the test execution.  Each progress line shows the current values of
---   the cumulative test execution counts; a final, persistent line shows
---   the final count values.
---
---   The 'PutText' function is also passed, and returns, an arbitrary state
---   value (called 'st' here).  The initial state value is given in the
---   'PutText'; the final value is returned by 'runTestText'.
-
-data PutText st = PutText (String -> Bool -> st -> IO st) st
-
-
--- | Two reporting schemes are defined here.  @putTextToHandle@ writes
--- report lines to a given handle.  'putTextToShowS' accumulates
--- persistent lines for return as a whole by 'runTestText'.
---
--- @putTextToHandle@ writes persistent lines to the given handle,
--- following each by a newline character.  In addition, if the given flag
--- is @True@, it writes progress lines to the handle as well.  A progress
--- line is written with no line termination, so that it can be
--- overwritten by the next report line.  As overwriting involves writing
--- carriage return and blank characters, its proper effect is usually
--- only obtained on terminal devices.
-
-putTextToHandle
-    :: Handle
-    -> Bool -- ^ Write progress lines to handle?
-    -> PutText Int
-putTextToHandle handle showProgress = PutText put initCnt
- where
-  initCnt = if showProgress then 0 else -1
-  put line pers (-1) = do when pers (hPutStrLn handle line); return (-1)
-  put line True  cnt = do hPutStrLn handle (erase cnt ++ line); return 0
-  put line False _   = do hPutStr handle ('\r' : line); return (length line)
-    -- The "erasing" strategy with a single '\r' relies on the fact that the
-    -- lengths of successive summary lines are monotonically nondecreasing.
-  erase cnt = if cnt == 0 then "" else "\r" ++ replicate cnt ' ' ++ "\r"
-
-
--- | Accumulates persistent lines (dropping progess lines) for return by
---   'runTestText'.  The accumulated lines are represented by a
---   @'ShowS' ('String' -> 'String')@ function whose first argument is the
---   string to be appended to the accumulated report lines.
-
-putTextToShowS :: PutText ShowS
-putTextToShowS = PutText put id
- where put line pers f = return (if pers then acc f line else f)
-       acc f line rest = f (line ++ '\n' : rest)
-
-
--- | Executes a test, processing each report line according to the given
---   reporting scheme.  The reporting scheme's state is threaded through calls
---   to the reporting scheme's function and finally returned, along with final
---   count values.
-
-runTestText :: PutText st -> Test -> IO (Counts, st)
-runTestText (PutText put us0) t = do
-  (counts', us1) <- performTest reportStart reportError reportFailure us0 t
-  us2 <- put (showCounts counts') True us1
-  return (counts', us2)
- where
-  reportStart ss us = put (showCounts (counts ss)) False us
-  reportError   = reportProblem "Error:"   "Error in:   "
-  reportFailure = reportProblem "Failure:" "Failure in: "
-  reportProblem p0 p1 loc msg ss us = put line True us
-   where line  = "### " ++ kind ++ path' ++ "\n" ++ formatLocation loc ++ msg
-         kind  = if null path' then p0 else p1
-         path' = showPath (path ss)
-
-formatLocation :: Maybe SrcLoc -> String
-formatLocation Nothing = ""
-formatLocation (Just loc) = srcLocFile loc ++ ":" ++ show (srcLocStartLine loc) ++ "\n"
-
--- | Converts test execution counts to a string.
-
-showCounts :: Counts -> String
-showCounts Counts{ cases = cases', tried = tried',
-                   errors = errors', failures = failures' } =
-  "Cases: " ++ show cases' ++ "  Tried: " ++ show tried' ++
-  "  Errors: " ++ show errors' ++ "  Failures: " ++ show failures'
-
-
--- | Converts a test case path to a string, separating adjacent elements by
---   the colon (\':\'). An element of the path is quoted (as with 'show') when
---   there is potential ambiguity.
-
-showPath :: Path -> String
-showPath [] = ""
-showPath nodes = foldl1 f (map showNode nodes)
- where f b a = a ++ ":" ++ b
-       showNode (ListItem n) = show n
-       showNode (Label label) = safe label (show label)
-       safe s ss = if ':' `elem` s || "\"" ++ s ++ "\"" /= ss then ss else s
-
-
--- | Provides the \"standard\" text-based test controller. Reporting is made to
---   standard error, and progress reports are included. For possible
---   programmatic use, the final counts are returned.
---
---   The \"TT\" in the name suggests \"Text-based reporting to the Terminal\".
-
-runTestTT :: Test -> IO Counts
-runTestTT t = do (counts', 0) <- runTestText (putTextToHandle stderr True) t
-                 return counts'
-
--- | Convenience wrapper for 'runTestTT'.
---   Simply runs 'runTestTT' and then exits back to the OS,
---   using 'exitSuccess' if there were no errors or failures,
---   or 'exitFailure' if there were. For example:
---
---   > tests :: Test
---   > tests = ...
---   >
---   > main :: IO ()
---   > main = runTestTTAndExit tests
-
-runTestTTAndExit :: Test -> IO ()
-runTestTTAndExit tests = do
-  c <- runTestTT tests
-  if (errors c == 0) && (failures c == 0)
-    then exitSuccess
-    else exitFailure
diff --git a/vendor/hspec-expectations-0.8.2/src/Test/Hspec/Expectations.hs b/vendor/hspec-expectations-0.8.2/src/Test/Hspec/Expectations.hs
deleted file mode 100644
--- a/vendor/hspec-expectations-0.8.2/src/Test/Hspec/Expectations.hs
+++ /dev/null
@@ -1,189 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE ImplicitParams #-}
--- |
--- Introductory documentation: <https://github.com/sol/hspec-expectations#readme>
-module Test.Hspec.Expectations (
-
--- * Setting expectations
-  Expectation
-, expectationFailure
-, shouldBe
-, shouldSatisfy
-, shouldStartWith
-, shouldEndWith
-, shouldContain
-, shouldMatchList
-, shouldReturn
-
-, shouldNotBe
-, shouldNotSatisfy
-, shouldNotContain
-, shouldNotReturn
-
--- * Expecting exceptions
-, shouldThrow
-
--- ** Selecting exceptions
-, Selector
-
--- ** Predefined type-based selectors
--- |
--- There are predefined selectors for some standard exceptions.  Each selector
--- is just @const True@ with an appropriate type.
-, anyException
-, anyErrorCall
-, anyIOException
-, anyArithException
-
--- ** Combinators for defining value-based selectors
--- |
--- Some exceptions (most prominently `ErrorCall`) have no `Eq` instance.
--- Selecting a specific value would require pattern matching.
---
--- For such exceptions, combinators that construct selectors are provided.
--- Each combinator corresponds to a constructor; it takes the same arguments,
--- and has the same name (but starting with a lower-case letter).
-, errorCall
-
--- * Re-exports
-, HasCallStack
-) where
-
-import qualified Test.HUnit
-import           Test.HUnit ((@?=))
-import           Control.Exception
-import           Data.Typeable
-import           Data.List
-
-import           Control.Monad (unless)
-
-import           Test.Hspec.Expectations.Matcher
-
-import           Data.CallStack (HasCallStack)
-
-type Expectation = Test.HUnit.Assertion
-
-expectationFailure :: HasCallStack => String -> Expectation
-expectationFailure = Test.HUnit.assertFailure
-
-expectTrue :: HasCallStack => String -> Bool -> Expectation
-expectTrue msg b = unless b (expectationFailure msg)
-
-infix 1 `shouldBe`, `shouldSatisfy`, `shouldStartWith`, `shouldEndWith`, `shouldContain`, `shouldMatchList`, `shouldReturn`, `shouldThrow`
-infix 1 `shouldNotBe`, `shouldNotSatisfy`, `shouldNotContain`, `shouldNotReturn`
-
--- |
--- @actual \`shouldBe\` expected@ sets the expectation that @actual@ is equal
--- to @expected@.
-shouldBe :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation
-actual `shouldBe` expected = actual @?= expected
-
--- |
--- @v \`shouldSatisfy\` p@ sets the expectation that @p v@ is @True@.
-shouldSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
-v `shouldSatisfy` p = expectTrue ("predicate failed on: " ++ show v) (p v)
-
-compareWith :: (HasCallStack, Show a) => (a -> a -> Bool) -> String -> a -> a -> Expectation
-compareWith comparator errorDesc result expected = expectTrue errorMsg (comparator expected result)
-  where
-    errorMsg = show result ++ " " ++ errorDesc ++ " " ++ show expected
-
--- |
--- @list \`shouldStartWith\` prefix@ sets the expectation that @list@ starts with @prefix@,
-shouldStartWith :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
-shouldStartWith = compareWith isPrefixOf "does not start with"
-
--- |
--- @list \`shouldEndWith\` suffix@ sets the expectation that @list@ ends with @suffix@,
-shouldEndWith :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
-shouldEndWith = compareWith isSuffixOf "does not end with"
-
--- |
--- @list \`shouldContain\` sublist@ sets the expectation that @sublist@ is contained,
--- wholly and intact, anywhere in @list@.
-shouldContain :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
-shouldContain = compareWith isInfixOf "does not contain"
-
--- |
--- @xs \`shouldMatchList\` ys@ sets the expectation that @xs@ has the same
--- elements that @ys@ has, possibly in another order
-shouldMatchList :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
-xs `shouldMatchList` ys = maybe (return ()) expectationFailure (matchList xs ys)
-
--- |
--- @action \`shouldReturn\` expected@ sets the expectation that @action@
--- returns @expected@.
-shouldReturn :: (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
-action `shouldReturn` expected = action >>= (`shouldBe` expected)
-
--- |
--- @actual \`shouldNotBe\` notExpected@ sets the expectation that @actual@ is not
--- equal to @notExpected@
-shouldNotBe :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation
-actual `shouldNotBe` notExpected = expectTrue ("not expected: " ++ show actual) (actual /= notExpected)
-
--- |
--- @v \`shouldNotSatisfy\` p@ sets the expectation that @p v@ is @False@.
-shouldNotSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
-v `shouldNotSatisfy` p = expectTrue ("predicate succeeded on: " ++ show v) ((not . p) v)
-
--- |
--- @list \`shouldNotContain\` sublist@ sets the expectation that @sublist@ is not
--- contained anywhere in @list@.
-shouldNotContain :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
-list `shouldNotContain` sublist = expectTrue errorMsg ((not . isInfixOf sublist) list)
-  where
-    errorMsg = show list ++ " does contain " ++ show sublist
-
--- |
--- @action \`shouldNotReturn\` notExpected@ sets the expectation that @action@
--- does not return @notExpected@.
-shouldNotReturn :: (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
-action `shouldNotReturn` notExpected = action >>= (`shouldNotBe` notExpected)
-
--- |
--- A @Selector@ is a predicate; it can simultaneously constrain the type and
--- value of an exception.
-type Selector a = (a -> Bool)
-
--- |
--- @action \`shouldThrow\` selector@ sets the expectation that @action@ throws
--- an exception.  The precise nature of the expected exception is described
--- with a 'Selector'.
-shouldThrow :: (HasCallStack, Exception e) => IO a -> Selector e -> Expectation
-action `shouldThrow` p = do
-  r <- try action
-  case r of
-    Right _ ->
-      expectationFailure $
-        "did not get expected exception: " ++ exceptionType
-    Left e ->
-      (`expectTrue` p e) $
-        "predicate failed on expected exception: " ++ exceptionType ++ " (" ++ show e ++ ")"
-  where
-    -- a string repsentation of the expected exception's type
-    exceptionType = (show . typeOf . instanceOf) p
-      where
-        instanceOf :: Selector a -> a
-        instanceOf _ = error "Test.Hspec.Expectations.shouldThrow: broken Typeable instance"
-
-anyException :: Selector SomeException
-anyException = const True
-
-anyErrorCall :: Selector ErrorCall
-anyErrorCall = const True
-
-errorCall :: String -> Selector ErrorCall
-#if MIN_VERSION_base(4,9,0)
-errorCall s (ErrorCallWithLocation msg _) = s == msg
-#else
-errorCall s (ErrorCall msg) = s == msg
-#endif
-
-anyIOException :: Selector IOException
-anyIOException = const True
-
-anyArithException :: Selector ArithException
-anyArithException = const True
diff --git a/vendor/hspec-expectations-0.8.2/src/Test/Hspec/Expectations/Contrib.hs b/vendor/hspec-expectations-0.8.2/src/Test/Hspec/Expectations/Contrib.hs
deleted file mode 100644
--- a/vendor/hspec-expectations-0.8.2/src/Test/Hspec/Expectations/Contrib.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-{-# LANGUAGE CPP #-}
--- |
--- Experimental combinators, that may become part of the main distribution, if
--- they turn out to be useful for a wider audience.
-module Test.Hspec.Expectations.Contrib (
--- * Predicates
--- | (useful in combination with `shouldSatisfy`)
-  isLeft
-, isRight
-) where
-
-
-#if MIN_VERSION_base(4,7,0)
-import Data.Either
-#else
-
-isLeft :: Either a b -> Bool
-{-# DEPRECATED isLeft "use Data.Either.Compat.isLeft from package base-compat instead" #-}
-isLeft (Left  _) = True
-isLeft (Right _) = False
-
-isRight :: Either a b -> Bool
-{-# DEPRECATED isRight "use Data.Either.Compat.isRight from package base-compat instead" #-}
-isRight (Left  _) = False
-isRight (Right _) = True
-#endif
diff --git a/vendor/hspec-expectations-0.8.2/src/Test/Hspec/Expectations/Matcher.hs b/vendor/hspec-expectations-0.8.2/src/Test/Hspec/Expectations/Matcher.hs
deleted file mode 100644
--- a/vendor/hspec-expectations-0.8.2/src/Test/Hspec/Expectations/Matcher.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-module Test.Hspec.Expectations.Matcher (matchList) where
-
-import           Prelude hiding (showList)
-import           Data.List
-
-matchList :: (Show a, Eq a) => [a] -> [a] -> Maybe String
-xs `matchList` ys
-  | null extra && null missing = Nothing
-  | otherwise = Just (err "")
-  where
-    extra   = xs \\ ys
-    missing = ys \\ xs
-
-    msgAndList msg zs = showString msg . showList zs . showString "\n"
-    optMsgList msg zs = if null zs then id else msgAndList msg zs
-
-    err :: ShowS
-    err =
-        showString "Actual list is not a permutation of expected list!\n"
-      . msgAndList "  expected list contains:   " ys
-      . msgAndList "  actual list contains:     " xs
-      . optMsgList "  the missing elements are: " missing
-      . optMsgList "  the extra elements are:   " extra
-
-showList :: Show a => [a] -> ShowS
-showList xs = showChar '[' . foldr (.) (showChar ']') (intersperse (showString ", ") $ map shows xs)
diff --git a/vendor/stm-2.5.0.1/Control/Concurrent/STM/TMVar.hs b/vendor/stm-2.5.0.1/Control/Concurrent/STM/TMVar.hs
new file mode 100644
--- /dev/null
+++ b/vendor/stm-2.5.0.1/Control/Concurrent/STM/TMVar.hs
@@ -0,0 +1,168 @@
+{-# LANGUAGE CPP, DeriveDataTypeable, MagicHash, UnboxedTuples #-}
+
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Trustworthy #-}
+#endif
+
+{-# OPTIONS -fno-warn-implicit-prelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Concurrent.STM.TMVar
+-- Copyright   :  (c) The University of Glasgow 2004
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  non-portable (requires STM)
+--
+-- TMVar: Transactional MVars, for use in the STM monad
+-- (GHC only)
+--
+-----------------------------------------------------------------------------
+
+module Control.Concurrent.STM.TMVar (
+#ifdef __GLASGOW_HASKELL__
+        -- * TMVars
+        TMVar,
+        newTMVar,
+        newEmptyTMVar,
+        newTMVarIO,
+        newEmptyTMVarIO,
+        takeTMVar,
+        putTMVar,
+        readTMVar,
+        tryReadTMVar,
+        swapTMVar,
+        tryTakeTMVar,
+        tryPutTMVar,
+        isEmptyTMVar,
+        mkWeakTMVar
+#endif
+  ) where
+
+#ifdef __GLASGOW_HASKELL__
+import GHC.Base
+import GHC.Conc
+import GHC.Weak
+
+import Data.Typeable (Typeable)
+
+newtype TMVar a = TMVar (TVar (Maybe a)) deriving (Eq, Typeable)
+{- ^
+A 'TMVar' is a synchronising variable, used
+for communication between concurrent threads.  It can be thought of
+as a box, which may be empty or full.
+-}
+
+-- |Create a 'TMVar' which contains the supplied value.
+newTMVar :: a -> STM (TMVar a)
+newTMVar a = do
+  t <- newTVar (Just a)
+  return (TMVar t)
+
+-- |@IO@ version of 'newTMVar'.  This is useful for creating top-level
+-- 'TMVar's using 'System.IO.Unsafe.unsafePerformIO', because using
+-- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't
+-- possible.
+newTMVarIO :: a -> IO (TMVar a)
+newTMVarIO a = do
+  t <- newTVarIO (Just a)
+  return (TMVar t)
+
+-- |Create a 'TMVar' which is initially empty.
+newEmptyTMVar :: STM (TMVar a)
+newEmptyTMVar = do
+  t <- newTVar Nothing
+  return (TMVar t)
+
+-- |@IO@ version of 'newEmptyTMVar'.  This is useful for creating top-level
+-- 'TMVar's using 'System.IO.Unsafe.unsafePerformIO', because using
+-- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't
+-- possible.
+newEmptyTMVarIO :: IO (TMVar a)
+newEmptyTMVarIO = do
+  t <- newTVarIO Nothing
+  return (TMVar t)
+
+-- |Return the contents of the 'TMVar'.  If the 'TMVar' is currently
+-- empty, the transaction will 'retry'.  After a 'takeTMVar',
+-- the 'TMVar' is left empty.
+takeTMVar :: TMVar a -> STM a
+takeTMVar (TMVar t) = do
+  m <- readTVar t
+  case m of
+    Nothing -> retry
+    Just a  -> do writeTVar t Nothing; return a
+
+-- | A version of 'takeTMVar' that does not 'retry'.  The 'tryTakeTMVar'
+-- function returns 'Nothing' if the 'TMVar' was empty, or @'Just' a@ if
+-- the 'TMVar' was full with contents @a@.  After 'tryTakeTMVar', the
+-- 'TMVar' is left empty.
+tryTakeTMVar :: TMVar a -> STM (Maybe a)
+tryTakeTMVar (TMVar t) = do
+  m <- readTVar t
+  case m of
+    Nothing -> return Nothing
+    Just a  -> do writeTVar t Nothing; return (Just a)
+
+-- |Put a value into a 'TMVar'.  If the 'TMVar' is currently full,
+-- 'putTMVar' will 'retry'.
+putTMVar :: TMVar a -> a -> STM ()
+putTMVar (TMVar t) a = do
+  m <- readTVar t
+  case m of
+    Nothing -> do writeTVar t (Just a); return ()
+    Just _  -> retry
+
+-- | A version of 'putTMVar' that does not 'retry'.  The 'tryPutTMVar'
+-- function attempts to put the value @a@ into the 'TMVar', returning
+-- 'True' if it was successful, or 'False' otherwise.
+tryPutTMVar :: TMVar a -> a -> STM Bool
+tryPutTMVar (TMVar t) a = do
+  m <- readTVar t
+  case m of
+    Nothing -> do writeTVar t (Just a); return True
+    Just _  -> return False
+
+-- | This is a combination of 'takeTMVar' and 'putTMVar'; ie. it
+-- takes the value from the 'TMVar', puts it back, and also returns
+-- it.
+readTMVar :: TMVar a -> STM a
+readTMVar (TMVar t) = do
+  m <- readTVar t
+  case m of
+    Nothing -> retry
+    Just a  -> return a
+
+-- | A version of 'readTMVar' which does not retry. Instead it
+-- returns @Nothing@ if no value is available.
+--
+-- @since 2.3
+tryReadTMVar :: TMVar a -> STM (Maybe a)
+tryReadTMVar (TMVar t) = readTVar t
+
+-- |Swap the contents of a 'TMVar' for a new value.
+swapTMVar :: TMVar a -> a -> STM a
+swapTMVar (TMVar t) new = do
+  m <- readTVar t
+  case m of
+    Nothing -> retry
+    Just old -> do writeTVar t (Just new); return old
+
+-- |Check whether a given 'TMVar' is empty.
+isEmptyTMVar :: TMVar a -> STM Bool
+isEmptyTMVar (TMVar t) = do
+  m <- readTVar t
+  case m of
+    Nothing -> return True
+    Just _  -> return False
+
+-- | Make a 'Weak' pointer to a 'TMVar', using the second argument as
+-- a finalizer to run when the 'TMVar' is garbage-collected.
+--
+-- @since 2.4.4
+mkWeakTMVar :: TMVar a -> IO () -> IO (Weak (TMVar a))
+mkWeakTMVar tmv@(TMVar (TVar t#)) (IO finalizer) = IO $ \s ->
+    case mkWeak# t# tmv finalizer s of (# s1, w #) -> (# s1, Weak w #)
+#endif
diff --git a/version.yaml b/version.yaml
deleted file mode 100644
--- a/version.yaml
+++ /dev/null
@@ -1,1 +0,0 @@
-&version 2.10.5