Make Haddock test package more generic.

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"]