aboutsummaryrefslogtreecommitdiff
path: root/haddock-test/src
diff options
context:
space:
mode:
authorŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-08-19 13:04:54 +0200
committerŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-08-22 23:40:28 +0200
commitcf22686d11bf9923926f3380793e64d2ff4141fc (patch)
tree689d9bf827cf26ba9e839e4498c6c5ae71c092c1 /haddock-test/src
parent863d33c4d125e13f87193802f6d4faed38da24db (diff)
Re-implement test acceptance functionality.
Diffstat (limited to 'haddock-test/src')
-rw-r--r--haddock-test/src/Test/Haddock.hs13
1 files changed, 12 insertions, 1 deletions
diff --git a/haddock-test/src/Test/Haddock.hs b/haddock-test/src/Test/Haddock.hs
index 18ae38ca..41e15978 100644
--- a/haddock-test/src/Test/Haddock.hs
+++ b/haddock-test/src/Test/Haddock.hs
@@ -27,6 +27,8 @@ data CheckResult
| Pass
| NoRef
| Error String
+ | Accepted
+ deriving Eq
runAndCheck :: Config c -> IO ()
@@ -43,12 +45,13 @@ checkFiles cfg@(Config { .. }) = do
failed <- liftM catMaybes . forM files $ \file -> do
putStr $ "Checking \"" ++ file ++ "\"... "
- status <- checkFile cfg file
+ status <- maybeAcceptFile cfg file =<< checkFile cfg file
case status of
Fail -> putStrLn "FAIL" >> (return $ Just file)
Pass -> putStrLn "PASS" >> (return Nothing)
NoRef -> putStrLn "PASS [no .ref]" >> (return Nothing)
Error msg -> putStrLn ("ERROR (" ++ msg ++ ")") >> return Nothing
+ Accepted -> putStrLn "ACCEPTED" >> return Nothing
if null failed
then do
@@ -127,6 +130,14 @@ diffFile cfg diff file = do
refFile' = outFile dcfg file <.> "ref" <.> "dump"
+maybeAcceptFile :: Config c -> FilePath -> CheckResult -> IO CheckResult
+maybeAcceptFile cfg@(Config { cfgDirConfig = dcfg }) file result
+ | cfgAccept cfg && result `elem` [NoRef, Fail] = do
+ copyFile (outFile dcfg file) (refFile dcfg file)
+ pure Accepted
+maybeAcceptFile _ _ result = pure result
+
+
outDir :: DirConfig -> TestPackage -> FilePath
outDir dcfg tpkg = dcfgOutDir dcfg </> tpkgName tpkg