@@ -6,7 +6,7 @@ module Stackage.Test
66 ) where
77
88import qualified Control.Concurrent as C
9−import Control.Exception (Exception, SomeException, handle, throwIO, IOException)
9+import Control.Exception (Exception, SomeException, handle, throwIO, IOException, try)
1010import Control.Monad (replicateM, unless, when, forM_)
1111import qualified Data.Map as Map
1212import qualified Data.Set as Set
@@ -17,13 +17,14 @@ import Stackage.Util
1717import System.Directory (copyFile, createDirectory,
1818 createDirectoryIfMissing, doesFileExist, findExecutable,
1919 getDirectoryContents, removeFile,
20− renameDirectory)
20+ renameDirectory, canonicalizePath)
2121import System.Exit (ExitCode (ExitSuccess))
2222import System.FilePath ((<.>), (</>), takeDirectory)
2323import System.IO (IOMode (WriteMode, AppendMode),
2424 withBinaryFile)
2525import System.Process (readProcess, runProcess, waitForProcess)
2626import Text.ParserCombinators.ReadP (readP_to_S)
27+import Data.IORef (IORef, readIORef, atomicModifyIORef, newIORef)
2728
2829runTestSuites :: BuildSettings -> BuildPlan -> IO ()
2930runTestSuites settings' bp = do
@@ -40,7 +41,8 @@ runTestSuites settings' bp = do
4041 copyBuiltInHaddocks docdir
4142
4243 cabalVersion <- getCabalVersion
43− allPass <- parFoldM (testWorkerThreads settings) (runTestSuite cabalVersion settings testdir docdir bp) (&&) True $ Map.toList selected
44+ haddockFilesRef <- newIORef []
45+ allPass <- parFoldM (testWorkerThreads settings) (runTestSuite cabalVersion settings testdir docdir bp haddockFilesRef) (&&) True $ Map.toList selected
4446 unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
4547 where
4648 notSkipped p _ = p `Set.notMember` bpSkippedTests bp
@@ -108,9 +110,11 @@ runTestSuite :: CabalVersion
108110 -> FilePath -- ^ testdir
109111 -> FilePath -- ^ docdir
110112 -> BuildPlan
113+ -> IORef [FilePath] -- ^ .haddock files
111114 -> (PackageName, SelectedPackageInfo)
112115 -> IO Bool
113−runTestSuite cabalVersion settings testdir docdir bp (packageName, SelectedPackageInfo {..}) = do
116+runTestSuite cabalVersion settings testdir docdir
117+ bp haddockFilesRef (packageName, SelectedPackageInfo {..}) = do
114118 -- Set up a new environment that includes the sandboxed bin folder in PATH.
115119 env' <- getModifiedEnv settings
116120 let menv = Just $ addSandbox env'
@@ -137,18 +141,26 @@ runTestSuite cabalVersion settings testdir docdir bp (packageName, SelectedPacka
137141
138142 -- Try building docs first in case tests have an expected failure.
139143 when (buildDocs settings) $ do
144+ hfs <- readIORef haddockFilesRef
145+ let hfsOpts = map ("--haddock-options=-o " ++) hfs
140146 getHandle AppendMode $ run "cabal"
141− [ "haddock"
142− , "--hyperlink-source"
143− , "--html"
144− , "--hoogle"
145− , "--html-location=../$pkg-$version/"
146− ] dir
147+ ( "haddock"
148+ : "--hyperlink-source"
149+ : "--html"
150+ : "--hoogle"
151+ : "--html-location=../$pkg-$version/"
152+ : hfsOpts) dir
147153 let PackageName packageName' = packageName
148154 handle (\(_ :: IOException) -> return ()) $ renameDirectory
149155 (dir </> "dist" </> "doc" </> "html" </> packageName')
150156 (docdir </> package)
151157
158+ enewPath <- try $ canonicalizePath $ docdir </> package </> packageName' <.> "haddock"
159+ case enewPath :: Either IOException FilePath of
160+ Left e -> print e
161+ Right newPath -> atomicModifyIORef haddockFilesRef $ \hfs'
162+ -> (newPath : hfs', ())
163+
152164 when spiHasTests $ do
153165 getHandle AppendMode $ run "cabal" ["build"] dir
154166 getHandle AppendMode $ run "cabal" (concat