Skip to content
Browse files

Merge pull request #3452 from bennofs/fix-3451

haddock/hscolour: fix highlighted source location
  • Loading branch information...
2 parents db0d443 + 209e2b6 commit 9d0c0c03d9a1d4b17e0fbedfb486e2f6910fb1b5 @23Skidoo 23Skidoo committed May 24, 2016
View
17 Cabal/Distribution/Simple/BuildPaths.hs
@@ -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
View
35 Cabal/Distribution/Simple/Haddock.hs
@@ -135,22 +135,24 @@ 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
tmpFileOpts = defaultTempFileOptions
{ 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,21 +248,19 @@ 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
}
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,15 +664,15 @@ 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
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
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
View
11 Cabal/Distribution/Simple/Install.hs
@@ -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,22 +119,22 @@ 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
-- be per library (when there are convenience libraries.)
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
View
21 Cabal/Distribution/Simple/Setup.hs
@@ -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"
View
2 cabal-install/Distribution/Client/Config.hs
@@ -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)]]
View
7 cabal-install/Main.hs
@@ -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)

0 comments on commit 9d0c0c0

Please sign in to comment.
Something went wrong with that request. Please try again.