Relocatable build tree

Cabal/src/Distribution/Simple/Build.hs

@@ -573,6 +573,7 @@ buildComponent
                     lib'
                     lbi
                     clbi
+                    Nothing
               debug verbosity $ "Registering inplace:\n" ++ IPI.showInstalledPackageInfo installedPkgInfo
               registerPackage
                 verbosity
@@ -860,7 +861,7 @@ testSuiteLibV09AsLibAndExe
           , testSuites = []
           , subLibraries = [lib]
           }
-      ipi = inplaceInstalledPackageInfo inplaceDir distPref pkg (mkAbiHash "") lib lbi libClbi
+      ipi = inplaceInstalledPackageInfo inplaceDir distPref pkg (mkAbiHash "") lib lbi libClbi Nothing
       testLibDep =
         Dependency
           pkgName'

Cabal/src/Distribution/Simple/Haddock.hs

@@ -437,6 +437,7 @@ haddock_setupHooks
                   lib
                   lbi'
                   clbi
+                  Nothing
 
             debug verbosity $
               "Registering inplace:\n"

Cabal/src/Distribution/Simple/Register.hs

@@ -277,10 +277,20 @@ generateRegistrationInfo verbosity pkg lib lbi clbi inplace reloc distPref packa
   inplaceDir <- absoluteWorkingDirLBI lbi
   installedPkgInfo <-
     if inplace
-      then -- NB: With an inplace installation, the user may run './Setup
-      -- build' to update the library files, without reregistering.
-      -- In this case, it is critical that the ABI hash not flip.
-
+      then do
+        -- NB: With an inplace installation, the user may run './Setup
+        -- build' to update the library files, without reregistering.
+        -- In this case, it is critical that the ABI hash not flip.
+
+        -- When a relocatable build is requested, emit ${pkgroot}-relative
+        -- paths (relative to the directory containing the package db) so that
+        -- the dist tree can be copied/relocated without invalidating the
+        -- registration. Only GHC understands the ${pkgroot} substitution, so
+        -- for other compilers we fall back to absolute paths.
+        maybePkgRoot <-
+          if reloc && compilerFlavor (compiler lbi) == GHC
+            then Just <$> GHC.pkgRoot verbosity lbi packageDb
+            else return Nothing
         return
           ( inplaceInstalledPackageInfo
               inplaceDir
@@ -290,6 +300,7 @@ generateRegistrationInfo verbosity pkg lib lbi clbi inplace reloc distPref packa
               lib
               lbi
               clbi
+              maybePkgRoot
           )
       else do
         abi_hash <- abiHash verbosity pkg distPref lbi lib clbi
@@ -621,8 +632,13 @@ inplaceInstalledPackageInfo
   -> Library
   -> LocalBuildInfo
   -> ComponentLocalBuildInfo
+  -> Maybe (SymbolicPath CWD (Dir Pkg))
+  -- ^ If @Just pkgroot@, emit paths relative to @pkgroot@ using the
+  -- @${pkgroot}@ substitution variable (for relocatable inplace builds).
+  -- @pkgroot@ is the directory containing the package database (see
+  -- 'Distribution.Simple.GHC.pkgRoot'). If @Nothing@, emit absolute paths.
   -> InstalledPackageInfo
-inplaceInstalledPackageInfo inplaceDir distPref pkg abi_hash lib lbi clbi =
+inplaceInstalledPackageInfo inplaceDir distPref pkg abi_hash lib lbi clbi mb_pkgroot =
   generalInstalledPackageInfo
     adjustRelativeIncludeDirs
     pkg
@@ -633,25 +649,32 @@ inplaceInstalledPackageInfo inplaceDir distPref pkg abi_hash lib lbi clbi =
     installDirs
   where
     i = interpretSymbolicPathAbsolute inplaceDir -- See Note [Symbolic paths] in Distribution.Utils.Path
+    -- Make an absolute path relative to ${pkgroot} when a relocatable build
+    -- was requested; otherwise leave it absolute.
+    relocate :: FilePath -> FilePath
+    relocate = case mb_pkgroot of
+      Nothing -> id
+      Just pkgroot -> ("${pkgroot}" </>) . shortRelativePath (getSymbolicPath pkgroot)
     adjustRelativeIncludeDirs = concatMap $ \d ->
