Merge pull request #10993 from mpickering/wip/separateProgDb

configureCompiler: separate compiler vs ProgramDb

Author: mergify[bot]

Cabal/src/Distribution/Simple/Configure.hs

@@ -48,8 +48,10 @@ module Distribution.Simple.Configure
   , getInstalledPackagesMonitorFiles
   , getInstalledPackagesById
   , getPackageDBContents
+  , configCompiler
   , configCompilerEx
   , configCompilerAuxEx
+  , configCompilerProgDb
   , computeEffectiveProfiling
   , ccLdOptionsBuildInfo
   , checkForeignDeps
@@ -2484,10 +2486,14 @@ configCompilerAuxEx cfg = do
     programDb
     verbosity
 
+-- | Configure the compiler and associated programs such as @hc-pkg@, @haddock@
+-- and toolchain program such as @ar@, @ld@.
 configCompilerEx
   :: Maybe CompilerFlavor
   -> Maybe FilePath
+  -- ^ user-specified @hc@ path (optional)
   -> Maybe FilePath
+  -- ^ user-specified @hc-pkg@ path (optional)
   -> ProgramDb
   -> Verbosity
   -> IO (Compiler, Platform, ProgramDb)
@@ -2496,10 +2502,46 @@ configCompilerEx (Just hcFlavor) hcPath hcPkg progdb verbosity = do
   (comp, maybePlatform, programDb) <- case hcFlavor of
     GHC -> GHC.configure verbosity hcPath hcPkg progdb
     GHCJS -> GHCJS.configure verbosity hcPath hcPkg progdb
-    UHC -> UHC.configure verbosity hcPath hcPkg progdb
+    UHC -> UHC.configure verbosity hcPath progdb
     _ -> dieWithException verbosity UnknownCompilerException
   return (comp, fromMaybe buildPlatform maybePlatform, programDb)
 
+-- | Configure the compiler ONLY.
+configCompiler
+  :: Maybe CompilerFlavor
+  -> Maybe FilePath
+  -- ^ user-specified @hc@ path (optional)
+  -> ProgramDb
+  -> Verbosity
+  -> IO (Compiler, Platform, ProgramDb)
+configCompiler mbFlavor hcPath progdb verbosity = do
+  (comp, maybePlatform, programDb) <-
+    case mbFlavor of
+      Nothing -> dieWithException verbosity UnknownCompilerException
+      Just hcFlavor ->
+        case hcFlavor of
+          GHC -> GHC.configureCompiler verbosity hcPath progdb
+          GHCJS -> GHCJS.configureCompiler verbosity hcPath progdb
+          UHC -> UHC.configure verbosity hcPath progdb
+          _ -> dieWithException verbosity UnknownCompilerException
+  return (comp, fromMaybe buildPlatform maybePlatform, programDb)
+
+-- | Configure programs associated to the compiler, such as @hc-pkg@, @haddock@
+-- and toolchain program such as @ar@, @ld@.
+configCompilerProgDb
+  :: Verbosity
+  -> Compiler
+  -> ProgramDb
+  -- ^ program database containing the compiler
+  -> Maybe FilePath
+  -- ^ user-specified @hc-pkg@ path (optional)
+  -> IO ProgramDb
+configCompilerProgDb verbosity comp hcProgDb hcPkgPath = do
+  case compilerFlavor comp of
+    GHC -> GHC.compilerProgramDb verbosity comp hcProgDb hcPkgPath
+    GHCJS -> GHCJS.compilerProgramDb verbosity comp hcProgDb hcPkgPath
+    _ -> return hcProgDb
+
 -- -----------------------------------------------------------------------------
 -- Testing C lib and header dependencies
 

Cabal/src/Distribution/Simple/GHC.hs

