module Control.Rematch(
Matcher(..)
, expect
, runMatch
, is
, equalTo
, isEmpty
, hasSize
, everyItem
, hasItem
, greaterThan
, greaterThanOrEqual
, lessThan
, lessThanOrEqual
, isJust
, isNothing
, isRight
, isLeft
, no
, allOf
, anyOf
, matcherOn
, matchList
, standardMismatch
) where
import Test.HUnit(Assertion, assertFailure)
import qualified Data.Maybe as M
import Control.Rematch.Run
import Control.Rematch.Formatting
data Matcher a = Matcher {
match :: a -> Bool
, description :: String
, describeMismatch :: a -> String
}
expect :: a -> Matcher a -> Assertion
expect a matcher = case res of
MatchSuccess -> return ()
(MatchFailure msg) -> assertFailure msg
where res = runMatch matcher a
no :: Matcher a -> Matcher a
no (Matcher m desc mismatch) = Matcher (not . m) ("not " ++ desc) mismatch
runMatch :: Matcher a -> a -> Match
runMatch m a = if match m a
then MatchSuccess
else MatchFailure $ "Expected:\n " ++ description m ++ "\n but: " ++ describeMismatch m a
is :: (Show a, Eq a) => a -> Matcher a
is a = Matcher (a == ) ("equalTo " ++ show a) standardMismatch
equalTo :: (Show a, Eq a) => a -> Matcher a
equalTo = is
allOf :: [Matcher a] -> Matcher a
allOf [] = Matcher (const False) "allOf" (const "was: no matchers supplied")
allOf matchers = Matcher {
match = and . matchList matchers
, description = describeList "all" $ map description matchers
, describeMismatch = \a -> describeList "" (map (`describeMismatch` a) (filter (\m -> not $ match m a) matchers))
}
anyOf :: [Matcher a] -> Matcher a
anyOf [] = Matcher (const False) "anyOf" (const "was: no matchers supplied")
anyOf matchers = Matcher {
match = or . matchList matchers
, description = describeList "or" $ map description matchers
, describeMismatch = \a -> describeList "" (map (`describeMismatch` a) matchers)
}
everyItem :: Matcher a -> Matcher [a]
everyItem m = Matcher {
match = all (match m)
, description = "everyItem(" ++ description m ++ ")"
, describeMismatch = describeList "" . map (describeMismatch m) . filter (not . match m)
}
hasItem :: Matcher a -> Matcher [a]
hasItem m = Matcher {
match = any (match m)
, description = "hasItem(" ++ description m ++ ")"
, describeMismatch = go
}
where go [] = "got an empty list: []"
go as = describeList "" (map (describeMismatch m) as)
isEmpty :: (Show a) => Matcher [a]
isEmpty = Matcher {
match = null
, description = "isEmpty"
, describeMismatch = standardMismatch
}
hasSize :: (Show a) => Int -> Matcher [a]
hasSize n = Matcher {
match = ((== n) . length)
, description = "hasSize(" ++ show n ++ ")"
, describeMismatch = standardMismatch
}
matcherOn :: (Show a) => String -> (a -> a -> Bool) -> a -> Matcher a
matcherOn name comp a = Matcher {
match = comp a
, description = name ++ "(" ++ show a ++ ")"
, describeMismatch = standardMismatch
}
greaterThan :: (Ord a, Show a) => a -> Matcher a
greaterThan = matcherOn "greaterThan" (<)
greaterThanOrEqual :: (Ord a, Show a) => a -> Matcher a
greaterThanOrEqual = matcherOn "greaterThanOrEqual" (<=)
lessThan :: (Ord a, Show a) => a -> Matcher a
lessThan = matcherOn "lessThan" (>)
lessThanOrEqual :: (Ord a, Show a) => a -> Matcher a
lessThanOrEqual = matcherOn "lessThanOrEqual" (>=)
isJust :: (Show a) => Matcher (Maybe a)
isJust = Matcher {
match = M.isJust
, description = "isJust"
, describeMismatch = standardMismatch
}
isNothing :: (Show a) => Matcher (Maybe a)
isNothing = Matcher {
match = M.isNothing
, description = "isNothing"
, describeMismatch = standardMismatch
}
isRight :: (Show a, Show b) => Matcher (Either a b)
isRight = Matcher {
match = go
, description = "isRight"
, describeMismatch = standardMismatch
}
where go (Right _) = True
go (Left _) = False
isLeft :: (Show a, Show b) => Matcher (Either a b)
isLeft = Matcher {
match = go
, description = "isLeft"
, describeMismatch = standardMismatch
}
where go (Left _) = True
go (Right _) = False
matchList :: [Matcher a] -> a -> [Bool]
matchList matchers a = map (`match` a) matchers
standardMismatch :: (Show a) => a -> String
standardMismatch a = "was " ++ show a