haddock-project fixes

.gitignore

@@ -68,6 +68,7 @@ register.sh
 # windows test artifacts
 cabal-testsuite/**/*.exe
 cabal-testsuite/**/*.bat
+cabal-testsuite/**/haddocks
 
 # python artifacts from documentation builds
 *.pyc

Cabal/src/Distribution/Simple/Haddock.hs

@@ -432,7 +432,7 @@ createHaddockIndex
 createHaddockIndex verbosity programDb comp platform flags = do
   let args = fromHaddockProjectFlags flags
   (haddockProg, _version) <-
-    getHaddockProg verbosity programDb comp args (haddockProjectQuickJump flags)
+    getHaddockProg verbosity programDb comp args (Flag True)
   runHaddock verbosity defaultTempFileOptions comp platform haddockProg False args
 
 -- ------------------------------------------------------------------------------
@@ -489,12 +489,12 @@ fromHaddockProjectFlags :: HaddockProjectFlags -> HaddockArgs
 fromHaddockProjectFlags flags =
   mempty
     { argOutputDir = Dir (fromFlag $ haddockProjectDir flags)
-    , argQuickJump = haddockProjectQuickJump flags
-    , argGenContents = haddockProjectGenContents flags
-    , argGenIndex = haddockProjectGenIndex flags
+    , argQuickJump = Flag True
+    , argGenContents = Flag True
+    , argGenIndex = Flag True
     , argPrologueFile = haddockProjectPrologue flags
     , argInterfaces = fromFlagOrDefault [] (haddockProjectInterfaces flags)
-    , argLinkedSource = haddockProjectLinkedSource flags
+    , argLinkedSource = Flag True
     , argLib = haddockProjectLib flags
     }
 
@@ -835,7 +835,12 @@ renderArgs verbosity tmpFileOpts version comp platform args k = do
           ( \o ->
               outputDir
                 </> case o of
-                  Html -> "index.html"
+                  Html
+                    | fromFlagOrDefault False (argGenIndex args) ->
+                        "index.html"
+                  Html
+                    | otherwise ->
+                        mempty
                   Hoogle -> pkgstr <.> "txt"
           )
         . fromFlagOrDefault [Html]

Cabal/src/Distribution/Simple/Setup/Haddock.hs

@@ -381,21 +381,10 @@ data HaddockProjectFlags = HaddockProjectFlags
   -- * `--gen-index`
   -- * `--gen-contents`
   -- * `--hyperlinked-source`
-  , haddockProjectLocal :: Flag Bool
-  -- ^ a shortcut option which builds self contained directory which contains
-  -- all the documentation, it implies:
-  -- * `--quickjump`
-  -- * `--gen-index`
-  -- * `--gen-contents`
-  -- * `--hyperlinked-source`
-  --
-  -- And it will also pass `--base-url` option to `haddock`.
   , -- options passed to @haddock@ via 'createHaddockIndex'
     haddockProjectDir :: Flag String
   -- ^ output directory of combined haddocks, the default is './haddocks'
   , haddockProjectPrologue :: Flag String
-  , haddockProjectGenIndex :: Flag Bool
-  , haddockProjectGenContents :: Flag Bool
   , haddockProjectInterfaces :: Flag [(FilePath, Maybe FilePath, Maybe FilePath, Visibility)]
   -- ^ 'haddocksInterfaces' is inferred by the 'haddocksAction'; currently not
   -- exposed to the user.
@@ -414,8 +403,6 @@ data HaddockProjectFlags = HaddockProjectFlags
   , haddockProjectForeignLibs :: Flag Bool
   , haddockProjectInternal :: Flag Bool
   , haddockProjectCss :: Flag FilePath
-  , haddockProjectLinkedSource :: Flag Bool
-  , haddockProjectQuickJump :: Flag Bool
   , haddockProjectHscolourCss :: Flag FilePath
   , -- haddockContent is not supported, a fixed value is provided
     -- haddockIndex is not supported, a fixed value is provided