@@ -41,6 +41,8 @@
 module Distribution.Simple.GHC
   ( getGhcInfo
   , configure
+  , configureCompiler
+  , compilerProgramDb
   , getInstalledPackages
   , getInstalledPackagesMonitorFiles
   , getPackageDBContents
@@ -86,6 +88,7 @@ import Prelude ()
 import Control.Arrow ((***))
 import Control.Monad (forM_)
 import qualified Data.Map as Map
+import Data.Maybe (fromJust)
 import Distribution.CabalSpecVersion
 import Distribution.InstalledPackageInfo (InstalledPackageInfo)
 import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
@@ -152,20 +155,35 @@ import Distribution.Simple.Setup.Build
 -- -----------------------------------------------------------------------------
 -- Configuring
 
+-- | Configure GHC, and then auxiliary programs such as @ghc-pkg@, @haddock@
+-- as well as toolchain programs such as @ar@, @ld.
 configure
   :: Verbosity
   -> Maybe FilePath
+  -- ^ user-specified @ghc@ path (optional)
   -> Maybe FilePath
+  -- ^ user-specified @ghc-pkg@ path (optional)
   -> ProgramDb
   -> IO (Compiler, Maybe Platform, ProgramDb)
 configure verbosity hcPath hcPkgPath conf0 = do
+  (comp, compPlatform, progdb1) <- configureCompiler verbosity hcPath conf0
+  compProgDb <- compilerProgramDb verbosity comp progdb1 hcPkgPath
+  return (comp, compPlatform, compProgDb)
+
+-- | Configure GHC.
+configureCompiler
+  :: Verbosity
+  -> Maybe FilePath
+  -- ^ user-specified @ghc@ path (optional)
+  -> ProgramDb
+  -> IO (Compiler, Maybe Platform, ProgramDb)
+configureCompiler verbosity hcPath conf0 = do
   (ghcProg, ghcVersion, progdb1) <-
     requireProgramVersion
       verbosity
       ghcProgram
       (orLaterVersion (mkVersion [7, 0, 1]))
       (userMaybeSpecifyPath "ghc" hcPath conf0)
-  let implInfo = ghcVersionImplInfo ghcVersion
 
   -- Cabal currently supports GHC less than `maxGhcVersion`
   let maxGhcVersion = mkVersion [9, 14]
@@ -181,48 +199,12 @@ configure verbosity hcPath hcPkgPath conf0 = do
         ++ " is version "
         ++ prettyShow ghcVersion
 
-  -- This is slightly tricky, we have to configure ghc first, then we use the
-  -- location of ghc to help find ghc-pkg in the case that the user did not
-  -- specify the location of ghc-pkg directly:
-  (ghcPkgProg, ghcPkgVersion, progdb2) <-
-    requireProgramVersion
-      verbosity
-      ghcPkgProgram
-        { programFindLocation = guessGhcPkgFromGhcPath ghcProg
-        }
-      anyVersion
-      (userMaybeSpecifyPath "ghc-pkg" hcPkgPath progdb1)
-
-  when (ghcVersion /= ghcPkgVersion) $
-    dieWithException verbosity $
-      VersionMismatchGHC (programPath ghcProg) ghcVersion (programPath ghcPkgProg) ghcPkgVersion
-  -- Likewise we try to find the matching hsc2hs and haddock programs.
-  let hsc2hsProgram' =
-        hsc2hsProgram
-          { programFindLocation = guessHsc2hsFromGhcPath ghcProg
-          }
-      haddockProgram' =
-        haddockProgram
-          { programFindLocation = guessHaddockFromGhcPath ghcProg
-          }
-      hpcProgram' =
-        hpcProgram
-          { programFindLocation = guessHpcFromGhcPath ghcProg
-          }
-      runghcProgram' =
-        runghcProgram
-          { programFindLocation = guessRunghcFromGhcPath ghcProg
-          }
-      progdb3 =
-        addKnownProgram haddockProgram' $
-          addKnownProgram hsc2hsProgram' $
-            addKnownProgram hpcProgram' $
-              addKnownProgram runghcProgram' progdb2
-
+  let implInfo = ghcVersionImplInfo ghcVersion
   languages <- Internal.getLanguages verbosity implInfo ghcProg
   extensions0 <- Internal.getExtensions verbosity implInfo ghcProg
 
   ghcInfo <- Internal.getGhcInfo verbosity implInfo ghcProg
+
   let ghcInfoMap = Map.fromList ghcInfo
       filterJS = if ghcVersion < mkVersion [9, 8] then filterExt JavaScriptFFI else id
       extensions =
@@ -254,7 +236,13 @@ configure verbosity hcPath hcPkgPath conf0 = do
       -- So, we need to be careful to only strip the /common/ prefix.
       -- In this example, @AbiTag@ is "inplace".
       compilerAbiTag :: AbiTag
-      compilerAbiTag = maybe NoAbiTag AbiTag (dropWhile (== '-') . stripCommonPrefix (prettyShow compilerId) <$> Map.lookup "Project Unit Id" ghcInfoMap)
+      compilerAbiTag =
+        maybe
+          NoAbiTag
+          AbiTag
+          ( dropWhile (== '-') . stripCommonPrefix (prettyShow compilerId)
+              <$> Map.lookup "Project Unit Id" ghcInfoMap
+          )
 
   let comp =
         Compiler
@@ -266,9 +254,73 @@ configure verbosity hcPath hcPkgPath conf0 = do
           , compilerProperties = ghcInfoMap
           }
       compPlatform = Internal.targetPlatform ghcInfo
