Skip to content

Commit

Permalink
Reinstall add-source deps even when LBI can't be loaded.
Browse files Browse the repository at this point in the history 
But only if it happens due to version mismatch. Fixes #3136.
  • Loading branch information
@23Skidoo
23Skidoo committed Feb 21, 2016
1 parent bb2e99e commit 354757c
Showing 1 changed file with 107 additions and 63 deletions.
170 changes: 107 additions & 63 deletions cabal-install/Main.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -511,89 +511,128 @@ reconfigure verbosity flagDistPref addConfigFlags extraArgs globalFlags
distPref <- findSavedDistPref config flagDistPref
eLbi <- tryGetPersistBuildConfig distPref
config' <- case eLbi of
Left err -> onNoBuildConfig (useSandbox, config) distPref err
Right lbi -> onBuildConfig (useSandbox, config) distPref lbi
Left err -> onNoBuildConfig useSandbox config distPref err
Right lbi -> onBuildConfig useSandbox config distPref lbi
return (useSandbox, config', distPref)

where

-- Was the sandbox created after the package was already configured? We may
-- need to skip reinstallation of add-source deps and force reconfigure.
checkSandboxConfigModified :: FilePath -> IO Bool
checkSandboxConfigModified distPref = do
let buildConfig = localBuildInfoFile distPref
sandboxConfig <- getSandboxConfigFilePath globalFlags
sandboxConfig `existsAndIsMoreRecentThan` buildConfig

-- Is the @cabal.config@ file newer than @dist/setup-config@? Then we need
-- to force reconfigure. Note that it's possible to use @cabal.config@ even
-- without sandboxes.
checkUserPackageEnvironmentFileModified :: FilePath -> IO Bool
checkUserPackageEnvironmentFileModified distPref = do
let buildConfig = localBuildInfoFile distPref
userPackageEnvironmentFile `existsAndIsMoreRecentThan` buildConfig

-- Reinstall add-source deps if needed, check whether
-- @cabal.sandbox.config@/@cabal.config@ are newer than @dist/setup-config@.
maybeReinstallDeps :: UseSandbox -> SavedConfig -> Bool -> ConfigFlags
-> IO WereDepsReinstalled
maybeReinstallDeps useSandbox config isSandboxConfigNewer configureFlags = do
let skipAddSourceDepsCheck'
| isSandboxConfigNewer = SkipAddSourceDepsCheck
| otherwise = skipAddSourceDepsCheck

case skipAddSourceDepsCheck' of
DontSkipAddSourceDepsCheck -> maybeReinstallAddSourceDeps verbosity
numJobsFlag configureFlags globalFlags
(useSandbox, config)
SkipAddSourceDepsCheck -> do
info verbosity "Skipping add-source deps check..."
return NoDepsReinstalled

-- We couldn't load the saved package config file.
--
-- If we're in a sandbox: add-source deps don't have to be reinstalled
-- (since we don't know the compiler & platform).
onNoBuildConfig :: (UseSandbox, SavedConfig) -> FilePath
onNoBuildConfig :: UseSandbox -> SavedConfig -> FilePath
-> ConfigStateFileError -> IO SavedConfig
onNoBuildConfig (_, config) distPref err = do
let msg = case err of
ConfigStateFileMissing -> "Package has never been configured."
ConfigStateFileNoParse -> "Saved package config file seems "
++ "to be corrupt."
_ -> show err
case err of
onNoBuildConfig useSandbox config distPref err = do
let distVerbFlags = mempty { configVerbosity = toFlag verbosity
, configDistPref = toFlag distPref }
defaultFlags = mappend addConfigFlags distVerbFlags
needReconfigure <- case err of
-- Note: the build config could have been generated by a custom setup
-- script built against a different Cabal version, so it's crucial that
-- we ignore the bad version error here.
ConfigStateFileBadVersion _ _ _ -> info verbosity msg
_ -> do
let distVerbFlags = mempty
{ configVerbosity = toFlag verbosity
, configDistPref = toFlag distPref
}
defaultFlags = mappend addConfigFlags distVerbFlags
notice verbosity
$ msg ++ " Configuring with default flags." ++ configureManually
ConfigStateFileBadVersion oldCabal _ _ -> do
info verbosity $ "The package was configured by "
++ display oldCabal
++ ", while the 'cabal' executable you're running is built against"
++ "Cabal " ++ display cabalVersion ++ "."
isSandboxConfigNewer <- checkSandboxConfigModified distPref
isUserPackageEnvironmentFileNewer <-
checkUserPackageEnvironmentFileModified distPref
depsReinstalled <- maybeReinstallDeps useSandbox config
isSandboxConfigNewer
(defaultFlags `mappend` savedConfigureFlags config)

-- Can't reconfigure automatically because we don't know which
-- configure options were used.
case depsReinstalled of
ReinstalledSomeDeps ->
notice verbosity $ reinstalledDepsMessage ReconfigureManual
NoDepsReinstalled ->
if isSandboxConfigNewer
then notice verbosity $ sandboxConfigNewerMessage ReconfigureManual
else if isUserPackageEnvironmentFileNewer
then notice verbosity $
userPackageEnvironmentFileModifiedMessage
ReconfigureManual
else return ()
return Nothing

ConfigStateFileMissing -> return $
Just "Package has never been configured."
ConfigStateFileNoParse -> return $
Just ("Saved package config file seems "
++ "to be corrupt.")
_ -> return $ Just (show err)

case needReconfigure of
Just msg -> do
notice verbosity $
msg ++ " Configuring with default flags." ++ configureManually
configureAction (defaultFlags, defaultConfigExFlags)
extraArgs globalFlags
Nothing -> return ()

return config

-- Package has been configured, but the configuration may be out of
-- date or required flags may not be set.
--
-- If we're in a sandbox: reinstall the modified add-source deps and
-- force reconfigure if we did.
onBuildConfig :: (UseSandbox, SavedConfig) -> FilePath
onBuildConfig :: UseSandbox -> SavedConfig -> FilePath
-> LBI.LocalBuildInfo -> IO SavedConfig
onBuildConfig (useSandbox, config) distPref lbi = do
onBuildConfig useSandbox config distPref lbi = do
let configFlags = LBI.configFlags lbi
distVerbFlags = mempty
{ configVerbosity = toFlag verbosity
, configDistPref = toFlag distPref
}
flags = mconcat [configFlags, addConfigFlags, distVerbFlags]

-- Was the sandbox created after the package was already configured? We
-- may need to skip reinstallation of add-source deps and force
-- reconfigure.
let buildConfig = localBuildInfoFile distPref
sandboxConfig <- getSandboxConfigFilePath globalFlags
isSandboxConfigNewer <-
sandboxConfig `existsAndIsMoreRecentThan` buildConfig

let skipAddSourceDepsCheck'
| isSandboxConfigNewer = SkipAddSourceDepsCheck
| otherwise = skipAddSourceDepsCheck

when (skipAddSourceDepsCheck' == SkipAddSourceDepsCheck) $
info verbosity "Skipping add-source deps check..."

let (_, config') = updateInstallDirs
(configUserInstall flags)
(useSandbox, config)

depsReinstalled <-
case skipAddSourceDepsCheck' of
DontSkipAddSourceDepsCheck ->
maybeReinstallAddSourceDeps
verbosity numJobsFlag flags globalFlags
(useSandbox, config')
SkipAddSourceDepsCheck -> do
return NoDepsReinstalled

-- Is the @cabal.config@ file newer than @dist/setup.config@? Then we need
-- to force reconfigure. Note that it's possible to use @cabal.config@
-- even without sandboxes.
-- Reinstall add-source deps if needed.
isSandboxConfigNewer <- checkSandboxConfigModified distPref
isUserPackageEnvironmentFileNewer <-
userPackageEnvironmentFile `existsAndIsMoreRecentThan` buildConfig
checkUserPackageEnvironmentFileModified distPref
depsReinstalled <- maybeReinstallDeps useSandbox config'
isSandboxConfigNewer flags

-- Determine whether we need to reconfigure and which message to show to
-- the user if that is the case.
Expand All @@ -614,17 +653,17 @@ reconfigure verbosity flagDistPref addConfigFlags extraArgs globalFlags
return config'

-- Determine what message, if any, to display to the user if reconfiguration
-- is required.
-- is required in the 'onBuildConfig' branch.
determineMessageToShow :: FilePath -> LBI.LocalBuildInfo -> ConfigFlags
-> WereDepsReinstalled -> Bool -> Bool
-> IO (Maybe String)
determineMessageToShow _ _ _ _ True _ =
-- The sandbox was created after the package was already configured.
return $! Just $! sandboxConfigNewerMessage
return $! Just $! sandboxConfigNewerMessage ReconfigureAuto

determineMessageToShow _ _ _ _ False True =
-- The user package environment file was modified.
return $! Just $! userPackageEnvironmentFileModifiedMessage
return $! Just $! userPackageEnvironmentFileModifiedMessage ReconfigureAuto

determineMessageToShow distPref lbi configFlags depsReinstalled
False False = do
Expand All @@ -634,7 +673,7 @@ reconfigure verbosity flagDistPref addConfigFlags extraArgs globalFlags
case depsReinstalled of
ReinstalledSomeDeps ->
-- Some add-source deps were reinstalled.
return $! Just $! reinstalledDepsMessage
return $! Just $! reinstalledDepsMessage ReconfigureAuto
NoDepsReinstalled ->
case checkFlags configFlags of
-- Flag required by the caller is not set.
Expand All @@ -657,16 +696,20 @@ reconfigure verbosity flagDistPref addConfigFlags extraArgs globalFlags
else Nothing

reconfiguringMostRecent = " Re-configuring with most recently used options."
configureManually = " If this fails, please run configure manually."
sandboxConfigNewerMessage =
configureManually = " If this fails, please run 'configure' manually."
askConfigureManually = " If the next step fails, "
++ "please run 'configure' manually."

autoOrManual ReconfigureAuto = reconfiguringMostRecent ++ configureManually
autoOrManual ReconfigureManual = askConfigureManually

sandboxConfigNewerMessage how =
"The sandbox was created after the package was already configured."
++ reconfiguringMostRecent
++ configureManually
userPackageEnvironmentFileModifiedMessage =
++ autoOrManual how
userPackageEnvironmentFileModifiedMessage how =
"The user package environment file ('"
++ userPackageEnvironmentFile ++ "') was modified."
++ reconfiguringMostRecent
++ configureManually
++ autoOrManual how
distPrefMessage =
"Package previously configured with different \"dist\" prefix."
++ reconfiguringMostRecent
Expand All @@ -675,10 +718,11 @@ reconfigure verbosity flagDistPref addConfigFlags extraArgs globalFlags
pdFile ++ " has been changed."
++ reconfiguringMostRecent
++ configureManually
reinstalledDepsMessage =
reinstalledDepsMessage how =
"Some add-source dependencies have been reinstalled."
++ reconfiguringMostRecent
++ configureManually
++ autoOrManual how

data HowToReconfigure = ReconfigureManual | ReconfigureAuto

installAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
-> [String] -> Action
Expand Down

0 comments on commit 354757c

Please sign in to comment.