diff options
Diffstat (limited to 'haddock-test/src/Test/Haddock.hs')
| -rw-r--r-- | haddock-test/src/Test/Haddock.hs | 90 | 
1 files changed, 44 insertions, 46 deletions
| diff --git a/haddock-test/src/Test/Haddock.hs b/haddock-test/src/Test/Haddock.hs index a2c6609a..f31ec53f 100644 --- a/haddock-test/src/Test/Haddock.hs +++ b/haddock-test/src/Test/Haddock.hs @@ -31,21 +31,20 @@ data CheckResult  runAndCheck :: Config c -> IO ()  runAndCheck cfg = do      runHaddock cfg -    if cfgAccept cfg -        then acceptFiles cfg -        else checkFiles cfg +    checkFiles cfg  checkFiles :: Config c -> IO ()  checkFiles cfg@(Config { .. }) = do      putStrLn "Testing output files..." -    failed <- liftM catMaybes . forM cfgFiles $ \file -> do -        let mdl = takeBaseName file -        putStr $ "Checking " ++ mdl ++ "... " -        status <- checkModule cfg mdl +    files <- getDirectoryContents (cfgOutDir cfg) +    failed <- liftM catMaybes . forM files $ \file -> do +        putStr $ "Checking \"" ++ file ++ "\"... " + +        status <- checkFile cfg file          case status of -            Fail -> putStrLn "FAIL" >> (return $ Just mdl) +            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 @@ -59,43 +58,38 @@ checkFiles cfg@(Config { .. }) = do              exitFailure -acceptFiles :: Config c -> IO () -acceptFiles (Config { cfgFiles = files, cfgDirConfig = dcfg }) = do - -    forM_ files $ \file -> do -        let mdl = takeBaseName file -        putStr $ "Accepting " ++ mdl ++ "... " -        copyFile (outFile dcfg mdl) (refFile dcfg mdl) -        putStrLn "DONE" - - -maybeDiff :: Config c -> [String] -> IO () +maybeDiff :: Config c -> [FilePath] -> IO ()  maybeDiff (Config { cfgDiffTool = Nothing }) _ = pure () -maybeDiff cfg@(Config { cfgDiffTool = (Just diff) }) mdls = do +maybeDiff cfg@(Config { cfgDiffTool = (Just diff) }) files = do      putStrLn "Diffing failed cases..." -    forM_ mdls $ diffModule cfg diff +    forM_ files $ diffFile cfg diff  runHaddock :: Config c -> IO ()  runHaddock (Config { .. }) = do -    putStrLn "Running Haddock process..." -      haddockStdOut <- openFile cfgHaddockStdOut WriteMode -    handle <- runProcess' cfgHaddockPath $ processConfig -        { pcArgs = cfgHaddockArgs ++ cfgFiles -        , pcEnv = Just $ cfgEnv -        , pcStdOut = Just $ haddockStdOut -        } -    waitForSuccess "Failed to run Haddock on specified test files" handle - -checkModule :: Config c -> String -> IO CheckResult -checkModule cfg mdl = do -    hasRef <- doesFileExist $ refFile dcfg mdl +    putStrLn "Generating documentation..." +    forM_ cfgPackages $ \tpkg -> do +        handle <- runProcess' cfgHaddockPath $ processConfig +            { pcArgs = concat +                [ cfgHaddockArgs +                , pure $ "--odir=" ++ outDir cfgDirConfig tpkg +                , tpkgFiles tpkg +                ] +            , pcEnv = Just $ cfgEnv +            , pcStdOut = Just $ haddockStdOut +            } +        waitForSuccess "Failed to run Haddock on specified test files" handle + + +checkFile :: Config c -> FilePath -> IO CheckResult +checkFile cfg file = do +    hasRef <- doesFileExist $ refFile dcfg file      if hasRef          then do -            mout <- ccfgRead ccfg mdl <$> readFile (outFile dcfg mdl) -            mref <- ccfgRead ccfg mdl <$> readFile (refFile dcfg mdl) +            mout <- ccfgRead ccfg file <$> readFile (outFile dcfg file) +            mref <- ccfgRead ccfg file <$> readFile (refFile dcfg file)              return $ case (mout, mref) of                  (Just out, Just ref)                      | ccfgEqual ccfg out ref -> Pass @@ -107,14 +101,14 @@ checkModule cfg mdl = do      dcfg = cfgDirConfig cfg -diffModule :: Config c -> FilePath -> String -> IO () -diffModule cfg diff mdl = do -    Just out <- ccfgRead ccfg mdl <$> readFile (outFile dcfg mdl) -    Just ref <- ccfgRead ccfg mdl <$> readFile (refFile dcfg mdl) +diffFile :: Config c -> FilePath -> FilePath -> IO () +diffFile cfg diff file = do +    Just out <- ccfgRead ccfg file <$> readFile (outFile dcfg file) +    Just ref <- ccfgRead ccfg file <$> readFile (refFile dcfg file)      writeFile outFile' $ ccfgDump ccfg out      writeFile refFile' $ ccfgDump ccfg ref -    putStrLn $ "Diff for module " ++ show mdl ++ ":" +    putStrLn $ "Diff for file \"" ++ file ++ "\":"      hFlush stdout      handle <- runProcess' diff $ processConfig          { pcArgs = [outFile', refFile'] @@ -124,13 +118,17 @@ diffModule cfg diff mdl = do    where      dcfg = cfgDirConfig cfg      ccfg = cfgCheckConfig cfg -    outFile' = outFile dcfg mdl <.> "dump" -    refFile' = outFile dcfg mdl <.> "ref" <.> "dump" +    outFile' = outFile dcfg file <.> "dump" +    refFile' = outFile dcfg file <.> "ref" <.> "dump" + + +outDir :: DirConfig -> TestPackage -> FilePath +outDir dcfg tpkg = dcfgOutDir dcfg </> tpkgName tpkg -outFile :: DirConfig -> String -> FilePath -outFile dcfg mdl = dcfgOutDir dcfg </> mdl <.> "html" +outFile :: DirConfig -> FilePath -> FilePath +outFile dcfg file = dcfgOutDir dcfg </> file -refFile :: DirConfig -> String -> FilePath -refFile dcfg mdl = dcfgRefDir dcfg </> mdl <.> "html" +refFile :: DirConfig -> FilePath -> FilePath +refFile dcfg file = dcfgRefDir dcfg </> file | 
