diff options
author | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-08-04 18:52:46 +0200 |
---|---|---|
committer | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-08-22 23:40:26 +0200 |
commit | 18333ed77a6134c01c000d82efd5e05a8d502428 (patch) | |
tree | aabf5663c564bbdef01c32e81540121fa34e673c | |
parent | a2d23f2b34f9341c7c812cb7ce59c41fbd9de130 (diff) |
Implement actual diffing mechanism.
-rwxr-xr-x | html-test/run.hs | 31 |
1 files changed, 24 insertions, 7 deletions
diff --git a/html-test/run.hs b/html-test/run.hs index 52fae690..039ff676 100755 --- a/html-test/run.hs +++ b/html-test/run.hs @@ -75,12 +75,14 @@ checkFiles (Config { .. }) = do Pass -> putStrLn "PASS" >> (return Nothing) NoRef -> putStrLn "PASS [no .ref]" >> (return Nothing) - when (null failed) $ do - putStrLn "All tests passed!" - exitSuccess - - putStrLn "Diffing failed cases..." - forM_ failed checkModule + if null failed + then do + putStrLn "All tests passed!" + exitSuccess + else do + putStrLn "Diffing failed cases..." + forM_ failed diffModule + exitFailure runHaddock :: Config -> IO () @@ -154,7 +156,22 @@ checkModule mdl = do diffModule :: String -> IO () -diffModule mdl = return () +diffModule mdl = do + out <- readFile $ outFile mdl + ref <- readFile $ refFile mdl + let out' = stripLinks . dropVersion $ out + let ref' = stripLinks . dropVersion $ ref + writeFile outFile' out' + writeFile refFile' ref' + + putStrLn $ "Diff for module " ++ show mdl ++ ":" + handle <- runProcess' "diff" $ processConfig + { pcArgs = [outFile', refFile'] + } + waitForProcess handle >> return () + where + outFile' = outFile mdl <.> "nolinks" + refFile' = outFile mdl <.> "ref" <.> "nolinks" outFile :: String -> FilePath |