{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Syd.Hspec (fromHspec) where

import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception
import Control.Monad.Writer
import Data.List
import qualified Test.Hspec.Core.Spec as Hspec
import Test.QuickCheck
import Test.Syd as Syd

-- | Import an Hspec 'Test.Hspec.Spec' as a Sydtest 'Test.Syd.Spec'.
--
-- The reasoning behind this function is that, eventhough migration from hspec
-- to sydtest is usually very simple, you might depend on certain libraries
-- beyond your control that still use hspec.  In that case you want to be able
-- to still use those libraries but also use sydtest already.
--
-- For this reason, and because hspec doesn't tell you wether a test is pending
-- until after you run it, pending tests are imported as passing tests.
fromHspec :: Hspec.Spec -> Syd.Spec
fromHspec :: Spec -> Spec
fromHspec Spec
spec = do
  [SpecTree ()]
trees <- IO [SpecTree ()] -> TestDefM '[] () [SpecTree ()]
forall a. IO a -> TestDefM '[] () a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SpecTree ()] -> TestDefM '[] () [SpecTree ()])
-> IO [SpecTree ()] -> TestDefM '[] () [SpecTree ()]
forall a b. (a -> b) -> a -> b
$ Spec -> IO [SpecTree ()]
runSpecM_ Spec
spec
  -- We have to use 'doNotRandomiseExecutionOrder' and 'sequential' because otherwise
  -- passing hspec tests would stop working when imported into sydtest
  Spec -> Spec
forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
doNotRandomiseExecutionOrder (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ Spec -> Spec
forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
sequential (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ (SpecTree () -> Spec) -> [SpecTree ()] -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SpecTree () -> Spec
importSpecTree [SpecTree ()]
trees

runSpecM_ :: Hspec.SpecWith () -> IO [Hspec.SpecTree ()]
#if MIN_VERSION_hspec_core(2,10,1)
runSpecM_ :: Spec -> IO [SpecTree ()]
runSpecM_ = ((Endo Config, [SpecTree ()]) -> [SpecTree ()])
-> IO (Endo Config, [SpecTree ()]) -> IO [SpecTree ()]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Endo Config, [SpecTree ()]) -> [SpecTree ()]
forall a b. (a, b) -> b
snd (IO (Endo Config, [SpecTree ()]) -> IO [SpecTree ()])
-> (Spec -> IO (Endo Config, [SpecTree ()]))
-> Spec
-> IO [SpecTree ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spec -> IO (Endo Config, [SpecTree ()])
forall a. SpecWith a -> IO (Endo Config, [SpecTree a])
Hspec.runSpecM
#else
runSpecM_ = Hspec.runSpecM
#endif

-- Hspec.NodeWithCleanup's semantics are so weird that we can only do
-- this translation if inner equals ().
importSpecTree :: Hspec.SpecTree () -> Syd.Spec
importSpecTree :: SpecTree () -> Spec
importSpecTree = SpecTree () -> Spec
go
  where
    go :: Hspec.SpecTree () -> Syd.Spec
    go :: SpecTree () -> Spec
go = \case
      Hspec.Leaf Item ()
item -> Item () -> Spec
forall inner. Item inner -> TestDefM '[] inner ()
importItem Item ()
item
      Hspec.Node String
d [SpecTree ()]
ts -> String -> Spec -> Spec
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe String
d (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ (SpecTree () -> Spec) -> [SpecTree ()] -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SpecTree () -> Spec
go [SpecTree ()]
ts
#if MIN_VERSION_hspec_core(2,10,1)
      Hspec.NodeWithCleanup Maybe (String, Location)
_ IO ()
cleanup [SpecTree ()]
ts -> IO () -> Spec -> Spec
forall (outers :: [*]) inner result.
IO ()
-> TestDefM outers inner result -> TestDefM outers inner result
afterAll_ IO ()
cleanup ((SpecTree () -> Spec) -> [SpecTree ()] -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SpecTree () -> Spec
go [SpecTree ()]
ts)
#else
#if MIN_VERSION_hspec_core(2,8,0)
      Hspec.NodeWithCleanup _ cleanup ts -> afterAll_ (cleanup ()) (mapM_ go ts)
#else
      Hspec.NodeWithCleanup cleanup ts ->   afterAll_ (cleanup ()) (mapM_ go ts)
#endif
#endif

importItem :: forall inner. Hspec.Item inner -> Syd.TestDefM '[] inner ()
importItem :: forall inner. Item inner -> TestDefM '[] inner ()
importItem item :: Item inner
item@Hspec.Item {Bool
String
Maybe Bool
Maybe Location
Annotations
Params
-> (ActionWith inner -> IO ()) -> ProgressCallback -> IO Result
itemRequirement :: String
itemLocation :: Maybe Location
itemIsParallelizable :: Maybe Bool
itemIsFocused :: Bool
itemAnnotations :: Annotations
itemExample :: Params
-> (ActionWith inner -> IO ()) -> ProgressCallback -> IO Result
itemRequirement :: forall a. Item a -> String
itemLocation :: forall a. Item a -> Maybe Location
itemIsParallelizable :: forall a. Item a -> Maybe Bool
itemIsFocused :: forall a. Item a -> Bool
itemAnnotations :: forall a. Item a -> Annotations
itemExample :: forall a.
Item a
-> Params
-> (ActionWith a -> IO ())
-> ProgressCallback
-> IO Result
..} =
  let parallelMod :: TestDefM '[] inner () -> TestDefM '[] inner ()
parallelMod = case Maybe Bool
itemIsParallelizable of
        Just Bool
True -> TestDefM '[] inner () -> TestDefM '[] inner ()
forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
parallel
        Just Bool
False -> TestDefM '[] inner () -> TestDefM '[] inner ()
forall (a :: [*]) b c. TestDefM a b c -> TestDefM a b c
sequential
        Maybe Bool
Nothing -> TestDefM '[] inner () -> TestDefM '[] inner ()
forall a. a -> a
id
   in TestDefM '[] inner () -> TestDefM '[] inner ()
parallelMod (TestDefM '[] inner () -> TestDefM '[] inner ())
-> TestDefM '[] inner () -> TestDefM '[] inner ()
forall a b. (a -> b) -> a -> b
$
        String -> ImportedItem inner -> TestDefM '[] inner ()
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it String
itemRequirement (Item inner -> ImportedItem inner
forall a. Item a -> ImportedItem a
ImportedItem Item inner
item :: ImportedItem inner)

newtype ImportedItem a = ImportedItem (Hspec.Item a)

instance IsTest (ImportedItem a) where
  type Arg1 (ImportedItem a) = ()
  type Arg2 (ImportedItem a) = a
  runTest :: ImportedItem a
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (ImportedItem a) -> Arg2 (ImportedItem a) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest = ImportedItem a
-> TestRunSettings
-> ProgressReporter
-> ((() -> a -> IO ()) -> IO ())
-> IO TestRunResult
ImportedItem a
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (ImportedItem a) -> Arg2 (ImportedItem a) -> IO ())
    -> IO ())
-> IO TestRunResult
forall inner.
ImportedItem inner
-> TestRunSettings
-> ProgressReporter
-> ((() -> inner -> IO ()) -> IO ())
-> IO TestRunResult
runImportedItem

applyWrapper2' ::
  forall r outerArgs innerArg.
  ((outerArgs -> innerArg -> IO ()) -> IO ()) ->
  (outerArgs -> innerArg -> IO r) ->
  IO r
applyWrapper2' :: forall r outerArgs innerArg.
((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs -> innerArg -> IO r) -> IO r
applyWrapper2' (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper outerArgs -> innerArg -> IO r
func = do
  MVar r
var <- IO (MVar r)
forall a. IO (MVar a)
newEmptyMVar
  (outerArgs -> innerArg -> IO ()) -> IO ()
wrapper ((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs -> innerArg -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \outerArgs
outerArgs innerArg
innerArg -> do
    r
res <- outerArgs -> innerArg -> IO r
func outerArgs
outerArgs innerArg
innerArg IO r -> (r -> IO r) -> IO r
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= r -> IO r
forall a. a -> IO a
evaluate
    MVar r -> r -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar r
var r
res
  MVar r -> IO r
forall a. MVar a -> IO a
readMVar MVar r
var

runImportedItem ::
  ImportedItem inner ->
  TestRunSettings ->
  ProgressReporter ->
  ((() -> inner -> IO ()) -> IO ()) ->
  IO TestRunResult
runImportedItem :: forall inner.
ImportedItem inner
-> TestRunSettings
-> ProgressReporter
-> ((() -> inner -> IO ()) -> IO ())
-> IO TestRunResult
runImportedItem (ImportedItem Hspec.Item {Bool
String
Maybe Bool
Maybe Location
Annotations
Params
-> (ActionWith inner -> IO ()) -> ProgressCallback -> IO Result
itemRequirement :: forall a. Item a -> String
itemLocation :: forall a. Item a -> Maybe Location
itemIsParallelizable :: forall a. Item a -> Maybe Bool
itemIsFocused :: forall a. Item a -> Bool
itemAnnotations :: forall a. Item a -> Annotations
itemExample :: forall a.
Item a
-> Params
-> (ActionWith a -> IO ())
-> ProgressCallback
-> IO Result
itemRequirement :: String
itemLocation :: Maybe Location
itemIsParallelizable :: Maybe Bool
itemIsFocused :: Bool
itemAnnotations :: Annotations
itemExample :: Params
-> (ActionWith inner -> IO ()) -> ProgressCallback -> IO Result
..}) TestRunSettings
trs ProgressReporter
progressReporter (() -> ActionWith inner) -> IO ()
wrapper = do
  let report :: ProgressReporter
report = ProgressReporter -> ProgressReporter
reportProgress ProgressReporter
progressReporter
  let qcargs :: Args
qcargs = TestRunSettings -> Args
makeQuickCheckArgs TestRunSettings
trs
  let params :: Hspec.Params
      params :: Params
params =
        Hspec.Params
          { paramsQuickCheckArgs :: Args
Hspec.paramsQuickCheckArgs = Args
qcargs,
            -- TODO use the right depth when sydtest supports smallcheck
            paramsSmallCheckDepth :: Maybe Int
Hspec.paramsSmallCheckDepth = Params -> Maybe Int
Hspec.paramsSmallCheckDepth Params
Hspec.defaultParams
          }
      callback :: Hspec.ProgressCallback
      callback :: ProgressCallback
callback = IO () -> ProgressCallback
forall a b. a -> b -> a
const (IO () -> ProgressCallback) -> IO () -> ProgressCallback
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  TVar Word
exampleCounter <- Word -> IO (TVar Word)
forall a. a -> IO (TVar a)
newTVarIO Word
1
  let totalExamples :: Word
totalExamples = (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Word) (Args -> Int
maxSuccess Args
qcargs)
  -- There's no real nice way to do progress reporting here because:
  --   * hspec does not tell us whether we're using a property or not
  --   * we could use the 'callback' above, but then we cannot time the examples.
  --
  -- The tradeoff that we are making is that the output is more verbose:
  -- You'll see 'ProgressExampleStarting' even for unit tests, but at least the
  -- examples in a property test are timed.
  ProgressReporter
report Progress
ProgressTestStarting
  Result
result <-
    Params
-> (ActionWith inner -> IO ()) -> ProgressCallback -> IO Result
itemExample
      Params
params
      ( \ActionWith inner
takeInner -> ((() -> ActionWith inner) -> IO ())
-> (() -> ActionWith inner) -> IO ()
forall r outerArgs innerArg.
((outerArgs -> innerArg -> IO ()) -> IO ())
-> (outerArgs -> innerArg -> IO r) -> IO r
applyWrapper2' (() -> ActionWith inner) -> IO ()
wrapper ((() -> ActionWith inner) -> IO ())
-> (() -> ActionWith inner) -> IO ()
forall a b. (a -> b) -> a -> b
$ \() inner
inner -> do
          Word
exampleNr <- TVar Word -> IO Word
forall a. TVar a -> IO a
readTVarIO TVar Word
exampleCounter
          ProgressReporter
report ProgressReporter -> ProgressReporter
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Progress
ProgressExampleStarting Word
totalExamples Word
exampleNr
          (()
result, Word64
duration) <- IO () -> IO ((), Word64)
forall (m :: * -> *) a. MonadIO m => m a -> m (a, Word64)
timeItDuration (IO () -> IO ((), Word64)) -> IO () -> IO ((), Word64)
forall a b. (a -> b) -> a -> b
$ ActionWith inner
takeInner inner
inner
          ProgressReporter
report ProgressReporter -> ProgressReporter
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word64 -> Progress
ProgressExampleDone Word
totalExamples Word
exampleNr Word64
duration
          STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar Word -> (Word -> Word) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Word
exampleCounter Word -> Word
forall a. Enum a => a -> a
succ
          () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
result
      )
      ProgressCallback
callback
  ProgressReporter
report Progress
ProgressTestDone
  (TestStatus
testRunResultStatus, Maybe SomeException
testRunResultException) <- case Result -> ResultStatus
Hspec.resultStatus Result
result of
    ResultStatus
Hspec.Success -> (TestStatus, Maybe SomeException)
-> IO (TestStatus, Maybe SomeException)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestStatus
TestPassed, Maybe SomeException
forall a. Maybe a
Nothing)
    -- This is certainly a debatable choice, but there's no need to make
    -- tests fail here, and there's no way to know ahead of time whether
    -- a test is pending so we have no choice.
    Hspec.Pending Maybe Location
_ Maybe String
_ -> (TestStatus, Maybe SomeException)
-> IO (TestStatus, Maybe SomeException)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestStatus
TestPassed, Maybe SomeException
forall a. Maybe a
Nothing)
    Hspec.Failure Maybe Location
mloc FailureReason
fr -> do
      let withExtraContext :: Maybe String -> SomeException -> SomeException
          withExtraContext :: Maybe String -> SomeException -> SomeException
withExtraContext = (SomeException -> SomeException)
-> (String -> SomeException -> SomeException)
-> Maybe String
-> SomeException
-> SomeException
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SomeException -> SomeException
forall a. a -> a
id (\String
extraContext SomeException
se -> Contextual -> SomeException
forall e. Exception e => e -> SomeException
SomeException (Contextual -> SomeException) -> Contextual -> SomeException
forall a b. (a -> b) -> a -> b
$ SomeException -> String -> Contextual
forall e. Exception e => e -> String -> Contextual
addContextToException SomeException
se String
extraContext)
          niceLocation :: Hspec.Location -> String
          niceLocation :: Location -> String
niceLocation Hspec.Location {Int
String
locationFile :: String
locationLine :: Int
locationColumn :: Int
locationFile :: Location -> String
locationLine :: Location -> Int
locationColumn :: Location -> Int
..} = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
":" [String
locationFile, Int -> String
forall a. Show a => a -> String
show Int
locationLine, Int -> String
forall a. Show a => a -> String
show Int
locationColumn]
          withLocationContext :: SomeException -> SomeException
          withLocationContext :: SomeException -> SomeException
withLocationContext = Maybe String -> SomeException -> SomeException
withExtraContext (Maybe String -> SomeException -> SomeException)
-> Maybe String -> SomeException -> SomeException
forall a b. (a -> b) -> a -> b
$ Location -> String
niceLocation (Location -> String) -> Maybe Location -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Location
mloc
          withContext :: SomeException -> Contextual
          withContext :: SomeException -> Contextual
withContext SomeException
e = SomeException -> String -> Contextual
forall e. Exception e => e -> String -> Contextual
addContextToException (SomeException -> SomeException
withLocationContext SomeException
e) (Result -> String
Hspec.resultInfo Result
result)

      SomeException
exception <- (Maybe String -> SomeException -> SomeException)
-> FailureReason -> IO SomeException
failureReasonToException Maybe String -> SomeException -> SomeException
withExtraContext FailureReason
fr

      (TestStatus, Maybe SomeException)
-> IO (TestStatus, Maybe SomeException)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestStatus
TestFailed, SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just (SomeException -> Maybe SomeException)
-> SomeException -> Maybe SomeException
forall a b. (a -> b) -> a -> b
$ (SomeException -> Contextual)
-> SomeException -> FailureReason -> SomeException
maybeAddContextToException SomeException -> Contextual
withContext SomeException
exception FailureReason
fr)

  let testRunResultNumTests :: Maybe a
testRunResultNumTests = Maybe a
forall a. Maybe a
Nothing
  let testRunResultNumShrinks :: Maybe a
testRunResultNumShrinks = Maybe a
forall a. Maybe a
Nothing
  let testRunResultGoldenCase :: Maybe a
testRunResultGoldenCase = Maybe a
forall a. Maybe a
Nothing
  let testRunResultFailingInputs :: [a]
testRunResultFailingInputs = []
  let testRunResultExtraInfo :: Maybe a
testRunResultExtraInfo = Maybe a
forall a. Maybe a
Nothing
  let testRunResultLabels :: Maybe a
testRunResultLabels = Maybe a
forall a. Maybe a
Nothing
  let testRunResultClasses :: Maybe a
testRunResultClasses = Maybe a
forall a. Maybe a
Nothing
  let testRunResultTables :: Maybe a
testRunResultTables = Maybe a
forall a. Maybe a
Nothing

  TestRunResult -> IO TestRunResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult {[String]
Maybe String
Maybe Word
Maybe (Map String Int)
Maybe (Map String (Map String Int))
Maybe (Map [String] Int)
Maybe SomeException
Maybe GoldenCase
TestStatus
forall a. [a]
forall a. Maybe a
testRunResultStatus :: TestStatus
testRunResultException :: Maybe SomeException
testRunResultNumTests :: forall a. Maybe a
testRunResultNumShrinks :: forall a. Maybe a
testRunResultGoldenCase :: forall a. Maybe a
testRunResultFailingInputs :: forall a. [a]
testRunResultExtraInfo :: forall a. Maybe a
testRunResultLabels :: forall a. Maybe a
testRunResultClasses :: forall a. Maybe a
testRunResultTables :: forall a. Maybe a
testRunResultStatus :: TestStatus
testRunResultException :: Maybe SomeException
testRunResultNumTests :: Maybe Word
testRunResultNumShrinks :: Maybe Word
testRunResultFailingInputs :: [String]
testRunResultLabels :: Maybe (Map [String] Int)
testRunResultClasses :: Maybe (Map String Int)
testRunResultTables :: Maybe (Map String (Map String Int))
testRunResultGoldenCase :: Maybe GoldenCase
testRunResultExtraInfo :: Maybe String
..}

failureReasonToException :: (Maybe String -> SomeException -> SomeException) -> Hspec.FailureReason -> IO SomeException
failureReasonToException :: (Maybe String -> SomeException -> SomeException)
-> FailureReason -> IO SomeException
failureReasonToException Maybe String -> SomeException -> SomeException
withExtraContext = \case
  FailureReason
Hspec.NoReason -> SomeException -> IO SomeException
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeException -> IO SomeException)
-> SomeException -> IO SomeException
forall a b. (a -> b) -> a -> b
$ Assertion -> SomeException
forall e. Exception e => e -> SomeException
SomeException (Assertion -> SomeException) -> Assertion -> SomeException
forall a b. (a -> b) -> a -> b
$ String -> Assertion
ExpectationFailed String
"Hspec had no more information about this failure."
  Hspec.Reason String
