[commit: Cabal] master: Fix fromFlag bug and use default flags for list command (f8a25d1)

[Paolo Capriotti]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/f8a25d1ea021c76432bf3da5166644f61df89cf3

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

commit f8a25d1ea021c76432bf3da5166644f61df89cf3
Author: Duncan Coutts <duncan at haskell.org>
Date:   Mon Mar 3 16:41:54 2008 +0000

    Fix fromFlag bug and use default flags for list command

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

 cabal-install/Hackage/Config.hs |   10 ++++++++++
 cabal-install/Hackage/Setup.hs  |    2 +-
 cabal-install/Main.hs           |   11 ++++++-----
 3 files changed, 17 insertions(+), 6 deletions(-)

diff --git a/cabal-install/Hackage/Config.hs b/cabal-install/Hackage/Config.hs
index 0017d4f..074fb05 100644
--- a/cabal-install/Hackage/Config.hs
+++ b/cabal-install/Hackage/Config.hs
@@ -14,6 +14,7 @@ module Hackage.Config
     ( SavedConfig(..)
     , savedConfigToConfigFlags
     , configRepos
+    , configPackageDB
     , defaultConfigFile
     , loadConfig
     , showConfig
@@ -32,6 +33,7 @@ import Distribution.Compat.ReadP (ReadP, char, munch1, readS_to_P)
 import Distribution.Compiler (CompilerFlavor(..), defaultCompilerFlavor)
 import Distribution.PackageDescription.Parse (ParseResult(..))
 import Distribution.ParseUtils (FieldDescr(..), simpleField, listField, liftField, field)
+import Distribution.Simple.Compiler (PackageDB(..))
 import Distribution.Simple.InstallDirs (InstallDirs(..), PathTemplate, toPathTemplate)
 import Distribution.Simple.Setup (Flag(..), toFlag, fromFlag, fromFlagOrDefault)
 import qualified Distribution.Simple.Setup as Cabal
@@ -42,6 +44,14 @@ import Hackage.ParseUtils
 import Hackage.Utils (readFileIfExists)
 import Distribution.Simple.Utils (notice, warn)
 
+configPackageDB :: Cabal.ConfigFlags -> PackageDB
+configPackageDB config =
+  fromFlagOrDefault defaultDB (Cabal.configPackageDB config)
+  where
+    defaultDB = case Cabal.configUserInstall config of
+      NoFlag     -> UserPackageDB
+      Flag True  -> UserPackageDB
+      Flag False -> GlobalPackageDB
 
 --
 -- * Configuration saved in the config file
diff --git a/cabal-install/Hackage/Setup.hs b/cabal-install/Hackage/Setup.hs
index 67d00c7..06b6121 100644
--- a/cabal-install/Hackage/Setup.hs
+++ b/cabal-install/Hackage/Setup.hs
@@ -156,7 +156,7 @@ listCommand = CommandUI {
     commandSynopsis     = "List available packages on the server (cached).",
     commandDescription  = Nothing,
     commandUsage        = usagePackages "list",
-    commandDefaultFlags = mempty,
+    commandDefaultFlags = defaultListFlags,
     commandOptions      = \_ -> [
         optionVerbose listVerbosity (\v flags -> flags { listVerbosity = v })
 
diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs
index b1c20c9..6435d41 100644
--- a/cabal-install/Main.hs
+++ b/cabal-install/Main.hs
@@ -23,7 +23,8 @@ import Distribution.Simple.SetupWrapper (setupWrapper)
 import Distribution.Simple.Configure (configCompilerAux)
 import Distribution.Simple.Utils (cabalVersion, die)
 import Hackage.Config           (SavedConfig(..), savedConfigToConfigFlags,
-                                 defaultConfigFile, loadConfig, configRepos)
+                                 defaultConfigFile, loadConfig, configRepos,
+                                 configPackageDB)
 import Hackage.List             (list)
 import Hackage.Install          (install)
 import Hackage.Update           (update)
@@ -126,7 +127,7 @@ installAction (cflags,iflags) extraArgs = do
                `mappend` cflags
   (comp, conf) <- configCompilerAux cflags'
   install verbosity
-          (fromFlag $ Cabal.configPackageDB cflags') (configRepos config)
+          (configPackageDB cflags') (configRepos config)
           comp conf cflags' iflags pkgs
 
 listAction :: ListFlags -> [String] -> IO ()
@@ -137,7 +138,7 @@ listAction listFlags extraArgs = do
   let flags = savedConfigToConfigFlags NoFlag config
   (comp, conf) <- configCompilerAux flags
   list verbosity
-       (fromFlag $ Cabal.configPackageDB flags)
+       (configPackageDB flags)
        (configRepos config)
        comp
        conf
@@ -160,7 +161,7 @@ upgradeAction (cflags,iflags) _extraArgs = do
                `mappend` cflags
   (comp, conf) <- configCompilerAux cflags'
   upgrade verbosity
-          (fromFlag $ Cabal.configPackageDB cflags') (configRepos config)
+          (configPackageDB cflags') (configRepos config)
           comp conf cflags' iflags
 
 fetchAction :: Flag Verbosity -> [String] -> IO ()
@@ -172,7 +173,7 @@ fetchAction verbosityFlag extraArgs = do
   let flags = savedConfigToConfigFlags NoFlag config
   (comp, conf) <- configCompilerAux flags
   fetch verbosity
-        (fromFlag $ Cabal.configPackageDB flags) (configRepos config)
+        (configPackageDB flags) (configRepos config)
         comp conf pkgs
 
 uploadAction :: UploadFlags -> [String] -> IO ()