-      -- configure gcc and ld
-      progdb4 = Internal.configureToolchain implInfo ghcProg ghcInfoMap progdb3
-  return (comp, compPlatform, progdb4)
+  return (comp, compPlatform, progdb1)
+
+-- | Given a configured @ghc@ program, configure auxiliary programs such
+-- as @ghc-pkg@ or @haddock@, as well as toolchain programs such as @ar@, @ld@,
+-- based on:
+--
+--  - the location of the @ghc@ executable,
+--  - toolchain information in the GHC settings file.
+compilerProgramDb
+  :: Verbosity
+  -> Compiler
+  -> ProgramDb
+  -> Maybe FilePath
+  -- ^ user-specified @ghc-pkg@ path (optional)
+  -> IO ProgramDb
+compilerProgramDb verbosity comp progdb1 hcPkgPath = do
+  let
+    ghcProg = fromJust $ lookupProgram ghcProgram progdb1
+    ghcVersion = compilerVersion comp
+
+  -- This is slightly tricky, we have to configure ghc first, then we use the
+  -- location of ghc to help find ghc-pkg in the case that the user did not
+  -- specify the location of ghc-pkg directly:
+  (ghcPkgProg, ghcPkgVersion, progdb2) <-
+    requireProgramVersion
+      verbosity
+      ghcPkgProgram
+        { programFindLocation = guessGhcPkgFromGhcPath ghcProg
+        }
+      anyVersion
+      (userMaybeSpecifyPath "ghc-pkg" hcPkgPath progdb1)
+
+  when (ghcVersion /= ghcPkgVersion) $
+    dieWithException verbosity $
+      VersionMismatchGHC (programPath ghcProg) ghcVersion (programPath ghcPkgProg) ghcPkgVersion
+  -- Likewise we try to find the matching hsc2hs and haddock programs.
+  let hsc2hsProgram' =
+        hsc2hsProgram
+          { programFindLocation = guessHsc2hsFromGhcPath ghcProg
+          }
+      haddockProgram' =
+        haddockProgram
+          { programFindLocation = guessHaddockFromGhcPath ghcProg
+          }
+      hpcProgram' =
+        hpcProgram
+          { programFindLocation = guessHpcFromGhcPath ghcProg
+          }
+      runghcProgram' =
+        runghcProgram
+          { programFindLocation = guessRunghcFromGhcPath ghcProg
+          }
+      progdb3 =
+        addKnownProgram haddockProgram' $
+          addKnownProgram hsc2hsProgram' $
+            addKnownProgram hpcProgram' $
+              addKnownProgram runghcProgram' progdb2
+
+      -- configure gcc, ld, ar etc... based on the paths stored
+      -- in the GHC settings file
+      progdb4 =
+        Internal.configureToolchain
+          (ghcVersionImplInfo ghcVersion)
+          ghcProg
+          (compilerProperties comp)
+          progdb3
+  return progdb4
 
 -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find
 -- the corresponding tool; e.g. if the tool is ghc-pkg, we try looking

Cabal/src/Distribution/Simple/GHCJS.hs

