module Test.Hspec.Expectations.Pretty where
import Data.Dynamic (Typeable)
import Test.Hspec.Expectations (Expectation)
import Text.PrettyPrint.Free (pretty, renderPretty, displayS)
import System.Console.Terminfo.PrettyPrint (PrettyTerm(..))
import Control.Exception as E
import Control.DeepSeq (deepseq)
import Control.Monad (unless)
infix 1 `shouldBe`, `shouldSatisfy`, `shouldReturn`
data HspecFailure = HspecFailure String deriving (Typeable)
instance Show HspecFailure where show (HspecFailure msg) = msg
instance Exception HspecFailure
assertFailure :: String
-> Expectation
assertFailure msg = msg `deepseq` E.throwIO (HspecFailure msg)
assertEqual :: (Eq a, PrettyTerm a) => String
-> a
-> a
-> Expectation
assertEqual preface expected actual =
unless (actual == expected) $ assertFailure msg
where
msg = (if null preface then "" else preface ++ "\n") ++
"expected: " ++ render (pretty expected) ++
"\n but got: " ++ render (pretty actual)
render x = displayS (renderPretty 0.4 80 x) ""
shouldBe :: (Show a, PrettyTerm a, Eq a) => a -> a -> Expectation
actual `shouldBe` expected = assertEqual "" expected actual
shouldSatisfy :: (Show a, PrettyTerm a) => a -> (a -> Bool) -> Expectation
v `shouldSatisfy` p = assertBool ("predicate failed on: " ++ show v) (p v)
where assertBool msg b = unless b (assertFailure msg)
shouldReturn :: (Show a, PrettyTerm a, Eq a) => IO a -> a -> Expectation
action `shouldReturn` expected = action >>= (`shouldBe` expected)