c880ef6 · stackage · git.iko.soy

git.iko.soy/stackage

on master help sign in

Create a haddock directory

c880ef6Michael Snoyman12 years ago

.gitignore+1

compare with master

unifiedsplit

@@ -19,3 +19,4 @@ module-name-conflicts.txt

19/exclusive

20/inclusive

21*.stackage

22+/haddock/

Stackage/Test.hs+44−8

@@ -6,7 +6,7 @@ module Stackage.Test

7import qualified Control.Concurrent as C

8import Control.Exception (Exception, SomeException, handle, throwIO)

9−import Control.Monad (replicateM, unless, when)

9+import Control.Monad (replicateM, unless, when, forM_)

10import qualified Data.Map as Map

11import qualified Data.Set as Set

12import Data.Version (parseVersion, Version (Version))

@@ -14,9 +14,11 @@ import Data.Typeable (Typeable)

14import Stackage.Types

15import Stackage.Util

16import System.Directory (copyFile, createDirectory,

17− createDirectoryIfMissing, removeFile)

17+ createDirectoryIfMissing, doesFileExist, findExecutable,

18+ getDirectoryContents, removeFile,

19+ renameDirectory)

18import System.Exit (ExitCode (ExitSuccess))

20import System.Exit (ExitCode (ExitSuccess))

19−import System.FilePath ((<.>), (</>))

21+import System.FilePath ((<.>), (</>), takeDirectory)

20import System.IO (IOMode (WriteMode, AppendMode),

22import System.IO (IOMode (WriteMode, AppendMode),

21 withBinaryFile)

23 withBinaryFile)

22import System.Process (readProcess, runProcess, waitForProcess)

24import System.Process (readProcess, runProcess, waitForProcess)

@@ -28,10 +30,16 @@ runTestSuites settings' bp = do

28 let selected = Map.filterWithKey notSkipped $ bpPackages bp

30 let selected = Map.filterWithKey notSkipped $ bpPackages bp

29 putStrLn "Running test suites"

31 putStrLn "Running test suites"

30 let testdir = "runtests"

32 let testdir = "runtests"

33+ docdir = "haddock"

31 rm_r testdir

34 rm_r testdir

35+ rm_r docdir

32 createDirectory testdir

36 createDirectory testdir

37+ createDirectory docdir

38+

39+ copyBuiltInHaddocks docdir

40+

33 cabalVersion <- getCabalVersion

41 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

35 unless allPass $ error $ "There were failures, please see the logs in " ++ testdir

43 unless allPass $ error $ "There were failures, please see the logs in " ++ testdir

36 where

44 where

37 notSkipped p _ = p `Set.notMember` bpSkippedTests bp

45 notSkipped p _ = p `Set.notMember` bpSkippedTests bp

@@ -96,10 +104,11 @@ data CabalVersion = CabalVersion Int Int

104

97runTestSuite :: CabalVersion

105runTestSuite :: CabalVersion

98 -> BuildSettings

106 -> BuildSettings

99− -> FilePath

107+ -> FilePath -- ^ testdir

108+ -> FilePath -- ^ docdir

100 -> (PackageName, SelectedPackageInfo)

109 -> (PackageName, SelectedPackageInfo)

101 -> IO Bool

110 -> IO Bool

102−runTestSuite cabalVersion settings testdir (packageName, SelectedPackageInfo {..}) = do

111+runTestSuite cabalVersion settings testdir docdir (packageName, SelectedPackageInfo {..}) = do

103 -- Set up a new environment that includes the sandboxed bin folder in PATH.

112 -- Set up a new environment that includes the sandboxed bin folder in PATH.

104 env' <- getModifiedEnv settings

113 env' <- getModifiedEnv settings

105 let menv = Just $ addSandbox env'

114 let menv = Just $ addSandbox env'

@@ -131,8 +140,18 @@ runTestSuite cabalVersion settings testdir (packageName, SelectedPackageInfo {..

131 then ["--show-details=streaming"] -- FIXME temporary workaround for https://github.com/haskell/cabal/issues/1810

140 then ["--show-details=streaming"] -- FIXME temporary workaround for https://github.com/haskell/cabal/issues/1810

132 else []

141 else []

133 ]) dir

142 ]) dir

134− when (buildDocs settings) $

143+ when (buildDocs settings) $ do

135− getHandle AppendMode $ run "cabal" ["haddock"] dir

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)

136 return True

155 return True

137 let expectedFailure = packageName `Set.member` expectedFailuresBuild settings

156 let expectedFailure = packageName `Set.member` expectedFailuresBuild settings

138 if passed

157 if passed

@@ -154,3 +173,20 @@ runTestSuite cabalVersion settings testdir (packageName, SelectedPackageInfo {..

154 dir = testdir </> package

173 dir = testdir </> package

155 getHandle mode = withBinaryFile logfile mode

174 getHandle mode = withBinaryFile logfile mode

156 package = packageVersionString (packageName, spiVersion)

175 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'