diff --git a/hspec-core.cabal b/hspec-core.cabal
--- a/hspec-core.cabal
+++ b/hspec-core.cabal
@@ -1,11 +1,11 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.34.5.
+-- This file has been generated from package.yaml by hpack version 0.34.6.
 --
 -- see: https://github.com/sol/hpack
 
 name:             hspec-core
-version:          2.9.2
+version:          2.9.3
 license:          MIT
 license-file:     LICENSE
 copyright:        (c) 2011-2021 Simon Hengel,
@@ -48,9 +48,20 @@
     , quickcheck-io >=0.2.0
     , random
     , setenv
-    , stm >=2.2
     , tf-random
     , transformers >=0.2.2.0
+  if impl(ghc >= 8.2.1)
+    build-depends:
+        ghc
+      , ghc-boot-th
+  if impl(ghc >= 8.4.1)
+    build-depends:
+        stm >=2.2
+  else
+    other-modules:
+        Control.Concurrent.STM.TMVar
+    hs-source-dirs:
+        vendor/stm-2.5.0.1/
   exposed-modules:
       Test.Hspec.Core.Spec
       Test.Hspec.Core.Hooks
@@ -77,6 +88,10 @@
       Test.Hspec.Core.FailureReport
       Test.Hspec.Core.Formatters.Diff
       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.Unicode
       Test.Hspec.Core.Formatters.V1.Free
       Test.Hspec.Core.Formatters.V1.Monad
       Test.Hspec.Core.QuickCheckUtil
@@ -88,7 +103,6 @@
       Test.Hspec.Core.Tree
       Control.Concurrent.Async
       Data.Algorithm.Diff
-      Text.Show.Unicode
       Paths_hspec_core
   default-language: Haskell2010
 
@@ -114,16 +128,27 @@
     , directory
     , filepath
     , hspec-expectations ==0.8.2.*
-    , hspec-meta ==2.9.0.1
+    , hspec-meta ==2.9.2
     , process
     , quickcheck-io >=0.2.0
     , random
     , setenv
     , silently >=1.2.4
-    , stm >=2.2
     , temporary
     , tf-random
     , transformers >=0.2.2.0
+  if impl(ghc >= 8.2.1)
+    build-depends:
+        ghc
+      , ghc-boot-th
+  if impl(ghc >= 8.4.1)
+    build-depends:
+        stm >=2.2
+  else
+    other-modules:
+        Control.Concurrent.STM.TMVar
+    hs-source-dirs:
+        vendor/stm-2.5.0.1/
   build-tool-depends:
       hspec-meta:hspec-meta-discover
   other-modules:
@@ -144,6 +169,10 @@
       Test.Hspec.Core.Formatters
       Test.Hspec.Core.Formatters.Diff
       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.Unicode
       Test.Hspec.Core.Formatters.V1
       Test.Hspec.Core.Formatters.V1.Free
       Test.Hspec.Core.Formatters.V1.Monad
@@ -162,7 +191,6 @@
       Test.Hspec.Core.Util
       Control.Concurrent.Async
       Data.Algorithm.Diff
-      Text.Show.Unicode
       All
       GetOpt.Declarative.EnvironmentSpec
       GetOpt.Declarative.UtilSpec
@@ -179,6 +207,9 @@
       Test.Hspec.Core.FormatSpec
       Test.Hspec.Core.Formatters.DiffSpec
       Test.Hspec.Core.Formatters.InternalSpec
+      Test.Hspec.Core.Formatters.Pretty.ParserSpec
+      Test.Hspec.Core.Formatters.Pretty.UnicodeSpec
+      Test.Hspec.Core.Formatters.PrettySpec
       Test.Hspec.Core.Formatters.V1Spec
       Test.Hspec.Core.Formatters.V2Spec
       Test.Hspec.Core.HooksSpec
diff --git a/src/Test/Hspec/Core/Format.hs b/src/Test/Hspec/Core/Format.hs
--- a/src/Test/Hspec/Core/Format.hs
+++ b/src/Test/Hspec/Core/Format.hs
@@ -25,8 +25,7 @@
 import qualified Control.Concurrent.Async as Async
 import           Control.Monad.IO.Class
 
-import           Test.Hspec.Core.Spec (Progress, Location(..))
-import           Test.Hspec.Core.Example (FailureReason(..))
+import           Test.Hspec.Core.Example (Progress, Location(..), FailureReason(..))
 import           Test.Hspec.Core.Util (Path)
 import           Test.Hspec.Core.Clock (Seconds(..))
 
