diff --git a/ChangeLog.md b/ChangeLog.md index 739a0421d2..9eceb2233f 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -33,7 +33,8 @@ Other enhancements: `1.24.0.0`. * Experimental: Add flag `--haddock-for-hackage` to Stack's `build` command (including the `haddock` synonym for `build --haddock`) to enable building - with flags to generate Haddock documentation suitable for upload to Hackage. + with flags to generate Haddock documentation, and an archive file, suitable + for upload to Hackage. Bug fixes: diff --git a/doc/build_command.md b/doc/build_command.md index 227d8c12b5..baf0766f5d 100644 --- a/doc/build_command.md +++ b/doc/build_command.md @@ -243,18 +243,35 @@ Unset the flag to disable building Haddock documentation for dependencies. Default: Disabled Set the flag to build with flags to generate Haddock documentation suitable for -upload to Hackage. +upload to Hackage. This requires Haddock documentation for dependencies to have +been built previously (command `stack haddock`). -For each local package, the generated Haddock documentation files are in -directory `doc\html\-docs\`, relative to Stack's dist work -directory (see [`stack path --dist-dir`](path_command.md)). +For each local package: + +* the generated Haddock documentation files are in directory + `doc\html\-docs\`, relative to Stack's dist work directory + (see [`stack path --dist-dir`](path_command.md)); and +* an archive of the `-docs` directory and its contents is in + Stack's dist work directory. If the flag is set: * the [`--[no-]haddock-hyperlink-source`](#-no-haddock-hyperlink-source-flag) - flag is ignored and `--haddock-hyperlink-source` is implied; and + flag is ignored and `--haddock-hyperlink-source` is implied; +* the [`--[no-]haddock-deps`](#-no-haddock-deps-flag) flag is ignored and + `--no-haddock-deps` is implied; * the [`--[no-]haddock-internal`](#-no-haddock-hyperlink-internal-flag) flag is - ignored and `--no-haddock-internal` is implied. + ignored and `--no-haddock-internal` is implied; +* the [`--[no-]open`](#-no-open-flag) flag is ignored and `--no-open` is + implied; and +* the [`--[no-]force-dirty`](#-no-force-dirty-flag) flag is ignored and + `--force-dirty` is implied. + +!!! info + + Stack does not distinguish the building of Haddock documentation for Hackage + from the building of Haddock documentation generally. If the former has + occurred, use the `--force-dirty` flag. !!! note diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index ac79b89e66..f06297e91d 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -98,8 +98,10 @@ import Stack.Build.Cache , writePackageProjectRoot, writeSetupConfigMod ) import Stack.Build.Haddock - ( generateDepsHaddockIndex, generateLocalHaddockIndex - , generateSnapHaddockIndex, openHaddocksInBrowser + ( generateDepsHaddockIndex + , generateLocalHaddockForHackageArchives + , generateLocalHaddockIndex, generateSnapHaddockIndex + , openHaddocksInBrowser ) import Stack.Build.Installed ( ) import Stack.Build.Source ( addUnlistedToBuildCache ) @@ -853,29 +855,33 @@ executePlan' installedMap0 targets plan ee@ExecuteEnv {..} = do unless (null errs) $ prettyThrowM $ ExecutionFailure errs when (boptsHaddock eeBuildOpts) $ do - snapshotDumpPkgs <- liftIO (readTVarIO eeSnapshotDumpPkgs) - localDumpPkgs <- liftIO (readTVarIO eeLocalDumpPkgs) - generateLocalHaddockIndex eeBaseConfigOpts localDumpPkgs eeLocals - generateDepsHaddockIndex - eeBaseConfigOpts - eeGlobalDumpPkgs - snapshotDumpPkgs - localDumpPkgs - eeLocals - generateSnapHaddockIndex eeBaseConfigOpts eeGlobalDumpPkgs snapshotDumpPkgs - when (boptsOpenHaddocks eeBuildOpts) $ do - let planPkgs, localPkgs, installedPkgs, availablePkgs - :: Map PackageName (PackageIdentifier, InstallLocation) - planPkgs = Map.map (taskProvides &&& taskLocation) (planTasks plan) - localPkgs = - Map.fromList - [ (packageName p, (packageIdentifier p, Local)) - | p <- map lpPackage eeLocals - ] - installedPkgs = - Map.map (swap . second installedPackageIdentifier) installedMap' - availablePkgs = Map.unions [planPkgs, localPkgs, installedPkgs] - openHaddocksInBrowser eeBaseConfigOpts availablePkgs (Map.keysSet targets) + if boptsHaddockForHackage eeBuildOpts + then + generateLocalHaddockForHackageArchives eeLocals + else do + snapshotDumpPkgs <- liftIO (readTVarIO eeSnapshotDumpPkgs) + localDumpPkgs <- liftIO (readTVarIO eeLocalDumpPkgs) + generateLocalHaddockIndex eeBaseConfigOpts localDumpPkgs eeLocals + generateDepsHaddockIndex + eeBaseConfigOpts + eeGlobalDumpPkgs + snapshotDumpPkgs + localDumpPkgs + eeLocals + generateSnapHaddockIndex eeBaseConfigOpts eeGlobalDumpPkgs snapshotDumpPkgs + when (boptsOpenHaddocks eeBuildOpts) $ do + let planPkgs, localPkgs, installedPkgs, availablePkgs + :: Map PackageName (PackageIdentifier, InstallLocation) + planPkgs = Map.map (taskProvides &&& taskLocation) (planTasks plan) + localPkgs = + Map.fromList + [ (packageName p, (packageIdentifier p, Local)) + | p <- map lpPackage eeLocals + ] + installedPkgs = + Map.map (swap . second installedPackageIdentifier) installedMap' + availablePkgs = Map.unions [planPkgs, localPkgs, installedPkgs] + openHaddocksInBrowser eeBaseConfigOpts availablePkgs (Map.keysSet targets) where installedMap' = Map.difference installedMap0 $ Map.fromList diff --git a/src/Stack/Build/Haddock.hs b/src/Stack/Build/Haddock.hs index e40892bcf9..c7dffdcf60 100644 --- a/src/Stack/Build/Haddock.hs +++ b/src/Stack/Build/Haddock.hs @@ -9,15 +9,22 @@ module Stack.Build.Haddock , openHaddocksInBrowser , shouldHaddockDeps , shouldHaddockPackage + , generateLocalHaddockForHackageArchives ) where +import qualified Codec.Archive.Tar as Tar +import qualified Codec.Compression.GZip as GZip import qualified Data.Foldable as F import qualified Data.HashSet as HS import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Text as T import Data.Time ( UTCTime ) -import Path ( (), parent, parseRelDir ) +import Distribution.Text ( display ) +import Path + ( (), addExtension, fromAbsDir, fromAbsFile, fromRelDir + , parent, parseRelDir, parseRelFile + ) import Path.Extra ( parseCollapsedAbsFile, toFilePathNoTrailingSep , tryGetModificationTime @@ -26,10 +33,13 @@ import Path.IO ( copyDirRecur', doesFileExist, ensureDir, ignoringAbsence , removeDirRecur ) +import qualified RIO.ByteString.Lazy as BL import RIO.List ( intercalate ) import RIO.Process ( HasProcessContext, withWorkingDir ) -import Stack.Constants ( docDirSuffix, relDirAll, relFileIndexHtml ) -import Stack.Prelude +import Stack.Constants + ( docDirSuffix, htmlDirSuffix, relDirAll, relFileIndexHtml ) +import Stack.Constants.Config ( distDirFromDir ) +import Stack.Prelude hiding ( Display (..) ) import Stack.Types.Build.Exception ( BuildException (..) ) import Stack.Types.CompilerPaths ( CompilerPaths (..), HasCompiler (..) ) @@ -37,6 +47,7 @@ import Stack.Types.ConfigureOpts ( BaseConfigOpts (..) ) import Stack.Types.BuildOpts ( BuildOpts (..), BuildOptsCLI (..), HaddockOpts (..) ) import Stack.Types.DumpPackage ( DumpPackage (..) ) +import Stack.Types.EnvConfig ( HasEnvConfig (..) ) import Stack.Types.GhcPkgId ( GhcPkgId ) import Stack.Types.Package ( InstallLocation (..), LocalPackage (..), Package (..) ) @@ -320,3 +331,64 @@ localDepsDocDir bco = localDocDir bco relDirAll -- | Path of snapshot packages documentation directory. snapDocDir :: BaseConfigOpts -> Path Abs Dir snapDocDir bco = bcoSnapInstallRoot bco docDirSuffix + +generateLocalHaddockForHackageArchives :: + (HasEnvConfig env, HasTerm env) + => [LocalPackage] + -> RIO env () +generateLocalHaddockForHackageArchives = + mapM_ + ( \lp -> + let pkg = lpPackage lp + pkgId = PackageIdentifier (packageName pkg) (packageVersion pkg) + pkgDir = parent (lpCabalFile lp) + in generateLocalHaddockForHackageArchive pkgDir pkgId + ) + +-- | Generate an archive file containing local Haddock documentation for +-- Hackage, in a form accepted by Hackage. +generateLocalHaddockForHackageArchive :: + (HasEnvConfig env, HasTerm env) + => Path Abs Dir + -- ^ The package directory. + -> PackageIdentifier + -- ^ The package name and version. + -> RIO env () +generateLocalHaddockForHackageArchive pkgDir pkgId = do + distDir <- distDirFromDir pkgDir + let pkgIdName = display pkgId + name = pkgIdName <> "-docs" + (nameRelDir, tarGzFileName) = fromMaybe + (error "impossible") + ( do relDir <- parseRelDir name + nameRelFile <- parseRelFile name + tarGz <- addExtension ".gz" =<< addExtension ".tar" nameRelFile + pure (relDir, tarGz) + ) + 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 + +createTarGzFile + :: Path Abs File + -- ^ Full path to archive file + -> Path Abs Dir + -- ^ Base directory + -> Path Rel Dir + -- ^ Directory to archive, relative to base directory + -> RIO env () +createTarGzFile tar base dir = do + entries <- liftIO $ Tar.pack base' [dir'] + BL.writeFile tar' $ GZip.compress $ Tar.write entries + where + base' = fromAbsDir base + dir' = fromRelDir dir + tar' = fromAbsFile tar diff --git a/src/Stack/Config/Build.hs b/src/Stack/Config/Build.hs index 7876c4ec14..b35d04ade4 100644 --- a/src/Stack/Config/Build.hs +++ b/src/Stack/Config/Build.hs @@ -36,18 +36,23 @@ buildOptsFromMonoid BuildOptsMonoid{..} = BuildOpts FirstTrue (if noStripping then Just False else Nothing)) , boptsHaddock = fromFirstFalse buildMonoidHaddock , boptsHaddockOpts = haddockOptsFromMonoid buildMonoidHaddockOpts - , boptsOpenHaddocks = fromFirstFalse buildMonoidOpenHaddocks - , boptsHaddockDeps = getFirst buildMonoidHaddockDeps - , boptsHaddockInternal = fromFirstFalse buildMonoidHaddockInternal + , boptsOpenHaddocks = + not isHaddockFromHackage && fromFirstFalse buildMonoidOpenHaddocks + , boptsHaddockDeps = if isHaddockFromHackage + then Nothing + else getFirst buildMonoidHaddockDeps + , boptsHaddockInternal = + not isHaddockFromHackage && fromFirstFalse buildMonoidHaddockInternal , boptsHaddockHyperlinkSource = - fromFirstTrue buildMonoidHaddockHyperlinkSource - , boptsHaddockForHackage = fromFirstFalse buildMonoidHaddockForHackage + isHaddockFromHackage || fromFirstTrue buildMonoidHaddockHyperlinkSource + , boptsHaddockForHackage = isHaddockFromHackage , boptsInstallExes = fromFirstFalse buildMonoidInstallExes , boptsInstallCompilerTool = fromFirstFalse buildMonoidInstallCompilerTool , boptsPreFetch = fromFirstFalse buildMonoidPreFetch , boptsKeepGoing = getFirst buildMonoidKeepGoing , boptsKeepTmpFiles = fromFirstFalse buildMonoidKeepTmpFiles - , boptsForceDirty = fromFirstFalse buildMonoidForceDirty + , boptsForceDirty = + isHaddockFromHackage || fromFirstFalse buildMonoidForceDirty , boptsTests = fromFirstFalse buildMonoidTests , boptsTestOpts = testOptsFromMonoid buildMonoidTestOpts additionalArgs @@ -64,6 +69,7 @@ buildOptsFromMonoid BuildOptsMonoid{..} = BuildOpts , boptsDdumpDir = getFirst buildMonoidDdumpDir } where + isHaddockFromHackage = fromFirstFalse buildMonoidHaddockForHackage -- These options are not directly used in bopts, instead they -- transform other options. tracing = getAny buildMonoidTrace diff --git a/src/Stack/Constants.hs b/src/Stack/Constants.hs index 08c5d63504..6b239669c1 100644 --- a/src/Stack/Constants.hs +++ b/src/Stack/Constants.hs @@ -71,6 +71,7 @@ module Stack.Constants , relDirLoadedSnapshotCache , bindirSuffix , docDirSuffix + , htmlDirSuffix , relDirHpc , relDirLib , relDirShare @@ -452,6 +453,10 @@ bindirSuffix = relDirBin docDirSuffix :: Path Rel Dir docDirSuffix = $(mkRelDir "doc") +-- | Suffix applied to a path to get the @html@ directory. +htmlDirSuffix :: Path Rel Dir +htmlDirSuffix = $(mkRelDir "html") + relDirHpc :: Path Rel Dir relDirHpc = $(mkRelDir "hpc")