Commit 0a2fb235 authored by Duncan Coutts's avatar Duncan Coutts

Rearrange config settings and global command line settings

The intention here is to have the config file content and parser
be derivied from the command line types and flags. Now instead
of having a saved config type that contains additional
information to that kept in command line parameters we now put
all the information in the command line settings type and make
the saved config just the aggregation of the settings for
various key commands like configure, install, upload. There's
also an extended GlobalFlags type with the things like repos,
cache dir etc. When we generate the initial config file we put
in commented out versions of all (non-deprecated) valid fields,
along with their default values. The aim is to make the config
file self-documenting.
parent 2cfad55c
This diff is collapsed.
--FIXME: make this whole module go away!
module Distribution.Client.ParseUtils (
parseFields
) where
import Distribution.ParseUtils
( Field(..), FieldDescr(..), ParseResult(..)
, readFields, warning, lineNo )
import Control.Monad (foldM)
import qualified Data.Map as Map
--FIXME: this function is now in Cabal as of 1.5, so remove this local copy
parseFields :: [FieldDescr a] -> a -> String -> ParseResult a
parseFields fields initial = \str ->
readFields str >>= foldM setField initial
where
fieldMap = Map.fromList
[ (name, f) | f@(FieldDescr name _ _) <- fields ]
setField accum (F line name value) = case Map.lookup name fieldMap of
Just (FieldDescr _ _ set) -> set line value accum
Nothing -> do
warning $ "Unrecognized field " ++ name ++ " on line " ++ show line
return accum
setField accum f = do
warning $ "Unrecognized stanza on line " ++ show (lineNo f)
return accum
......@@ -11,9 +11,9 @@
--
-----------------------------------------------------------------------------
module Distribution.Client.Setup
( globalCommand, Cabal.GlobalFlags(..)
, configureCommand, filterConfigureFlags
, installCommand, InstallFlags(..)
( globalCommand, GlobalFlags(..), globalRepos
, configureCommand, Cabal.ConfigFlags(..), filterConfigureFlags, configPackageDB'
, installCommand, InstallFlags(..), installOptions, defaultInstallFlags
, listCommand, ListFlags(..)
, updateCommand
, upgradeCommand
......@@ -24,20 +24,25 @@ module Distribution.Client.Setup
, reportCommand
, parsePackageArgs
--TODO: stop exporting these:
, showRepo
, parseRepo
) where
import Distribution.Client.Types
( Username(..), Password(..) )
( Username(..), Password(..), Repo(..), RemoteRepo(..), LocalRepo(..) )
import Distribution.Simple.Program
( defaultProgramConfiguration )
import Distribution.Simple.Command hiding (boolOpt)
import qualified Distribution.Simple.Command as Command
import qualified Distribution.Simple.Setup as Cabal
( GlobalFlags(..), globalCommand
, ConfigFlags(..), configureCommand )
( ConfigFlags(..), configureCommand )
import Distribution.Simple.Setup
( Flag(..), toFlag, flagToList, flagToMaybe, trueArg, optionVerbosity )
( Flag(..), toFlag, fromFlag, flagToList, flagToMaybe, fromFlagOrDefault
, optionVerbosity, trueArg )
import Distribution.Simple.Compiler
( PackageDB(..) )
import Distribution.Version
( Version(Version), VersionRange(..) )
import Distribution.Package
......@@ -45,21 +50,54 @@ import Distribution.Package
import Distribution.Text
( Text(parse), display )
import Distribution.ReadE
( readP_to_E )
import Distribution.Compat.ReadP
( ReadP, readP_to_S, (+++) )
( readP_to_E, succeedReadE )
import qualified Distribution.Compat.ReadP as Parse
( ReadP, readP_to_S, char, munch1, pfail, (+++) )
import Distribution.Verbosity
( Verbosity, normal )
import Data.Char (isSpace)
import Data.Maybe (listToMaybe)
import Data.Monoid (Monoid(..))
import Control.Monad (liftM)
import Data.Char
( isSpace, isAlphaNum )
import Data.Maybe
( listToMaybe, maybeToList )
import Data.Monoid
( Monoid(..) )
import Control.Monad
( liftM )
import System.FilePath
( (</>) )
import Network.URI
( parseAbsoluteURI, uriToString )
-- ------------------------------------------------------------
-- * Global flags
-- ------------------------------------------------------------
-- | Flags that apply at the top level, not to any sub-command.
data GlobalFlags = GlobalFlags {
globalVersion :: Flag Bool,
globalNumericVersion :: Flag Bool,
globalConfigFile :: Flag FilePath,
globalRemoteRepos :: [RemoteRepo], -- ^Available Hackage servers.
globalCacheDir :: Flag FilePath,
globalLocalRepos :: [FilePath]
}
globalCommand :: CommandUI Cabal.GlobalFlags
globalCommand = Cabal.globalCommand {
commandDescription = Just $ \pname ->
defaultGlobalFlags :: GlobalFlags
defaultGlobalFlags = GlobalFlags {
globalVersion = Flag False,
globalNumericVersion = Flag False,
globalConfigFile = mempty,
globalRemoteRepos = [],
globalCacheDir = mempty,
globalLocalRepos = mempty
}
globalCommand :: CommandUI GlobalFlags
globalCommand = CommandUI {
commandName = "",
commandSynopsis = "",
commandDescription = Just $ \pname ->
"Typical step for installing Cabal packages:\n"
++ " " ++ pname ++ " install [PACKAGES]\n"
++ "\nOccasionally you need to update the list of available packages:\n"
......@@ -67,20 +105,101 @@ globalCommand = Cabal.globalCommand {
++ "\nFor more information about a command, try '"
++ pname ++ " COMMAND --help'."
++ "\nThis program is the command line interface to the Haskell Cabal Infrastructure."
++ "\nSee http://www.haskell.org/cabal/ for more information.\n"
++ "\nSee http://www.haskell.org/cabal/ for more information.\n",
commandUsage = \_ -> [],
commandDefaultFlags = defaultGlobalFlags,
commandOptions = \showOrParseArgs ->
(case showOrParseArgs of ShowArgs -> take 2; ParseArgs -> id)
[option ['V'] ["version"]
"Print version information"
globalVersion (\v flags -> flags { globalVersion = v })
trueArg
,option [] ["numeric-version"]
"Print just the version number"
globalNumericVersion (\v flags -> flags { globalNumericVersion = v })
trueArg
,option [] ["config-file"]
"Set an alternate location for the config file"
globalConfigFile (\v flags -> flags { globalConfigFile = v })
(reqArgFlag "FILE")
,option [] ["remote-repo"]
"The name and url for a remote repository"
globalRemoteRepos (\v flags -> flags { globalRemoteRepos = v })
(reqArg' "NAME:URL" (maybeToList . readRepo) (map showRepo))
,option [] ["remote-repo-cache"]
"The location where downloads from all remote repos are cached"
globalCacheDir (\v flags -> flags { globalCacheDir = v })
(reqArgFlag "DIR")
,option [] ["local-repo"]
"The location of a local repository"
globalLocalRepos (\v flags -> flags { globalLocalRepos = v })
(reqArg' "DIR" (\x -> [x]) id)
]
}
instance Monoid GlobalFlags where
mempty = GlobalFlags {
globalVersion = mempty,
globalNumericVersion = mempty,
globalConfigFile = mempty,
globalRemoteRepos = mempty,
globalCacheDir = mempty,
globalLocalRepos = mempty
}
mappend a b = GlobalFlags {
globalVersion = combine globalVersion,
globalNumericVersion = combine globalNumericVersion,
globalConfigFile = combine globalConfigFile,
globalRemoteRepos = combine globalRemoteRepos,
globalCacheDir = combine globalCacheDir,
globalLocalRepos = combine globalLocalRepos
}
where combine field = field a `mappend` field b
globalRepos :: GlobalFlags -> [Repo]
globalRepos globalFlags = remoteRepos ++ localRepos
where
remoteRepos =
[ Repo (Left remote) cacheDir
| remote <- globalRemoteRepos globalFlags
, let cacheDir = fromFlag (globalCacheDir globalFlags)
</> remoteRepoName remote ]
localRepos =
[ Repo (Right LocalRepo) local
| local <- globalLocalRepos globalFlags ]
-- ------------------------------------------------------------
-- * Config flags
-- ------------------------------------------------------------
configureCommand :: CommandUI Cabal.ConfigFlags
configureCommand = (Cabal.configureCommand defaultProgramConfiguration) {
commandDefaultFlags = mempty
}
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
filterConfigureFlags :: Cabal.ConfigFlags -> Version -> Cabal.ConfigFlags
filterConfigureFlags flags cabalLibVersion
| cabalLibVersion >= Version [1,3,10] [] = flags
-- older Cabal does not grok the constraints flag:
| otherwise = flags { Cabal.configConstraints = [] }
-- ------------------------------------------------------------
-- * Other commands
-- ------------------------------------------------------------
fetchCommand :: CommandUI (Flag Verbosity)
fetchCommand = CommandUI {
......@@ -241,8 +360,12 @@ installCommand = configureCommand {
commandDefaultFlags = (mempty, defaultInstallFlags),
commandOptions = \showOrParseArgs ->
liftOptionsFst (commandOptions configureCommand showOrParseArgs) ++
liftOptionsSnd
([ option "" ["documentation"]
liftOptionsSnd (installOptions showOrParseArgs)
}
installOptions :: ShowOrParseArgs -> [OptionField InstallFlags]
installOptions showOrParseArgs =
[ option "" ["documentation"]
"building of documentation"
installDocumentation (\v flags -> flags { installDocumentation = v })
(boolOpt [] [])
......@@ -287,11 +410,20 @@ installCommand = configureCommand {
installOnly (\v flags -> flags { installOnly = v })
trueArg
: []
_ -> [])
}
_ -> []
instance Monoid InstallFlags where
mempty = defaultInstallFlags
mempty = InstallFlags {
installDocumentation= mempty,
installDryRun = mempty,
installReinstall = mempty,
installOnly = mempty,
installRootCmd = mempty,
installCabalVersion = mempty,
installLogFile = mempty,
installBuildReports = mempty,
installSymlinkBinDir= mempty
}
mappend a b = InstallFlags {
installDocumentation= combine installDocumentation,
installDryRun = combine installDryRun,
......@@ -378,6 +510,10 @@ instance Monoid UploadFlags where
boolOpt :: SFlags -> SFlags -> MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
boolOpt = Command.boolOpt flagToMaybe Flag
reqArgFlag :: ArgPlaceHolder -> SFlags -> LFlags -> Description ->
(b -> Flag String) -> (Flag String -> b -> b) -> OptDescr b
reqArgFlag ad = reqArg ad (succeedReadE Flag) flagToList
liftOptionsFst :: [OptionField a] -> [OptionField (a,b)]
liftOptionsFst = map (liftOption fst (\a (_,b) -> (a,b)))
......@@ -400,13 +536,32 @@ parsePackageArgs = parsePkgArgs []
Just dep -> parsePkgArgs (dep:ds) args
Nothing -> Left ("Failed to parse package dependency: " ++ show arg)
readPToMaybe :: ReadP a a -> String -> Maybe a
readPToMaybe p str = listToMaybe [ r | (r,s) <- readP_to_S p str, all isSpace s ]
readPToMaybe :: Parse.ReadP a a -> String -> Maybe a
readPToMaybe p str = listToMaybe [ r | (r,s) <- Parse.readP_to_S p str
, all isSpace s ]
parseDependencyOrPackageId :: ReadP r Dependency
parseDependencyOrPackageId = parse +++ liftM pkgidToDependency parse
parseDependencyOrPackageId :: Parse.ReadP r Dependency
parseDependencyOrPackageId = parse Parse.+++ liftM pkgidToDependency parse
where
pkgidToDependency :: PackageIdentifier -> Dependency
pkgidToDependency p = case packageVersion p of
Version [] _ -> Dependency (packageName p) AnyVersion
version -> Dependency (packageName p) (ThisVersion version)
showRepo :: RemoteRepo -> String
showRepo repo = remoteRepoName repo ++ ":"
++ uriToString id (remoteRepoURI repo) []
readRepo :: String -> Maybe RemoteRepo
readRepo = readPToMaybe parseRepo
parseRepo :: Parse.ReadP r RemoteRepo
parseRepo = do
name <- Parse.munch1 (\c -> isAlphaNum c || c `elem` "_-.")
Parse.char ':'
uriStr <- Parse.munch1 (\c -> isAlphaNum c || c `elem` "+-=._/*()@'$:;&!?~")
uri <- maybe Parse.pfail return (parseAbsoluteURI uriStr)
return $ RemoteRepo {
remoteRepoName = name,
remoteRepoURI = uri
}
......@@ -14,25 +14,32 @@
module Main where
import Distribution.Client.Setup
import Distribution.Client.Types
( UnresolvedDependency(UnresolvedDependency) )
( GlobalFlags(..), globalCommand, globalRepos
, ConfigFlags(..), configureCommand
, InstallFlags(..), installCommand, upgradeCommand
, fetchCommand, checkCommand
, updateCommand
, ListFlags(..), listCommand
, UploadFlags(..), uploadCommand
, reportCommand
, parsePackageArgs, configPackageDB' )
import Distribution.Simple.Setup
( Flag(..), fromFlag, fromFlagOrDefault, flagToMaybe
, SDistFlags, sdistCommand )
import qualified Distribution.Simple.Setup as Cabal
import Distribution.Simple.Program (defaultProgramConfiguration)
import Distribution.Simple.Command
import Distribution.Simple.Configure (configCompilerAux)
import Distribution.Simple.Utils (cabalVersion, die, intercalate)
import Distribution.Text
( display )
( BuildFlags(..), buildCommand
, HaddockFlags(..), haddockCommand
, HscolourFlags(..), hscolourCommand
, CopyFlags(..), copyCommand
, RegisterFlags(..), registerCommand
, CleanFlags(..), cleanCommand
, SDistFlags(..), sdistCommand
, TestFlags(..), testCommand
, Flag(..), fromFlag, fromFlagOrDefault, flagToMaybe )
import Distribution.Client.Types
( UnresolvedDependency(UnresolvedDependency) )
import Distribution.Client.SetupWrapper
( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
import Distribution.Client.Config
( SavedConfig(..), savedConfigToConfigFlags, defaultConfigFile
, loadConfig, configRepos, configPackageDB )
( SavedConfig(..), loadConfig )
import Distribution.Client.List (list)
import Distribution.Client.Install (install, upgrade)
import Distribution.Client.Update (update)
......@@ -43,6 +50,12 @@ import Distribution.Client.Upload as Upload (upload, check, report)
import Distribution.Client.SrcDist (sdist)
import qualified Distribution.Client.Win32SelfUpgrade as Win32SelfUpgrade
import Distribution.Simple.Program (defaultProgramConfiguration)
import Distribution.Simple.Command
import Distribution.Simple.Configure (configCompilerAux)
import Distribution.Simple.Utils (cabalVersion, die, intercalate)
import Distribution.Text
( display )
import Distribution.Verbosity as Verbosity
( Verbosity, normal, intToVerbosity )
import qualified Paths_cabal_install (version)
......@@ -68,14 +81,14 @@ mainWorker args =
CommandHelp help -> printHelp help
CommandList opts -> printOptionsList opts
CommandErrors errs -> printErrors errs
CommandReadyToGo (flags, commandParse) ->
CommandReadyToGo (globalflags, commandParse) ->
case commandParse of
_ | fromFlag (globalVersion flags) -> printVersion
| fromFlag (globalNumericVersion flags) -> printNumericVersion
_ | fromFlag (globalVersion globalflags) -> printVersion
| fromFlag (globalNumericVersion globalflags) -> printNumericVersion
CommandHelp help -> printHelp help
CommandList opts -> printOptionsList opts
CommandErrors errs -> printErrors errs
CommandReadyToGo action -> action
CommandReadyToGo action -> action globalflags
where
printHelp help = getProgName >>= putStr . help
......@@ -101,29 +114,30 @@ mainWorker args =
,checkCommand `commandAddAction` checkAction
,sdistCommand `commandAddAction` sdistAction
,reportCommand `commandAddAction` reportAction
,wrapperAction (Cabal.buildCommand defaultProgramConfiguration)
Cabal.buildVerbosity Cabal.buildDistPref
,wrapperAction Cabal.copyCommand
Cabal.copyVerbosity Cabal.copyDistPref
,wrapperAction Cabal.haddockCommand
Cabal.haddockVerbosity Cabal.haddockDistPref
,wrapperAction Cabal.cleanCommand
Cabal.cleanVerbosity Cabal.cleanDistPref
,wrapperAction Cabal.hscolourCommand
Cabal.hscolourVerbosity Cabal.hscolourDistPref
,wrapperAction Cabal.registerCommand
Cabal.regVerbosity Cabal.regDistPref
,wrapperAction Cabal.testCommand
Cabal.testVerbosity Cabal.testDistPref
,wrapperAction (buildCommand defaultProgramConfiguration)
buildVerbosity buildDistPref
,wrapperAction copyCommand
copyVerbosity copyDistPref
,wrapperAction haddockCommand
haddockVerbosity haddockDistPref
,wrapperAction cleanCommand
cleanVerbosity cleanDistPref
,wrapperAction hscolourCommand
hscolourVerbosity hscolourDistPref
,wrapperAction registerCommand
regVerbosity regDistPref
,wrapperAction testCommand
testVerbosity testDistPref
]
wrapperAction :: Monoid flags
=> CommandUI flags
-> (flags -> Flag Verbosity)
-> (flags -> Flag String)
-> Command (IO ())
-> Command (GlobalFlags -> IO ())
wrapperAction command verbosityFlag distPrefFlag =
commandAddAction command $ \flags extraArgs -> do
commandAddAction command
{ commandDefaultFlags = mempty } $ \flags extraArgs _globalFlags -> do
let verbosity = fromFlagOrDefault normal (verbosityFlag flags)
setupScriptOptions = defaultSetupScriptOptions {
useDistPref = fromFlagOrDefault
......@@ -133,118 +147,103 @@ wrapperAction command verbosityFlag distPrefFlag =
setupWrapper verbosity setupScriptOptions Nothing
command (const flags) extraArgs
configureAction :: Cabal.ConfigFlags -> [String] -> IO ()
configureAction flags extraArgs = do
configFile <- defaultConfigFile --FIXME
let verbosity = fromFlagOrDefault normal (Cabal.configVerbosity flags)
config <- loadConfig verbosity configFile
let flags' = savedConfigToConfigFlags (Cabal.configUserInstall flags) config
`mappend` flags
configureAction :: ConfigFlags -> [String] -> GlobalFlags -> IO ()
configureAction flags extraArgs globalFlags = do
let verbosity = fromFlagOrDefault normal (configVerbosity flags)
config <- loadConfig verbosity (globalConfigFile globalFlags)
let flags' = savedConfigureFlags config `mappend` flags
(comp, conf) <- configCompilerAux flags'
let setupScriptOptions = defaultSetupScriptOptions {
useCompiler = Just comp,
useProgramConfig = conf,
useDistPref = fromFlagOrDefault
(useDistPref defaultSetupScriptOptions)
(Cabal.configDistPref flags)
(configDistPref flags)
}
setupWrapper verbosity setupScriptOptions Nothing
configureCommand (const flags') extraArgs
installAction :: (Cabal.ConfigFlags, InstallFlags) -> [String] -> IO ()
installAction (cflags,iflags) _
| Cabal.fromFlag (installOnly iflags)
= let verbosity = fromFlagOrDefault normal (Cabal.configVerbosity cflags)
installAction :: (ConfigFlags, InstallFlags) -> [String] -> GlobalFlags -> IO ()
installAction (cflags,iflags) _ _globalFlags
| fromFlag (installOnly iflags)
= let verbosity = fromFlagOrDefault normal (configVerbosity cflags)
in setupWrapper verbosity defaultSetupScriptOptions Nothing
Cabal.installCommand mempty []
installCommand mempty []
installAction (cflags,iflags) extraArgs = do
installAction (cflags,iflags) extraArgs globalFlags = do
pkgs <- either die return (parsePackageArgs extraArgs)
configFile <- defaultConfigFile --FIXME
let verbosity = fromFlagOrDefault normal (Cabal.configVerbosity cflags)
config <- loadConfig verbosity configFile
let cflags' = savedConfigToConfigFlags (Cabal.configUserInstall cflags) config
`mappend` cflags
let verbosity = fromFlagOrDefault normal (configVerbosity cflags)
config <- loadConfig verbosity (globalConfigFile globalFlags)
let cflags' = savedConfigureFlags config `mappend` cflags
(comp, conf) <- configCompilerAux cflags'
install verbosity
(configPackageDB cflags') (configRepos config)
comp conf cflags' iflags {
installSymlinkBinDir = configSymlinkBinDir config
}
[ UnresolvedDependency pkg (Cabal.configConfigurationsFlags cflags')
(configPackageDB' cflags') (globalRepos (savedGlobalFlags config))
comp conf cflags' iflags
[ UnresolvedDependency pkg (configConfigurationsFlags cflags')
| pkg <- pkgs ]
listAction :: ListFlags -> [String] -> IO ()
listAction listFlags extraArgs = do
configFile <- defaultConfigFile --FIXME
listAction :: ListFlags -> [String] -> GlobalFlags -> IO ()
listAction listFlags extraArgs globalFlags = do
let verbosity = fromFlag (listVerbosity listFlags)
config <- loadConfig verbosity configFile
let flags = savedConfigToConfigFlags NoFlag config
config <- loadConfig verbosity (globalConfigFile globalFlags)
let flags = savedConfigureFlags config
(comp, conf) <- configCompilerAux flags
list verbosity
(configPackageDB flags)
(configRepos config)
(configPackageDB' flags)
(globalRepos (savedGlobalFlags config))
comp
conf
listFlags
extraArgs
updateAction :: Flag Verbosity -> [String] -> IO ()
updateAction verbosityFlag extraArgs = do
updateAction :: Flag Verbosity -> [String] -> GlobalFlags -> IO ()
updateAction verbosityFlag extraArgs globalFlags = do
unless (null extraArgs) $ do
die $ "'update' doesn't take any extra arguments: " ++ unwords extraArgs
configFile <- defaultConfigFile --FIXME
let verbosity = fromFlag verbosityFlag
config <- loadConfig verbosity configFile
update verbosity (configRepos config)
config <- loadConfig verbosity (globalConfigFile globalFlags)
update verbosity (globalRepos (savedGlobalFlags config))
upgradeAction :: (Cabal.ConfigFlags, InstallFlags) -> [String] -> IO ()
upgradeAction (cflags,iflags) extraArgs = do
upgradeAction :: (ConfigFlags, InstallFlags) -> [String] -> GlobalFlags -> IO ()
upgradeAction (cflags,iflags) extraArgs globalFlags = do
pkgs <- either die return (parsePackageArgs extraArgs)
configFile <- defaultConfigFile --FIXME
let verbosity = fromFlagOrDefault normal (Cabal.configVerbosity cflags)
config <- loadConfig verbosity configFile
let cflags' = savedConfigToConfigFlags (Cabal.configUserInstall cflags) config
`mappend` cflags
let verbosity = fromFlagOrDefault normal (configVerbosity cflags)
config <- loadConfig verbosity (globalConfigFile globalFlags)
let cflags' = savedConfigureFlags config `mappend` cflags
(comp, conf) <- configCompilerAux cflags'
upgrade verbosity
(configPackageDB cflags') (configRepos config)
comp conf cflags' iflags {
installSymlinkBinDir = configSymlinkBinDir config
}
[ UnresolvedDependency pkg (Cabal.configConfigurationsFlags cflags')
(configPackageDB' cflags') (globalRepos (savedGlobalFlags config))
comp conf cflags' iflags
[ UnresolvedDependency pkg (configConfigurationsFlags cflags')
| pkg <- pkgs ]
fetchAction :: Flag Verbosity -> [String] -> IO ()
fetchAction verbosityFlag extraArgs = do
fetchAction :: Flag Verbosity -> [String] -> GlobalFlags -> IO ()
fetchAction verbosityFlag extraArgs globalFlags = do
pkgs <- either die return (parsePackageArgs extraArgs)
configFile <- defaultConfigFile --FIXME
let verbosity = fromFlag verbosityFlag
config <- loadConfig verbosity configFile
let flags = savedConfigToConfigFlags NoFlag config
config <- loadConfig verbosity (globalConfigFile globalFlags)
let flags = savedConfigureFlags config
(comp, conf) <- configCompilerAux flags
fetch verbosity
(configPackageDB flags) (configRepos config)
(configPackageDB' flags) (globalRepos (savedGlobalFlags config))
comp conf
[ UnresolvedDependency pkg [] --TODO: flags?
| pkg <- pkgs ]
uploadAction :: UploadFlags -> [String] -> IO ()
uploadAction flags extraArgs = do
configFile <- defaultConfigFile --FIXME
let verbosity = fromFlag (uploadVerbosity flags)
config <- loadConfig verbosity configFile
uploadAction :: UploadFlags -> [String] -> GlobalFlags -> IO ()
uploadAction uploadFlags extraArgs globalFlags = do
let verbosity = fromFlag (uploadVerbosity uploadFlags)
config <- loadConfig verbosity (globalConfigFile globalFlags)
let uploadFlags' = savedUploadFlags config `mappend` uploadFlags
-- FIXME: check that the .tar.gz files exist and report friendly error message if not
let tarfiles = extraArgs
checkTarFiles tarfiles
if fromFlag (uploadCheck flags)
if fromFlag (uploadCheck uploadFlags')
then Upload.check verbosity tarfiles
else upload verbosity
(configRepos config)
(flagToMaybe $ configUploadUsername config
`mappend` uploadUsername flags)
(flagToMaybe $ configUploadPassword config
`mappend` uploadPassword flags)
(globalRepos (savedGlobalFlags config))
(flagToMaybe $ uploadUsername uploadFlags')
(flagToMaybe $ uploadPassword uploadFlags')
tarfiles
where