Better messages for invalid cabal file names #895

ChangeLog.md

@@ -29,6 +29,7 @@ Bug fixes:
 * `stack solver` and `stack init --solver` check for test suite and benchmark dependencies [#862](https://github.com/commercialhaskell/stack/issues/862)
 * More intelligent logic for setting UTF-8 locale environment variables [#856](https://github.com/commercialhaskell/stack/issues/856)
 * Create missing directories for `stack sdist`
+* Don't ignore .cabal files with extra periods [#895](https://github.com/commercialhaskell/stack/issues/895)
 
 ## 0.1.3.1
 

src/Stack/Build/Source.hs

@@ -226,9 +226,8 @@ getLocalPackageViews = do
         cabalfp <- getCabalFileName dir
         gpkg <- readPackageUnresolved cabalfp
         let cabalID = package $ packageDescription gpkg
-        name <- parsePackageNameFromFilePath cabalfp
-        when (fromCabalPackageName (pkgName $ cabalID) /= name)
-            $ throwM $ MismatchedCabalName cabalfp name
+            name = fromCabalPackageName $ pkgName $ cabalID
+        checkCabalFileName name cabalfp
         let lpv = LocalPackageView
                 { lpvVersion = fromCabalVersion $ pkgVersion cabalID
                 , lpvRoot = dir

src/Stack/Package.hs

@@ -30,7 +30,8 @@ module Stack.Package
   ,packageToolDependencies
   ,packageDependencies
   ,packageIdentifier
-  ,autogenDir)
+  ,autogenDir
+  ,checkCabalFileName)
   where
 
 import           Control.Exception hiding (try,catch)
@@ -133,11 +134,20 @@ readPackageDir :: (MonadLogger m, MonadIO m, MonadThrow m, MonadCatch m)
 readPackageDir packageConfig dir = do
     cabalfp <- getCabalFileName dir
     pkg <- readPackage packageConfig cabalfp
-    name <- parsePackageNameFromFilePath cabalfp
-    when (packageName pkg /= name)
-        $ throwM $ MismatchedCabalName cabalfp name
+    checkCabalFileName (packageName pkg) cabalfp
+
     return (cabalfp, pkg)
 
+-- | Check if the given name in the @Package@ matches the name of the .cabal file
+checkCabalFileName :: MonadThrow m => PackageName -> Path Abs File -> m ()
+checkCabalFileName name cabalfp = do
+    -- Previously, we just use parsePackageNameFromFilePath. However, that can
+    -- lead to confusing error messages. See:
+    -- https://github.com/commercialhaskell/stack/issues/895
+    let expected = packageNameString name ++ ".cabal"
+    when (expected /= toFilePath (filename cabalfp))
+        $ throwM $ MismatchedCabalName cabalfp name
+
 -- | Resolve a parsed cabal file into a 'Package'.
 resolvePackage :: PackageConfig
                -> GenericPackageDescription
@@ -922,7 +932,7 @@ getCabalFileName pkgDir = do
         [] -> throwM $ PackageNoCabalFileFound pkgDir
         [x] -> return x
         _:_ -> throwM $ PackageMultipleCabalFilesFound pkgDir files
-  where hasExtension fp x = FilePath.takeExtensions fp == "." ++ x
+  where hasExtension fp x = FilePath.takeExtension fp == "." ++ x
 
 -- | Path for the package's build log.
 buildLogPath :: (MonadReader env m, HasBuildConfig env, MonadThrow m)

src/Stack/Types/Package.hs

@@ -63,10 +63,13 @@ instance Show PackageException where
         ": " ++
         intercalate ", " (map (toFilePath . filename) files)
     show (MismatchedCabalName fp name) = concat
-        [ "cabal file "
+        [ "cabal file path "
         , toFilePath fp
-        , " has a mismatched package name: "
+        , " does not match the package name it defines.\n"
+        , "Please rename the file to: "
         , packageNameString name
+        , ".cabal\n"
+        , "For more information, see: https://github.com/commercialhaskell/stack/issues/317"
         ]
 
 -- | Some package info.

src/Stack/Types/PackageName.hs

@@ -52,11 +52,13 @@ import qualified Options.Applicative as O
 data PackageNameParseFail
   = PackageNameParseFail ByteString
   | CabalFileNameParseFail FilePath
+  | CabalFileNameInvalidPackageName FilePath
   deriving (Typeable)
 instance Exception PackageNameParseFail
 instance Show PackageNameParseFail where
     show (PackageNameParseFail bs) = "Invalid package name: " ++ show bs
-    show (CabalFileNameParseFail fp) = "Invalid file path for cabal file: " ++ fp
+    show (CabalFileNameParseFail fp) = "Invalid file path for cabal file, must have a .cabal extension: " ++ fp
+    show (CabalFileNameInvalidPackageName fp) = "cabal file names must use valid package names followed by a .cabal extension, the following is invalid: " ++ fp
 
 -- | A package name.
 newtype PackageName =
@@ -138,8 +140,11 @@ toCabalPackageName (PackageName name) =
 
 -- | Parse a package name from a file path.
 parsePackageNameFromFilePath :: MonadThrow m => Path a File -> m PackageName
-parsePackageNameFromFilePath fp =
-  clean (toFilePath (filename fp)) >>= parsePackageNameFromString
+parsePackageNameFromFilePath fp = do
+    base <- clean $ toFilePath $ filename fp
+    case parsePackageNameFromString base of
+        Nothing -> throwM $ CabalFileNameInvalidPackageName $ toFilePath fp
+        Just x -> return x
   where clean = liftM reverse . strip . reverse
         strip ('l':'a':'b':'a':'c':'.':xs) = return xs
         strip _ = throwM (CabalFileNameParseFail (toFilePath fp))