Merge pull request #6522 from commercialhaskell/fix6520

Fix #6520 Avoid archiving Haddock for Hackage when inappropriate

ChangeLog.md

@@ -23,6 +23,9 @@ Behaviour changes:
   `latest-snapshot: https://stackage-haddock.haskell.org/snapshots.json`.
 * Remove hidden flag `--skip-intermediate-deps`, effectively deprecated since
   Stack 1.3.0, from `ghci` and `repl` commands.
+* The `haddock --haddock-for-hackage` command only seeks to create an archive of
+  the `<package_version>-docs` directory for build targets and if flags
+  excluding the building of project packages are not set.
 
 Other enhancements:
 

doc/build_command.md

@@ -315,13 +315,17 @@ Set the flag to build project packages with flags to generate Haddock
 documentation suitable for upload to Hackage. The form of the Haddock
 documentation generated for other packages is unaffected.
 
-For each project package:
-
-* the generated Haddock documentation files are in directory
-  `doc\html\<package_version>-docs\`, relative to Stack's dist work directory
-  (see [`stack path --dist-dir`](path_command.md)); and
-* an archive of the `<package_version>-docs` directory and its contents is in
-  Stack's dist work directory.
+For each project package, the generated Haddock documentation files are in
+directory `doc\html\<package_version>-docs\`, relative to Stack's dist work
+directory (see [`stack path --dist-dir`](path_command.md)).
+
+Unless flags are set to exclude the building of project packages, for each
+targetted project package with generated documentation, an archive of the
+`<package_version>-docs` directory and its contents is in Stack's dist work
+directory. (The flags that exclude project packages are
+[`--only-dependencies`](#-only-dependencies-flag),
+[`--dependencies-only`](#-dependencies-only-flag), or
+[`--only-snapshot`](#-only-snapshot-flag).)
 
 If the flag is set:
 

src/Stack/Build/Haddock.hs

@@ -47,9 +47,9 @@ import           Stack.Types.CompilerPaths
                    ( CompilerPaths (..), HasCompiler (..) )
 import           Stack.Types.ConfigureOpts ( BaseConfigOpts (..) )
 import           Stack.Types.BuildOpts ( BuildOpts (..), HaddockOpts (..) )
-import           Stack.Types.BuildOptsCLI ( BuildOptsCLI (..) )
+import           Stack.Types.BuildOptsCLI ( BuildOptsCLI (..), BuildSubset (BSOnlyDependencies, BSOnlySnapshot) )
 import           Stack.Types.DumpPackage ( DumpPackage (..) )
-import           Stack.Types.EnvConfig ( HasEnvConfig (..) )
+import           Stack.Types.EnvConfig ( EnvConfig (..), HasEnvConfig (..) )
 import           Stack.Types.GhcPkgId ( GhcPkgId )
 import           Stack.Types.InterfaceOpt ( InterfaceOpt (..) )
 import           Stack.Types.Package
@@ -397,14 +397,17 @@ generateLocalHaddockForHackageArchives ::
      (HasEnvConfig env, HasTerm env)
   => [LocalPackage]
   -> RIO env ()
-generateLocalHaddockForHackageArchives =
-  mapM_
-    ( \lp ->
-        let pkg = lp.package
-            pkgId = PackageIdentifier pkg.name pkg.version
-            pkgDir = parent lp.cabalFP
-        in generateLocalHaddockForHackageArchive pkgDir pkgId
-    )
+generateLocalHaddockForHackageArchives lps = do
+  buildSubset <- view $ envConfigL . to (.buildOptsCLI.buildSubset)
+  let localsExcluded =
+        buildSubset == BSOnlyDependencies || buildSubset == BSOnlySnapshot
+  unless localsExcluded $
+    forM_ lps $ \lp ->
+      let pkg = lp.package
+          pkgId = PackageIdentifier pkg.name pkg.version
+          pkgDir = parent lp.cabalFP
+      in  when lp.wanted $
+            generateLocalHaddockForHackageArchive pkgDir pkgId
 
 -- | Generate an archive file containing local Haddock documentation for
 -- Hackage, in a form accepted by Hackage.
@@ -428,15 +431,22 @@ generateLocalHaddockForHackageArchive pkgDir pkgId = do
         )
       tarGzFile = distDir </> tarGzFileName
       docDir = distDir </> docDirSuffix </> htmlDirSuffix
-  createTarGzFile tarGzFile docDir nameRelDir
-  prettyInfo $
-       fillSep
-         [ flow "Archive of Haddock documentation for Hackage for"
-         , style Current (fromString pkgIdName)
-         , flow "created at:"
-         ]
-    <> line
-    <> pretty tarGzFile
+  tarGzFileCreated <- createTarGzFile tarGzFile docDir nameRelDir
+  if tarGzFileCreated
+    then
+      prettyInfo $
+           fillSep
+             [ flow "Archive of Haddock documentation for Hackage for"
+             , style Current (fromString pkgIdName)
+             , flow "created at:"
+             ]
+        <> line
+        <> pretty tarGzFile
+    else
+      prettyWarnL
+        [ flow "No Haddock documentation for Hackage available for"
+        , style Error (fromString pkgIdName) <> "."
+        ]
 
 createTarGzFile ::
      Path Abs File
@@ -445,10 +455,19 @@ createTarGzFile ::
      -- ^ Base directory
   -> Path Rel Dir
      -- ^ Directory to archive, relative to base directory
-  -> RIO env ()
+  -> RIO env Bool
 createTarGzFile tar base dir = do
-   entries <- liftIO $ Tar.pack base' [dir']
-   BL.writeFile tar' $ GZip.compress $ Tar.write entries
+  dirExists <- doesDirExist $ base </> dir
+  if dirExists
+    then do
+      entries <- liftIO $ Tar.pack base' [dir']
+      if null entries
+        then pure False
+        else do
+          ensureDir $ parent tar
+          BL.writeFile tar' $ GZip.compress $ Tar.write entries
+          pure True
+    else pure False
  where
   base' = fromAbsDir base
   dir' = fromRelDir dir