From 39af2cb1d244bb3921765ca9f06f06ad675b5539 Mon Sep 17 00:00:00 2001
From: Mikhail Glushenkov <the.dead.shall.rise@gmail.com>
Date: Sun, 24 Mar 2013 21:19:05 +0100
Subject: [PATCH] Add a ForcePackageDBStack argument to configPackageDB'.

We use userInstallDirs in sandbox mode to prevent cabal-install from doing
unnecessary things like invoking itself via 'sudo' (see commit
7b2e3630f2ada8a56bf9100144e1bb9acbe6dc6a and 'rootCmd' in D.C.Install), but in
this particular case we want userInstall to be False to prevent UserPackageDB
from being added to the package DB stack (see #1183 and interpretPackageDbFlags
in D.S.Configure).
---
 cabal-install/Main.hs | 26 +++++++++++++++++---------
 1 file changed, 17 insertions(+), 9 deletions(-)

diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs
index b8574724bd3..c6b75c3bccb 100644
--- a/cabal-install/Main.hs
+++ b/cabal-install/Main.hs
@@ -205,7 +205,8 @@ configureAction (configFlags, configExFlags) extraArgs globalFlags = do
       globalFlags'   = savedGlobalFlags      config `mappend` globalFlags
   (comp, platform, conf) <- configCompilerAux configFlags'
   configure verbosity
-            (configPackageDB' configFlags') (globalRepos globalFlags')
+            (configPackageDB' configFlags' DontForceGlobalInstall)
+            (globalRepos globalFlags')
             comp platform conf configFlags' configExFlags' extraArgs
 
 buildAction :: BuildFlags -> [String] -> GlobalFlags -> IO ()
@@ -376,7 +377,8 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
       globalFlags'   = savedGlobalFlags      config `mappend` globalFlags
   (comp, platform, conf) <- configCompilerAux' configFlags'
   install verbosity
-          (configPackageDB' configFlags') (globalRepos globalFlags')
+          (configPackageDB' configFlags' DontForceGlobalInstall)
+          (globalRepos globalFlags')
           comp platform conf globalFlags' configFlags' configExFlags'
           installFlags' haddockFlags
           targets
@@ -423,7 +425,7 @@ listAction listFlags extraArgs globalFlags = do
       globalFlags' = savedGlobalFlags    config `mappend` globalFlags
   (comp, _, conf) <- configCompilerAux' configFlags
   list verbosity
-       (configPackageDB' configFlags)
+       (configPackageDB' configFlags DontForceGlobalInstall)
        (globalRepos globalFlags')
        comp
        conf
@@ -439,7 +441,7 @@ infoAction infoFlags extraArgs globalFlags = do
       globalFlags' = savedGlobalFlags    config `mappend` globalFlags
   (comp, _, conf) <- configCompilerAux configFlags
   info verbosity
-       (configPackageDB' configFlags)
+       (configPackageDB' configFlags DontForceGlobalInstall)
        (globalRepos globalFlags')
        comp
        conf
@@ -480,7 +482,8 @@ fetchAction fetchFlags extraArgs globalFlags = do
       globalFlags' = savedGlobalFlags config `mappend` globalFlags
   (comp, platform, conf) <- configCompilerAux' configFlags
   fetch verbosity
-        (configPackageDB' configFlags) (globalRepos globalFlags')
+        (configPackageDB' configFlags DontForceGlobalInstall)
+        (globalRepos globalFlags')
         comp platform conf globalFlags' fetchFlags
         targets
 
@@ -582,7 +585,7 @@ initAction initFlags _extraArgs globalFlags = do
   let configFlags  = savedConfigureFlags config
   (comp, _, conf) <- configCompilerAux' configFlags
   initCabal verbosity
-            (configPackageDB' configFlags)
+            (configPackageDB' configFlags DontForceGlobalInstall)
             comp
             conf
             initFlags
@@ -623,11 +626,16 @@ win32SelfUpgradeAction _ _ _ = return ()
 -- Utils (transitionary)
 --
 
-configPackageDB' :: ConfigFlags -> PackageDBStack
-configPackageDB' cfg =
+data ForceGlobalInstall = DontForceGlobalInstall
+                        | ForceGlobalInstall
+
+configPackageDB' :: ConfigFlags -> ForceGlobalInstall -> PackageDBStack
+configPackageDB' cfg force =
     interpretPackageDbFlags userInstall (configPackageDBs cfg)
   where
-    userInstall = fromFlagOrDefault True (configUserInstall cfg)
+    userInstall = case force of
+      ForceGlobalInstall     -> False
+      DontForceGlobalInstall -> fromFlagOrDefault True (configUserInstall cfg)
 
 configCompilerAux' :: ConfigFlags
                    -> IO (Compiler, Platform, ProgramConfiguration)