Commit 146d736d authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Merge pull request #2859 from adamgundry/fix-sandbox-hcpkg

Use configured compiler for cabal sandbox hc-pkg
parents 63a2c9c7 833da5e2
......@@ -14,8 +14,6 @@ module Distribution.Client.Exec ( exec
import Control.Monad (unless)
import Data.Foldable (forM_)
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
......@@ -91,22 +89,19 @@ sandboxEnvironment verbosity sandboxDir comp platform programDb =
let Just program = lookupProgram hcProgram programDb
gDb <- getGlobalPackageDB verbosity program
sandboxConfigFilePath <- getSandboxConfigFilePath mempty
let compilerPackagePath = hcPackagePath gDb
let sandboxPackagePath = sandboxPackageDBPath sandboxDir comp platform
compilerPackagePaths = prependToSearchPath gDb sandboxPackagePath
-- Packages database must exist, otherwise things will start
-- failing in mysterious ways.
forM_ compilerPackagePath $ \fp -> do
exists <- doesDirectoryExist fp
unless exists $ warn verbosity $ "Package database is not a directory: " ++ fp
exists <- doesDirectoryExist sandboxPackagePath
unless exists $ warn verbosity $ "Package database is not a directory: "
++ sandboxPackagePath
-- Build the environment
return [ (packagePathEnvVar, compilerPackagePath)
, ("CABAL_SANDBOX_PACKAGE_PATH", compilerPackagePath)
return [ (packagePathEnvVar, Just compilerPackagePaths)
, ("CABAL_SANDBOX_PACKAGE_PATH", Just compilerPackagePaths)
, ("CABAL_SANDBOX_CONFIG", Just sandboxConfigFilePath)
]
hcPackagePath gDb =
let s = sandboxPackageDBPath sandboxDir comp platform
in Just $ prependToSearchPath gDb s
prependToSearchPath path newValue =
newValue ++ [searchPathSeparator] ++ path
......
......@@ -39,7 +39,7 @@ module Distribution.Client.Sandbox (
updateInstallDirs,
-- FIXME: move somewhere else
configPackageDB', configCompilerAux'
configPackageDB', configCompilerAux', getPersistOrConfigCompiler
) where
import Distribution.Client.Setup
......@@ -65,7 +65,8 @@ import Distribution.Client.Sandbox.PackageEnvironment
, createPackageEnvironmentFile, classifyPackageEnvironment
, tryLoadSandboxPackageEnvironmentFile, loadUserConfig
, commentPackageEnvironment, showPackageEnvironmentWithComments
, sandboxPackageEnvironmentFile, userPackageEnvironmentFile )
, sandboxPackageEnvironmentFile, userPackageEnvironmentFile
, sandboxPackageDBPath )
import Distribution.Client.Sandbox.Types ( SandboxPackageInfo(..)
, UseSandbox(..) )
import Distribution.Client.SetupWrapper
......@@ -82,7 +83,10 @@ import Distribution.Simple.Compiler ( Compiler(..), PackageDB(..)
import Distribution.Simple.Configure ( configCompilerAuxEx
, interpretPackageDbFlags
, getPackageDBContents
, maybeGetPersistBuildConfig
, findDistPrefOrDefault
, findDistPref )
import qualified Distribution.Simple.LocalBuildInfo as LocalBuildInfo
import Distribution.Simple.PreProcess ( knownSuffixHandlers )
import Distribution.Simple.Program ( ProgramConfiguration )
import Distribution.Simple.Setup ( Flag(..), HaddockFlags(..)
......@@ -479,11 +483,13 @@ sandboxListSources verbosity _sandboxFlags globalFlags = do
-- tool with provided arguments, restricted to the sandbox.
sandboxHcPkg :: Verbosity -> SandboxFlags -> GlobalFlags -> [String] -> IO ()
sandboxHcPkg verbosity _sandboxFlags globalFlags extraArgs = do
(_sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags
(sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags
let configFlags = savedConfigureFlags . pkgEnvSavedConfig $ pkgEnv
dbStack = configPackageDB' configFlags
(comp, _platform, conf) <- configCompilerAux' configFlags
-- Invoke hc-pkg for the most recently configured compiler (if any),
-- using the right package-db for the compiler (see #1935).
(comp, platform, conf) <- getPersistOrConfigCompiler configFlags
let dir = sandboxPackageDBPath sandboxDir comp platform
dbStack = [GlobalPackageDB, SpecificPackageDB dir]
Register.invokeHcPkg verbosity comp conf dbStack extraArgs
updateInstallDirs :: Flag Bool
......@@ -791,3 +797,18 @@ configCompilerAux' configFlags =
configCompilerAuxEx configFlags
--FIXME: make configCompilerAux use a sensible verbosity
{ configVerbosity = fmap lessVerbose (configVerbosity configFlags) }
-- | Try to read the most recently configured compiler from the
-- 'localBuildInfoFile', falling back on 'configCompilerAuxEx' if it
-- cannot be read.
getPersistOrConfigCompiler :: ConfigFlags
-> IO (Compiler, Platform, ProgramConfiguration)
getPersistOrConfigCompiler configFlags = do
distPref <- findDistPrefOrDefault (configDistPref configFlags)
mlbi <- maybeGetPersistBuildConfig distPref
case mlbi of
Nothing -> do configCompilerAux' configFlags
Just lbi -> return ( LocalBuildInfo.compiler lbi
, LocalBuildInfo.hostPlatform lbi
, LocalBuildInfo.withPrograms lbi
)
......@@ -100,6 +100,7 @@ import Distribution.Client.Sandbox (sandboxInit
,updateInstallDirs
,configCompilerAux'
,getPersistOrConfigCompiler
,configPackageDB')
import Distribution.Client.Sandbox.PackageEnvironment
(setPackageDB
......@@ -1158,7 +1159,7 @@ execAction execFlags extraArgs globalFlags = do
let verbosity = fromFlag (execVerbosity execFlags)
(useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags
let configFlags = savedConfigureFlags config
(comp, platform, conf) <- configCompilerAux' configFlags
(comp, platform, conf) <- getPersistOrConfigCompiler configFlags
exec verbosity useSandbox comp platform conf extraArgs
userConfigAction :: UserConfigFlags -> [String] -> GlobalFlags -> IO ()
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment