Commit 09753724 authored by Benno Fünfstück's avatar Benno Fünfstück
Browse files

haddock/hscolour: fix highlighted source location

When generating haddocks with the `--for-hackage` switch, the generated
haddocks are placed in a different directory than the normal ones, which
includes the package id instead of just the package name. When we ran
hscolour, we didn't respect this, so the highlighted source would not
be placed in the correct directory and thus was missing from the tarball.
This patch fixes that.

Fixes #3451
parent 716884e4
......@@ -13,7 +13,7 @@
module Distribution.Simple.BuildPaths (
defaultDistPref, srcPref,
hscolourPref, haddockPref,
haddockDirName, hscolourPref, haddockPref,
autogenModulesDir,
autogenModuleName,
......@@ -48,12 +48,19 @@ import System.FilePath ((</>), (<.>))
srcPref :: FilePath -> FilePath
srcPref distPref = distPref </> "src"
hscolourPref :: FilePath -> PackageDescription -> FilePath
hscolourPref :: HaddockTarget -> FilePath -> PackageDescription -> FilePath
hscolourPref = haddockPref
haddockPref :: FilePath -> PackageDescription -> FilePath
haddockPref distPref pkg_descr
= distPref </> "doc" </> "html" </> display (packageName pkg_descr)
-- | This is the name of the directory in which the generated haddocks
-- should be stored. It does not include the @<dist>/doc/html@ prefix.
haddockDirName :: HaddockTarget -> PackageDescription -> FilePath
haddockDirName ForDevelopment = display . packageName
haddockDirName ForHackage = (++ "-docs") . display . packageId
-- | The directory to which generated haddock documentation should be written.
haddockPref :: HaddockTarget -> FilePath -> PackageDescription -> FilePath
haddockPref haddockTarget distPref pkg_descr
= distPref </> "doc" </> "html" </> haddockDirName haddockTarget pkg_descr
-- |The directory in which we put auto-generated modules
autogenModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> String
......
......@@ -135,15 +135,15 @@ haddock pkg_descr lbi suffixes flags' = do
comp = compiler lbi
platform = hostPlatform lbi
flags
| fromFlag (haddockForHackage flags') = flags'
flags = case haddockTarget of
ForDevelopment -> flags'
ForHackage -> flags'
{ haddockHoogle = Flag True
, haddockHtml = Flag True
, haddockHtmlLocation = Flag (pkg_url ++ "/docs")
, haddockContents = Flag (toPathTemplate pkg_url)
, haddockHscolour = Flag True
}
| otherwise = flags'
pkg_url = "/package/$pkg-$version"
flag f = fromFlag $ f flags
......@@ -151,6 +151,8 @@ haddock pkg_descr lbi suffixes flags' = do
{ optKeepTempFiles = flag haddockKeepTempFiles }
htmlTemplate = fmap toPathTemplate . flagToMaybe . haddockHtmlLocation
$ flags
haddockTarget =
fromFlagOrDefault ForDevelopment (haddockForHackage flags')
setupMessage verbosity "Running Haddock for" (packageId pkg_descr)
(confHaddock, version, _) <-
......@@ -178,15 +180,14 @@ haddock pkg_descr lbi suffixes flags' = do
-- the tools match the requests, we can proceed
when (flag haddockHscolour) $
hscolour' (warn verbosity) pkg_descr lbi suffixes
hscolour' (warn verbosity) haddockTarget pkg_descr lbi suffixes
(defaultHscolourFlags `mappend` haddockToHscolour flags)
libdirArgs <- getGhcLibDir verbosity lbi
let commonArgs = mconcat
[ libdirArgs
, fromFlags (haddockTemplateEnv lbi (packageId pkg_descr)) flags
, fromPackageDescription forDist pkg_descr ]
forDist = fromFlagOrDefault False (haddockForHackage flags)
, fromPackageDescription haddockTarget pkg_descr ]
withAllComponentsInBuildOrder pkg_descr lbi $ \component clbi -> do
initialBuildSteps (flag haddockDistPref) pkg_descr lbi clbi verbosity
......@@ -247,11 +248,12 @@ fromFlags env flags =
argOutputDir = maybe mempty Dir . flagToMaybe $ haddockDistPref flags
}
fromPackageDescription :: Bool -> PackageDescription -> HaddockArgs
fromPackageDescription forDist pkg_descr =
fromPackageDescription :: HaddockTarget -> PackageDescription -> HaddockArgs
fromPackageDescription haddockTarget pkg_descr =
mempty { argInterfaceFile = Flag $ haddockName pkg_descr,
argPackageName = Flag $ packageId $ pkg_descr,
argOutputDir = Dir $ "doc" </> "html" </> name,
argOutputDir = Dir $
"doc" </> "html" </> haddockDirName haddockTarget pkg_descr,
argPrologue = Flag $ if null desc then synopsis pkg_descr
else desc,
argTitle = Flag $ showPkg ++ subtitle
......@@ -259,9 +261,6 @@ fromPackageDescription forDist pkg_descr =
where
desc = PD.description pkg_descr
showPkg = display (packageId pkg_descr)
name
| forDist = showPkg ++ "-docs"
| otherwise = display (packageName pkg_descr)
subtitle | null (synopsis pkg_descr) = ""
| otherwise = ": " ++ synopsis pkg_descr
......@@ -647,16 +646,16 @@ hscolour :: PackageDescription
-> [PPSuffixHandler]
-> HscolourFlags
-> IO ()
hscolour pkg_descr lbi suffixes flags = do
hscolour' die pkg_descr lbi suffixes flags
hscolour = hscolour' die ForDevelopment
hscolour' :: (String -> IO ()) -- ^ Called when the 'hscolour' exe is not found.
-> HaddockTarget
-> PackageDescription
-> LocalBuildInfo
-> [PPSuffixHandler]
-> HscolourFlags
-> IO ()
hscolour' onNoHsColour pkg_descr lbi suffixes flags =
hscolour' onNoHsColour haddockTarget pkg_descr lbi suffixes flags =
either onNoHsColour (\(hscolourProg, _, _) -> go hscolourProg) =<<
lookupProgramVersion verbosity hscolourProgram
(orLaterVersion (Version [1,8] [])) (withPrograms lbi)
......@@ -665,7 +664,7 @@ hscolour' onNoHsColour pkg_descr lbi suffixes flags =
go hscolourProg = do
setupMessage verbosity "Running hscolour for" (packageId pkg_descr)
createDirectoryIfMissingVerbose verbosity True $
hscolourPref distPref pkg_descr
hscolourPref haddockTarget distPref pkg_descr
withAllComponentsInBuildOrder pkg_descr lbi $ \comp clbi -> do
initialBuildSteps distPref pkg_descr lbi clbi verbosity
......@@ -673,7 +672,7 @@ hscolour' onNoHsColour pkg_descr lbi suffixes flags =
let
doExe com = case (compToExe com) of
Just exe -> do
let outputDir = hscolourPref distPref pkg_descr
let outputDir = hscolourPref haddockTarget distPref pkg_descr
</> exeName exe </> "src"
runHsColour hscolourProg outputDir =<< getExeSourceFiles lbi exe clbi
Nothing -> do
......@@ -682,7 +681,7 @@ hscolour' onNoHsColour pkg_descr lbi suffixes flags =
return ()
case comp of
CLib lib -> do
let outputDir = hscolourPref distPref pkg_descr </> "src"
let outputDir = hscolourPref haddockTarget distPref pkg_descr </> "src"
runHsColour hscolourProg outputDir =<< getLibSourceFiles lbi lib clbi
CExe _ -> when (fromFlag (hscolourExecutables flags)) $ doExe comp
CTest _ -> when (fromFlag (hscolourTestSuites flags)) $ doExe comp
......
......@@ -26,7 +26,8 @@ import Distribution.Simple.Utils
, die, info, notice, warn, matchDirFileGlob )
import Distribution.Simple.Compiler
( CompilerFlavor(..), compilerFlavor )
import Distribution.Simple.Setup (CopyFlags(..), fromFlag)
import Distribution.Simple.Setup
( CopyFlags(..), fromFlag, HaddockTarget(ForDevelopment) )
import Distribution.Simple.BuildTarget
import qualified Distribution.Simple.GHC as GHC
......@@ -118,8 +119,8 @@ copyPackage verbosity pkg_descr lbi distPref copydest = do
-- Install (package-global) Haddock files
-- TODO: these should be done per-library
docExists <- doesDirectoryExist $ haddockPref distPref pkg_descr
info verbosity ("directory " ++ haddockPref distPref pkg_descr ++
docExists <- doesDirectoryExist $ haddockPref ForDevelopment distPref pkg_descr
info verbosity ("directory " ++ haddockPref ForDevelopment distPref pkg_descr ++
" does exist: " ++ show docExists)
-- TODO: this is a bit questionable, Haddock files really should
......@@ -127,13 +128,13 @@ copyPackage verbosity pkg_descr lbi distPref copydest = do
when docExists $ do
createDirectoryIfMissingVerbose verbosity True htmlPref
installDirectoryContents verbosity
(haddockPref distPref pkg_descr) htmlPref
(haddockPref ForDevelopment distPref pkg_descr) htmlPref
-- setPermissionsRecursive [Read] htmlPref
-- The haddock interface file actually already got installed
-- in the recursive copy, but now we install it where we actually
-- want it to be (normally the same place). We could remove the
-- copy in htmlPref first.
let haddockInterfaceFileSrc = haddockPref distPref pkg_descr
let haddockInterfaceFileSrc = haddockPref ForDevelopment distPref pkg_descr
</> haddockName pkg_descr
haddockInterfaceFileDest = interfacePref </> haddockName pkg_descr
-- We only generate the haddock interface file for libs, So if the
......
......@@ -39,6 +39,7 @@ module Distribution.Simple.Setup (
configAbsolutePaths, readPackageDbList, showPackageDbList,
CopyFlags(..), emptyCopyFlags, defaultCopyFlags, copyCommand,
InstallFlags(..), emptyInstallFlags, defaultInstallFlags, installCommand,
HaddockTarget(..),
HaddockFlags(..), emptyHaddockFlags, defaultHaddockFlags, haddockCommand,
HscolourFlags(..), emptyHscolourFlags, defaultHscolourFlags, hscolourCommand,
BuildFlags(..), emptyBuildFlags, defaultBuildFlags, buildCommand,
......@@ -1248,13 +1249,27 @@ hscolourCommand = CommandUI
-- * Haddock flags
-- ------------------------------------------------------------
-- | When we build haddock documentation, there are two cases:
--
-- 1. We build haddocks only for the current development version,
-- intended for local use and not for distribution. In this case,
-- we store the generated documentation in @<dist>/doc/html/<package name>@.
--
-- 2. We build haddocks for intended for uploading them to hackage.
-- In this case, we need to follow the layout that hackage expects
-- from documentation tarballs, and we might also want to use different
-- flags than for development builds, so in this case we store the generated
-- documentation in @<dist>/doc/html/<package id>-docs@.
data HaddockTarget = ForHackage | ForDevelopment deriving (Eq, Show, Generic)
data HaddockFlags = HaddockFlags {
haddockProgramPaths :: [(String, FilePath)],
haddockProgramArgs :: [(String, [String])],
haddockHoogle :: Flag Bool,
haddockHtml :: Flag Bool,
haddockHtmlLocation :: Flag String,
haddockForHackage :: Flag Bool,
haddockForHackage :: Flag HaddockTarget,
haddockExecutables :: Flag Bool,
haddockTestSuites :: Flag Bool,
haddockBenchmarks :: Flag Bool,
......@@ -1276,7 +1291,7 @@ defaultHaddockFlags = HaddockFlags {
haddockHoogle = Flag False,
haddockHtml = Flag False,
haddockHtmlLocation = NoFlag,
haddockForHackage = Flag False,
haddockForHackage = Flag ForDevelopment,
haddockExecutables = Flag False,
haddockTestSuites = Flag False,
haddockBenchmarks = Flag False,
......@@ -1345,7 +1360,7 @@ haddockOptions showOrParseArgs =
,option "" ["for-hackage"]
"Collection of flags to generate documentation suitable for upload to hackage"
haddockForHackage (\v flags -> flags { haddockForHackage = v })
trueArg
(noArg (Flag ForHackage))
,option "" ["executables"]
"Run haddock for Executables targets"
......
......@@ -46,7 +46,8 @@ import Distribution.Client.Setup
, manpageCommand
)
import Distribution.Simple.Setup
( HaddockFlags(..), haddockCommand, defaultHaddockFlags
( HaddockTarget(..)
, HaddockFlags(..), haddockCommand, defaultHaddockFlags
, HscolourFlags(..), hscolourCommand
, ReplFlags(..)
, CopyFlags(..), copyCommand
......@@ -901,7 +902,7 @@ haddockAction haddockFlags extraArgs globalFlags = do
setupScriptOptions = defaultSetupScriptOptions { useDistPref = distPref }
setupWrapper verbosity setupScriptOptions Nothing
haddockCommand (const haddockFlags') extraArgs
when (fromFlagOrDefault False $ haddockForHackage haddockFlags) $ do
when (haddockForHackage haddockFlags == Flag ForHackage) $ do
pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref)
let dest = distPref </> name <.> "tar.gz"
name = display (packageId pkg) ++ "-docs"
......@@ -1103,7 +1104,7 @@ uploadAction uploadFlags extraArgs globalFlags = do
++ "If you need to customise Haddock options, "
++ "run 'haddock --for-hackage' first "
++ "to generate a documentation tarball."
haddockAction (defaultHaddockFlags { haddockForHackage = Flag True })
haddockAction (defaultHaddockFlags { haddockForHackage = Flag ForHackage })
[] globalFlags
distPref <- findSavedDistPref config NoFlag
pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment