{-# LANGUAGE CPP #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.IO where import qualified Control.Exception as E import Test.HUnit.Lang import Test.QuickCheck.Property instance Testable Assertion where property :: Assertion -> Property property = Assertion -> Property propertyIO #if !MIN_VERSION_QuickCheck(2,9,0) exhaustive _ = True #endif propertyIO :: Assertion -> Property propertyIO :: Assertion -> Property propertyIO Assertion action = IO Result -> Property forall prop. Testable prop => IO prop -> Property ioProperty (IO Result -> Property) -> IO Result -> Property forall a b. (a -> b) -> a -> b $ do (Assertion action Assertion -> IO Result -> IO Result forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Result -> IO Result forall (m :: * -> *) a. Monad m => a -> m a return Result succeeded) IO Result -> (HUnitFailure -> IO Result) -> IO Result forall e a. Exception e => IO a -> (e -> IO a) -> IO a `E.catch` \ HUnitFailure e -> Result -> IO Result forall (m :: * -> *) a. Monad m => a -> m a return Result failed {theException :: Maybe AnException theException = AnException -> Maybe AnException forall a. a -> Maybe a Just (HUnitFailure -> AnException forall e. Exception e => e -> AnException E.toException HUnitFailure e), reason :: String reason = HUnitFailure -> String formatAssertion HUnitFailure e} where formatAssertion :: HUnitFailure -> String formatAssertion HUnitFailure e = case HUnitFailure e of #if MIN_VERSION_HUnit(1,3,0) HUnitFailure Maybe SrcLoc _ FailureReason err -> #else HUnitFailure err -> #endif #if MIN_VERSION_HUnit(1,5,0) FailureReason -> String formatFailureReason FailureReason err #else err #endif