Skip to content

Commit 9d0c0c0

Browse files
23Skidoo23Skidoo
committed
Merge pull request #3452 from bennofs/fix-3451
haddock/hscolour: fix highlighted source location
2 parents db0d443 + 209e2b6 commit 9d0c0c0

File tree

6 files changed

+58
-35
lines changed

6 files changed

+58
-35
lines changed

‎Cabal/Distribution/Simple/BuildPaths.hs

Lines changed: 12 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@
1313

1414
module Distribution.Simple.BuildPaths (
1515
defaultDistPref, srcPref,
16-
hscolourPref, haddockPref,
16+
haddockDirName, hscolourPref, haddockPref,
1717
autogenModulesDir,
1818

1919
autogenModuleName,
@@ -48,12 +48,19 @@ import System.FilePath ((</>), (<.>))
4848
srcPref :: FilePath -> FilePath
4949
srcPref distPref = distPref </> "src"
5050

51-
hscolourPref :: FilePath -> PackageDescription -> FilePath
51+
hscolourPref :: HaddockTarget -> FilePath -> PackageDescription -> FilePath
5252
hscolourPref = haddockPref
5353

54-
haddockPref :: FilePath -> PackageDescription -> FilePath
55-
haddockPref distPref pkg_descr
56-
= distPref </> "doc" </> "html" </> display (packageName pkg_descr)
54+
-- | This is the name of the directory in which the generated haddocks
55+
-- should be stored. It does not include the @<dist>/doc/html@ prefix.
56+
haddockDirName :: HaddockTarget -> PackageDescription -> FilePath
57+
haddockDirName ForDevelopment = display . packageName
58+
haddockDirName ForHackage = (++ "-docs") . display . packageId
59+
60+
-- | The directory to which generated haddock documentation should be written.
61+
haddockPref :: HaddockTarget -> FilePath -> PackageDescription -> FilePath
62+
haddockPref haddockTarget distPref pkg_descr
63+
= distPref </> "doc" </> "html" </> haddockDirName haddockTarget pkg_descr
5764

5865
-- |The directory in which we put auto-generated modules
5966
autogenModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> String

‎Cabal/Distribution/Simple/Haddock.hs

Lines changed: 17 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -135,22 +135,24 @@ haddock pkg_descr lbi suffixes flags' = do
135135
comp = compiler lbi
136136
platform = hostPlatform lbi
137137

138-
flags
139-
| fromFlag (haddockForHackage flags') = flags'
138+
flags = case haddockTarget of
139+
ForDevelopment -> flags'
140+
ForHackage -> flags'
140141
{ haddockHoogle = Flag True
141142
, haddockHtml = Flag True
142143
, haddockHtmlLocation = Flag (pkg_url ++ "/docs")
143144
, haddockContents = Flag (toPathTemplate pkg_url)
144145
, haddockHscolour = Flag True
145146
}
146-
| otherwise = flags'
147147
pkg_url = "/package/$pkg-$version"
148148
flag f = fromFlag $ f flags
149149

150150
tmpFileOpts = defaultTempFileOptions
151151
{ optKeepTempFiles = flag haddockKeepTempFiles }
152152
htmlTemplate = fmap toPathTemplate . flagToMaybe . haddockHtmlLocation
153153
$ flags
154+
haddockTarget =
155+
fromFlagOrDefault ForDevelopment (haddockForHackage flags')
154156

155157
setupMessage verbosity "Running Haddock for" (packageId pkg_descr)
156158
(confHaddock, version, _) <-
@@ -178,15 +180,14 @@ haddock pkg_descr lbi suffixes flags' = do
178180
-- the tools match the requests, we can proceed
179181

180182
when (flag haddockHscolour) $
181-
hscolour' (warn verbosity) pkg_descr lbi suffixes
183+
hscolour' (warn verbosity) haddockTarget pkg_descr lbi suffixes
182184
(defaultHscolourFlags `mappend` haddockToHscolour flags)
183185

184186
libdirArgs <- getGhcLibDir verbosity lbi
185187
let commonArgs = mconcat
186188
[ libdirArgs
187189
, fromFlags (haddockTemplateEnv lbi (packageId pkg_descr)) flags
188-
, fromPackageDescription forDist pkg_descr ]
189-
forDist = fromFlagOrDefault False (haddockForHackage flags)
190+
, fromPackageDescription haddockTarget pkg_descr ]
190191

191192
withAllComponentsInBuildOrder pkg_descr lbi $ \component clbi -> do
192193
initialBuildSteps (flag haddockDistPref) pkg_descr lbi clbi verbosity
@@ -247,21 +248,19 @@ fromFlags env flags =
247248
argOutputDir = maybe mempty Dir . flagToMaybe $ haddockDistPref flags
248249
}
249250

250-
fromPackageDescription :: Bool -> PackageDescription -> HaddockArgs
251-
fromPackageDescription forDist pkg_descr =
251+
fromPackageDescription :: HaddockTarget -> PackageDescription -> HaddockArgs
252+
fromPackageDescription haddockTarget pkg_descr =
252253
mempty { argInterfaceFile = Flag $ haddockName pkg_descr,
253254
argPackageName = Flag $ packageId $ pkg_descr,
254-
argOutputDir = Dir $ "doc" </> "html" </> name,
255+
argOutputDir = Dir $
256+
"doc" </> "html" </> haddockDirName haddockTarget pkg_descr,
255257
argPrologue = Flag $ if null desc then synopsis pkg_descr
256258
else desc,
257259
argTitle = Flag $ showPkg ++ subtitle
258260
}
259261
where
260262
desc = PD.description pkg_descr
261263
showPkg = display (packageId pkg_descr)
262-
name
263-
| forDist = showPkg ++ "-docs"
264-
| otherwise = display (packageName pkg_descr)
265264
subtitle | null (synopsis pkg_descr) = ""
266265
| otherwise = ": " ++ synopsis pkg_descr
267266

@@ -647,16 +646,16 @@ hscolour :: PackageDescription
647646
-> [PPSuffixHandler]
648647
-> HscolourFlags
649648
-> IO ()
650-
hscolour pkg_descr lbi suffixes flags = do
651-
hscolour' die pkg_descr lbi suffixes flags
649+
hscolour = hscolour' die ForDevelopment
652650

653651
hscolour' :: (String -> IO ()) -- ^ Called when the 'hscolour' exe is not found.
652+
-> HaddockTarget
654653
-> PackageDescription
655654
-> LocalBuildInfo
656655
-> [PPSuffixHandler]
657656
-> HscolourFlags
658657
-> IO ()
659-
hscolour' onNoHsColour pkg_descr lbi suffixes flags =
658+
hscolour' onNoHsColour haddockTarget pkg_descr lbi suffixes flags =
660659
either onNoHsColour (\(hscolourProg, _, _) -> go hscolourProg) =<<
661660
lookupProgramVersion verbosity hscolourProgram
662661
(orLaterVersion (Version [1,8] [])) (withPrograms lbi)
@@ -665,15 +664,15 @@ hscolour' onNoHsColour pkg_descr lbi suffixes flags =
665664
go hscolourProg = do
666665
setupMessage verbosity "Running hscolour for" (packageId pkg_descr)
667666
createDirectoryIfMissingVerbose verbosity True $
668-
hscolourPref distPref pkg_descr
667+
hscolourPref haddockTarget distPref pkg_descr
669668

670669
withAllComponentsInBuildOrder pkg_descr lbi $ \comp clbi -> do
671670
initialBuildSteps distPref pkg_descr lbi clbi verbosity
672671
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
673672
let
674673
doExe com = case (compToExe com) of
675674
Just exe -> do
676-
let outputDir = hscolourPref distPref pkg_descr
675+
let outputDir = hscolourPref haddockTarget distPref pkg_descr
677676
</> exeName exe </> "src"
678677
runHsColour hscolourProg outputDir =<< getExeSourceFiles lbi exe clbi
679678
Nothing -> do
@@ -682,7 +681,7 @@ hscolour' onNoHsColour pkg_descr lbi suffixes flags =
682681
return ()
683682
case comp of
684683
CLib lib -> do
685-
let outputDir = hscolourPref distPref pkg_descr </> "src"
684+
let outputDir = hscolourPref haddockTarget distPref pkg_descr </> "src"
686685
runHsColour hscolourProg outputDir =<< getLibSourceFiles lbi lib clbi
687686
CExe _ -> when (fromFlag (hscolourExecutables flags)) $ doExe comp
688687
CTest _ -> when (fromFlag (hscolourTestSuites flags)) $ doExe comp

‎Cabal/Distribution/Simple/Install.hs

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,8 @@ import Distribution.Simple.Utils
2626
, die, info, notice, warn, matchDirFileGlob )
2727
import Distribution.Simple.Compiler
2828
( CompilerFlavor(..), compilerFlavor )
29-
import Distribution.Simple.Setup (CopyFlags(..), fromFlag)
29+
import Distribution.Simple.Setup
30+
( CopyFlags(..), fromFlag, HaddockTarget(ForDevelopment) )
3031
import Distribution.Simple.BuildTarget
3132

