TestCommon.hs

{-# LANGUAGE ScopedTypeVariables       #-}

module Text.XmlHtml.TestCommon where

import           Control.Exception as E
import           System.IO.Unsafe
import           Test.Hspec
import           Test.HUnit hiding (Test, Node)

------------------------------------------------------------------------------
-- | Tests a simple Bool property.
testIt :: String -> Bool -> Spec
testIt name b = it name $ assertBool name b

------------------------------------------------------------------------------
-- | Tests with assertEqual which gives more useful information to the user on
-- failure.  We should probably stop using testIt.  :/
testEqual :: (Eq a, Show a) => String -> a -> a -> Spec
testEqual name expected actual = it name $ assertEqual name expected actual

------------------------------------------------------------------------------
-- Code adapted from ChasingBottoms.
--
-- Adding an actual dependency isn't possible because Cabal refuses to build
-- the package due to version conflicts.
--
-- isBottom is impossible to write, but very useful!  So we defy the
-- impossible, and write it anyway.
isBottom :: a -> Bool
isBottom a = unsafePerformIO $
    (E.evaluate a >> return False) `E.catches` [
        E.Handler $ \ (_ :: PatternMatchFail) -> return True,
        E.Handler $ \ (_ :: ErrorCall)        -> return True,
        E.Handler $ \ (_ :: NoMethodError)    -> return True,
        E.Handler $ \ (_ :: RecConError)      -> return True,
        E.Handler $ \ (_ :: RecUpdError)      -> return True,
        E.Handler $ \ (_ :: RecSelError)      -> return True
        ]

------------------------------------------------------------------------------
isLeft :: Either a b -> Bool
isLeft = either (const True) (const False)

------------------------------------------------------------------------------
isRight :: Either a b -> Bool
isRight = not . isLeft