Per-component cabal_macros.h (haskell#1893) and install paths

This commit is a number of refactorings that I needed to do
while fixing bugs with internal libraries support.

- With internal libraries, it becomes especially clear that
  cabal_macros.h and Paths_foo.hs need to be done per-component.
  It is done!

  This change breaks BC in an important way: the preprocessor
  interface now takes a ComponentLocalBuildInfo along with the
  BuildInfo and LocalBuildInfo.  This means that if you implemented
  a custom preprocessor, or called 'preprocessComponent' in a custom
  Setup, you will have to make sure you pass the right
  ComponentLocalBuildInfo.  Some sub-notes:

    - While I was mucking about cabal_macros.h, I updated it to have
      two new macros: CURRENT_COMPONENT_ID (an alias for
      CURRENT_PACKAGE_KEY, but using modern terminology) and
      LOCAL_COMPONENT_ID (which refers to the public library; we use
      this in Cabal's test suite but it's unclear what the general
      utility of this is.  See the TODO.)

    - checkForeignDeps has a hack where we hardcode the
      cabal_macros.h of the main library.  If we did the foreign dep
      check for every component individually that would be better,
      but I didn't want to roll it into this patch.

- The other piece I needed for internal libraries was per-component
  install directories; otherwise, internal libraries clobber each
  other.  absoluteInstallDirs now takes a ComponentId, which is used
  to determine what '$libname' expands to.  Generally, InstallPaths
  must be computed per component, c.f. haskell#2836.  We're not TRULY
  per-component install paths, since some files are installed for
  the "per-package" InstallPaths (the one we computed for the
  library as a whole), but for libraries we have to compute
  InstallPaths for each one.

    - While doing this, ComponentLocalBuildInfo grew a new
      'componentId' field for non-library things.  This lets us
      treat InstallPaths expansion uniformly.

Signed-off-by: Edward Z. Yang <[email protected]>

Author: ezyang

Cabal/Distribution/Simple/Build.hs

@@ -87,22 +87,22 @@ build pkg_descr lbi flags suffixes = do
   info verbosity $ "Component build order: "
                 ++ intercalate ", " (map showComponentName componentsToBuild)
 
-  initialBuildSteps distPref pkg_descr lbi verbosity
   when (null targets) $
     -- Only bother with this message if we're building the whole package
     setupMessage verbosity "Building" (packageId pkg_descr)
 
   internalPackageDB <- createInternalPackageDB verbosity lbi distPref
 
-  withComponentsInBuildOrder pkg_descr lbi componentsToBuild $ \comp clbi ->
+  withComponentsInBuildOrder pkg_descr lbi componentsToBuild $ \comp clbi -> do
+    initialBuildSteps distPref pkg_descr lbi clbi verbosity
     let bi     = componentBuildInfo comp
         progs' = addInternalBuildTools pkg_descr lbi bi (withPrograms lbi)
         lbi'   = lbi {
                    withPrograms  = progs',
                    withPackageDB = withPackageDB lbi ++ [internalPackageDB]
                  }
-    in buildComponent verbosity (buildNumJobs flags) pkg_descr
-                      lbi' suffixes comp clbi distPref
+    buildComponent verbosity (buildNumJobs flags) pkg_descr
+                   lbi' suffixes comp clbi distPref
 
 
 repl     :: PackageDescription  -- ^ Mostly information from the .cabal file
@@ -127,8 +127,6 @@ repl pkg_descr lbi flags suffixes args = do
                  ++ intercalate ", "
                       [ showComponentName c | (c,_) <- componentsToBuild ]
 
-  initialBuildSteps distPref pkg_descr lbi verbosity
-
   internalPackageDB <- createInternalPackageDB verbosity lbi distPref
 
   let lbiForComponent comp lbi' =
@@ -140,17 +138,19 @@ repl pkg_descr lbi flags suffixes args = do
 
   -- build any dependent components
   sequence_
