haddock/hscolour: fix highlighted source location

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

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

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

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"

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)]]

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)