Create a haddock directory

This commit is contained in:
Michael Snoyman 2014-10-19 10:51:10 +03:00
parent 3e1e9ab086
commit c880ef6060
2 changed files with 45 additions and 8 deletions

1
.gitignore vendored
View File

@ -19,3 +19,4 @@ module-name-conflicts.txt
/exclusive
/inclusive
*.stackage
/haddock/

View File

@ -6,7 +6,7 @@ module Stackage.Test
import qualified Control.Concurrent as C
import Control.Exception (Exception, SomeException, handle, throwIO)
import Control.Monad (replicateM, unless, when)
import Control.Monad (replicateM, unless, when, forM_)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Version (parseVersion, Version (Version))
@ -14,9 +14,11 @@ import Data.Typeable (Typeable)
import Stackage.Types
import Stackage.Util
import System.Directory (copyFile, createDirectory,
createDirectoryIfMissing, removeFile)
createDirectoryIfMissing, doesFileExist, findExecutable,
getDirectoryContents, removeFile,
renameDirectory)
import System.Exit (ExitCode (ExitSuccess))
import System.FilePath ((<.>), (</>))
import System.FilePath ((<.>), (</>), takeDirectory)
import System.IO (IOMode (WriteMode, AppendMode),
withBinaryFile)
import System.Process (readProcess, runProcess, waitForProcess)
@ -28,10 +30,16 @@ runTestSuites settings' bp = do
let selected = Map.filterWithKey notSkipped $ bpPackages bp
putStrLn "Running test suites"
let testdir = "runtests"
docdir = "haddock"
rm_r testdir
rm_r docdir
createDirectory testdir
createDirectory docdir
copyBuiltInHaddocks docdir
cabalVersion <- getCabalVersion
allPass <- parFoldM (testWorkerThreads settings) (runTestSuite cabalVersion settings testdir) (&&) True $ Map.toList selected
allPass <- parFoldM (testWorkerThreads settings) (runTestSuite cabalVersion settings testdir docdir) (&&) True $ Map.toList selected
unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
where
notSkipped p _ = p `Set.notMember` bpSkippedTests bp
@ -96,10 +104,11 @@ data CabalVersion = CabalVersion Int Int
runTestSuite :: CabalVersion
-> BuildSettings
-> FilePath
-> FilePath -- ^ testdir
-> FilePath -- ^ docdir
-> (PackageName, SelectedPackageInfo)
-> IO Bool
runTestSuite cabalVersion settings testdir (packageName, SelectedPackageInfo {..}) = do
runTestSuite cabalVersion settings testdir docdir (packageName, SelectedPackageInfo {..}) = do
-- Set up a new environment that includes the sandboxed bin folder in PATH.
env' <- getModifiedEnv settings
let menv = Just $ addSandbox env'
@ -131,8 +140,18 @@ runTestSuite cabalVersion settings testdir (packageName, SelectedPackageInfo {..
then ["--show-details=streaming"] -- FIXME temporary workaround for https://github.com/haskell/cabal/issues/1810
else []
]) dir
when (buildDocs settings) $
getHandle AppendMode $ run "cabal" ["haddock"] dir
when (buildDocs settings) $ do
getHandle AppendMode $ run "cabal"
[ "haddock"
, "--hyperlink-source"
, "--html"
, "--hoogle"
, "--html-location=../$pkg-$version/"
] dir
let PackageName packageName' = packageName
renameDirectory
(dir </> "dist" </> "doc" </> "html" </> packageName')
(docdir </> package)
return True
let expectedFailure = packageName `Set.member` expectedFailuresBuild settings
if passed
@ -154,3 +173,20 @@ runTestSuite cabalVersion settings testdir (packageName, SelectedPackageInfo {..
dir = testdir </> package
getHandle mode = withBinaryFile logfile mode
package = packageVersionString (packageName, spiVersion)
copyBuiltInHaddocks docdir = do
Just ghc <- findExecutable "ghc"
copyTree (takeDirectory ghc </> "../share/doc/ghc/html/libraries") docdir
where
copyTree src dest = do
entries <- fmap (filter (\s -> s /= "." && s /= ".."))
$ getDirectoryContents src
forM_ entries $ \entry -> do
let src' = src </> entry
dest' = dest </> entry
isFile <- doesFileExist src'
if isFile
then copyFile src' dest'
else do
createDirectory dest'
copyTree src' dest'