-    [ let comp = getComponent pkg_descr cname
-          lbi' = lbiForComponent comp lbi
-       in buildComponent verbosity NoFlag
-                         pkg_descr lbi' suffixes comp clbi distPref
+    [ do let comp = getComponent pkg_descr cname
+             lbi' = lbiForComponent comp lbi
+         initialBuildSteps distPref pkg_descr lbi clbi verbosity
+         buildComponent verbosity NoFlag
+                        pkg_descr lbi' suffixes comp clbi distPref
     | (cname, clbi) <- init componentsToBuild ]
 
   -- REPL for target components
   let (cname, clbi) = componentForRepl
       comp = getComponent pkg_descr cname
       lbi' = lbiForComponent comp lbi
-   in replComponent verbosity pkg_descr lbi' suffixes comp clbi distPref
+  initialBuildSteps distPref pkg_descr lbi clbi verbosity
+  replComponent verbosity pkg_descr lbi' suffixes comp clbi distPref
 
 
 -- | Start an interpreter without loading any package files.
@@ -173,7 +173,7 @@ buildComponent :: Verbosity
                -> IO ()
 buildComponent verbosity numJobs pkg_descr lbi suffixes
                comp@(CLib lib) clbi distPref = do
-    preprocessComponent pkg_descr comp lbi False verbosity suffixes
+    preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
     extras <- preprocessExtras comp lbi
     info verbosity $ "Building library " ++ libName lib ++ "..."
     let libbi = libBuildInfo lib
@@ -192,7 +192,7 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
 
 buildComponent verbosity numJobs pkg_descr lbi suffixes
                comp@(CExe exe) clbi _ = do
-    preprocessComponent pkg_descr comp lbi False verbosity suffixes
+    preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
     extras <- preprocessExtras comp lbi
     info verbosity $ "Building executable " ++ exeName exe ++ "..."
     let ebi = buildInfo exe
@@ -204,7 +204,7 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
                comp@(CTest test@TestSuite { testInterface = TestSuiteExeV10{} })
                clbi _distPref = do
     let exe = testSuiteExeV10AsExe test
-    preprocessComponent pkg_descr comp lbi False verbosity suffixes
+    preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
     extras <- preprocessExtras comp lbi
     info verbosity $ "Building test suite " ++ testName test ++ "..."
     let ebi = buildInfo exe
@@ -224,7 +224,7 @@ buildComponent verbosity numJobs pkg_descr lbi0 suffixes
     pwd <- getCurrentDirectory
     let (pkg, lib, libClbi, lbi, ipi, exe, exeClbi) =
           testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd
-    preprocessComponent pkg_descr comp lbi False verbosity suffixes
+    preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
     extras <- preprocessExtras comp lbi
     info verbosity $ "Building test suite " ++ testName test ++ "..."
     buildLib verbosity numJobs pkg lbi lib libClbi
@@ -248,7 +248,7 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
                comp@(CBench bm@Benchmark { benchmarkInterface = BenchmarkExeV10 {} })
                clbi _ = do
     let (exe, exeClbi) = benchmarkExeV10asExe bm clbi
-    preprocessComponent pkg_descr comp lbi False verbosity suffixes
+    preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
     extras <- preprocessExtras comp lbi
     info verbosity $ "Building benchmark " ++ benchmarkName bm ++ "..."
     let ebi = buildInfo exe
@@ -281,15 +281,15 @@ replComponent :: Verbosity
               -> IO ()
 replComponent verbosity pkg_descr lbi suffixes
                comp@(CLib lib) clbi _ = do
-    preprocessComponent pkg_descr comp lbi False verbosity suffixes
+    preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
     extras <- preprocessExtras comp lbi
     let libbi = libBuildInfo lib
         lib' = lib { libBuildInfo = libbi { cSources = cSources libbi ++ extras } }
     replLib verbosity pkg_descr lbi lib' clbi
 
 replComponent verbosity pkg_descr lbi suffixes
                comp@(CExe exe) clbi _ = do
-    preprocessComponent pkg_descr comp lbi False verbosity suffixes
+    preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
     extras <- preprocessExtras comp lbi
     let ebi = buildInfo exe
         exe' = exe { buildInfo = ebi { cSources = cSources ebi ++ extras } }
@@ -300,7 +300,7 @@ replComponent verbosity pkg_descr lbi suffixes
                comp@(CTest test@TestSuite { testInterface = TestSuiteExeV10{} })
                clbi _distPref = do
     let exe = testSuiteExeV10AsExe test
-    preprocessComponent pkg_descr comp lbi False verbosity suffixes
+    preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
     extras <- preprocessExtras comp lbi
     let ebi = buildInfo exe
         exe' = exe { buildInfo = ebi { cSources = cSources ebi ++ extras } }
@@ -314,7 +314,7 @@ replComponent verbosity pkg_descr lbi0 suffixes
     pwd <- getCurrentDirectory
     let (pkg, lib, libClbi, lbi, _, _, _) =
           testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd
-    preprocessComponent pkg_descr comp lbi False verbosity suffixes
+    preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
     extras <- preprocessExtras comp lbi
     let libbi = libBuildInfo lib
         lib' = lib { libBuildInfo = libbi { cSources = cSources libbi ++ extras } }
@@ -331,7 +331,7 @@ replComponent verbosity pkg_descr lbi suffixes
                comp@(CBench bm@Benchmark { benchmarkInterface = BenchmarkExeV10 {} })
                clbi _ = do
     let (exe, exeClbi) = benchmarkExeV10asExe bm clbi
-    preprocessComponent pkg_descr comp lbi False verbosity suffixes
+    preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
     extras <- preprocessExtras comp lbi
     let ebi = buildInfo exe
         exe' = exe { buildInfo = ebi { cSources = cSources ebi ++ extras } }
@@ -384,21 +384,13 @@ testSuiteLibV09AsLibAndExe pkg_descr
             libExposed     = True,
             libBuildInfo   = bi
           }
