From 8a51434ba8781c63d54fa78dc1b50df5146c8da1 Mon Sep 17 00:00:00 2001
From: Rodrigo Mesquita <rodrigo.m.mesquita@gmail.com>
Date: Tue, 5 Nov 2024 11:35:00 +0000
Subject: [PATCH] Fix haddock compilation with in-library calls

`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.
---
 Cabal/src/Distribution/Simple/Haddock.hs | 23 ++++++++++++++---------
 1 file changed, 14 insertions(+), 9 deletions(-)

diff --git a/Cabal/src/Distribution/Simple/Haddock.hs b/Cabal/src/Distribution/Simple/Haddock.hs
index d6147186cae..aad0119599b 100644
--- a/Cabal/src/Distribution/Simple/Haddock.hs
+++ b/Cabal/src/Distribution/Simple/Haddock.hs
@@ -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)
 
 -- ------------------------------------------------------------------------------