@@ -6,7 +6,7 @@ module Stackage.Test
66
77import qualified Control.Concurrent as C
88import Control.Exception (Exception, SomeException, handle, throwIO)
9−import Control.Monad (replicateM, unless, when)
9+import Control.Monad (replicateM, unless, when, forM_)
1010import qualified Data.Map as Map
1111import qualified Data.Set as Set
1212import Data.Version (parseVersion, Version (Version))
@@ -14,9 +14,11 @@ import Data.Typeable (Typeable)
1414import Stackage.Types
1515import Stackage.Util
1616import System.Directory (copyFile, createDirectory,
17− createDirectoryIfMissing, removeFile)
17+ createDirectoryIfMissing, doesFileExist, findExecutable,
18+ getDirectoryContents, removeFile,
19+ renameDirectory)
1820import System.Exit (ExitCode (ExitSuccess))
19−import System.FilePath ((<.>), (</>))
21+import System.FilePath ((<.>), (</>), takeDirectory)
2022import System.IO (IOMode (WriteMode, AppendMode),
2123 withBinaryFile)
2224import System.Process (readProcess, runProcess, waitForProcess)
@@ -28,10 +30,16 @@ runTestSuites settings' bp = do
2830 let selected = Map.filterWithKey notSkipped $ bpPackages bp
2931 putStrLn "Running test suites"
3032 let testdir = "runtests"
33+ docdir = "haddock"
3134 rm_r testdir
35+ rm_r docdir
3236 createDirectory testdir
37+ createDirectory docdir
38+
39+ copyBuiltInHaddocks docdir
40+
3341 cabalVersion <- getCabalVersion
34− allPass <- parFoldM (testWorkerThreads settings) (runTestSuite cabalVersion settings testdir) (&&) True $ Map.toList selected
42+ allPass <- parFoldM (testWorkerThreads settings) (runTestSuite cabalVersion settings testdir docdir) (&&) True $ Map.toList selected
3543 unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
3644 where
3745 notSkipped p _ = p `Set.notMember` bpSkippedTests bp
@@ -96,10 +104,11 @@ data CabalVersion = CabalVersion Int Int
96104
97105runTestSuite :: CabalVersion
98106 -> BuildSettings
99− -> FilePath
107+ -> FilePath -- ^ testdir
108+ -> FilePath -- ^ docdir
100109 -> (PackageName, SelectedPackageInfo)
101110 -> IO Bool
102−runTestSuite cabalVersion settings testdir (packageName, SelectedPackageInfo {..}) = do
111+runTestSuite cabalVersion settings testdir docdir (packageName, SelectedPackageInfo {..}) = do
103112 -- Set up a new environment that includes the sandboxed bin folder in PATH.
104113 env' <- getModifiedEnv settings
105114 let menv = Just $ addSandbox env'
@@ -131,8 +140,18 @@ runTestSuite cabalVersion settings testdir (packageName, SelectedPackageInfo {..
131140 then ["--show-details=streaming"] -- FIXME temporary workaround for https://github.com/haskell/cabal/issues/1810
132141 else []
133142 ]) dir
134− when (buildDocs settings) $
135− getHandle AppendMode $ run "cabal" ["haddock"] dir
143+ when (buildDocs settings) $ do
144+ getHandle AppendMode $ run "cabal"
145+ [ "haddock"
146+ , "--hyperlink-source"
147+ , "--html"
148+ , "--hoogle"
149+ , "--html-location=../$pkg-$version/"
150+ ] dir
151+ let PackageName packageName' = packageName
152+ renameDirectory
153+ (dir </> "dist" </> "doc" </> "html" </> packageName')
154+ (docdir </> package)
136155 return True
137156 let expectedFailure = packageName `Set.member` expectedFailuresBuild settings
138157 if passed
@@ -154,3 +173,20 @@ runTestSuite cabalVersion settings testdir (packageName, SelectedPackageInfo {..
154173 dir = testdir </> package
155174 getHandle mode = withBinaryFile logfile mode
156175 package = packageVersionString (packageName, spiVersion)
176+
177+copyBuiltInHaddocks docdir = do
178+ Just ghc <- findExecutable "ghc"
179+ copyTree (takeDirectory ghc </> "../share/doc/ghc/html/libraries") docdir
180+ where
181+ copyTree src dest = do
182+ entries <- fmap (filter (\s -> s /= "." && s /= ".."))
183+ $ getDirectoryContents src
184+ forM_ entries $ \entry -> do
185+ let src' = src </> entry
186+ dest' = dest </> entry
187+ isFile <- doesFileExist src'
188+ if isFile
189+ then copyFile src' dest'
190+ else do
191+ createDirectory dest'
192+ copyTree src' dest'