Commit 9d0c0c03 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Merge pull request #3452 from bennofs/fix-3451

haddock/hscolour: fix highlighted source location
parents db0d443c 209e2b6a
......@@ -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"
......
......@@ -1026,7 +1026,7 @@ haddockFlagsFields = [ field
name = fieldName field
, name `notElem` exclusions ]
where
exclusions = ["verbose", "builddir"]
exclusions = ["verbose", "builddir", "for-hackage"]
-- | Fields for the 'program-locations' section.
withProgramsFields :: [FieldDescr [(String, FilePath)]]
......
......@@ -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