s -> SomeException -> IO SomeException
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeException -> IO SomeException)
-> SomeException -> IO SomeException
forall a b. (a -> b) -> a -> b
$ Assertion -> SomeException
forall e. Exception e => e -> SomeException
SomeException (Assertion -> SomeException) -> Assertion -> SomeException
forall a b. (a -> b) -> a -> b
$ String -> Assertion
ExpectationFailed String
s
  Hspec.ExpectedButGot Maybe String
mExtraContext String
expected String
actual -> Maybe String -> SomeException -> SomeException
withExtraContext Maybe String
mExtraContext (SomeException -> SomeException)
-> (Assertion -> SomeException) -> Assertion -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assertion -> SomeException
forall e. Exception e => e -> SomeException
SomeException (Assertion -> SomeException) -> IO Assertion -> IO SomeException
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> IO Assertion
mkNotEqualButShouldHaveBeenEqual String
actual String
expected
  Hspec.Error Maybe String
mExtraContext SomeException
e -> SomeException -> IO SomeException
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeException -> IO SomeException)
-> SomeException -> IO SomeException
forall a b. (a -> b) -> a -> b
$ Maybe String -> SomeException -> SomeException
withExtraContext Maybe String
mExtraContext SomeException
e
#if MIN_VERSION_hspec_core(2,11,0)
  Hspec.ColorizedReason String
s -> SomeException -> IO SomeException
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeException -> IO SomeException)
-> SomeException -> IO SomeException
forall a b. (a -> b) -> a -> b
$ Assertion -> SomeException
forall e. Exception e => e -> SomeException
SomeException (Assertion -> SomeException) -> Assertion -> SomeException
forall a b. (a -> b) -> a -> b
$ String -> Assertion
ExpectationFailed String
s
#endif

maybeAddContextToException :: (SomeException -> Contextual) -> SomeException -> Hspec.FailureReason -> SomeException
maybeAddContextToException :: (SomeException -> Contextual)
-> SomeException -> FailureReason -> SomeException
maybeAddContextToException SomeException -> Contextual
withContext SomeException
e = \case
  Hspec.ExpectedButGot {} -> SomeException
e
  FailureReason
_ -> Contextual -> SomeException
forall e. Exception e => e -> SomeException
SomeException (SomeException -> Contextual
withContext SomeException
e)