Some hspec helpers

hspec-helpers.hs

{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}

import Control.Exception (PatternMatchFail(..), evaluate) -- @base@
import Control.Exception.Safe (catch) -- @safe-exceptions@
import Test.HUnit (assertFailure) -- @HUnit@
import Test.Hspec (HasCallStack) -- @hspec@
import qualified Test.Hspec as Hspec -- @hspec@

shouldReturn :: (HasCallStack, MonadIO m, Show a, Eq a) => m a -> a -> m ()
shouldReturn action expected = action >>= \x -> x `shouldBe` expected

shouldBe :: (HasCallStack, MonadIO m, Show a, Eq a) => a -> a -> m ()
shouldBe x expected = liftIO $ x `Hspec.shouldBe` expected

shouldMatchJustM
  :: forall m a
   . (HasCallStack, MonadIO m)
  => m (Maybe a)
  -> m a
shouldMatchJustM mx = shouldMatchPatternM mx \case Just y -> y

shouldMatchNothingM
  :: forall m a
   . (HasCallStack, MonadIO m)
  => m (Maybe a)
  -> m ()
shouldMatchNothingM mx = shouldMatchPatternM mx \case Nothing -> ()

shouldMatchPatternM
  :: forall m a b
   . (HasCallStack, MonadIO m)
  => m a
  -> (a -> b)
  -> m b
shouldMatchPatternM mx matcher = do
  x <- mx
  liftIO do
    evaluate (matcher x) `catch` \case
      PatternMatchFail err -> do
        assertFailure $ "Pattern did not match: " <> err