module Control.Rematch(
Matcher(..)
, runMatch
, is
, equalTo
, isEmpty
, hasSize
, everyItem
, hasItem
, greaterThan
, greaterThanOrEqual
, lessThan
, lessThanOrEqual
, isJust
, hasJust
, isNothing
, isRight
, hasRight
, isLeft
, hasLeft
, isNot
, allOf
, anyOf
, on
, matcherOn
, matchList
, standardMismatch
) where
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
}
isNot :: Matcher a -> Matcher a
isNot (Matcher m desc mismatch) = Matcher (not . m) ("isNot " ++ desc) mismatch
runMatch :: Matcher a -> a -> Match
runMatch m a = if match m a
then MatchSuccess
else MatchFailure $ "\nExpected: " ++ 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)
}
on :: Matcher b -> ((a -> b), String) -> Matcher a
on m (f, name) = Matcher {
match = match m . f
, description = name ++ " " ++ (description m)
, describeMismatch = describeMismatch m . f
}
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
}
hasJust :: Matcher a -> Matcher (Maybe a)
hasJust matcher = Matcher {
match = (\a -> M.isJust a && (match matcher (M.fromJust a)))
, description = "hasJust(" ++ description matcher ++ ")"
, describeMismatch = mismatchDescription
}
where mismatchDescription (Just x) = matcher `describeMismatch` x
mismatchDescription Nothing = "but was Nothing"
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
hasRight :: (Show a, Show b) => Matcher b -> Matcher (Either a b)
hasRight matcher = Matcher {
match = (\e -> case e of
(Right a) -> match matcher a
(Left _) -> False)
, description = "hasRight(" ++ description matcher ++ ")"
, describeMismatch = standardMismatch
}
isLeft :: (Show a, Show b) => Matcher (Either a b)
isLeft = Matcher {
match = go
, description = "isLeft"
, describeMismatch = standardMismatch
}
where go (Left _) = True
go (Right _) = False
hasLeft :: (Show a, Show b) => Matcher a -> Matcher (Either a b)
hasLeft matcher = Matcher {
match = (\e -> case e of
(Left a) -> match matcher a
(Right _) -> False)
, description = "hasRight(" ++ description matcher ++ ")"
, describeMismatch = standardMismatch
}
matchList :: [Matcher a] -> a -> [Bool]
matchList matchers a = map (`match` a) matchers
standardMismatch :: (Show a) => a -> String
standardMismatch a = "was " ++ show a