Simplify the behavior of package db flags.

Previously, the `-no-user-package` and `-no-global-package` flags
affected the "initial" stack only, while `user-package` and
`global-packages` appended to the end of the stack.

This commit changes the behavior of those flags, so that they are always
applied to the stack as a whole.

The effect of the GHC_PACKAGE_PATH environment variable has also been
changed: terminating it with a separator now adds the default package
dbs (user and global) instead of the initial stack.

4 files changed, 41 insertions, 39 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 7d22a7b138..c26efb2597 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -276,8 +276,6 @@ data DynFlag
    | Opt_ForceRecomp
    | Opt_ExcessPrecision
    | Opt_EagerBlackHoling
-   | Opt_ReadGlobalPackageConf
-   | Opt_ReadUserPackageConf
    | Opt_NoHsMain
    | Opt_SplitObjs
    | Opt_StgStats
@@ -550,7 +548,7 @@ data DynFlags = DynFlags {
   depSuffixes           :: [String],
 
   --  Package flags
-  extraPkgConfs         :: [PkgConfRef],
+  extraPkgConfs         :: [PkgConfRef] -> [PkgConfRef],
         -- ^ The @-package-db@ flags given on the command line, in the order
         -- they appeared.
 
@@ -925,7 +923,7 @@ defaultDynFlags mySettings =
 
         hpcDir                  = ".hpc",
 
-        extraPkgConfs           = [],
+        extraPkgConfs           = id,
         packageFlags            = [],
         pkgDatabase             = Nothing,
         pkgState                = panic "no package state yet: call GHC.setSessionDynFlags",
@@ -1757,12 +1755,12 @@ dynamic_flags = [
 package_flags :: [Flag (CmdLineP DynFlags)]
 package_flags = [
         ------- Packages ----------------------------------------------------
-    Flag "package-db"            (HasArg (extraPkgConf_ . PkgConfFile))
+    Flag "package-db"            (HasArg (addPkgConfRef . PkgConfFile))
   , Flag "clear-package-db"      (NoArg clearPkgConf)
-  , Flag "no-global-package-db"  (NoArg (unSetDynFlag Opt_ReadGlobalPackageConf))
-  , Flag "no-user-package-db"    (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
-  , Flag "global-package-db"     (NoArg (extraPkgConf_ GlobalPkgConf))
-  , Flag "user-package-db"       (NoArg (extraPkgConf_ UserPkgConf))
+  , Flag "no-global-package-db"  (NoArg removeGlobalPkgConf)
+  , Flag "no-user-package-db"    (NoArg removeUserPkgConf)
+  , Flag "global-package-db"     (NoArg (addPkgConfRef GlobalPkgConf))
+  , Flag "user-package-db"       (NoArg (addPkgConfRef UserPkgConf))
 
   , Flag "package-name"          (hasArg setPackageName)
   , Flag "package-id"            (HasArg exposePackageId)
@@ -2073,8 +2071,6 @@ xFlags = [
 defaultFlags :: [DynFlag]
 defaultFlags
   = [ Opt_AutoLinkPackages,
-      Opt_ReadGlobalPackageConf,
-      Opt_ReadUserPackageConf,
 
       Opt_SharedImplib,
 
@@ -2417,13 +2413,23 @@ data PkgConfRef
   | UserPkgConf
   | PkgConfFile FilePath
 
-extraPkgConf_ :: PkgConfRef -> DynP ()
-extraPkgConf_  p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
+addPkgConfRef :: PkgConfRef -> DynP ()
+addPkgConfRef p = upd $ \s -> s { extraPkgConfs = (p:) . extraPkgConfs s }
+
+removeUserPkgConf :: DynP ()
+removeUserPkgConf = upd $ \s -> s { extraPkgConfs = filter isNotUser . extraPkgConfs s }
+  where
+    isNotUser UserPkgConf = False
+    isNotUser _ = True
+
+removeGlobalPkgConf :: DynP ()
+removeGlobalPkgConf = upd $ \s -> s { extraPkgConfs = filter isNotGlobal . extraPkgConfs s }
+  where
+    isNotGlobal GlobalPkgConf = False
+    isNotGlobal _ = True
 
 clearPkgConf :: DynP ()
-clearPkgConf = do
-  unSetDynFlag Opt_ReadGlobalPackageConf
-  unSetDynFlag Opt_ReadUserPackageConf
+clearPkgConf = upd $ \s -> s { extraPkgConfs = const [] }
 
 exposePackage, exposePackageId, hidePackage, ignorePackage,
         trustPackage, distrustPackage :: String -> DynP ()
diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index 6d917fa327..cdda96193c 100644
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -184,13 +184,7 @@ initPackages dflags = do
 
 readPackageConfigs :: DynFlags -> IO [PackageConfig]
 readPackageConfigs dflags = do
-  let -- Read global package db, unless the -no-user-package-db flag was given
-      global_conf_refs = [GlobalPkgConf | dopt Opt_ReadGlobalPackageConf dflags]
-      -- Read user's package conf (eg. ~/.ghc/i386-linux-6.3/package.conf)
-      -- unless the -no-user-package-db flag was given.
-      user_conf_refs = [UserPkgConf | dopt Opt_ReadUserPackageConf dflags]
-
-      system_conf_refs = global_conf_refs ++ user_conf_refs
+  let system_conf_refs = [UserPkgConf, GlobalPkgConf]
 
   e_pkg_path <- tryIO (getEnv "GHC_PACKAGE_PATH")
   let base_conf_refs = case e_pkg_path of
@@ -202,9 +196,9 @@ readPackageConfigs dflags = do
          -> map PkgConfFile cs
          where cs = parseSearchPath path
          -- if the path ends in a separator (eg. "/foo/bar:")
-         -- the we tack on the base paths.
+         -- then we tack on the system paths.
 
-  let conf_refs = base_conf_refs ++ reverse (extraPkgConfs dflags)
+  let conf_refs = reverse (extraPkgConfs dflags base_conf_refs)
   -- later packages shadow earlier ones.  extraPkgConfs
   -- is in the opposite order to the flags on the
   -- command line.
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index ac44c02c86..b501961b4e 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -601,13 +601,13 @@
           </row>
           <row>
             <entry><option>-clear-package-db</option></entry>
-            <entry>Use an empty initial package db stack.</entry>
+            <entry>Clear the package db stack.</entry>
             <entry>static</entry>
             <entry>-</entry>
           </row>
           <row>
             <entry><option>-no-global-package-db</option></entry>
-            <entry>Don't add the global db to the initial package db stack.</entry>
+            <entry>Remove the global package db from the stack.</entry>
             <entry>static</entry>
             <entry>-</entry>
           </row>
@@ -619,7 +619,7 @@
           </row>
           <row>
             <entry><option>-no-user-package-db</option></entry>
-            <entry>Don't add the user's package db to the initial package db stack.</entry>
+            <entry>Remove the user's package db from the stack.</entry>
             <entry>static</entry>
             <entry>-</entry>
           </row>
diff --git a/docs/users_guide/packages.xml b/docs/users_guide/packages.xml
index 8df8cb953a..d1df2d4712 100644
--- a/docs/users_guide/packages.xml
+++ b/docs/users_guide/packages.xml
@@ -408,7 +408,7 @@ _ZCMain_main_closure
       see GHC's package table by running GHC with the <option>-v</option>
       flag.</para>
 
-    <para>Package databases mayb overlap, and they are arranged in a stack
+    <para>Package databases may overlap, and they are arranged in a stack
       structure. Packages closer to the top of the stack will override
       (<emphasis>shadow</emphasis>) those below them. By default, the stack
       contains just the global and the user's package databases, in that
@@ -425,9 +425,9 @@ _ZCMain_main_closure
         </term>
         <listitem>
           <para>Add the package database <replaceable>file</replaceable> on top
-            of the current stack. Packages in additional databases read this
-            way will override those in the initial stack and those in
-            previously specified databases.</para>
+              of the current stack. Packages in additional databases read this
+              way will override those in the initial stack and those in
+              previously specified databases.</para>
         </listitem>
       </varlistentry>
 
@@ -437,7 +437,8 @@ _ZCMain_main_closure
           </indexterm>
         </term>
         <listitem>
-          <para>Prevent loading of the global package database in the initial stack.</para>
+          <para>Remove the global package database from the package database
+              stack.</para>
         </listitem>
       </varlistentry>
 
@@ -447,7 +448,8 @@ _ZCMain_main_closure
           </indexterm>
         </term>
         <listitem>
-          <para>Prevent loading of the user's local package database in the initial stack.</para>
+          <para>Prevent loading of the user's local package database in the
+              initial stack.</para>
         </listitem>
       </varlistentry>
 
@@ -457,10 +459,10 @@ _ZCMain_main_closure
           </indexterm>
         </term>
         <listitem>
-          <para>Start with an empty initial package database stack. This option
-            is equivalent to the combination of
-            <literal>-no-global-package-db</literal> and
-            <literal>-no-user-package-db.</literal></para>
+            <para>Reset the current package database stack. This option removes
+                every previously specified package database (including those
+                read from the <literal>GHC_PACKAGE_PATH</literal> environment
+                variable) from the package database stack.</para>
         </listitem>
       </varlistentry>
 
@@ -508,7 +510,7 @@ _ZCMain_main_closure
         packages.</para>
 
       <para>If <literal>GHC_PACKAGE_PATH</literal> ends in a separator, then
-        the initial package database stack (by default, the user and global
+        the default package database stack (i.e. the user and global
         package databases, in that order) is appended. For example, to augment
         the usual set of packages with a database of your own, you could say
         (on Unix):