module Control.Exception.Assert
( module Control.Exception.Assert
, assert
) where
import Prelude
import Control.Applicative
import Control.Exception
import Data.Data
newtype Arse = Arse String deriving (Typeable)
instance Show Arse where show (Arse s) = s
instance Exception Arse where
fromException se = do
AssertionFailed failure <- fromException se
return (Arse failure)
assertMessage :: String -> String -> (a -> a) -> a -> a
assertMessage name msg arse = mapException describe . arse where
describe (AssertionFailed failure) = Arse $
oneline failure ++ " \"" ++ name ++ "\", " ++ msg
oneline = filter ((&&) <$> (/=) '\n' <*> (/=) '\r')
byEq :: (Eq x, Show x) => (Bool -> a -> a) -> String ->
x -> x -> a -> a
byEq arse name x y = assertMessage name
(show x ++ " ≠ " ++ show y) (arse $ x == y)
byOrd :: (Ord x, Show x) => (Bool -> a -> a) -> String ->
Ordering -> x -> x -> a -> a
byOrd arse name o x y = assertMessage name
(show x ++ no ++ show y) (arse $ o == compare x y)
where
no = case o of
LT -> " ≮ "
EQ -> " ≠ "
GT -> " ≯ "
byPred :: (Show x) => (Bool -> a -> a) -> String ->
(x -> Bool) -> x -> a -> a
byPred arse name p x = assertMessage name (show x) (arse $ p x)