diff --git a/cabal-install/Distribution/Client/Init.hs b/cabal-install/Distribution/Client/Init.hs index 39b07071c227057b20f257cc9aa1f9ea72af8059..049732d66aac51c9a7f3bedccd231171802ec09c 100644 --- a/cabal-install/Distribution/Client/Init.hs +++ b/cabal-install/Distribution/Client/Init.hs @@ -93,19 +93,28 @@ import Distribution.Simple.PackageIndex import Distribution.Text ( display, Text(..) ) +import Distribution.Client.PackageIndex + ( elemByPackageName ) +import Distribution.Client.IndexUtils + ( getSourcePackages ) +import Distribution.Client.Types + ( SourcePackageDb(..), Repo ) + initCabal :: Verbosity -> PackageDBStack + -> [Repo] -> Compiler -> ProgramConfiguration -> InitFlags -> IO () -initCabal verbosity packageDBs comp conf initFlags = do +initCabal verbosity packageDBs repos comp conf initFlags = do installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf + sourcePkgDb <- getSourcePackages verbosity repos hSetBuffering stdout NoBuffering - initFlags' <- extendFlags installedPkgIndex initFlags + initFlags' <- extendFlags installedPkgIndex sourcePkgDb initFlags writeLicense initFlags' writeSetupFile initFlags' @@ -121,9 +130,9 @@ initCabal verbosity packageDBs comp conf initFlags = do -- | Fill in more details by guessing, discovering, or prompting the -- user. -extendFlags :: InstalledPackageIndex -> InitFlags -> IO InitFlags -extendFlags pkgIx = - getPackageName +extendFlags :: InstalledPackageIndex -> SourcePackageDb -> InitFlags -> IO InitFlags +extendFlags pkgIx sourcePkgDb = + getPackageName sourcePkgDb >=> getVersion >=> getLicense >=> getAuthorInfo @@ -152,17 +161,35 @@ maybeToFlag :: Maybe a -> Flag a maybeToFlag = maybe NoFlag Flag -- | Get the package name: use the package directory (supplied, or the current --- directory by default) as a guess. -getPackageName :: InitFlags -> IO InitFlags -getPackageName flags = do +-- directory by default) as a guess. It looks at the SourcePackageDb to avoid +-- using an existing package name. +getPackageName :: SourcePackageDb -> InitFlags -> IO InitFlags +getPackageName sourcePkgDb flags = do guess <- traverse guessPackageName (flagToMaybe $ packageDir flags) ?>> Just `fmap` (getCurrentDirectory >>= guessPackageName) + let guess' | isPkgRegistered guess = Nothing + | otherwise = guess + pkgName' <- return (flagToMaybe $ packageName flags) - ?>> maybePrompt flags (prompt "Package name" guess) - ?>> return guess + ?>> maybePrompt flags (prompt "Package name" guess') + ?>> return guess' + + chooseAgain <- if isPkgRegistered pkgName' + then promptYesNo promptOtherNameMsg (Just True) + else return False + + if chooseAgain + then getPackageName sourcePkgDb flags + else return $ flags { packageName = maybeToFlag pkgName' } + + where + isPkgRegistered (Just pkg) = elemByPackageName (packageIndex sourcePkgDb) pkg + isPkgRegistered Nothing = False - return $ flags { packageName = maybeToFlag pkgName' } + promptOtherNameMsg = "This package name is already used by another " ++ + "package on hackage. Do you want to choose a " ++ + "different name" -- | Package version: use 0.1.0.0 as a last resort, but try prompting the user -- if possible. diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs index e1ffd304d49c2faf67394dbfa9d9cf6bc6314748..a6354e75d726c5d5c0a605767de6e6e21b7e71e3 100644 --- a/cabal-install/Main.hs +++ b/cabal-install/Main.hs @@ -1060,9 +1060,11 @@ initAction initFlags _extraArgs globalFlags = do (globalFlags { globalRequireSandbox = Flag False }) mempty let configFlags = savedConfigureFlags config + let globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, _, conf) <- configCompilerAux' configFlags initCabal verbosity (configPackageDB' configFlags) + (globalRepos globalFlags') comp conf initFlags