From d8209e9122111fa987c7d2112c290c8b2c7001f6 Mon Sep 17 00:00:00 2001
From: Mike Pilgrem <mpilgrem@users.noreply.github.com>
Date: Sun, 10 Dec 2023 00:01:06 +0000
Subject: [PATCH] Fix #6369 Accept package names, in fact, acceptable to Cabal

---
 ChangeLog.md                   |  1 +
 src/Stack/Types/GhcPkgId.hs    | 14 ++++++++++----
 src/Stack/Types/PackageName.hs | 16 +++++++++++-----
 3 files changed, 22 insertions(+), 9 deletions(-)

diff --git a/ChangeLog.md b/ChangeLog.md
index 710eb030b8..2727c19537 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -63,6 +63,7 @@ Bug fixes:
 * Fix the `Curator` instance of `ToJSON`, as regards `expect-haddock-failure`.
 * Better error message if a `resolver:` or `snapshot:` value is, in error, a
   YAML number.
+* Stack accepts all package names that are, in fact, acceptable to Cabal.
 
 ## v2.13.1 - 2023-09-29
 
diff --git a/src/Stack/Types/GhcPkgId.hs b/src/Stack/Types/GhcPkgId.hs
index 10aae5baa9..d399eaf693 100644
--- a/src/Stack/Types/GhcPkgId.hs
+++ b/src/Stack/Types/GhcPkgId.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE NoImplicitPrelude #-}
 
 -- | A ghc-pkg id.
 
@@ -12,13 +12,14 @@ module Stack.Types.GhcPkgId
 
 import           Data.Aeson.Types ( FromJSON (..), ToJSON (..), withText )
 import           Data.Attoparsec.Text
-                   ( Parser, choice, digit, endOfInput, letter, many1, parseOnly
+                   ( Parser, (<?>), choice, endOfInput, many1, parseOnly
                    , satisfy
                    )
+import           Data.Char ( isAlphaNum )
 import qualified Data.Text as T
 import           Database.Persist.Sql ( PersistField, PersistFieldSql )
-import           Prelude ( Read (..) )
 import           Stack.Prelude
+import           Text.Read ( Read (..) )
 
 -- | A parse fail.
 newtype GhcPkgIdParseFail
@@ -70,7 +71,12 @@ ghcPkgIdParser :: Parser GhcPkgId
 ghcPkgIdParser =
   let elements = "_.-" :: String
   in  GhcPkgId . T.pack <$>
-        many1 (choice [digit, letter, satisfy (`elem` elements)])
+        many1 (choice [alphaNum, satisfy (`elem` elements)])
+
+-- | Parse an alphanumerical character, as recognised by `isAlphaNum`.
+alphaNum :: Parser Char
+alphaNum = satisfy isAlphaNum <?> "alphanumeric"
+{-# INLINE alphaNum #-}
 
 -- | Get a string representation of GHC package id.
 ghcPkgIdString :: GhcPkgId -> String
diff --git a/src/Stack/Types/PackageName.hs b/src/Stack/Types/PackageName.hs
index 6d61811cd9..5d1eebc1db 100644
--- a/src/Stack/Types/PackageName.hs
+++ b/src/Stack/Types/PackageName.hs
@@ -22,9 +22,15 @@ packageNameArgument =
     case parsePackageName s of
       Just x -> Right x
       Nothing -> Left $ unlines
-        [ "Expected valid package name, but got: " ++ s
-        , "Package names consist of one or more alphanumeric words separated \
-          \by hyphens."
-        , "To avoid ambiguity with version numbers, each of these words must \
-          \contain at least one letter."
+        [ "Expected a package name acceptable to Cabal, but got: " ++ s ++ "\n"
+        , "An acceptable package name comprises an alphanumeric 'word'; or \
+          \two or more"
+        , "such words, with the words separated by a hyphen/minus character ('-'). A \
+          \word"
+        , "cannot be comprised only of the characters '0' to '9'. \n"
+        , "An alphanumeric character is one in one of the Unicode Letter \
+          \categories"
+        , "(Lu (uppercase), Ll (lowercase), Lt (titlecase), Lm (modifier), or \
+          \Lo (other))"
+        , "or Number categories (Nd (decimal), Nl (letter), or No (other))."
         ]