Inspired by @Wizek's answer, here's a version works with a newer version of HUnit and that is suitable for use with Selenium/WebDriver.
It unpacks and repacks FailureReason's different constructors appropriately
The key difference is the use of Control.Monad.Catch which lets you work with WD as opposed to IO.
Also there's no need to write the $>
operator - there's already &
from Data.Function
import Test.HUnit.Lang
import Control.Monad.Catch
import qualified Data.Text as Text
import Data.Function ((&))
failDetails :: Text -> WD () -> WD ()
failDetails textMessage expectation =
expectation `catch` \(HUnitFailure loc reason) ->
throwM $ HUnitFailure loc $ addMessageTo reason
where
message :: String
message = Text.unpack textMessage
addMessageTo :: FailureReason -> FailureReason
addMessageTo (Reason reason) = Reason $ reason ++ "\n" ++ message
addMessageTo (ExpectedButGot preface expected actual) =
ExpectedButGot newPreface expected actual
where
newPreface =
case preface of
Nothing -> Just message
Just existingMessage -> Just $ existingMessage ++ "\n" ++ message