-    -- NB: temporary hack; I have a refactor which solves this
-    cid = computeComponentId NoFlag
-                             (package pkg_descr)
-                             (CTestName (testName test))
-                             (map ((\(SimpleUnitId cid0) -> cid0) . fst)
-                                  (componentPackageDeps clbi))
-                             (flagAssignment lbi)
-    uid = SimpleUnitId cid
     (compat_name, compat_key) = computeCompatPackageKey
                                 (compiler lbi) (package pkg_descr)
-                                (CTestName (testName test)) uid
+                                (CTestName (testName test)) (componentUnitId clbi)
     libClbi = LibComponentLocalBuildInfo
                 { componentPackageDeps = componentPackageDeps clbi
                 , componentPackageRenaming = componentPackageRenaming clbi
-                , componentUnitId = uid
+                , componentUnitId = componentUnitId clbi
                 , componentCompatPackageName = compat_name
                 , componentCompatPackageKey = compat_key
                 , componentExposedModules = [IPI.ExposedModule m Nothing]
@@ -427,6 +419,9 @@ testSuiteLibV09AsLibAndExe pkg_descr
     -- | The stub executable needs a new 'ComponentLocalBuildInfo'
     -- that exposes the relevant test suite library.
     exeClbi = ExeComponentLocalBuildInfo {
+                -- TODO: this is a hack, but as long as this is unique
+                -- (doesn't clobber something) we won't run into trouble
+                componentUnitId = mkUnitId (stubName test),
                 componentPackageDeps =
                     (IPI.installedUnitId ipi, packageId ipi)
                   : (filter (\(_, x) -> let PackageName name = pkgName x
@@ -450,6 +445,7 @@ benchmarkExeV10asExe bm@Benchmark { benchmarkInterface = BenchmarkExeV10 _ f }
             buildInfo  = benchmarkBuildInfo bm
           }
     exeClbi = ExeComponentLocalBuildInfo {
+                componentUnitId = componentUnitId clbi,
                 componentPackageDeps = componentPackageDeps clbi,
                 componentPackageRenaming = componentPackageRenaming clbi
               }
@@ -534,9 +530,10 @@ replExe verbosity pkg_descr lbi exe clbi =
 initialBuildSteps :: FilePath -- ^"dist" prefix
                   -> PackageDescription  -- ^mostly information from the .cabal file
                   -> LocalBuildInfo -- ^Configuration information
+                  -> ComponentLocalBuildInfo
                   -> Verbosity -- ^The verbosity to use
                   -> IO ()
-initialBuildSteps _distPref pkg_descr lbi verbosity = do
+initialBuildSteps _distPref pkg_descr lbi clbi verbosity = do
   -- check that there's something to build
   unless (not . null $ allBuildInfo pkg_descr) $ do
     let name = display (packageId pkg_descr)
@@ -545,23 +542,24 @@ initialBuildSteps _distPref pkg_descr lbi verbosity = do
 
   createDirectoryIfMissingVerbose verbosity True (buildDir lbi)
 
-  writeAutogenFiles verbosity pkg_descr lbi
+  writeAutogenFiles verbosity pkg_descr lbi clbi
 
 -- | Generate and write out the Paths_<pkg>.hs and cabal_macros.h files
 --
 writeAutogenFiles :: Verbosity
                   -> PackageDescription
                   -> LocalBuildInfo
+                  -> ComponentLocalBuildInfo
                   -> IO ()
-writeAutogenFiles verbosity pkg lbi = do
-  createDirectoryIfMissingVerbose verbosity True (autogenModulesDir lbi)
+writeAutogenFiles verbosity pkg lbi clbi = do
+  createDirectoryIfMissingVerbose verbosity True (autogenModulesDir lbi clbi)
 
-  let pathsModulePath = autogenModulesDir lbi
+  let pathsModulePath = autogenModulesDir lbi clbi
                     </> ModuleName.toFilePath (autogenModuleName pkg) <.> "hs"
-  rewriteFile pathsModulePath (Build.PathsModule.generate pkg lbi)
+  rewriteFile pathsModulePath (Build.PathsModule.generate pkg lbi clbi)
 
-  let cppHeaderPath = autogenModulesDir lbi </> cppHeaderName
-  rewriteFile cppHeaderPath (Build.Macros.generate pkg lbi)
+  let cppHeaderPath = autogenModulesDir lbi clbi </> cppHeaderName
+  rewriteFile cppHeaderPath (Build.Macros.generate pkg lbi clbi)
 
 -- | Check that the given build targets are valid in the current context.
 --

Cabal/Distribution/Simple/Build/Macros.hs

@@ -22,36 +22,30 @@ module Distribution.Simple.Build.Macros (
     generatePackageVersionMacros,
   ) where
 
-import Data.Maybe
-         ( isJust )
 import Distribution.Package
-         ( PackageIdentifier(PackageIdentifier) )
 import Distribution.Version
-         ( Version(versionBranch) )
 import Distribution.PackageDescription
-         ( PackageDescription )
+import Distribution.Simple.Compiler
 import Distribution.Simple.LocalBuildInfo
-         ( LocalBuildInfo(withPrograms), externalPackageDeps
-         , localComponentId, localCompatPackageKey )
 import Distribution.Simple.Program.Db
-         ( configuredPrograms )
 import Distribution.Simple.Program.Types
-         ( ConfiguredProgram(programId, programVersion) )
 import Distribution.Text
-         ( display )
+
+import Data.Maybe
+         ( isJust )
 
 -- ------------------------------------------------------------
 -- * Generate cabal_macros.h
 -- ------------------------------------------------------------
 
 -- | The contents of the @cabal_macros.h@ for the given configured package.
 --
-generate :: PackageDescription -> LocalBuildInfo -> String
-generate _pkg_descr lbi =
+generate :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> String
+generate _pkg_descr lbi clbi =
   "/* DO NOT EDIT: This file is automatically generated by Cabal */\n\n" ++
-  generatePackageVersionMacros (map snd (externalPackageDeps lbi)) ++
+  generatePackageVersionMacros (map snd (componentPackageDeps clbi)) ++
   generateToolVersionMacros (configuredPrograms . withPrograms $ lbi) ++
-  generateComponentIdMacro lbi
+  generateComponentIdMacro lbi clbi
 
 -- | Helper function that generates just the @VERSION_pkg@ and @MIN_VERSION_pkg@
 -- macros for a list of package ids (usually used with the specific deps of
@@ -83,10 +77,10 @@ generateToolVersionMacros progs = concat
 -- 'generateToolVersionMacros'.
 --
 generateMacros :: String -> String -> Version -> String
-generateMacros prefix name version =
+generateMacros macro_prefix name version =
   concat
-  ["#define ", prefix, "VERSION_",name," ",show (display version),"\n"
-  ,"#define MIN_", prefix, "VERSION_",name,"(major1,major2,minor) (\\\n"
+  ["#define ", macro_prefix, "VERSION_",name," ",show (display version),"\n"
+  ,"#define MIN_", macro_prefix, "VERSION_",name,"(major1,major2,minor) (\\\n"
   ,"  (major1) <  ",major1," || \\\n"
   ,"  (major1) == ",major1," && (major2) <  ",major2," || \\\n"
   ,"  (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")"
@@ -95,14 +89,21 @@ generateMacros prefix name version =
   where
     (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)
 
--- | Generate the @CURRENT_COMPONENT_ID@ definition for the component ID
---   of the current package.
-generateComponentIdMacro :: LocalBuildInfo -> String
-generateComponentIdMacro lbi =
-    concat
-    [ "#define CURRENT_COMPONENT_ID \"" ++ display (localComponentId lbi) ++ "\"\n\n"
-    , "#define CURRENT_PACKAGE_KEY \"" ++ localCompatPackageKey lbi ++ "\"\n\n"
-    ]
+-- | Generate the @CURRENT_PACKAGE_KEY@ definition for the package key
+--   of the current package, if supported by the compiler.
+--   NB: this only makes sense for definite packages.
+generateComponentIdMacro :: LocalBuildInfo -> ComponentLocalBuildInfo -> String
+generateComponentIdMacro lbi clbi
+  | packageKeySupported (compiler lbi) =
+      concat
+      -- Has to be the local one, since it's not guaranteed to be
+      -- present for non-libraries (TODO: maybe we should store those?)
+      ["#define CURRENT_PACKAGE_KEY \"" ++ localCompatPackageKey lbi ++ "\"\n"
+      ,"#define CURRENT_COMPONENT_ID \"" ++ display (componentComponentId clbi) ++ "\"\n"
+      -- TODO: maybe just give component IDs for all dependents? Hmm...
+      ,"#define LOCAL_COMPONENT_ID \"" ++ display (localComponentId lbi) ++ "\"\n"
+      ,"\n"]
+  | otherwise = ""
 
 fixchar :: Char -> Char
 fixchar '-' = '_'

Cabal/Distribution/Simple/Build/PathsModule.hs

@@ -37,8 +37,8 @@ import Data.Maybe
 -- * Building Paths_<pkg>.hs
 -- ------------------------------------------------------------
 
-generate :: PackageDescription -> LocalBuildInfo -> String
-generate pkg_descr lbi =
+generate :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> String
+generate pkg_descr lbi clbi =
    let pragmas = cpp_pragma ++ ffi_pragmas ++ warning_pragmas
 
        cpp_pragma | supports_cpp = "{-# LANGUAGE CPP #-}\n"
@@ -169,21 +169,23 @@ generate pkg_descr lbi =
    in header++body
 
  where
+        cid = componentUnitId clbi
+
         InstallDirs {
           prefix     = flat_prefix,
           bindir     = flat_bindir,
           libdir     = flat_libdir,
           datadir    = flat_datadir,
           libexecdir = flat_libexecdir,
           sysconfdir = flat_sysconfdir
-        } = absoluteInstallDirs pkg_descr lbi NoCopyDest
+        } = absoluteInstallDirs pkg_descr lbi cid NoCopyDest
         InstallDirs {
           bindir     = flat_bindirrel,
           libdir     = flat_libdirrel,
           datadir    = flat_datadirrel,
           libexecdir = flat_libexecdirrel,
           sysconfdir = flat_sysconfdirrel
-        } = prefixRelativeInstallDirs (packageId pkg_descr) lbi
+        } = prefixRelativeInstallDirs (packageId pkg_descr) lbi cid
 
         flat_bindirreloc = shortRelativePath flat_prefix flat_bindir
         flat_libdirreloc = shortRelativePath flat_prefix flat_libdir

Cabal/Distribution/Simple/BuildPaths.hs

@@ -56,8 +56,10 @@ haddockPref distPref pkg_descr
     = distPref </> "doc" </> "html" </> display (packageName pkg_descr)
 
 -- |The directory in which we put auto-generated modules
-autogenModulesDir :: LocalBuildInfo -> String
-autogenModulesDir lbi = buildDir lbi </> "autogen"
+autogenModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> String
+autogenModulesDir lbi clbi = libBuildDir lbi clbi </> "autogen"
+-- NB: Look at 'checkForeignDeps' for where a simplified version of this
+-- has been copy-pasted.
 
 cppHeaderName :: String
 cppHeaderName = "cabal_macros.h"