Add and use a 'failure' helper instead of 'error'

Author: ch1bo

hydra-node/hydra-node.cabal

@@ -187,6 +187,7 @@ test-suite tests
     , QuickCheck
     , serialise
     , typed-protocols-examples
+    , HUnit
   build-tool-depends:
     hspec-discover:hspec-discover
   ghc-options:

hydra-node/test/Hydra/BehaviorSpec.hs

@@ -55,8 +55,7 @@ import Test.Hspec (
   shouldNotBe,
   shouldReturn,
  )
-import Test.Util (failAfter)
-import Prelude (error)
+import Test.Util (failAfter, failure)
 
 spec :: Spec
 spec = describe "Behavior of one ore more hydra-nodes" $ do
@@ -299,8 +298,7 @@ startHydraNode' snapshotStrategy nodeId connectToChain = do
               atomically $ do
                 st' <- queryLedgerState node
                 check (st == st')
-            -- TODO(SN): use MonadThrow instead?
-            when (isNothing result) $ error ("Expected ledger state of node " <> show nodeId <> " to be " <> show st)
+            when (isNothing result) $ failure ("Expected ledger state of node " <> show nodeId <> " to be " <> show st)
       , nodeId
       , capturedLogs
       }

hydra-node/test/Test/Util.hs

@@ -1,12 +1,22 @@
 module Test.Util where
 
-import Cardano.Prelude
+import Cardano.Prelude hiding (callStack, throwIO)
+import Control.Monad.Class.MonadThrow (MonadThrow (throwIO))
 import Control.Monad.Class.MonadTimer (DiffTime, MonadTimer, timeout)
-import Prelude (error)
+import Data.String (String)
+import GHC.Stack (callStack)
+import Test.HUnit.Lang (FailureReason (Reason), HUnitFailure (HUnitFailure))
 
-failAfter :: (HasCallStack, MonadTimer m) => DiffTime -> m () -> m ()
+failure :: (HasCallStack, MonadThrow m) => String -> m a
+failure msg =
+  throwIO (HUnitFailure location $ Reason msg)
+ where
+  location = case reverse $ getCallStack callStack of
+    (_, loc) : _ -> Just loc
+    _ -> Nothing
+
+failAfter :: (HasCallStack, MonadTimer m, MonadThrow m) => DiffTime -> m () -> m ()
 failAfter seconds action =
   timeout seconds action >>= \case
-    -- TODO(SN): use MonadThrow instead?
-    Nothing -> error $ "Test timed out after " <> show seconds <> " seconds"
+    Nothing -> failure $ "Test timed out after " <> show seconds <> " seconds"
     Just _ -> pure ()