@@ -432,11 +419,8 @@ defaultHaddockProjectFlags :: HaddockProjectFlags
 defaultHaddockProjectFlags =
   HaddockProjectFlags
     { haddockProjectHackage = Flag False
-    , haddockProjectLocal = Flag False
     , haddockProjectDir = Flag "./haddocks"
     , haddockProjectPrologue = NoFlag
-    , haddockProjectGenIndex = Flag False
-    , haddockProjectGenContents = Flag False
     , haddockProjectTestSuites = Flag False
     , haddockProjectProgramPaths = mempty
     , haddockProjectProgramArgs = mempty
@@ -447,8 +431,6 @@ defaultHaddockProjectFlags =
     , haddockProjectForeignLibs = Flag False
     , haddockProjectInternal = Flag False
     , haddockProjectCss = NoFlag
-    , haddockProjectLinkedSource = Flag False
-    , haddockProjectQuickJump = Flag False
     , haddockProjectHscolourCss = NoFlag
     , haddockProjectKeepTempFiles = Flag False
     , haddockProjectVerbosity = Flag normal
@@ -501,26 +483,12 @@ haddockProjectOptions _showOrParseArgs =
       ""
       ["hackage"]
       ( concat
-          [ "A short-cut option to build documentation linked to hackage; "
-          , "it implies --quickjump, --gen-index, --gen-contents, "
-          , "--hyperlinked-source and --html-location"
+          [ "A short-cut option to build documentation linked to hackage."
           ]
       )
       haddockProjectHackage
       (\v flags -> flags{haddockProjectHackage = v})
       trueArg
-  , option
-      ""
-      ["local"]
-      ( concat
-          [ "A short-cut option to build self contained documentation; "
-          , "it implies  --quickjump, --gen-index, --gen-contents "
-          , "and --hyperlinked-source."
-          ]
-      )
-      haddockProjectLocal
-      (\v flags -> flags{haddockProjectLocal = v})
-      trueArg
   , option
       ""
       ["output"]
@@ -535,20 +503,6 @@ haddockProjectOptions _showOrParseArgs =
       haddockProjectPrologue
       (\v flags -> flags{haddockProjectPrologue = v})
       (optArg' "PATH" maybeToFlag (fmap Just . flagToList))
-  , option
-      ""
-      ["gen-index"]
-      "Generate index"
-      haddockProjectGenIndex
-      (\v flags -> flags{haddockProjectGenIndex = v})
-      trueArg
-  , option
-      ""
-      ["gen-contents"]
-      "Generate contents"
-      haddockProjectGenContents
-      (\v flags -> flags{haddockProjectGenContents = v})
-      trueArg
   , option
       ""
       ["hoogle"]
@@ -605,20 +559,6 @@ haddockProjectOptions _showOrParseArgs =
       haddockProjectCss
       (\v flags -> flags{haddockProjectCss = v})
       (reqArgFlag "PATH")
-  , option
-      ""
-      ["hyperlink-source", "hyperlink-sources", "hyperlinked-source"]
-      "Hyperlink the documentation to the source code"
-      haddockProjectLinkedSource
-      (\v flags -> flags{haddockProjectLinkedSource = v})
-      trueArg
-  , option
-      ""
-      ["quickjump"]
-      "Generate an index for interactive documentation navigation"
-      haddockProjectQuickJump
-      (\v flags -> flags{haddockProjectQuickJump = v})
-      trueArg
   , option
       ""
       ["hscolour-css"]

cabal-install/src/Distribution/Client/CmdHaddockProject.hs

@@ -3,7 +3,6 @@ module Distribution.Client.CmdHaddockProject
   , haddockProjectAction
   ) where
 
-import Data.Bool (bool)
 import Distribution.Client.Compat.Prelude hiding (get)
 import Prelude ()
 
@@ -60,8 +59,6 @@ import Distribution.Simple.Compiler
   )
 import Distribution.Simple.Flag
   ( Flag (..)
-  , flagElim
-  , flagToList
   , fromFlag
   , fromFlagOrDefault
   )
@@ -93,6 +90,7 @@ import Distribution.Simple.Utils
 import Distribution.Types.InstalledPackageInfo (InstalledPackageInfo (..))
 import Distribution.Types.PackageId (pkgName)
 import Distribution.Types.PackageName (unPackageName)
+import Distribution.Types.UnitId (unUnitId)
 import Distribution.Types.Version (mkVersion)
 import Distribution.Types.VersionRange (orLaterVersion)
 import Distribution.Verbosity as Verbosity
@@ -108,15 +106,6 @@ haddockProjectAction flags _extraArgs globalFlags = do
   let outputDir = normalise $ fromFlag (haddockProjectDir flags)
   createDirectoryIfMissingVerbose verbosity True outputDir
 
-  when
-    ( (2 :: Int)
-        <= ( flagElim 0 (bool 0 1) (haddockProjectHackage flags)
-              + flagElim 0 (bool 0 1) (haddockProjectLocal flags)
-              + flagElim 0 (const 1) (haddockProjectHtmlLocation flags)
-           )
-    )
-    $ die' verbosity "Options `--local`, `--hackage` and `--html-location` are mutually exclusive`"
-
   warn verbosity "haddock-project command is experimental, it might break in the future"
 
   -- build all packages with appropriate haddock flags
@@ -142,14 +131,8 @@ haddockProjectAction flags _extraArgs globalFlags = do
           , haddockForeignLibs = haddockProjectForeignLibs flags
           , haddockInternal = haddockProjectInternal flags
           , haddockCss = haddockProjectCss flags
-          , haddockLinkedSource =
-              if localOrHackage
-                then Flag True
-                else haddockProjectLinkedSource flags
-          , haddockQuickJump =
-              if localOrHackage
-                then Flag True
-                else haddockProjectQuickJump flags
+          , haddockLinkedSource = Flag True
+          , haddockQuickJump = Flag True
           , haddockHscolourCss = haddockProjectHscolourCss flags
           , haddockContents =
               if localStyle
@@ -178,7 +161,10 @@ haddockProjectAction flags _extraArgs globalFlags = do
   -- we need.
   --
 
-  withContextAndSelectors RejectNoTargets Nothing nixFlags ["all"] globalFlags HaddockCommand $ \targetCtx ctx targetSelectors -> do
+  withContextAndSelectors RejectNoTargets Nothing
+                          (commandDefaultFlags CmdBuild.buildCommand)
+                          ["all"] globalFlags HaddockCommand
+                          $ \targetCtx ctx targetSelectors -> do
     baseCtx <- case targetCtx of
       ProjectContext -> return ctx
       GlobalContext -> return ctx
@@ -235,6 +221,17 @@ haddockProjectAction flags _extraArgs globalFlags = do
         (orLaterVersion (mkVersion [2, 26, 1]))
         progs
 
+    --
+    -- Build project; we need to build dependencies.
+    -- Issue #8958.
+    --
+
+    when localStyle $
+      CmdBuild.buildAction
+        (commandDefaultFlags CmdBuild.buildCommand)
+        ["all"]
+        globalFlags
+
     --
     -- Build haddocks of each components
     --
@@ -254,6 +251,8 @@ haddockProjectAction flags _extraArgs globalFlags = do
           | not localStyle ->
               return []
         Left package -> do
+          -- TODO: this might not work for public packages with sublibraries.
+          -- Issue #9026.
           let packageName = unPackageName (pkgName $ sourcePackageId package)
               destDir = outputDir </> packageName
           fmap catMaybes $ for (haddockInterfaces package) $ \interfacePath -> do
@@ -274,14 +273,15 @@ haddockProjectAction flags _extraArgs globalFlags = do
           case elabLocalToProject package of
             True -> do
               let distDirParams = elabDistDirParams sharedConfig' package
+                  unitId = unUnitId (elabUnitId package)
                   buildDir = distBuildDirectory distLayout distDirParams
                   packageName = unPackageName (pkgName $ elabPkgSourceId package)
               let docDir =
                     buildDir
                       </> "doc"
                       </> "html"
                       </> packageName
-                  destDir = outputDir </> packageName
+                  destDir = outputDir </> unitId
                   interfacePath =
                     destDir
                       </> packageName
@@ -292,17 +292,23 @@ haddockProjectAction flags _extraArgs globalFlags = do
                   copyDirectoryRecursive verbosity docDir destDir
                     >> return
                       [
-                        ( packageName
+                        ( unitId
                         , interfacePath
                         , Visible
                         )
                       ]
-                False -> return []
+                False -> do
+                  warn verbosity
+                       ("haddocks of "
+                        ++ show unitId
+                        ++ " not found in the store")
+                  return []
             False
               | not localStyle ->
                   return []
             False -> do
               let packageName = unPackageName (pkgName $ elabPkgSourceId package)
+                  unitId = unUnitId (elabUnitId package)
                   packageDir =
                     storePackageDirectory
                       (cabalStoreDirLayout cabalLayout)
@@ -322,12 +328,17 @@ haddockProjectAction flags _extraArgs globalFlags = do
                     -- generated contents page
                     >> return
                       [
-                        ( packageName
+                        ( unitId
                         , interfacePath
                         , Hidden
                         )
                       ]
-                False -> return []
+                False -> do
+                  warn verbosity
+                       ("haddocks of "
+                        ++ show unitId
+                        ++ " not found in the store")
+                  return []
 
     --
     -- generate index, content, etc.
@@ -336,27 +347,14 @@ haddockProjectAction flags _extraArgs globalFlags = do
     let flags' =
           flags
             { haddockProjectDir = Flag outputDir
-            , haddockProjectGenIndex =
-                if localOrHackage
-                  then Flag True
-                  else haddockProjectGenIndex flags
-            , haddockProjectGenContents =
-                if localOrHackage
-                  then Flag True
-                  else haddockProjectGenContents flags
-            , haddockProjectQuickJump =
-                if localOrHackage
-                  then Flag True
-                  else haddockProjectQuickJump flags
-            , haddockProjectLinkedSource = haddockLinkedSource haddockFlags
             , haddockProjectInterfaces =
                 Flag
                   [ ( interfacePath
-                    , Just packageName
-                    , Just packageName
+                    , Just name
+                    , Just name
                     , visibility
                     )
-                  | (packageName, interfacePath, visibility) <- packageInfos
+                  | (name, interfacePath, visibility) <- packageInfos
                   ]
             }
     createHaddockIndex
@@ -372,17 +370,9 @@ haddockProjectAction flags _extraArgs globalFlags = do
     -- transitive dependencies; or depend on `--haddocks-html-location` to
     -- provide location of the documentation of dependencies.
     localStyle =
-      let local = fromFlagOrDefault False (haddockProjectLocal flags)
-          hackage = fromFlagOrDefault False (haddockProjectHackage flags)
+      let hackage = fromFlagOrDefault False (haddockProjectHackage flags)
           location = fromFlagOrDefault False (const True <$> haddockProjectHtmlLocation flags)
-       in local && not hackage && not location
-            -- or if none of the flags is given set `localStyle` to `True`
-            || not local && not hackage && not location
-
-    localOrHackage =
-      any id $
-        flagToList (haddockProjectLocal flags)
-          ++ flagToList (haddockProjectHackage flags)
+       in not hackage && not location
 
     reportTargetProblems :: Show x => [x] -> IO a
     reportTargetProblems =