diff --git a/src/Test/Hspec/Core/Formatters/Diff.hs b/src/Test/Hspec/Core/Formatters/Diff.hs
--- a/src/Test/Hspec/Core/Formatters/Diff.hs
+++ b/src/Test/Hspec/Core/Formatters/Diff.hs
@@ -2,41 +2,21 @@
 {-# LANGUAGE ViewPatterns #-}
 module Test.Hspec.Core.Formatters.Diff (
   Diff (..)
-, recover
 , diff
 #ifdef TEST
-, recoverString
 , partition
 , breakList
 #endif
 ) where
 
 import           Prelude ()
-import           Control.Arrow
 import           Test.Hspec.Core.Compat hiding (First)
 
 import           Data.Char
 import qualified Data.Algorithm.Diff as Diff
-import           Text.Show.Unicode (urecover)
 
 data Diff = First String | Second String | Both String
   deriving (Eq, Show)
-
-recover :: Bool -> String -> String -> (String, String)
-recover unicode expected actual = case (recoverString unicode expected, recoverString unicode actual) of
-  (Just expected_, Just actual_) -> (expected_, actual_)
-  _ -> (rec expected, rec actual)
-  where
-    rec = if unicode then urecover else id
-
-recoverString :: Bool -> String -> Maybe String
-recoverString unicode input = case readMaybe 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'
 
 diff :: String -> String -> [Diff]
 diff expected actual = map (toDiff . fmap concat) $ Diff.getGroupedDiff (partition expected) (partition actual)
diff --git a/src/Test/Hspec/Core/Formatters/Pretty.hs b/src/Test/Hspec/Core/Formatters/Pretty.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Hspec/Core/Formatters/Pretty.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Test.Hspec.Core.Formatters.Pretty (
+  pretty2
+#ifdef TEST
+, pretty
+, recoverString
+#endif
+) where
+
+import           Prelude ()
+import           Test.Hspec.Core.Compat hiding (shows, intercalate)
+
+import           Control.Arrow
+import           Data.Char
+import           Data.String
+import           Data.List (intersperse)
+import qualified Text.Show as Show
+
+import           Test.Hspec.Core.Formatters.Pretty.Unicode
+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
+  (Just expected_, Just actual_) -> (expected_, actual_)
+  _ -> case (pretty unicode expected, pretty unicode actual) of
+    (Just expected_, Just actual_) -> (expected_, actual_)
+#if __GLASGOW_HASKELL__ >= 802
+    _ -> (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 :: Bool -> String -> Maybe String
+recoverString unicode input = case readMaybe 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'
+
+pretty :: Bool -> String -> Maybe String
+pretty unicode = parseExpression >=> render_
+  where
+    render_ :: Expression -> Maybe String
+    render_ expr = guard (shouldParseBack expr) >> Just (renderExpression unicode expr)
+
+    shouldParseBack :: Expression -> 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
+          Tuple xs -> any go xs
+          List xs -> any go xs
+          Record _ _ -> True
+
+newtype Builder = Builder ShowS
+
+instance Monoid Builder where
+  mempty = Builder id
+#if MIN_VERSION_base(4,11,0)
+instance Semigroup Builder where
+#endif
+  Builder xs
+#if MIN_VERSION_base(4,11,0)
+    <>
+#else
+    `mappend`
+#endif
+    Builder ys = Builder (xs . ys)
+
+runBuilder :: Builder -> String
+runBuilder (Builder xs) = xs ""
+
+intercalate :: Builder -> [Builder] -> Builder
+intercalate x xs = mconcat $ intersperse x xs
+
+shows :: Show a => a -> Builder
+shows = Builder . Show.shows
+
+instance IsString Builder where
+  fromString = Builder . showString
+
+renderExpression :: Bool -> Expression -> String
+renderExpression unicode = runBuilder . render
+  where
+    renderLiteral lit = case lit of
+      Char c -> shows c
+      String str -> if unicode then Builder $ ushows str else shows str
+      Integer n -> shows n
+      Rational n -> shows 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 <> ")"
+      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/src/Test/Hspec/Core/Formatters/Pretty/Parser.hs b/src/Test/Hspec/Core/Formatters/Pretty/Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Hspec/Core/Formatters/Pretty/Parser.hs
@@ -0,0 +1,351 @@
+{-# 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
+) where
+
+import           Prelude ()
+import           Test.Hspec.Core.Compat hiding (fail)
+import           Test.Hspec.Core.Formatters.Pretty.Parser.Types
+
+#if __GLASGOW_HASKELL__ < 802 || __GLASGOW_HASKELL__ > 902
+
+parseExpression :: String -> Maybe Expression
+parseExpression _ = Nothing
+
+unsafeParseExpression :: String -> Maybe Expression
+unsafeParseExpression _ = Nothing
+
+#else
+
+import           GHC.Stack
+import           GHC.Exception (throw, errorCallWithCallStackException)
+
+#if __GLASGOW_HASKELL__ >= 804
+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 qualified GHC.Data.EnumSet as EnumSet
+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
+#if __GLASGOW_HASKELL__ >= 804
+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
+
+#define REJECT(name) name{} -> fail "name"
+
+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 $ negate n)
+      Literal (Integer n) -> return $ Literal (Integer $ negate n)
+      _ -> fail "NegApp"
+    HsPar _x e -> 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
+        fieldName = showFieldLabel . unLoc . hsRecFieldLbl
+        recordFields = mapM (recordField . unLoc)
+        recordField field = (,) (fieldName field) <$> toExpression (hsRecFieldArg field)
+
+    REJECT(HsUnboundVar)
+    REJECT(HsConLikeOut)
+    REJECT(HsRecFld)
+    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(HsBracket)
+    REJECT(HsRnBracketOut)
+    REJECT(HsTcBracketOut)
+    REJECT(HsSpliceE)
+    REJECT(HsProc)
+    REJECT(HsStatic)
+    REJECT(HsTick)
+    REJECT(HsBinTick)
+#if __GLASGOW_HASKELL__ >= 902
+    REJECT(HsGetField)
+    REJECT(HsProjection)
+#endif
+#if __GLASGOW_HASKELL__ >= 900
+    REJECT(HsPragE)
+#endif
+#if __GLASGOW_HASKELL__ <= 810
+    REJECT(HsSCC)
+    REJECT(HsCoreAnn)
+    REJECT(HsTickPragma)
+    REJECT(HsWrap)
+#endif
+#if __GLASGOW_HASKELL__ <= 808
+    REJECT(HsArrApp)
+    REJECT(HsArrForm)
+    REJECT(EWildPat)
+    REJECT(EAsPat)
+    REJECT(EViewPat)
+    REJECT(ELazyPat)
+#endif
+#if __GLASGOW_HASKELL__ <= 804
+    REJECT(HsAppTypeOut)
+    REJECT(ExplicitPArr)
+    REJECT(ExprWithTySigOut)
+    REJECT(PArrSeq)
+#endif
+    X(XExpr, fail "XExpr")
+
+instance ToExpression RdrName where
+  toExpression = return . Id . showRdrName
+
+instance ToExpression (HsTupArg GhcPs) where
+  toExpression t = case t of
+    Present _x expr -> toExpression expr
+    Missing _ -> fail "Missing (tuple section)"
+    X(XTupArg, fail "XTupArg")
+
+instance ToExpression e => ToExpression (GenLocated l e) where
+  toExpression (L _ e) = toExpression e
+
+instance ToExpression (HsOverLit GhcPs) where
+  toExpression = toExpression . ol_val
+
+#if __GLASGOW_HASKELL__ > 802
+#define _integralSource
+
+instance ToExpression IntegralLit where
+  toExpression il = toExpression (il_value il)
+#endif
+
+instance ToExpression OverLitVal where
+  toExpression lit = case lit of
+    HsIntegral _integralSource il -> toExpression il
+    HsFractional fl -> toExpression fl
+    HsIsString _ str -> toExpression str
+
+instance ToExpression FractionalLit where
+  toExpression fl = toExpression (fl_value fl)
+
+#if __GLASGOW_HASKELL__ >= 902
+fl_value :: FractionalLit -> Rational
+fl_value = rationalFromFractionalLit
+#endif
+
+instance ToExpression FastString where
+  toExpression = return . Literal . String . unpackFS
+
+instance ToExpression Integer where
+  toExpression = return . Literal . Integer
+
+instance ToExpression Rational where
+  toExpression = return . Literal . Rational
+
+instance ToExpression Char where
+  toExpression = return . Literal . Char
+
+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")
+
+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, "")
+
+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)
+
+showOccName :: OccName -> String
+showOccName = unpackFS . occNameFS
+
+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)
+
+#if __GLASGOW_HASKELL__ <= 900
+#if __GLASGOW_HASKELL__ >= 810
+    unECP = runECP_PV
+#else
+    unECP = return
+    runPV = id
+#endif
+#endif
+
+runParser :: String -> P a -> ParseResult a
+runParser str parser = unP parser parseState
+  where
+    location = mkRealSrcLoc "" 1 1
+    input = stringToStringBuffer str
+    parseState = initParserState opts input location
+    opts = mkParserOpts warn extensions False False False True
+
+#if __GLASGOW_HASKELL__ >= 804
+    extensions = EnumSet.fromList [TraditionalRecordSyntax]
+    warn = EnumSet.empty
+#else
+    extensions = mempty
+    warn = 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
diff --git a/src/Test/Hspec/Core/Formatters/Pretty/Parser/Types.hs b/src/Test/Hspec/Core/Formatters/Pretty/Parser/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Hspec/Core/Formatters/Pretty/Parser/Types.hs
@@ -0,0 +1,21 @@
+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 Rational
+  deriving (Eq, Show)
diff --git a/src/Test/Hspec/Core/Formatters/Pretty/Unicode.hs b/src/Test/Hspec/Core/Formatters/Pretty/Unicode.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Hspec/Core/Formatters/Pretty/Unicode.hs
@@ -0,0 +1,28 @@
+module Test.Hspec.Core.Formatters.Pretty.Unicode (
+  ushow
+, ushows
+) where
+
+import           Prelude ()
+import           Test.Hspec.Core.Compat
+
+import           Data.Char
+
+ushow :: String -> String
+ushow xs = ushows xs ""
+
+ushows :: String -> ShowS
+ushows = uShowString
+
+uShowString :: String -> ShowS
+uShowString cs = showChar '"' . showLitString cs . showChar '"'
+
+showLitString :: String -> ShowS
+showLitString []         s = s
+showLitString ('"' : cs) s = showString "\\\"" (showLitString cs s)
+showLitString (c   : cs) s = uShowLitChar c (showLitString cs s)
+
+uShowLitChar :: Char -> ShowS
+uShowLitChar c
+  | isPrint c && not (isAscii c) = showChar c
+  | otherwise = showLitChar c
diff --git a/src/Test/Hspec/Core/Formatters/V1.hs b/src/Test/Hspec/Core/Formatters/V1.hs
--- a/src/Test/Hspec/Core/Formatters/V1.hs
+++ b/src/Test/Hspec/Core/Formatters/V1.hs
@@ -65,7 +65,7 @@
 import           Data.Maybe
 import           Test.Hspec.Core.Util
 import           Test.Hspec.Core.Clock
