[commit: packages/Cabal] ghc-head: Fix a theoretical config desynchronisation issue. (4edd38c)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/Cabal

On branch  : ghc-head
Link       : http://git.haskell.org/?p=packages/Cabal.git;a=commit;h=4edd38c88717959e13cf95340c8fbfb5d656ba8b

>---------------------------------------------------------------

commit 4edd38c88717959e13cf95340c8fbfb5d656ba8b
Author: Mikhail Glushenkov <mikhail.glushenkov at gmail.com>
Date:   Fri May 3 23:51:47 2013 +0200

    Fix a theoretical config desynchronisation issue.
    
    In rare cases, 'cabal.sandbox.config' and 'dist/setup-config' could
    theoretically become desynchronised. Add a sanity check against this
    possibility.


>---------------------------------------------------------------

4edd38c88717959e13cf95340c8fbfb5d656ba8b
 cabal-install/Distribution/Client/Sandbox.hs |   62 ++++++++++++++++++++------
 cabal-install/Main.hs                        |    2 +-
 2 files changed, 50 insertions(+), 14 deletions(-)

diff --git a/cabal-install/Distribution/Client/Sandbox.hs b/cabal-install/Distribution/Client/Sandbox.hs
index ccafb4f..7c460d4 100644
--- a/cabal-install/Distribution/Client/Sandbox.hs
+++ b/cabal-install/Distribution/Client/Sandbox.hs
@@ -496,19 +496,36 @@ reinstallAddSourceDeps verbosity config configFlags configExFlags
 
 -- | Check if a sandbox is present and call @reinstallAddSourceDeps@ in that
 -- case.
-maybeReinstallAddSourceDeps :: Verbosity -> Flag (Maybe Int) -> GlobalFlags
+maybeReinstallAddSourceDeps :: Verbosity
+                               -> Flag (Maybe Int) -- ^ The '-j' flag
+                               -> ConfigFlags      -- ^ Saved configure flags
+                                                   -- (from dist/setup-config)
+                               -> GlobalFlags
                                -> IO (UseSandbox, WereDepsReinstalled)
-maybeReinstallAddSourceDeps verbosity numJobsFlag globalFlags' = do
+maybeReinstallAddSourceDeps verbosity numJobsFlag configFlags' globalFlags' = do
   currentDir <- getCurrentDirectory
   pkgEnvType <- classifyPackageEnvironment currentDir
   case pkgEnvType of
     AmbientPackageEnvironment -> return (NoSandbox, NoDepsReinstalled)
     UserPackageEnvironment    -> return (NoSandbox, NoDepsReinstalled)
     SandboxPackageEnvironment -> do