-      [ i $ makeRelativePathEx d -- local include-dir
-      , i $ libTargetDir </> makeRelativePathEx d -- autogen include-dir
+      [ relocate $ i $ makeRelativePathEx d -- local include-dir
+      , relocate $ i $ libTargetDir </> makeRelativePathEx d -- autogen include-dir
       ]
     libTargetDir = componentBuildDir lbi clbi
     installDirs =
-      (absoluteComponentInstallDirs pkg lbi (componentUnitId clbi) NoCopyDest)
-        { libdir = i libTargetDir
-        , dynlibdir = i libTargetDir
-        , bytecodelibdir = i libTargetDir
-        , datadir =
-            let rawDataDir = dataDir pkg
-             in if null $ getSymbolicPath rawDataDir
-                  then i sameDirectory
-                  else i rawDataDir
-        , docdir = i inplaceDocdir
-        , htmldir = inplaceHtmldir
-        , haddockdir = inplaceHtmldir
-        }
+      fmap relocate $
+        (absoluteComponentInstallDirs pkg lbi (componentUnitId clbi) NoCopyDest)
+          { libdir = i libTargetDir
+          , dynlibdir = i libTargetDir
+          , bytecodelibdir = i libTargetDir
+          , datadir =
+              let rawDataDir = dataDir pkg
+               in if null $ getSymbolicPath rawDataDir
+                    then i sameDirectory
+                    else i rawDataDir
+          , docdir = i inplaceDocdir
+          , htmldir = inplaceHtmldir
+          , haddockdir = inplaceHtmldir
+          }
     inplaceDocdir = distPref </> makeRelativePathEx "doc"
     inplaceHtmldir =
       i $

cabal-install/src/Distribution/Client/ProjectBuilding/PackageFileMonitor.hs

@@ -20,13 +20,18 @@ import Distribution.Client.Types hiding
   )
 
 import Distribution.InstalledPackageInfo (InstalledPackageInfo)
+import Distribution.Simple.Compiler (PackageDBX (..))
 import Distribution.Simple.LocalBuildInfo
   ( ComponentName (..)
   )
-import Distribution.Simple.Utils (removeFileForcibly)
+import Distribution.Simple.Utils (removeFileForcibly, shortRelativePath)
+import qualified Distribution.Types.LocalBuildConfig as LBC
 
+import qualified Data.Map as Map
 import qualified Data.Set as Set
 
+import System.FilePath (isAbsolute, normalise)
+
 -----------------------------
 -- Package change detection
 --
@@ -60,13 +65,17 @@ newPackageFileMonitor
   -> PackageFileMonitor
 newPackageFileMonitor
   shared
-  DistDirLayout{distPackageCacheFile}
+  DistDirLayout{distPackageCacheFile, distDirectory}
   dparams =
     PackageFileMonitor
       { pkgFileMonitorConfig =
           FileMonitor
             { fileMonitorCacheFile = distPackageCacheFile dparams "config"
-            , fileMonitorKeyValid = (==) `on` normaliseConfiguredPackage shared
+            , -- #12137: The config monitor key is compared after relativising
+              -- project-local paths, so that relocating the whole tree
+              -- does not spuriously invalidate it.
+              fileMonitorKeyValid =
+                (==) `on` (relativiseElabConfigPaths distDirectory . normaliseConfiguredPackage shared)
             , fileMonitorCheckIfOnlyValueChanged = False
             }
       , pkgFileMonitorBuild =
@@ -80,6 +89,47 @@ newPackageFileMonitor
           newFileMonitor (distPackageCacheFile dparams "registration")
       }
 
+-- | Rewrite the absolute paths in an 'ElaboratedConfiguredPackage' that live
+-- under the build tree root so that they become relative to it. This makes the
+-- package-configuration file monitor /key/ location-independent.
+relativiseElabConfigPaths :: FilePath -> ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage
+relativiseElabConfigPaths buildDir elab =
+  elab
+    { elabPkgSourceLocation = relLocation (elabPkgSourceLocation elab)
+    , elabPackageDbs = map (fmap relDB) (elabPackageDbs elab)
+    , elabSetupPackageDBStack = map relDB (elabSetupPackageDBStack elab)
+    , elabBuildPackageDBStack = map relDB (elabBuildPackageDBStack elab)
+    , elabRegisterPackageDBStack = map relDB (elabRegisterPackageDBStack elab)
+    , elabInplaceSetupPackageDBStack = map relDB (elabInplaceSetupPackageDBStack elab)
+    , elabInplaceBuildPackageDBStack = map relDB (elabInplaceBuildPackageDBStack elab)
+    , elabInplaceRegisterPackageDBStack = map relDB (elabInplaceRegisterPackageDBStack elab)
+    , elabInstallDirs = fmap rel (elabInstallDirs elab)
+    , elabExtraLibDirs = map rel (elabExtraLibDirs elab)
+    , elabExtraLibDirsStatic = map rel (elabExtraLibDirsStatic elab)
+    , elabExtraFrameworkDirs = map rel (elabExtraFrameworkDirs elab)
+    , elabExtraIncludeDirs = map rel (elabExtraIncludeDirs elab)
+    , elabProgramPaths = Map.map rel (elabProgramPaths elab)
+    , elabProgramPathExtra = map rel (elabProgramPathExtra elab)
+    , elabHaddockCss = fmap rel (elabHaddockCss elab)
+    , elabHaddockHscolourCss = fmap rel (elabHaddockHscolourCss elab)
+    , elabHaddockOutputDir = fmap rel (elabHaddockOutputDir elab)
+    , elabTestWrapper = fmap rel (elabTestWrapper elab)
+    }
+  where
+    rel :: FilePath -> FilePath
+    rel p
+      | isAbsolute p = shortRelativePath (normalise buildDir) (normalise p)
+      | otherwise = p
+
+    relDB :: PackageDBX FilePath -> PackageDBX FilePath
+    relDB (SpecificPackageDB fp) = SpecificPackageDB (rel fp)
+    relDB db = db
+
+    relLocation :: PackageLocation (Maybe FilePath) -> PackageLocation (Maybe FilePath)
+    relLocation (LocalUnpackedPackage fp) = LocalUnpackedPackage (rel fp)
+    relLocation (LocalTarballPackage fp) = LocalTarballPackage (rel fp)
+    relLocation loc = loc
+
 -- | Helper function for 'checkPackageFileMonitorChanged',
 -- 'updatePackageConfigFileMonitor' and 'updatePackageBuildFileMonitor'.
 --
