Hunit测试有例外

时间:2015-12-09 13:14:13

标签: haskell exception

我正在编写一个程序来解析一些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,如果在这种情况下使用异常的方法是正确的。

我想到了几个选项:

  • 使用(either displayException show $ parseTxt parser failTxt) @?= undefined 仍然失败,并且不会产生Left
  • 使用assertFail违反了我认为Either SomeException TestElement
  • 的目的
  • 我可以使用自定义的异常类型来匹配它,但是我可以使用fail来抛出我自己类型的错误

我认为我困惑的一个原因是我不知道错误何时被抛出(我认为懒惰的评估会在我与之匹配时抛出错误 - 这显然是错误的。)

1 个答案:

答案 0 :(得分:0)

感谢@ 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取代,前者只是重新导出。