Hunit测试例外

Question

我正在编写一个程序来解析一些xml。

我采取了使用MonadThrow来处理解析错误的方法，但是现在测试失败时-无法弄清楚如何测试它们。 这使我不确定这种方法是否正确。

首先，这里是一个完整的（无效）示例

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

这需要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

我undefined在上一个单元测试中要放置什么而不是undefined ，以及在这种情况下使用异常的方法是否正确。

---

我想到了几种选择：

• 使用(either displayException show $ parseTxt parser failTxt) @?= undefined仍然会失败，并且不会产生Left值
• 使用assertFail违抗有目的Either SomeException TestElement在我看来，
• 我可以使用自定义的异常类型来与之匹配，但是我可以使用失败引发自己类型的错误

我认为我感到困惑的原因之一是我不知道何时引发错误（我认为当我将其与之匹配时，惰性评估会引发错误-显然是错误的）。

Answer 1

感谢@ user2407038，我得以解决此问题：

为异常定义新的数据类型

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

然后调整导入和以下功能

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

注意1：仅当单元测试中的@?=运算时才需要deriving Eq ，对于有效版本的代码，则可以省略。

注意2：同样，对resourcet的直接依赖性也可以由exceptions代替， exceptions只是重新导出。