-      (useSandbox, config) <- loadConfigOrSandboxConfig verbosity
-                              (globalConfigFile globalFlags') mempty
+      (useSandbox, config') <- loadConfigOrSandboxConfig verbosity
+                               (globalConfigFile globalFlags') mempty
       case useSandbox of
         UseSandbox sandboxDir -> do
+
+          -- If the saved configure flags and the sandbox config are
+          -- desynchronised for some reason (can happen if the user did 'install
+          -- . A B C -w $NEW_COMPILER' and then aborted the installation after
+          -- the sandbox config was updated, but before the current project was
+          -- configured), synchronise them.
+          config <- if sandboxConfigUpdateNeeded config' configFlags'
+                     then do updateSandboxConfig verbosity configFlags'
+                             fmap snd $ loadConfigOrSandboxConfig verbosity
+                               (globalConfigFile globalFlags') mempty
+                     else return config'
+
+          -- Actually reinstall the modified add-source deps.
           let configFlags    = savedConfigureFlags config
               configExFlags  = defaultConfigExFlags
                                `mappend` savedConfigureExFlags config
@@ -519,6 +536,10 @@ maybeReinstallAddSourceDeps verbosity numJobsFlag globalFlags' = do
                                   `mappend` numJobsFlag
                 }
               globalFlags    = savedGlobalFlags config
+              -- This makes it possible to override things like
+              -- 'remote-repo-cache' from the command line. These options are
+              -- hidden, and are only useful for debugging, so this should be
+              -- fine.
                                `mappend` globalFlags'
 
           depsReinstalled <- reinstallAddSourceDeps verbosity config
@@ -534,12 +555,21 @@ maybeReinstallAddSourceDeps verbosity numJobsFlag globalFlags' = do
 -- sandbox config file if the user has configured the project with a different
 -- compiler. Note that we don't auto-enable things like 'library-profiling' (for
 -- now?) even if the user has passed '--enable-library-profiling' to
--- 'configure'. These options are supposed to be set in cabal.config.
+-- 'configure'. These options are supposed to be set in 'cabal.config'.
 maybeUpdateSandboxConfig :: Verbosity
-                            -> SavedConfig -- ^ old config
+                            -> SavedConfig -- ^ old 'cabal.sandbox.config'
                             -> ConfigFlags -- ^ new configure flags
                             -> IO ()
 maybeUpdateSandboxConfig verbosity savedConfig newConfigFlags = do
+  when (sandboxConfigUpdateNeeded savedConfig newConfigFlags) $
+    updateSandboxConfig verbosity newConfigFlags
+
+-- | Given the flags from an old 'cabal.sandbox.config' and the most current
+-- 'configure' flags, should we rewrite the auto-generated sandbox config file?
+sandboxConfigUpdateNeeded :: SavedConfig    -- ^ old 'cabal.sandbox.config'
+                             -> ConfigFlags -- ^ new configure flags
+                             -> Bool
+sandboxConfigUpdateNeeded savedConfig newConfigFlags =
   let oldConfigFlags = savedConfigureFlags savedConfig
 
       oldHcFlavor    = configHcFlavor   oldConfigFlags
@@ -549,13 +579,19 @@ maybeUpdateSandboxConfig verbosity savedConfig newConfigFlags = do
       newHcFlavor    = configHcFlavor   newConfigFlags
       newHcPath      = configHcPath     newConfigFlags
       newPackageDBs  = configPackageDBs newConfigFlags
-
-  when ((oldHcFlavor /= newHcFlavor)
-        || (oldHcPath /= newHcPath)
-        || (oldPackageDBs /= newPackageDBs)) $ do
-    pkgEnvDir <- getCurrentDirectory
-    updatePackageEnvironment verbosity pkgEnvDir
-      newHcFlavor newHcPath newPackageDBs
+  in (oldHcFlavor  /= newHcFlavor)
+     || (oldHcPath /= newHcPath)
+     || (oldPackageDBs /= newPackageDBs)
+
+-- | Actually update the sandbox config.
+updateSandboxConfig :: Verbosity -> ConfigFlags -> IO ()
+updateSandboxConfig verbosity newConfigFlags = do
+  pkgEnvDir <- getCurrentDirectory
+  let newHcFlavor    = configHcFlavor   newConfigFlags
+      newHcPath      = configHcPath     newConfigFlags
+      newPackageDBs  = configPackageDBs newConfigFlags
+  updatePackageEnvironment verbosity pkgEnvDir
+    newHcFlavor newHcPath newPackageDBs
 
 --
 -- Utils (transitionary)
diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs
index 89f80e0..4ba8b0b 100644
--- a/cabal-install/Main.hs
+++ b/cabal-install/Main.hs
@@ -374,7 +374,7 @@ reconfigure verbosity distPref    addConfigFlags
                           (useDistPref defaultSetupScriptOptions)
                           (configDistPref configFlags)
       (useSandbox, depsReinstalled) <- maybeReinstallAddSourceDeps verbosity
-                                       numJobsFlag globalFlags
+                                       numJobsFlag flags globalFlags
 
       -- Determine what message, if any, to display to the user if
       -- reconfiguration is required.