Fix #1569.

* Change `guessPackageName` to translate arbitrary strings into valid
package names.
* Change type of `packageName` flag from String to PackageName and
reject names that do not pass PackageName's corresponding parse
function.

cabal-install/Distribution/Client/Init.hs

@@ -154,7 +154,7 @@ getPackageName flags = do
               ?>> Just `fmap` (getCurrentDirectory >>= guessPackageName)
 
   pkgName' <-     return (flagToMaybe $ packageName flags)
-              ?>> maybePrompt flags (promptStr "Package name" guess)
+              ?>> maybePrompt flags (prompt "Package name" guess)
               ?>> return guess
 
   return $ flags { packageName = maybeToFlag pkgName' }
@@ -597,7 +597,7 @@ writeCabalFile flags@(InitFlags{packageName = NoFlag}) = do
   message flags "Error: no package name provided."
   return False
 writeCabalFile flags@(InitFlags{packageName = Flag p}) = do
-  let cabalFileName = p ++ ".cabal"
+  let cabalFileName = display p ++ ".cabal"
   message flags $ "Generating " ++ cabalFileName ++ "..."
   writeFileSafe flags cabalFileName (generateCabalFile cabalFileName flags)
   return True
@@ -647,7 +647,7 @@ generateCabalFile fileName c =
          $$ text ""
     else empty)
   $$
-  vcat [ fieldS "name"          (packageName   c)
+  vcat [ field  "name"          (packageName   c)
                 (Just "The name of the package.")
                 True
 
@@ -712,7 +712,9 @@ generateCabalFile fileName c =
 
        , case packageType c of
            Flag Executable ->
-             text "\nexecutable" <+> text (fromMaybe "" . flagToMaybe $ packageName c) $$ nest 2 (vcat
+             text "\nexecutable" <+>
+             text (maybe "" display . flagToMaybe $ packageName c) $$
+             nest 2 (vcat
              [ fieldS "main-is" NoFlag (Just ".hs or .lhs file containing the Main module.") True
 
              , generateBuildInfo Executable c

cabal-install/Distribution/Client/Init/Heuristics.hs

@@ -24,6 +24,7 @@ import Distribution.ModuleName
     ( ModuleName, toFilePath )
 import Distribution.Client.PackageIndex
     ( allPackagesByName )
+import qualified Distribution.Package as P
 import qualified Distribution.PackageDescription as PD
     ( category, packageDescription )
 import Distribution.Simple.Utils
@@ -34,8 +35,9 @@ import Language.Haskell.Extension ( Extension )
 
 import Distribution.Client.Types ( packageDescription, SourcePackageDb(..) )
 import Control.Applicative ( pure, (<$>), (<*>) )
+import Control.Arrow ( first )
 import Control.Monad ( liftM )
-import Data.Char   ( isUpper, isLower, isSpace )
+import Data.Char   ( isAlphaNum, isNumber, isUpper, isLower, isSpace )
 import Data.Either ( partitionEithers )
 import Data.List   ( isPrefixOf )
 import Data.Maybe  ( mapMaybe, catMaybes, maybeToList )
@@ -50,9 +52,26 @@ import System.FilePath ( takeExtension, takeBaseName, dropExtension,
 import Distribution.Client.Compat.Process ( readProcessWithExitCode )
 import System.Exit ( ExitCode(..) )
 
--- |Guess the package name based on the given root directory
-guessPackageName :: FilePath -> IO String
-guessPackageName = liftM (last . splitDirectories) . tryCanonicalizePath
+-- | Guess the package name based on the given root directory.
+guessPackageName :: FilePath -> IO P.PackageName
+guessPackageName = liftM (P.PackageName . repair . last . splitDirectories)
+                 . tryCanonicalizePath
+  where
+    -- Treat each span of non-alphanumeric characters as a hyphen. Each
+    -- hyphenated component of a package name must contain at least one
+    -- alphabetic character. An arbitrary character ('x') will be prepended if
+    -- this is not the case for the first component, and subsequent components
+    -- will simply be run together. For example, "1+2_foo-3" will become
+    -- "x12-foo3".
+    repair = repair' ('x' :) id
+    repair' invalid valid x = case dropWhile (not . isAlphaNum) x of
+        "" -> repairComponent ""
+        x' -> let (c, r) = first repairComponent $ break (not . isAlphaNum) x'
+              in c ++ repairRest r
+      where
+        repairComponent c | all isNumber c = invalid c
+                          | otherwise      = valid c
+    repairRest = repair' id ('-' :)
 
 -- |Data type of source files found in the working directory
 data SourceFileEntry = SourceFileEntry

cabal-install/Distribution/Client/Init/Types.hs

@@ -41,7 +41,7 @@ data InitFlags =
               , noComments     :: Flag Bool
               , minimal        :: Flag Bool
 
-              , packageName  :: Flag String
+              , packageName  :: Flag P.PackageName
               , version      :: Flag Version
               , cabalVersion :: Flag VersionRange
               , license      :: Flag License

cabal-install/Distribution/Client/Setup.hs

@@ -1323,7 +1323,9 @@ initCommand = CommandUI {
       , option ['p'] ["package-name"]
         "Name of the Cabal package to create."
         IT.packageName (\v flags -> flags { IT.packageName = v })
-        (reqArgFlag "PACKAGE")
+        (reqArg "PACKAGE" (readP_to_E ("Cannot parse package name: "++)
+                                      (toFlag `fmap` parse))
+                          (flagToList . fmap display))
 
       , option [] ["version"]
         "Initial version of the package."