Skip to content

Commit

Permalink
Fix haddock compilation with in-library calls
Browse files Browse the repository at this point in the history
`reusingGHCCompilationArtifacts` assumed the existence of a build folder
where objects were written (even if empty), but with InLibrary calls
this is no longer necessarily true.

Previously, the build folder ended up always existing because the call
of `configure` through `Setup` created the folder.
However, now that we may call Cabal the library directly, the existence
of this directory is no longer guaranteed.

Easy fix: don't try to copy the build folder if it doesn't exist yet.
  • Loading branch information
alt-romes committed Nov 5, 2024
1 parent 8e4fc80 commit 8a51434
Showing 1 changed file with 14 additions and 9 deletions.
23 changes: 14 additions & 9 deletions Cabal/src/Distribution/Simple/Haddock.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1058,24 +1058,29 @@ reusingGHCCompilationArtifacts
-> ((SymbolicPath Pkg (Path.Dir Artifacts), SymbolicPath Pkg (Path.Dir Artifacts), SymbolicPath Pkg (Path.Dir Artifacts)) -> IO r)
-- ^ Continuation
-> IO r
reusingGHCCompilationArtifacts verbosity tmpFileOpts mbWorkDir lbi bi clbi version act
| version >= mkVersion [2, 28, 0] = do
reusingGHCCompilationArtifacts verbosity tmpFileOpts mbWorkDir lbi bi clbi version act = do
let
vanillaOpts = componentGhcOptions normal lbi bi clbi (buildDir lbi)
i = interpretSymbolicPath mbWorkDir
iopt ghcDir = i $ fromFlag $ ghcDir vanillaOpts
copyDir ghcDir tmpDir = copyDirectoryRecursive verbosity (iopt ghcDir) (i tmpDir)

buildDirsExs <- (&&) <$> doesDirectoryExist (iopt ghcOptObjDir) <*> doesDirectoryExist (iopt ghcOptHiDir)

if version >= mkVersion [2, 28, 0]
&& buildDirsExs
then do
withTempDirectoryCwdEx verbosity tmpFileOpts mbWorkDir (distPrefLBI lbi) "haddock-objs" $ \tmpObjDir ->
withTempDirectoryCwdEx verbosity tmpFileOpts mbWorkDir (distPrefLBI lbi) "haddock-his" $ \tmpHiDir -> do
-- Re-use ghc's interface and obj files, but first copy them to
-- somewhere where it is safe if haddock overwrites them
let
vanillaOpts = componentGhcOptions normal lbi bi clbi (buildDir lbi)
i = interpretSymbolicPath mbWorkDir
copyDir ghcDir tmpDir = copyDirectoryRecursive verbosity (i $ fromFlag $ ghcDir vanillaOpts) (i tmpDir)
copyDir ghcOptObjDir tmpObjDir
copyDir ghcOptHiDir tmpHiDir
-- copyDir ghcOptStubDir tmpStubDir -- (see W.1 in Note [Hi Haddock Recompilation Avoidance])

act (tmpObjDir, tmpHiDir, fromFlag $ ghcOptHiDir vanillaOpts)
| otherwise = do
withTempDirectoryCwdEx verbosity tmpFileOpts mbWorkDir (distPrefLBI lbi) "tmp" $
\tmpFallback -> act (tmpFallback, tmpFallback, tmpFallback)
else withTempDirectoryCwdEx verbosity tmpFileOpts mbWorkDir (distPrefLBI lbi) "tmp" $
\tmpFallback -> act (tmpFallback, tmpFallback, tmpFallback)

-- ------------------------------------------------------------------------------

Expand Down

0 comments on commit 8a51434

Please sign in to comment.