3233
import qualified Distribution.Simple.GHC as GHC
@@ -118,22 +119,22 @@ copyPackage verbosity pkg_descr lbi distPref copydest = do
118119

119120
-- Install (package-global) Haddock files
120121
-- TODO: these should be done per-library
121-
docExists <- doesDirectoryExist $ haddockPref distPref pkg_descr
122-
info verbosity ("directory " ++ haddockPref distPref pkg_descr ++
122+
docExists <- doesDirectoryExist $ haddockPref ForDevelopment distPref pkg_descr
123+
info verbosity ("directory " ++ haddockPref ForDevelopment distPref pkg_descr ++
123124
" does exist: " ++ show docExists)
124125

125126
-- TODO: this is a bit questionable, Haddock files really should
126127
-- be per library (when there are convenience libraries.)
127128
when docExists $ do
128129
createDirectoryIfMissingVerbose verbosity True htmlPref
129130
installDirectoryContents verbosity
130-
(haddockPref distPref pkg_descr) htmlPref
131+
(haddockPref ForDevelopment distPref pkg_descr) htmlPref
131132
-- setPermissionsRecursive [Read] htmlPref
132133
-- The haddock interface file actually already got installed
133134
-- in the recursive copy, but now we install it where we actually
134135
-- want it to be (normally the same place). We could remove the
135136
-- copy in htmlPref first.
136-
let haddockInterfaceFileSrc = haddockPref distPref pkg_descr
137+
let haddockInterfaceFileSrc = haddockPref ForDevelopment distPref pkg_descr
137138
</> haddockName pkg_descr
138139
haddockInterfaceFileDest = interfacePref </> haddockName pkg_descr
139140
-- We only generate the haddock interface file for libs, So if the

‎Cabal/Distribution/Simple/Setup.hs

Lines changed: 18 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,7 @@ module Distribution.Simple.Setup (
3939
configAbsolutePaths, readPackageDbList, showPackageDbList,
4040
CopyFlags(..), emptyCopyFlags, defaultCopyFlags, copyCommand,
4141
InstallFlags(..), emptyInstallFlags, defaultInstallFlags, installCommand,
42+
HaddockTarget(..),
4243
HaddockFlags(..), emptyHaddockFlags, defaultHaddockFlags, haddockCommand,
4344
HscolourFlags(..), emptyHscolourFlags, defaultHscolourFlags, hscolourCommand,
4445
BuildFlags(..), emptyBuildFlags, defaultBuildFlags, buildCommand,
@@ -1248,13 +1249,27 @@ hscolourCommand = CommandUI
12481249
-- * Haddock flags
12491250
-- ------------------------------------------------------------
12501251

1252+
1253+
-- | When we build haddock documentation, there are two cases:
1254+
--
1255+
-- 1. We build haddocks only for the current development version,
1256+
-- intended for local use and not for distribution. In this case,
1257+
-- we store the generated documentation in @<dist>/doc/html/<package name>@.
1258+
--
1259+
-- 2. We build haddocks for intended for uploading them to hackage.
1260+
-- In this case, we need to follow the layout that hackage expects
1261+
-- from documentation tarballs, and we might also want to use different
1262+
-- flags than for development builds, so in this case we store the generated
1263+
-- documentation in @<dist>/doc/html/<package id>-docs@.
1264+
data HaddockTarget = ForHackage | ForDevelopment deriving (Eq, Show, Generic)
1265+
12511266
data HaddockFlags = HaddockFlags {
12521267
haddockProgramPaths :: [(String, FilePath)],
12531268
haddockProgramArgs :: [(String, [String])],
12541269
haddockHoogle :: Flag Bool,
12551270
haddockHtml :: Flag Bool,
12561271
haddockHtmlLocation :: Flag String,
1257-
haddockForHackage :: Flag Bool,
1272+
haddockForHackage :: Flag HaddockTarget,
12581273
haddockExecutables :: Flag Bool,
12591274
haddockTestSuites :: Flag Bool,
12601275
haddockBenchmarks :: Flag Bool,
@@ -1276,7 +1291,7 @@ defaultHaddockFlags = HaddockFlags {
12761291
haddockHoogle = Flag False,
12771292
haddockHtml = Flag False,
12781293
haddockHtmlLocation = NoFlag,
1279-
haddockForHackage = Flag False,
1294+
haddockForHackage = Flag ForDevelopment,
12801295
haddockExecutables = Flag False,
12811296
haddockTestSuites = Flag False,
12821297
haddockBenchmarks = Flag False,
@@ -1345,7 +1360,7 @@ haddockOptions showOrParseArgs =
13451360
,option "" ["for-hackage"]
13461361
"Collection of flags to generate documentation suitable for upload to hackage"
13471362
haddockForHackage (\v flags -> flags { haddockForHackage = v })
1348-
trueArg
1363+
(noArg (Flag ForHackage))
13491364

13501365
,option "" ["executables"]
13511366
"Run haddock for Executables targets"

‎cabal-install/Distribution/Client/Config.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1026,7 +1026,7 @@ haddockFlagsFields = [ field
10261026
name = fieldName field
10271027
, name `notElem` exclusions ]
10281028
where
1029-
exclusions = ["verbose", "builddir"]
1029+
exclusions = ["verbose", "builddir", "for-hackage"]
10301030

10311031
-- | Fields for the 'program-locations' section.
10321032
withProgramsFields :: [FieldDescr [(String, FilePath)]]

‎cabal-install/Main.hs

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,8 @@ import Distribution.Client.Setup
4646
, manpageCommand
4747
)
4848
import Distribution.Simple.Setup
49-
( HaddockFlags(..), haddockCommand, defaultHaddockFlags
49+
( HaddockTarget(..)
50+
, HaddockFlags(..), haddockCommand, defaultHaddockFlags
5051
, HscolourFlags(..), hscolourCommand
5152
, ReplFlags(..)
5253
, CopyFlags(..), copyCommand
@@ -901,7 +902,7 @@ haddockAction haddockFlags extraArgs globalFlags = do
901902
setupScriptOptions = defaultSetupScriptOptions { useDistPref = distPref }
902903
setupWrapper verbosity setupScriptOptions Nothing
903904
haddockCommand (const haddockFlags') extraArgs
904-
when (fromFlagOrDefault False $ haddockForHackage haddockFlags) $ do
905+
when (haddockForHackage haddockFlags == Flag ForHackage) $ do
905906
pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref)
906907
let dest = distPref </> name <.> "tar.gz"
907908
name = display (packageId pkg) ++ "-docs"
@@ -1103,7 +1104,7 @@ uploadAction uploadFlags extraArgs globalFlags = do
11031104
++ "If you need to customise Haddock options, "
11041105
++ "run 'haddock --for-hackage' first "
11051106
++ "to generate a documentation tarball."
1106-
haddockAction (defaultHaddockFlags { haddockForHackage = Flag True })
1107+
haddockAction (defaultHaddockFlags { haddockForHackage = Flag ForHackage })
11071108
[] globalFlags
11081109
distPref <- findSavedDistPref config NoFlag
11091110
pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref)

0 commit comments

Comments
 (0)