Hunit测试例外

Question

I am writing a program to parse some xml.

I took the approach of using MonadThrow to take care of errors in parsing, but now when testing the fails - can't figure out how to test them. Which makes me unsure if this approach is the right one.

First of all here is a complete (non-working) example

exception.hs

{-# LANGUAGE OverloadedStrings #-}

import Test.Tasty
import Test.Tasty.HUnit

import Control.Exception (SomeException, displayException)
import Control.Monad (unless)
import Control.Monad.Trans.Resource (MonadThrow)
import Data.Function (on)
import Text.XML (Element, parseText, def, documentRoot, elementName)
import Data.Text (Text)
import Data.Text.Lazy (fromStrict)

data TestElement = TestElement deriving (Show, Eq)

main :: IO ()
main = defaultMain unitTests

unitTests :: TestTree
unitTests = testGroup "Unit tests"
    [ testCase "parseTxt parser goodTxt1 == Right TestElement " $
        parseTxt parser goodTxt1 @?= Right TestElement
    , testCase "parseTxt parser goodTxt2 == Right TestElement " $
        parseTxt parser goodTxt2 @?= Right TestElement
    , testCase "parseTxt parser failTxt == Left \"ElementName does not match TestElement\"" $
        parseTxt parser failTxt @?= undefined
    --hunit
    ]


parseTxt :: (Element -> Either SomeException a) -> Text -> Either SomeException a
parseTxt parser inText = documentRoot <$> (parseText def $ fromStrict inText) >>=
                         parser

parser :: MonadThrow m => Element -> m TestElement
parser elmt =
    do unless (elementName elmt == "TestElement")
         $ fail "ElementName does not match TestElement"
       {-here usually some more complicated attribute/subnode parsing happens-}
       return TestElement

failTxt :: Text
failTxt = "<ToastElement></ToastElement>"

goodTxt1 :: Text
goodTxt1 = "<TestElement />"

goodTxt2 :: Text
goodTxt2 = "<TestElement></TestElement>"

instance Eq SomeException where
    (==) = (==) `on` displayException

which needs exception.cabal

[...]
executable exception
  hs-source-dirs:      src
  main-is:             Main.hs
  default-language:    Haskell2010
  build-depends:       base >= 4.7 && < 5
               ,       xml-conduit
               ,       exceptions
               ,       resourcet
               ,       tasty
               ,       tasty-hunit
               ,       text

TL;DR

I am not sure what to put instead of the undefined in the last unit test and if the approach of using exceptions is right in this case.

---

There are several options I thought of:

• using (either displayException show $ parseTxt parser failTxt) @?= undefined still fails and does not yield a Left value
• using assertFail defies the purpose of having a Either SomeException TestElement in my opinion
• I could use a self-defined exception-type in order to match against it, but can I use fail to throw an error of my own type

I think one of the sources of my confusion is that I don't know when the error is thrown (I thought lazy evaluation would throw the error when I matched against it - which is apparently wrong).

Answer 1

Thanks to @user2407038 I've been able to solve this:

defining a new datatype for the exception

data ParseException = TagMismatch String deriving (Typeable, Eq, Show)

then adjusting the imports and the following functions

parseTxt :: Exception e => (Element -> Either e a) -> Text -> Either SomeException a
parseTxt parser inText = documentRoot <$> (parseText def $ fromStrict inText) >>=
                         (first toException . parser)

first :: (a -> c) -> Either a b -> Either c b
first f (Left l) = Left (f l)
first _ (Right r) = Right r

parser :: MonadThrow m => Element -> m TestElement
parser elmt =
    do unless (elementName elmt == "TestElement")
         $ throwM $ TagMismatch "TestElement"
       return TestElement

unitTests :: TestTree
unitTests = testGroup "Unit tests"
    [ {-...-}
      testCase "parseTxt parser failTxt == fail" $
        (first aux $ parseTxt parser failTxt) @?= Left $ TagMismatch "TestElement"
    ]
    where aux = fromMaybe (error "converting from SomeException failed")
              . fromException

Note1: the deriving Eq is only necessary for the @?= operation in the unit tests and could be omitted for the productive version of the code.

Note2: Also the direct dependency on resourcet can be replaced by exceptions , which the former just reexports.