@@ -119,6 +169,7 @@ packageFileMonitorKeyValues elab =
         , elabTestKeepTix = False
         , elabTestTestOptions = []
         , elabBenchmarkOptions = []
+        , elabBuildOptions = (elabBuildOptions elab){LBC.relocatable = False}
         }
 
     -- The second part is the value used to guard the build step. So this is
@@ -209,11 +260,14 @@ checkPackageFileMonitorChanged
       changedToMaybe (MonitorUnchanged x _) = Just x
 
 updatePackageConfigFileMonitor
-  :: PackageFileMonitor
+  :: FilePath
+  -- ^ The build directory
+  -> PackageFileMonitor
   -> FilePath
   -> ElaboratedConfiguredPackage
   -> IO ()
 updatePackageConfigFileMonitor
+  buildDir
   PackageFileMonitor{pkgFileMonitorConfig}
   srcdir
   pkg =
@@ -222,7 +276,7 @@ updatePackageConfigFileMonitor
       srcdir
       Nothing
       []
-      pkgconfig
+      (relativiseElabConfigPaths buildDir pkgconfig)
       ()
     where
       (pkgconfig, _buildComponents) = packageFileMonitorKeyValues pkg

cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs

@@ -576,7 +576,11 @@ buildInplaceUnpackedPackage
           whenReconfigure $ do
             mbLBI <- runConfigure
             invalidatePackageRegFileMonitor packageFileMonitor
-            updatePackageConfigFileMonitor packageFileMonitor (getSymbolicPath srcdir) pkg
+            updatePackageConfigFileMonitor
+              distDirectory
+              packageFileMonitor
+              (getSymbolicPath srcdir)
+              pkg
             return mbLBI
         PBBuildPhase{runBuild} ->
           whenRebuild $ withFileMonitor runBuild

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

@@ -85,23 +85,29 @@ import Distribution.Simple.Program.GHC (packageDbArgsDb)
 --
 -- This is for the benefit of debugging and external tools like editors.
 writePlanExternalRepresentation
-  :: DistDirLayout
+  :: Relocatable
+  -- ^ When 'Relocatable', emit project-local filesystem paths (@dist-dir@,
+  -- @build-info@, inplace @bin-file@, local @pkg-src@ @path@) relative to the
+  -- project root instead of as absolute paths, so that the whole tree
+  -- (sources + dist-dir) can be relocated without invalidating @plan.json@.
+  -> DistDirLayout
   -> ElaboratedInstallPlan
   -> ElaboratedSharedConfig
   -> IO ()
 writePlanExternalRepresentation
+  relocatable
   distDirLayout
   elaboratedInstallPlan
   elaboratedSharedConfig =
     writeFileAtomic (distProjectCacheFile distDirLayout "plan.json")
       $ BB.toLazyByteString
         . J.encodeToBuilder
-      $ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig
+      $ encodePlanAsJson relocatable distDirLayout elaboratedInstallPlan elaboratedSharedConfig
 
 -- | Renders a subset of the elaborated install plan in a semi-stable JSON
 -- format.
