haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-01-22 04:01:56 +01:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

Pass references to .haddock files

Browse Source
This commit is contained in:
Michael Snoyman 2014-10-23 09:52:32 +03:00
parent cdd0a645fc
commit 3802b46f79
1 changed files with 22 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
Stackage/Test.hs
View File

@ -6,7 +6,7 @@ module Stackage.Test
) where ) where
import qualified Control.Concurrent as C import qualified Control.Concurrent as C
import Control.Exception (Exception, SomeException, handle, throwIO, IOException) import Control.Exception (Exception, SomeException, handle, throwIO, IOException, try)
import Control.Monad (replicateM, unless, when, forM_) import Control.Monad (replicateM, unless, when, forM_)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
@ -17,13 +17,14 @@ import Stackage.Util
import System.Directory (copyFile, createDirectory, import System.Directory (copyFile, createDirectory,
createDirectoryIfMissing, doesFileExist, findExecutable, createDirectoryIfMissing, doesFileExist, findExecutable,
getDirectoryContents, removeFile, getDirectoryContents, removeFile,
renameDirectory) renameDirectory, canonicalizePath)
import System.Exit (ExitCode (ExitSuccess)) import System.Exit (ExitCode (ExitSuccess))
import System.FilePath ((<.>), (</>), takeDirectory) import System.FilePath ((<.>), (</>), takeDirectory)
import System.IO (IOMode (WriteMode, AppendMode), import System.IO (IOMode (WriteMode, AppendMode),
withBinaryFile) withBinaryFile)
import System.Process (readProcess, runProcess, waitForProcess) import System.Process (readProcess, runProcess, waitForProcess)
import Text.ParserCombinators.ReadP (readP_to_S) import Text.ParserCombinators.ReadP (readP_to_S)
import Data.IORef (IORef, readIORef, atomicModifyIORef, newIORef)
runTestSuites :: BuildSettings -> BuildPlan -> IO () runTestSuites :: BuildSettings -> BuildPlan -> IO ()
runTestSuites settings' bp = do runTestSuites settings' bp = do
@ -40,7 +41,8 @@ runTestSuites settings' bp = do
copyBuiltInHaddocks docdir copyBuiltInHaddocks docdir
cabalVersion <- getCabalVersion cabalVersion <- getCabalVersion
allPass <- parFoldM (testWorkerThreads settings) (runTestSuite cabalVersion settings testdir docdir bp) (&&) True $ Map.toList selected haddockFilesRef <- newIORef []
allPass <- parFoldM (testWorkerThreads settings) (runTestSuite cabalVersion settings testdir docdir bp haddockFilesRef) (&&) True $ Map.toList selected
unless allPass $ error $ "There were failures, please see the logs in " ++ testdir unless allPass $ error $ "There were failures, please see the logs in " ++ testdir
where where
notSkipped p _ = p `Set.notMember` bpSkippedTests bp notSkipped p _ = p `Set.notMember` bpSkippedTests bp
@ -108,9 +110,11 @@ runTestSuite :: CabalVersion
-> FilePath -- ^ testdir -> FilePath -- ^ testdir
-> FilePath -- ^ docdir -> FilePath -- ^ docdir
-> BuildPlan -> BuildPlan
-> IORef [FilePath] -- ^ .haddock files
-> (PackageName, SelectedPackageInfo) -> (PackageName, SelectedPackageInfo)
-> IO Bool -> IO Bool
runTestSuite cabalVersion settings testdir docdir bp (packageName, SelectedPackageInfo {..}) = do runTestSuite cabalVersion settings testdir docdir
bp haddockFilesRef (packageName, SelectedPackageInfo {..}) = do
-- Set up a new environment that includes the sandboxed bin folder in PATH. -- Set up a new environment that includes the sandboxed bin folder in PATH.
env' <- getModifiedEnv settings env' <- getModifiedEnv settings
let menv = Just $ addSandbox env' let menv = Just $ addSandbox env'
@ -137,18 +141,26 @@ runTestSuite cabalVersion settings testdir docdir bp (packageName, SelectedPacka
-- Try building docs first in case tests have an expected failure. -- Try building docs first in case tests have an expected failure.
when (buildDocs settings) $ do when (buildDocs settings) $ do
hfs <- readIORef haddockFilesRef
let hfsOpts = map ("--haddock-options=-o " ++) hfs
getHandle AppendMode $ run "cabal" getHandle AppendMode $ run "cabal"
[ "haddock" ( "haddock"
, "--hyperlink-source" : "--hyperlink-source"
, "--html" : "--html"
, "--hoogle" : "--hoogle"
, "--html-location=../$pkg-$version/" : "--html-location=../$pkg-$version/"
] dir : hfsOpts) dir
let PackageName packageName' = packageName let PackageName packageName' = packageName
handle (\(_ :: IOException) -> return ()) $ renameDirectory handle (\(_ :: IOException) -> return ()) $ renameDirectory
(dir </> "dist" </> "doc" </> "html" </> packageName') (dir </> "dist" </> "doc" </> "html" </> packageName')
(docdir </> package) (docdir </> package)
enewPath <- try $ canonicalizePath $ docdir </> package </> packageName' <.> "haddock"
case enewPath :: Either IOException FilePath of
Left e -> print e
Right newPath -> atomicModifyIORef haddockFilesRef $ \hfs'
-> (newPath : hfs', ())
when spiHasTests $ do when spiHasTests $ do
getHandle AppendMode $ run "cabal" ["build"] dir getHandle AppendMode $ run "cabal" ["build"] dir
getHandle AppendMode $ run "cabal" (concat getHandle AppendMode $ run "cabal" (concat