hablo/test/Utils.hs

46 lines
1.3 KiB
Haskell
Raw Normal View History

{-# LANGUAGE NamedFieldPuns #-}
module Utils (
assertAll
, assertEqual
, simpleTest
, tag
) where
import Distribution.TestSuite
import Text.Printf (printf)
tagInstance :: String -> TestInstance -> TestInstance
tagInstance tagName testInstance = testInstance {
tags = tagName : (tags testInstance)
}
tag :: String -> Test -> Test
tag tagName (Test testInstance) = Test (tagInstance tagName testInstance)
tag tagName group = group {groupTests = tag tagName <$> groupTests group}
simpleTest :: (String, IO Progress) -> Test
simpleTest (name, run) = Test testInstance
where
testInstance = TestInstance {
run
, name
, tags = []
, options = []
, setOption = \_ _ -> Right testInstance
}
wrong :: Show a => String -> a -> a -> IO Progress
wrong message expected actual = return . Finished . Fail $
printf "%s: %s vs. %s" message (show expected) (show actual)
assertAll :: [(Bool, IO Progress, String)] -> IO Progress
assertAll = foldr assert (return $ Finished Pass)
where
assert (bool, badIssue, checkMessage) next =
if bool then return $ Progress checkMessage next else badIssue
assertEqual :: (Show a, Eq a) => String -> a -> a -> (Bool, IO Progress, String)
assertEqual what a b =
(a == b, wrong (what ++ " do not match !") a b, what ++ " ok")