-import           Test.Hspec.Core.Spec (Location(..))
+import           Test.Hspec.Core.Example (Location(..))
 import           Text.Printf
 import           Control.Monad.IO.Class
 import           Control.Exception
diff --git a/src/Test/Hspec/Core/Formatters/V2.hs b/src/Test/Hspec/Core/Formatters/V2.hs
--- a/src/Test/Hspec/Core/Formatters/V2.hs
+++ b/src/Test/Hspec/Core/Formatters/V2.hs
@@ -80,9 +80,9 @@
 import           Data.Maybe
 import           Test.Hspec.Core.Util
 import           Test.Hspec.Core.Clock
-import           Test.Hspec.Core.Spec (Location(..))
+import           Test.Hspec.Core.Example (Location(..))
 import           Text.Printf
-import           Text.Show.Unicode (ushow)
+import           Test.Hspec.Core.Formatters.Pretty.Unicode (ushow)
 import           Control.Monad.IO.Class
 import           Control.Exception
 
@@ -131,6 +131,7 @@
   )
 
 import           Test.Hspec.Core.Formatters.Diff
+import           Test.Hspec.Core.Formatters.Pretty (pretty2)
 
 silent :: Formatter
 silent = Formatter {
@@ -277,7 +278,7 @@
           pretty <- prettyPrint
           let
             (expected, actual)
-              | pretty = recover unicode expected_ actual_
+              | pretty = pretty2 unicode expected_ actual_
               | otherwise = (expected_, actual_)
 
           mapM_ indent preface
diff --git a/test/Test/Hspec/Core/Formatters/DiffSpec.hs b/test/Test/Hspec/Core/Formatters/DiffSpec.hs
--- a/test/Test/Hspec/Core/Formatters/DiffSpec.hs
+++ b/test/Test/Hspec/Core/Formatters/DiffSpec.hs
@@ -12,34 +12,6 @@
 
 spec :: Spec
 spec = do
-  describe "recover" $ do
-    context "with single-line string literals" $ do
-      context "with --unicode" $ do
-        it "recovers unicode" $ do
-          recover True (show "foo\955bar") (show "foo-bar") `shouldBe` ("\"foo\955bar\"", "\"foo-bar\"")
-
-      context "with --no-unicode" $ do
-        it "does not recover unicode" $ do
-          recover False (show "foo\955bar") (show "foo-bar") `shouldBe` ("\"foo\\955bar\"", "\"foo-bar\"")
-
-  describe "recoverString" $ do
-    it "parses back multi-line string literals" $ do
-      recoverString True (show "foo\nbar\nbaz\n") `shouldBe` Just "foo\nbar\nbaz\n"
-
-    it "does not parse back string literals that contain control characters" $ do
-      recoverString True (show "foo\n\tbar\nbaz\n") `shouldBe` Nothing
-
-    it "does not parse back string literals that span a single line" $ do
-      recoverString True (show "foo\n") `shouldBe` Nothing
-
-    context "when unicode is True" $ do
-      it "parses back string literals that contain unicode" $ do
-        recoverString True (show "foo\n\955\nbaz\n") `shouldBe` Just "foo\n\955\nbaz\n"
-
-    context "when unicode is False" $ do
-      it "does not parse back string literals that contain unicode" $ do
-        recoverString False (show "foo\n\955\nbaz\n") `shouldBe` Nothing
-
   describe "partition" $ do
     context "with a single shown Char" $ do
       it "never partitions a character escape" $ do
diff --git a/test/Test/Hspec/Core/Formatters/Pretty/ParserSpec.hs b/test/Test/Hspec/Core/Formatters/Pretty/ParserSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Hspec/Core/Formatters/Pretty/ParserSpec.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE CPP #-}
+module Test.Hspec.Core.Formatters.Pretty.ParserSpec (spec, Person(..)) where
+
+import           Prelude ()
+import           Helper
+
+import           Test.Hspec.Core.Formatters.Pretty.Parser
+
+data Person = Person {
+  personName :: String
+, personAge :: Int
+} deriving (Eq, Show)
+
+string :: String -> Expression
+string = Literal . String
+
+integer :: Integer -> Expression
+integer = Literal . Integer
+
+spec :: Spec
+spec = do
+  let parse = unsafeParseExpression
+  describe "parseExpression" $ do
+    it "parses characters" $ do
+      parse (show 'c') `shouldBe` just (Literal $ Char 'c')
+
+    it "parses strings" $ do
+      parse (show "foo") `shouldBe` just (string "foo")
+
+    it "parses integers" $ do
+      parse "23" `shouldBe` just (integer 23)
+
+    it "parses negative integers" $ do
+      parse "-23" `shouldBe` just (integer (-23))
+
+    it "parses rationals" $ do
+      parse "23.0" `shouldBe` just (Literal $ Rational 23)
+
+    it "parses negative rationals" $ do
+      parse "-23.0" `shouldBe` just (Literal $ Rational (-23))
+
+    it "parses lists" $ do
+      parse (show ["foo", "bar", "baz"]) `shouldBe` just (List [string "foo", string "bar", string "baz"])
+
+    it "parses tuples" $ do
+      parse (show ("foo", "bar", "baz")) `shouldBe` just (Tuple [string "foo", string "bar", string "baz"])
+
+    it "parses Nothing" $ do
+      parse (show (Nothing :: Maybe Int)) `shouldBe` just (Id "Nothing")
+
+    it "parses Just" $ do
+      parse (show $ Just "foo") `shouldBe` just (App (Id "Just") (string "foo"))
+
+    it "parses nested Just" $ do
+      parse (show $ Just $ Just "foo") `shouldBe` just (App (Id "Just") . Parentheses $ App (Id "Just") (string "foo"))
+
+    it "parses records" $ do
+      let person = Person "Joe" 23
+
+      parse (show person) `shouldBe` just (Record "Person" [
+          ("personName", string "Joe")
+        , ("personAge", integer 23)
+        ])
+  where
+#if __GLASGOW_HASKELL__ >= 802
+    just = Just
+#else
+    just _ = Nothing
+#endif
diff --git a/test/Test/Hspec/Core/Formatters/Pretty/UnicodeSpec.hs b/test/Test/Hspec/Core/Formatters/Pretty/UnicodeSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Hspec/Core/Formatters/Pretty/UnicodeSpec.hs
@@ -0,0 +1,16 @@
+module Test.Hspec.Core.Formatters.Pretty.UnicodeSpec (spec) where
+
+import           Prelude ()
+import           Helper
+
+import           Test.Hspec.Core.Formatters.Pretty.Unicode
+
+spec :: Spec
+spec = do
+  describe "ushow" $ do
+    it "retains unicode characters" $ do
+      ushow "foo-\955-bar" `shouldBe` "\"foo-\955-bar\""
+
+    it "is inverted by read" $ do
+      property $ \ xs ->
+        read (ushow xs) `shouldBe` xs
diff --git a/test/Test/Hspec/Core/Formatters/PrettySpec.hs b/test/Test/Hspec/Core/Formatters/PrettySpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Hspec/Core/Formatters/PrettySpec.hs
@@ -0,0 +1,117 @@
+{-# LANGUAGE CPP #-}
+module Test.Hspec.Core.Formatters.PrettySpec (spec) where
+
+import           Prelude ()
+import           Helper
+
+import           Test.Hspec.Core.Formatters.Pretty.ParserSpec (Person(..))
+
+import           Test.Hspec.Core.Formatters.Pretty
+
+spec :: Spec
+spec = do
+  describe "pretty2" $ do
+    context "with single-line string literals" $ do
+      context "with --unicode" $ do
+        it "recovers unicode" $ do
+          pretty2 True (show "foo\955bar") (show "foo-bar") `shouldBe` ("\"foo\955bar\"", "\"foo-bar\"")
+
+      context "with --no-unicode" $ do
+        it "does not recover unicode" $ do
+          pretty2 False (show "foo\955bar") (show "foo-bar") `shouldBe` ("\"foo\\955bar\"", "\"foo-bar\"")
+
+  describe "recoverString" $ do
+    it "parses back multi-line string literals" $ do
+      recoverString True (show "foo\nbar\nbaz\n") `shouldBe` Just "foo\nbar\nbaz\n"
+
+    it "does not parse back string literals that contain control characters" $ do
+      recoverString True (show "foo\n\tbar\nbaz\n") `shouldBe` Nothing
+
+    it "does not parse back string literals that span a single line" $ do
+      recoverString True (show "foo\n") `shouldBe` Nothing
+
+    context "when unicode is True" $ do
+      it "parses back string literals that contain unicode" $ do
+        recoverString True (show "foo\n\955\nbaz\n") `shouldBe` Just "foo\n\955\nbaz\n"
+
+    context "when unicode is False" $ do
+      it "does not parse back string literals that contain unicode" $ do
+        recoverString False (show "foo\n\955\nbaz\n") `shouldBe` Nothing
+
+  describe "pretty" $ do
+    let person = Person "Joe" 23
+
+    it "pretty-prints records" $ do
+      pretty True (show person) `shouldBe` just [
+          "Person {"
+        , "  personName = \"Joe\","
+        , "  personAge = 23"
+        , "}"
+        ]
+
+    it "pretty-prints Just-values" $ do
+      pretty True (show $ Just person) `shouldBe` just [
+          "Just Person {"
+        , "  personName = \"Joe\","
+        , "  personAge = 23"
+        , "}"
+        ]
+
+    it "pretty-prints tuples" $ do
+      pretty True (show (person, 23 :: Int)) `shouldBe` just [
+          "(Person {"
+        , "  personName = \"Joe\","
+        , "  personAge = 23"
+        , "}, 23)"
+        ]
+
+    it "pretty-prints lists" $ do
+      pretty True (show [Just person, Nothing]) `shouldBe` just [
+          "[Just Person {"
+        , "  personName = \"Joe\","
+        , "  personAge = 23"
+        , "}, Nothing]"
+        ]
+
+    context "with --unicode" $ do
+      it "retains unicode characters in record fields" $ do
+        pretty True (show $ Person "λ-Joe" 23) `shouldBe` just [
+            "Person {"
+          , "  personName = \"λ-Joe\","
+          , "  personAge = 23"
+          , "}"
+          ]
+
+      it "retains unicode characters in list elements" $ do
+        pretty True (show ["foo", "λ", "bar"]) `shouldBe` just ["[\"foo\", \"λ\", \"bar\"]"]
+
+    context "with --no-unicode" $ do
+      it "does not retain unicode characters in record fields" $ do
+        pretty False (show $ Person "λ-Joe" 23) `shouldBe` just [
+            "Person {"
+          , "  personName = \"\\955-Joe\","
+          , "  personAge = 23"
+          , "}"
+          ]
+
+      it "does not retain unicode characters in list elements" $ do
+        pretty False (show ["foo", "λ", "bar"]) `shouldBe` just ["[\"foo\", \"\\955\", \"bar\"]"]
+
+    context "with input that looks like a list" $ do
+      it "it returns Nothing" $ do
+        pretty True "[23,42]" `shouldBe` Nothing
+
+    context "with input that looks like a tuple" $ do
+      it "it returns Nothing" $ do
+        pretty True "(23,42)" `shouldBe` Nothing
+
+    context "with input that looks like function applications" $ do
+      it "it returns Nothing" $ do
+        let input = unlines ["foo", "bar", "baz"]
+        pretty True input `shouldBe` Nothing
+  where
+#if __GLASGOW_HASKELL__ >= 802
+    just = Just . intercalate "\n"
+#else
+    just _ = Nothing
+#endif
diff --git a/test/Test/Hspec/Core/Formatters/V2Spec.hs b/test/Test/Hspec/Core/Formatters/V2Spec.hs
--- a/test/Test/Hspec/Core/Formatters/V2Spec.hs
+++ b/test/Test/Hspec/Core/Formatters/V2Spec.hs
@@ -204,7 +204,7 @@
 
     describe "formatterDone" $ do
       it "recovers unicode from ExpectedButGot" $ do
-        formatter <- formatterToFormat progress formatConfig { formatConfigOutputUnicode = True }
+        formatter <- formatterToFormat failed_examples formatConfig { formatConfigOutputUnicode = True }
         _ <- formatter .  ItemDone ([], "") . Item Nothing 0 "" $ Failure Nothing $ ExpectedButGot Nothing (show "\955") (show "\956")
         (fmap normalizeSummary . captureLines) (formatter $ Done []) `shouldReturn` [
             ""
@@ -224,7 +224,7 @@
 
       context "when actual/expected contain newlines" $ do
         it "adds indentation" $ do
-          formatter <- formatterToFormat progress formatConfig
+          formatter <- formatterToFormat failed_examples formatConfig
           _ <- formatter .  ItemDone ([], "") . Item Nothing 0 "" $ Failure Nothing $ ExpectedButGot Nothing "first\nsecond\nthird" "first\ntwo\nthird"
           (fmap normalizeSummary . captureLines) (formatter $ Done []) `shouldReturn` [
               ""
@@ -248,7 +248,7 @@
 
       context "without failures" $ do
         it "shows summary in green if there are no failures" $ do
-          formatter <- formatterToFormat progress formatConfig
+          formatter <- formatterToFormat failed_examples formatConfig
           _ <- formatter .  ItemDone ([], "") . Item Nothing 0 "" $ Success
           (fmap normalizeSummary . captureLines) (formatter $ Done []) `shouldReturn` [
               ""
@@ -258,7 +258,7 @@
 
       context "with pending examples" $ do
         it "shows summary in yellow if there are pending examples" $ do
-          formatter <- formatterToFormat progress formatConfig
+          formatter <- formatterToFormat failed_examples formatConfig
           _ <- formatter .  ItemDone ([], "") . Item Nothing 0 "" $ Pending Nothing Nothing
           (fmap normalizeSummary . captureLines) (formatter $ Done []) `shouldReturn` [
               ""
diff --git a/vendor/Control/Concurrent/Async.hs b/vendor/Control/Concurrent/Async.hs
--- a/vendor/Control/Concurrent/Async.hs
+++ b/vendor/Control/Concurrent/Async.hs
@@ -6,7 +6,7 @@
 #if __GLASGOW_HASKELL__ < 710
 {-# LANGUAGE DeriveDataTypeable #-}
 #endif
-{-# OPTIONS -Wall -fno-warn-implicit-prelude #-}
+{-# OPTIONS -Wall -fno-warn-implicit-prelude -fno-warn-unused-imports #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -24,65 +24,123 @@
 -- "Control.Concurrent".  The main additional functionality it
 -- provides is the ability to wait for the return value of a thread,
 -- but the interface also provides some additional safety and
--- robustness over using threads and @MVar@ directly.
+-- 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@ corresponds to a thread, and its 'ThreadId'
--- can be obtained with 'asyncThreadId', although that should rarely
--- be necessary.
+-- 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):
 --
--- >    do a1 <- async (getURL url1)
--- >       a2 <- async (getURL url2)
--- >       page1 <- wait a1
--- >       page2 <- wait a2
--- >       ...
+-- > withAsync (getURL url1) $ \a1 -> do
+-- >   withAsync (getURL url2) $ \a2 -> do
+-- >     page1 <- wait a1
+-- >     page2 <- wait a2
+-- >     ...
 --
--- where 'async' starts the operation in a separate thread, and
--- 'wait' waits for and returns the result.  If the operation
--- throws an exception, then that exception is re-thrown by
--- 'wait'.  This is one of the ways in which this library
--- provides some additional safety: it is harder to accidentally
--- forget about exceptions thrown in child threads.
+-- where 'withAsync' starts the operation in a separate thread, and
+-- 'wait' waits for and returns the result.
 --
--- A slight improvement over the previous example is this:
+-- * 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.
 --
--- >       withAsync (getURL url1) $ \a1 -> do
--- >       withAsync (getURL url2) $ \a2 -> do
--- >       page1 <- wait a1
--- >       page2 <- wait a2
--- >       ...
+-- 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.  Consider
--- the case when the first 'wait' throws an exception; then the second
--- 'Async' will be automatically killed rather than being left to run
--- in the background, possibly indefinitely.  This is the second way
--- that the library provides additional safety: using 'withAsync'
--- means we can avoid accidentally leaving threads running.
+-- 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.
 --
--- The pattern of performing two IO actions concurrently and waiting
--- for their results is packaged up in a combinator 'concurrently', so
--- we can further shorten the above example to:
+-- 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".
 --
--- >       (page1, page2) <- concurrently (getURL url1) (getURL url2)
--- >       ...
+-- == Miscellaneous
 --
 -- The 'Functor' instance can be used to change the result of an
 -- 'Async'.  For example:
 --
--- > ghci> a <- async (return 3)
--- > ghci> wait a
--- > 3
--- > ghci> wait (fmap (+1) a)
+-- > 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.
 
 -----------------------------------------------------------------------------
 
@@ -90,9 +148,9 @@
 
     -- * Asynchronous actions
     Async,
-    -- ** Spawning
-    async, asyncBound, asyncOn, asyncWithUnmask, asyncOnWithUnmask,
 
+    -- * High-level API
+
     -- ** Spawning with automatic 'cancel'ation
     withAsync, withAsyncBound, withAsyncOn, withAsyncWithUnmask,
     withAsyncOnWithUnmask,
@@ -101,36 +159,43 @@
     wait, poll, waitCatch, asyncThreadId,
     cancel, uninterruptibleCancel, cancelWith, AsyncCancelled(..),
 
-    -- ** STM operations
+    -- ** #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
+    -- *** Waiting for multiple 'Async's
     waitAny, waitAnyCatch, waitAnyCancel, waitAnyCatchCancel,
     waitEither, waitEitherCatch, waitEitherCancel, waitEitherCatchCancel,
     waitEither_,
     waitBoth,
 
-    -- ** Waiting for multiple 'Async's in STM
+    -- *** Waiting for multiple 'Async's in STM
     waitAnySTM, waitAnyCatchSTM,
     waitEitherSTM, waitEitherCatchSTM,
     waitEitherSTM_,
     waitBothSTM,
 
-    -- ** Linking
-    link, link2, ExceptionInLinkedThread(..),
+    -- * Low-level API
 
-    -- * Convenient utilities
-    race, race_,
-    concurrently, concurrently_,
-    mapConcurrently, forConcurrently,
-    mapConcurrently_, forConcurrently_,
-    replicateConcurrently, replicateConcurrently_,
-    Concurrently(..),
-    compareAsyncs,
+    -- ** Spawning (low-level API)
+    async, asyncBound, asyncOn, asyncWithUnmask, asyncOnWithUnmask,
 
+    -- ** Linking
+    link, linkOnly, link2, link2Only, ExceptionInLinkedThread(..),
+
   ) where
 
-import Control.Concurrent.STM
+import Control.Concurrent.STM.TMVar
 import Control.Exception
 import Control.Concurrent
 import qualified Data.Foldable as F
@@ -146,7 +211,7 @@
 #if __GLASGOW_HASKELL__ < 710
 import Data.Typeable
 #endif
-#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,13,0)
+#if MIN_VERSION_base(4,9,0)
 import Data.Semigroup (Semigroup((<>)))
 #endif
 
@@ -181,11 +246,16 @@
 instance Functor Async where
   fmap f (Async a w) = Async a (fmap (fmap f) w)
 
--- | Compare two 'Async's that may have different types
+-- | 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
 
@@ -226,7 +296,7 @@
 --
 -- > withAsync action inner = mask $ \restore -> do
 -- >   a <- async (restore action)
--- >   restore inner `finally` uninterruptibleCancel a
+-- >   restore (inner a) `finally` uninterruptibleCancel a
 --
 -- This is a useful variant of 'async' that ensures an @Async@ is
 -- never left running unintentionally.
@@ -285,7 +355,10 @@
 --
 {-# INLINE wait #-}
 wait :: Async a -> IO a
-wait = atomically . waitSTM
+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
@@ -509,7 +582,10 @@
 --
 {-# INLINE waitBoth #-}
 waitBoth :: Async a -> Async b -> IO (a,b)
-waitBoth left right = atomically (waitBothSTM left right)
+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.
 --
@@ -533,8 +609,12 @@
 #endif
 
 instance Show ExceptionInLinkedThread where
-  show (ExceptionInLinkedThread (Async t _) e) =
-    "ExceptionInLinkedThread " ++ show t ++ " " ++ show e
+  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
@@ -555,10 +635,11 @@
 
 -- | Link the given @Async@ to the current thread, such that if the
 -- @Async@ raises an exception, that exception will be re-thrown in
--- the current thread.  The supplied predicate determines which
--- exceptions in the target thread should be propagated to the source
--- thread.
+-- 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'
@@ -584,6 +665,13 @@
 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
@@ -628,6 +716,11 @@
 -- >   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
@@ -637,16 +730,15 @@
   withAsync right $ \b ->
   waitEither a b
 
-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
@@ -725,9 +817,19 @@
         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
+-- | 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.
@@ -739,6 +841,10 @@
 --
 -- > 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)
 
@@ -750,29 +856,16 @@
 forConcurrently :: Traversable t => t a -> (a -> IO b) -> IO (t b)
 forConcurrently = flip mapConcurrently
 
--- | `mapConcurrently_` is `mapConcurrently` with the return value discarded,
--- just like @mapM_
+-- | `mapConcurrently_` 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,
--- just like @forM_
+-- | `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_
 
--- | 'concurrently', but ignore the result values
---
--- @since 2.1.1
-concurrently_ :: IO a -> IO b -> IO ()
-concurrently_ left right = concurrently' left right (collect 0)
-  where
-    collect 2 _ = return ()
-    collect i m = do
-        e <- m
-        case e of
-            Left ex -> throwIO ex
-            Right _ -> collect (i + 1 :: Int) m
-
 -- | Perform the action in the given number of threads.
 --
 -- @since 2.1.1
@@ -861,10 +954,10 @@
 -- exception handler.
 {-# INLINE rawForkIO #-}
 rawForkIO :: IO () -> IO ThreadId
-rawForkIO action = IO $ \ s ->
+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) action = IO $ \ s ->
+rawForkOn (I# cpu) (IO action) = IO $ \ s ->
    case (forkOn# cpu action s) of (# s1, tid #) -> (# s1, ThreadId tid #)
diff --git a/vendor/Text/Show/Unicode.hs b/vendor/Text/Show/Unicode.hs
deleted file mode 100644
--- a/vendor/Text/Show/Unicode.hs
+++ /dev/null
@@ -1,140 +0,0 @@
-{- |
-Copyright   : (c) Takayuki Muranushi, 2016
-License     : BSD3
-Maintainer  : whosekiteneverfly@gmail.com
-Stability   : experimental
-
-
-Provides a interactive printer for printing Unicode characters in ghci REPL. Our design goal is that 'uprint' produces String representations that are valid Haskell 'String' literals and uses as many Unicode printable characters as possible. Hence
-
-@
-read . ushow == id
-@
-
-see the tests of this package for detailed specifications.
-
-__Example__
-
-With 'print' :
-
-@
-$ __ghci__
-...
-> __["哈斯克尔7.6.1"]__
-["\\21704\\26031\\20811\\23572\\&7.6.1"]
->
-@
-
-With 'uprint' :
-
-@
-$ __ghci -interactive-print=Text.Show.Unicode.uprint Text.Show.Unicode__
-...
-Ok, modules loaded: Text.Show.Unicode.
-> __("Хорошо!",["哈斯克尔7.6.1的力量","感じる"])__
-("Хорошо!",["哈斯克尔7.6.1的力量","感じる"])
-> "改\\n行"
-"改\\n行"
-@
-
-You can make 'uprint' the default interactive printer in several ways. One is to
-@cabal install unicode-show@, and add the following lines to your @~/.ghci@ config file.
-
-@
-import qualified Text.Show.Unicode
-:set -interactive-print=Text.Show.Unicode.uprint
-@
-
--}
-
-module Text.Show.Unicode (ushow, uprint, urecover, ushowWith, uprintWith, urecoverWith) where
-
-import           Prelude ()
-import           Test.Hspec.Core.Compat hiding (many, (<*>), (*>), (<*))
-
-import           Data.Char                    (isAscii, isPrint)
-import           Text.ParserCombinators.ReadP
-import           Text.Read.Lex                (lexChar)
-import qualified Data.List                     as L
-
-infixl 4 <*
-
-(<*) :: Monad m => m a -> m b -> m a
-(<*) = flip (>>)
-
--- Represents a replaced character using its literal form and its escaped form.
-type Replacement = (String, String)
-
--- | Parse one Haskell character literal expression from a 'String' produced by 'show', and
---
---  * If the found char satisfies the predicate, replace the literal string with the character itself.
---  * Otherwise, leave the string as it was.
---  * Note that special delimiter sequence "\&" may appear in a string. c.f.  <https://www.haskell.org/onlinereport/haskell2010/haskellch2.html#x7-200002.6 Section 2.6 of the Haskell 2010 specification>.
-recoverChar :: (Char -> Bool) -> ReadP Replacement
-recoverChar p = represent <$> gather lexCharAndConsumeEmpties
-  where
-    represent :: (String, Char) -> Replacement
-    represent (o,lc)
-      -- This is too dirty a hack.
-      -- However, I couldn't think of any other way to recover the & consumed by lexChar while not needlessly increasing the number of & by mis-detecting the escape sequence.
-      | p lc      =
-        if head o /= '\\' &&
-        "\\&" `L.isSuffixOf` o
-        then (o, lc : "\\&")
-        else (o, [lc])
-      | otherwise = (o, o)
-
--- | The base library lexChar has been handling & by itself since 4.9.1.0,
--- so consumeEmpties is a meaningless action,
--- but it makes sense for older versions of lexChar.
-lexCharAndConsumeEmpties :: ReadP Char
-lexCharAndConsumeEmpties = lexChar <* consumeEmpties
-    where
-    -- Consumes the string "\&" repeatedly and greedily (will only produce one match)
-    consumeEmpties :: ReadP ()
-    consumeEmpties = do
-        rest <- look
-        case rest of
-            ('\\':'&':_) -> string "\\&" >> consumeEmpties
-            _ -> return ()
-
--- | Show the input, and then replace Haskell character literals
--- with the character it represents, for any Unicode printable characters except backslash, single and double quotation marks.
--- If something fails, fallback to standard 'show'.
-ushow :: Show a => a -> String
-ushow = ushowWith shouldRecover
-
--- | Replace Haskell character literals with the character it represents, for
--- any Unicode printable characters except backslash, single and double
--- quotation marks.
-urecover :: String -> String
-urecover = urecoverWith shouldRecover
-
-shouldRecover :: Char -> Bool
-shouldRecover c = isPrint c && not (isAscii c)
-
--- | A version of 'print' that uses 'ushow'.
-uprint :: Show a => a -> IO ()
-uprint = putStrLn . ushow
-
--- | Show the input, and then replace character literals
--- with the character itself, for characters that satisfy the given predicate.
-ushowWith :: Show a => (Char -> Bool) -> a -> String
-ushowWith p = urecoverWith p . show
-
--- | Replace character literals with the character itself, for characters that
--- satisfy the given predicate.
-urecoverWith :: (Char -> Bool) -> String -> String
-urecoverWith p = go ("", "") . readP_to_S (many $ recoverChar p)
-  where
-    go :: Replacement -> [([Replacement], String)] -> String
-    go _  []            = ""
-    go _  (([],""):_)   = ""
-    go _  ((rs,""):_)   = snd $ last rs
-    go _  [(_,o)]       = o
-    go pr (([],_):rest) = go pr rest
-    go _  ((rs,_):rest) = let r = last rs in snd r ++ go r rest
-
--- | A version of 'print' that uses 'ushowWith'.
-uprintWith :: Show a => (Char -> Bool) -> a -> IO ()
-uprintWith p = putStrLn . ushowWith p
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
--- a/version.yaml
+++ b/version.yaml
@@ -1,1 +1,1 @@
-&version 2.9.2
+&version 2.9.3