46 lines
1.3 KiB
Haskell
46 lines
1.3 KiB
Haskell
|
{-# 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")
|
||
|
|
|