New version of the tests for exercism.io's Haskell exercise nucleotide-count_test.hs

gistfile1.hs

import Test.HUnit (Assertion, (@=?), runTestTT, assertFailure, Test(..), Counts(..))
import System.Exit (ExitCode(..), exitWith)
import DNA (count, nucleotideCounts, Base(..), DNA(..))
import Data.Map (fromList)
import Data.Monoid ( (<>) )
import qualified Control.Exception as E

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

assertError :: String -> a -> IO ()
assertError err f =
  do r <- E.try (E.evaluate f)
     case r of
       Left (E.ErrorCall s) | err == s -> return ()
       _ -> assertFailure ("expecting error " ++ show err)

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

main :: IO ()
main = exitProperly $ runTestTT $ TestList
       [ TestList countTests
       , TestList nucleotideCountTests]

countTests :: [Test]
countTests =
  [ testCase "empty dna strand has no adenosine" $
    0 @=? count A (DNA [])
  , testCase "repetitive cytidine gets counted" $
    5 @=? count C (DNA [C,C,C,C,C])
  , testCase "counts only thymidine" $
    1 @=? count T (DNA [G,G,G,G,G,T,A,A,C,C,C,G,G])
  -- Next two test cases are now redundant as they don't even type check
  --, testCase "dna has no uracil" $
  --  0 @=? count U (DNA [G,A,T,T,A,C,A])
  --, testCase "validates nucleotides" $
  --  assertError "invalid nucleotide 'X'" $ count X (DNA [G,A,C,T])
  ]

nucleotideCountTests :: [Test]
nucleotideCountTests =
  [ testCase "empty dna strand has no nucleotides" $
    fromList [(A, 0), (T, 0), (C, 0), (G, 0)] @=?
    nucleotideCounts (DNA [])
  , testCase "repetitive-sequence-has-only-guanosine" $
    fromList [(A, 0), (T, 0), (C, 0), (G, 8)] @=?
    nucleotideCounts (DNA [G,G,G,G,G,G,G,G])
  , testCase "counts all nucleotides" $
    fromList [(A, 20), (T, 21), (C, 12), (G, 17)] @=?
    nucleotideCounts (DNA [A,G,C,T,T,T,T,C,A,T,T,C,T,G,A,C,T,G,C,A,A,C,G,G,G,C,A,A,T,A] <>
                      DNA [T,G,T,C,T,C,T,G,T,G,T,G,G,A,T,T,A,A,A,A,A,A,A] <>
                      DNA [G,A,G,T,G,T,C,T,G,A,T,A,G,C,A,G,C])
  ]