Skip to content

Commit a2d98b8

Browse files
committed
Add a ForceGlobalInstall argument to configPackageDB'.
In sandbox mode userInstallDirs = globalInstallDirs and we set userInstall to False to prevent UserPackageDB from being added to the package DB stack (see haskell#1183).
1 parent 0c9284f commit a2d98b8

File tree

1 file changed

+17
-9
lines changed

1 file changed

+17
-9
lines changed

cabal-install/Main.hs

Lines changed: 17 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -205,7 +205,8 @@ configureAction (configFlags, configExFlags) extraArgs globalFlags = do
205205
globalFlags' = savedGlobalFlags config `mappend` globalFlags
206206
(comp, platform, conf) <- configCompilerAux configFlags'
207207
configure verbosity
208-
(configPackageDB' configFlags') (globalRepos globalFlags')
208+
(configPackageDB' configFlags' DontForceGlobalInstall)
209+
(globalRepos globalFlags')
209210
comp platform conf configFlags' configExFlags' extraArgs
210211

211212
buildAction :: BuildFlags -> [String] -> GlobalFlags -> IO ()
@@ -376,7 +377,8 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
376377
globalFlags' = savedGlobalFlags config `mappend` globalFlags
377378
(comp, platform, conf) <- configCompilerAux' configFlags'
378379
install verbosity
379-
(configPackageDB' configFlags') (globalRepos globalFlags')
380+
(configPackageDB' configFlags' DontForceGlobalInstall)
381+
(globalRepos globalFlags')
380382
comp platform conf globalFlags' configFlags' configExFlags'
381383
installFlags' haddockFlags
382384
targets
@@ -423,7 +425,7 @@ listAction listFlags extraArgs globalFlags = do
423425
globalFlags' = savedGlobalFlags config `mappend` globalFlags
424426
(comp, _, conf) <- configCompilerAux' configFlags
425427
list verbosity
426-
(configPackageDB' configFlags)
428+
(configPackageDB' configFlags DontForceGlobalInstall)
427429
(globalRepos globalFlags')
428430
comp
429431
conf
@@ -439,7 +441,7 @@ infoAction infoFlags extraArgs globalFlags = do
439441
globalFlags' = savedGlobalFlags config `mappend` globalFlags
440442
(comp, _, conf) <- configCompilerAux configFlags
441443
info verbosity
442-
(configPackageDB' configFlags)
444+
(configPackageDB' configFlags DontForceGlobalInstall)
443445
(globalRepos globalFlags')
444446
comp
445447
conf
@@ -480,7 +482,8 @@ fetchAction fetchFlags extraArgs globalFlags = do
480482
globalFlags' = savedGlobalFlags config `mappend` globalFlags
481483
(comp, platform, conf) <- configCompilerAux' configFlags
482484
fetch verbosity
483-
(configPackageDB' configFlags) (globalRepos globalFlags')
485+
(configPackageDB' configFlags DontForceGlobalInstall)
486+
(globalRepos globalFlags')
484487
comp platform conf globalFlags' fetchFlags
485488
targets
486489

@@ -582,7 +585,7 @@ initAction initFlags _extraArgs globalFlags = do
582585
let configFlags = savedConfigureFlags config
583586
(comp, _, conf) <- configCompilerAux' configFlags
584587
initCabal verbosity
585-
(configPackageDB' configFlags)
588+
(configPackageDB' configFlags DontForceGlobalInstall)
586589
comp
587590
conf
588591
initFlags
@@ -623,11 +626,16 @@ win32SelfUpgradeAction _ _ _ = return ()
623626
-- Utils (transitionary)
624627
--
625628

626-
configPackageDB' :: ConfigFlags -> PackageDBStack
627-
configPackageDB' cfg =
629+
data ForceGlobalInstall = DontForceGlobalInstall
630+
| ForceGlobalInstall
631+
632+
configPackageDB' :: ConfigFlags -> ForceGlobalInstall -> PackageDBStack
633+
configPackageDB' cfg force =
628634
interpretPackageDbFlags userInstall (configPackageDBs cfg)
629635
where
630-
userInstall = fromFlagOrDefault True (configUserInstall cfg)
636+
userInstall = case force of
637+
ForceGlobalInstall -> False
638+
DontForceGlobalInstall -> fromFlagOrDefault True (configUserInstall cfg)
631639

632640
configCompilerAux' :: ConfigFlags
633641
-> IO (Compiler, Platform, ProgramConfiguration)

0 commit comments

Comments
 (0)