-encodePlanAsJson :: DistDirLayout -> ElaboratedInstallPlan -> ElaboratedSharedConfig -> J.Value
-encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig =
+encodePlanAsJson :: Relocatable -> DistDirLayout -> ElaboratedInstallPlan -> ElaboratedSharedConfig -> J.Value
+encodePlanAsJson relocatable distDirLayout elaboratedInstallPlan elaboratedSharedConfig =
   -- TODO: [nice to have] include all of the sharedPackageConfig and all of
   --      the parts of the elaboratedInstallPlan
   J.object
@@ -116,9 +122,19 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig =
     , "install-plan" J..= installPlanToJ elaboratedInstallPlan
     ]
   where
+    relative :: Bool
+    relative = relocatable == Relocatable
+
     plat :: Platform
     plat@(Platform arch os) = pkgConfigPlatform elaboratedSharedConfig
 
+    -- For relocatable plans, express project-local paths relative to the build
+    -- directory (where plan.json itself lives), so the whole tree can be moved.
+    mkPath :: FilePath -> FilePath
+    mkPath p
+      | relative, isAbsolute p = shortRelativePath (normalise (distDirectory distDirLayout)) (normalise p)
+      | otherwise = p
+
     installPlanToJ :: ElaboratedInstallPlan -> [J.Value]
     installPlanToJ = map planPackageToJ . InstallPlan.toList
 
@@ -181,7 +197,7 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig =
              ]
           ++ ( case elabBuildStyle elab of
                 BuildInplaceOnly{} ->
-                  ["dist-dir" J..= J.String dist_dir] ++ [buildInfoFileLocation]
+                  ["dist-dir" J..= J.String (mkPath dist_dir)] ++ [buildInfoFileLocation]
                 BuildAndInstall ->
                   -- TODO: install dirs?
                   []
@@ -223,20 +239,20 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig =
           | elabSetupScriptCliVersion elab < mkVersion [3, 7, 0, 0] =
               "build-info" J..= J.Null
           | otherwise =
-              "build-info" J..= J.String (getSymbolicPath $ buildInfoPref $ makeSymbolicPath dist_dir)
+              "build-info" J..= J.String (mkPath $ getSymbolicPath $ buildInfoPref $ makeSymbolicPath dist_dir)
 
         packageLocationToJ :: PackageLocation (Maybe FilePath) -> J.Value
         packageLocationToJ pkgloc =
           case pkgloc of
             LocalUnpackedPackage local ->
               J.object
                 [ "type" J..= J.String "local"
-                , "path" J..= J.String local
+                , "path" J..= J.String (mkPath local)
                 ]
             LocalTarballPackage local ->
               J.object
                 [ "type" J..= J.String "local-tar"
-                , "path" J..= J.String local
+                , "path" J..= J.String (mkPath local)
                 ]
             RemoteTarballPackage uri _ ->
               J.object
@@ -310,7 +326,7 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig =
           where
             bin =
               if isInplaceBuildStyle (elabBuildStyle elab)
-                then dist_dir </> "build" </> prettyShow s </> prettyShow s <.> exeExtension plat
+                then mkPath $ dist_dir </> "build" </> prettyShow s </> prettyShow s <.> exeExtension plat
                 else InstallDirs.bindir (elabInstallDirs elab) </> prettyShow s <.> exeExtension plat
 
         flib_file' :: Pretty a => a -> [J.Pair]
@@ -319,7 +335,7 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig =
           where
             bin =
               if isInplaceBuildStyle (elabBuildStyle elab)
-                then dist_dir </> "build" </> prettyShow s </> ("lib" ++ prettyShow s) <.> dllExtension plat
+                then mkPath $ dist_dir </> "build" </> prettyShow s </> ("lib" ++ prettyShow s) <.> dllExtension plat
                 else InstallDirs.bindir (elabInstallDirs elab) </> ("lib" ++ prettyShow s) <.> dllExtension plat
 
     comp2str :: ComponentDeps.Component -> String

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

@@ -981,7 +981,16 @@ rebuildInstallPlan
         -> Rebuild ()
       phaseMaintainPlanOutputs elaboratedPlan elaboratedShared = liftIO $ do
         debug verbosity "Updating plan.json"
+        -- #12137: Emit project-relative paths in plan.json for relocatable builds
+        let isReloc pp = case pp of
+              InstallPlan.Configured elab -> LBC.relocatable (elabBuildOptions elab)
+              InstallPlan.Installed elab -> LBC.relocatable (elabBuildOptions elab)
+              InstallPlan.PreExisting _ -> False
+            relocatable
+              | any isReloc (InstallPlan.toList elaboratedPlan) = Relocatable
+              | otherwise = NotRelocatable
         writePlanExternalRepresentation
+          relocatable
           distDirLayout
           elaboratedPlan
           elaboratedShared