@@ -5,6 +5,8 @@
 module Distribution.Simple.GHCJS
   ( getGhcInfo
   , configure
+  , configureCompiler
+  , compilerProgramDb
   , getInstalledPackages
   , getInstalledPackagesMonitorFiles
   , getPackageDBContents
@@ -87,6 +89,7 @@ import Control.Arrow ((***))
 import Control.Monad (msum)
 import Data.Char (isLower)
 import qualified Data.Map as Map
+import Data.Maybe (fromJust)
 import System.Directory
   ( canonicalizePath
   , createDirectoryIfMissing
@@ -106,13 +109,29 @@ import qualified System.Info
 -- -----------------------------------------------------------------------------
 -- Configuring
 
+-- | Configure GHCJS, and then auxiliary programs such as @ghc-pkg@, @haddock@
+-- as well as toolchain programs such as @ar@, @ld.
 configure
   :: Verbosity
   -> Maybe FilePath
+  -- ^ user-specified @ghcjs@ path (optional)
   -> Maybe FilePath
+  -- ^ user-specified @ghcjs-pkg@ path (optional)
   -> ProgramDb
   -> IO (Compiler, Maybe Platform, ProgramDb)
 configure verbosity hcPath hcPkgPath conf0 = do
+  (comp, compPlatform, progdb1) <- configureCompiler verbosity hcPath conf0
+  compProgDb <- compilerProgramDb verbosity comp progdb1 hcPkgPath
+  return (comp, compPlatform, compProgDb)
+
+-- | Configure GHCJS.
+configureCompiler
+  :: Verbosity
+  -> Maybe FilePath
+  -- ^ user-specified @ghc@ path (optional)
+  -> ProgramDb
+  -> IO (Compiler, Maybe Platform, ProgramDb)
+configureCompiler verbosity hcPath conf0 = do
   (ghcjsProg, ghcjsVersion, progdb1) <-
     requireProgramVersion
       verbosity
@@ -133,6 +152,43 @@ configure verbosity hcPath hcPkgPath conf0 = do
 
   let implInfo = ghcjsVersionImplInfo ghcjsVersion ghcjsGhcVersion
 
+  languages <- Internal.getLanguages verbosity implInfo ghcjsProg
+  extensions <- Internal.getExtensions verbosity implInfo ghcjsProg
+
+  ghcjsInfo <- Internal.getGhcInfo verbosity implInfo ghcjsProg
+  let ghcInfoMap = Map.fromList ghcjsInfo
+
+  let comp =
+        Compiler
+          { compilerId = CompilerId GHCJS ghcjsVersion
+          , compilerAbiTag =
+              AbiTag $
+                "ghc" ++ intercalate "_" (map show . versionNumbers $ ghcjsGhcVersion)
+          , compilerCompat = [CompilerId GHC ghcjsGhcVersion]
+          , compilerLanguages = languages
+          , compilerExtensions = extensions
+          , compilerProperties = ghcInfoMap
+          }
+      compPlatform = Internal.targetPlatform ghcjsInfo
+  return (comp, compPlatform, progdb1)
+
+-- | Given a configured @ghcjs@ program, configure auxiliary programs such
+-- as @ghcjs-pkg@ or @haddock@, based on the location of the @ghcjs@ executable.
+compilerProgramDb
+  :: Verbosity
+  -> Compiler
+  -> ProgramDb
+  -> Maybe FilePath
+  -- ^ user-specified @ghc-pkg@ path (optional)
+  -> IO ProgramDb
+compilerProgramDb verbosity comp progdb1 hcPkgPath = do
+  let
+    ghcjsProg = fromJust $ lookupProgram ghcjsProgram progdb1
+    ghcjsVersion = compilerVersion comp
+    ghcjsGhcVersion = case compilerCompat comp of
+      [CompilerId GHC ghcjsGhcVer] -> ghcjsGhcVer
+      compat -> error $ "could not parse ghcjsGhcVersion:" ++ show compat
+
   -- This is slightly tricky, we have to configure ghc first, then we use the
   -- location of ghc to help find ghc-pkg in the case that the user did not
   -- specify the location of ghc-pkg directly:
@@ -187,25 +243,7 @@ configure verbosity hcPath hcPkgPath conf0 = do
             addKnownProgram hpcProgram' $
               {- addKnownProgram runghcProgram' -} progdb2
 
-  languages <- Internal.getLanguages verbosity implInfo ghcjsProg
-  extensions <- Internal.getExtensions verbosity implInfo ghcjsProg
-
-  ghcjsInfo <- Internal.getGhcInfo verbosity implInfo ghcjsProg
-  let ghcInfoMap = Map.fromList ghcjsInfo
-
-  let comp =
-        Compiler
-          { compilerId = CompilerId GHCJS ghcjsVersion
-          , compilerAbiTag =
-              AbiTag $
-                "ghc" ++ intercalate "_" (map show . versionNumbers $ ghcjsGhcVersion)
-          , compilerCompat = [CompilerId GHC ghcjsGhcVersion]
-          , compilerLanguages = languages
-          , compilerExtensions = extensions
-          , compilerProperties = ghcInfoMap
-          }
-      compPlatform = Internal.targetPlatform ghcjsInfo
-  return (comp, compPlatform, progdb3)
+  return progdb3
 
 guessGhcjsPkgFromGhcjsPath
   :: ConfiguredProgram