Tests for RNA transcription exercise from exercism.io, added error cases

AssertException.hs

module AssertException (assertException, assertErrorCall) where

import Control.Exception (ErrorCall(..), Exception, handleJust, SomeException(..))
import Control.Monad (guard)
import Test.HUnit (assertFailure)
import System.IO (hPutStrLn, stderr)

assertException :: (Exception e, Eq e) => e -> IO a -> IO ()
assertException ex action =
  handleJust isWanted (const $ return ()) $ do
    action
    assertFailure $ "Expected exception: " ++ show ex
  where
    isWanted = guard . (== ex)

assertErrorCall :: String -> IO a -> IO ()
assertErrorCall msg action = assertException (ErrorCall msg) action

rna-transcription_test.hs

import Test.HUnit (Assertion, (@=?), runTestTT, Test(..), Counts(..))
import System.Exit (ExitCode(..), exitWith)
import DNA (toRNA)

import AssertException (assertErrorCall)
import Control.Exception (evaluate)

exitProperly :: IO Counts -> IO ()
exitProperly m = do
  counts <- m
  exitWith $ if failures counts /= 0 || errors counts /= 0 then ExitFailure 1 else ExitSuccess

testCase :: String -> Assertion -> Test
testCase label assertion = TestLabel label (TestCase assertion)

toRNATests :: [Test]
toRNATests =
  [ testCase "transcribes cytosine to guanine" $
    "G" @=? toRNA "C"
  , testCase "transcribes guanine to cytosine" $
    "C" @=? toRNA "G"
  , testCase "transcribes adenine to uracil" $
    "U" @=? toRNA "A"
  , testCase "transcribes thymine to adenine" $
    "A" @=? toRNA "T"
  , testCase "transcribes all ACGT to UGCA" $
    "UGCACCAGAAUU" @=? toRNA "ACGTGGTCTTAA"
  , testCase "raises error for invalid nucleotide" $
    assertErrorCall "Invalid DNA nucleotide: 'B'" (evaluate $ toRNA "B")
  , testCase "raises error for invalid string" $
    assertErrorCall "Invalid DNA nucleotide: 'g'" (evaluate $ toRNA "CAgTa")
  ]

main :: IO ()
main = exitProperly (runTestTT (TestList toRNATests))