Commit f8a25d1e authored by Duncan Coutts's avatar Duncan Coutts

Fix fromFlag bug and use default flags for list command

parent 96e0a6f1
......@@ -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
......
......@@ -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 })
......
......@@ -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 ()
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment