aboutsummaryrefslogtreecommitdiff
path: root/haddock-test/src/Test
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-test/src/Test')
-rw-r--r--haddock-test/src/Test/Haddock.hs90
-rw-r--r--haddock-test/src/Test/Haddock/Config.hs50
2 files changed, 78 insertions, 62 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
diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs
index 451cd809..15a53829 100644
--- a/haddock-test/src/Test/Haddock/Config.hs
+++ b/haddock-test/src/Test/Haddock/Config.hs
@@ -2,7 +2,7 @@
module Test.Haddock.Config
- ( CheckConfig(..), DirConfig(..), Config(..)
+ ( TestPackage(..), CheckConfig(..), DirConfig(..), Config(..)
, defaultDirConfig
, cfgSrcDir, cfgRefDir, cfgOutDir, cfgResDir
, parseArgs, checkOpt, loadConfig
@@ -35,6 +35,12 @@ import Test.Haddock.Process
import Test.Haddock.Utils
+data TestPackage = TestPackage
+ { tpkgName :: String
+ , tpkgFiles :: [FilePath]
+ }
+
+
data CheckConfig c = CheckConfig
{ ccfgRead :: String -> String -> Maybe c
, ccfgDump :: c -> String
@@ -63,7 +69,7 @@ defaultDirConfig baseDir = DirConfig
data Config c = Config
{ cfgHaddockPath :: FilePath
- , cfgFiles :: [FilePath]
+ , cfgPackages :: [TestPackage]
, cfgHaddockArgs :: [String]
, cfgHaddockStdOut :: FilePath
, cfgDiffTool :: Maybe FilePath
@@ -164,7 +170,7 @@ loadConfig ccfg dcfg flags files = do
printVersions cfgEnv cfgHaddockPath
- cfgFiles <- processFileArgs dcfg files
+ cfgPackages <- processFileArgs dcfg files
cfgHaddockArgs <- liftM concat . sequence $
[ pure ["--no-warnings"]
@@ -230,24 +236,36 @@ defaultDiffTool =
isAvailable = liftM isJust . findProgramLocation silent
-processFileArgs :: DirConfig -> [String] -> IO [FilePath]
+processFileArgs :: DirConfig -> [String] -> IO [TestPackage]
processFileArgs dcfg [] =
- map toModulePath . filter isSourceFile <$> getDirectoryContents srcDir
+ processFileArgs dcfg . filter isValidEntry =<< getDirectoryContents srcDir
where
+ isValidEntry entry = entry /= "." && entry /= ".."
srcDir = dcfgSrcDir dcfg
- toModulePath = modulePath dcfg . takeBaseName
-processFileArgs dcfg args = pure $ map (processFileArg dcfg) args
+processFileArgs dcfg args = processFileArgs' dcfg args
+
+
+processFileArgs' :: DirConfig -> [String] -> IO [TestPackage]
+processFileArgs' dcfg args = do
+ (mdls, dirs) <- partitionM doesDirectoryExist' args
+ rootPkg <- pure $ TestPackage
+ { tpkgName = ""
+ , tpkgFiles = map (processFileArg dcfg) mdls
+ }
+ otherPkgs <- forM dirs $ \dir -> do
+ files <- getDirectoryContents dir
+ pure $ TestPackage
+ { tpkgName = dir
+ , tpkgFiles = map ((dcfgSrcDir dcfg </> dir) </>) files
+ }
+ pure $ rootPkg:otherPkgs
+ where
+ doesDirectoryExist' path = doesDirectoryExist (dcfgSrcDir dcfg </> path)
processFileArg :: DirConfig -> String -> FilePath
processFileArg dcfg arg
| isSourceFile arg = arg
- | otherwise = modulePath dcfg arg
-
-
-isSourceFile :: FilePath -> Bool
-isSourceFile path = takeExtension path `elem` [".hs", ".lhs"]
-
-
-modulePath :: DirConfig -> String -> FilePath
-modulePath dcfg mdl = dcfgSrcDir dcfg </> mdl <.> "hs"
+ | otherwise = dcfgSrcDir dcfg </> arg </> ".hs"
+ where
+ isSourceFile path = takeExtension path `elem` [".hs", ".lhs"]
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-26 07:08:58 +0000