import System.Cmd
import System.Environment
import System.FilePath
import System.Exit
import System.Directory
import Data.List
import Control.Monad
import Text.Printf
import Text.Regex
main = do
args <- getArgs
when (null args) $ error "You must give the path to the GHC lib dir as an argument"
putStrLn "Running tests..."
let libdir = head args
walkDirs libdir "."
putStrLn "All tests passed!"
haddockEq file1 file2 = (stripLinks file1) == (stripLinks file2)
where
stripLinks f = subRegex (mkRegexWithOpts "]*>" False False) f ""
allModules dir = do
contents <- getDirectoryContents dir
return $ filter ((==) ".hs" . takeExtension) contents
check modules = do
forM_ modules $ \mod -> do
let outfile = "output" > (dropExtension mod ++ ".html")
let reffile = dropExtension mod ++ ".html.ref"
b <- doesFileExist reffile
if b
then do
copyFile reffile ("output" > reffile)
out <- readFile outfile
ref <- readFile reffile
if not $ haddockEq out ref
then do
putStrLn $ "Output for " ++ mod ++ " has changed! Exiting with diff:"
system $ "diff " ++ reffile ++ " " ++ outfile
exitFailure
else do
putStrLn $ "Pass: " ++ mod
else do
putStrLn $ "Pass: " ++ mod ++ " (no .ref file)"
walkDirs libdir basedir = do
contents <- getDirectoryContents basedir
dirs <- filterM doesDirectoryExist .
map (basedir >) .
filter (`notElem` [".", "..", "output"]) $ contents
mapM_ (testDir libdir) dirs
testDir libdir dir = do
mods <- allModules dir
let mods' = map (dir >) mods
let outdir = "output" > dir
createDirectoryIfMissing True outdir
code <- system $ printf "../dist/build/haddock/haddock -B %s -o %s -h --optghc=-fglasgow-exts %s" libdir outdir (unwords mods')
unless (code == ExitSuccess) $ error "Haddock run failed! Exiting."
check mods'
walkDirs libdir dir