Update `Cabal` submodule

This also requires adapting `ghc-pkg` to use the new Cabal parsing API
as the old ReadP-based one has finally been evicted for good.

Hadrian bit finished by: Ben Gamari <ben@smart-cactus.org>

2 files changed, 26 insertions, 35 deletions

diff --git a/utils/ghc-cabal/ghc.mk b/utils/ghc-cabal/ghc.mk
index 70e418eaf6..9e403758fa 100644
--- a/utils/ghc-cabal/ghc.mk
+++ b/utils/ghc-cabal/ghc.mk
@@ -37,15 +37,15 @@ $(ghc-cabal_INPLACE) : $(ghc-cabal_DIST_BINARY) | $$(dir $$@)/.
 	"$(CP)" $< $@
 
 # Minor hack, since we can't reuse the `hs-suffix-rules-srcdir` macro
-ifneq ($(wildcard libraries/Cabal/Cabal/Distribution/Parsec/Lexer.x),)
+ifneq ($(wildcard libraries/Cabal/Cabal/Distribution/Fields/Lexer.x),)
 # Lexer.x exists so we have to call Alex ourselves
-CABAL_LEXER_DEP := bootstrapping/Cabal/Distribution/Parsec/Lexer.hs
+CABAL_LEXER_DEP := bootstrapping/Cabal/Distribution/Fields/Lexer.hs
 
-bootstrapping/Cabal/Distribution/Parsec/Lexer.hs: libraries/Cabal/Cabal/Distribution/Parsec/Lexer.x
-	mkdir -p bootstrapping/Cabal/Distribution/Parsec
+bootstrapping/Cabal/Distribution/Fields/Lexer.hs: libraries/Cabal/Cabal/Distribution/Fields/Lexer.x
+	mkdir -p bootstrapping/Cabal/Distribution/Fields
 	$(call cmd,ALEX) $< -o $@
 else
-CABAL_LEXER_DEP := libraries/Cabal/Cabal/Distribution/Parsec/Lexer.hs
+CABAL_LEXER_DEP := libraries/Cabal/Cabal/Distribution/Fields/Lexer.hs
 endif
 
 $(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*/*/*.hs)
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 34b28b1711..8b7655b3bb 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -36,13 +36,13 @@ import qualified Data.Graph as Graph
 import qualified Distribution.ModuleName as ModuleName
 import Distribution.ModuleName (ModuleName)
 import Distribution.InstalledPackageInfo as Cabal
-import Distribution.Compat.ReadP hiding (get)
-import Distribution.ParseUtils
+import qualified Distribution.Parsec as Cabal
 import Distribution.Package hiding (installedUnitId)
 import Distribution.Text
 import Distribution.Version
 import Distribution.Backpack
 import Distribution.Types.UnqualComponentName
+import Distribution.Types.LibraryName
 import Distribution.Types.MungedPackageName
 import Distribution.Types.MungedPackageId
 import Distribution.Simple.Utils (fromUTF8BS, toUTF8BS, writeUTF8File, readUTF8File)
@@ -59,7 +59,7 @@ import System.Console.GetOpt
 import qualified Control.Exception as Exception
 import Data.Maybe
 
-import Data.Char ( isSpace, toLower )
+import Data.Char ( toLower )
 import Control.Monad
 import System.Directory ( doesDirectoryExist, getDirectoryContents,
                           doesFileExist, removeFile,
@@ -501,11 +501,11 @@ runit verbosity cli nonopts = do
     (_cmd:_) -> do
         die ("command-line syntax error\n" ++ shortUsage prog)
 
-parseCheck :: ReadP a a -> String -> String -> IO a
-parseCheck parser str what =
-  case [ x | (x,ys) <- readP_to_S parser str, all isSpace ys ] of
-    [x] -> return x
-    _ -> die ("cannot parse \'" ++ str ++ "\' as a " ++ what)
+parseCheck :: Cabal.Parsec a => String -> String -> IO a
+parseCheck str what =
+  case Cabal.eitherParsec str of
+    Left e  -> die ("cannot parse \'" ++ str ++ "\' as a " ++ what ++ ": " ++ e)
+    Right x -> pure x
 
 -- | Either an exact 'PackageIdentifier', or a glob for all packages
 -- matching 'PackageName'.
@@ -518,20 +518,14 @@ displayGlobPkgId (ExactPackageIdentifier pid) = display pid
 displayGlobPkgId (GlobPackageIdentifier pn) = display pn ++ "-*"
 
 readGlobPkgId :: String -> IO GlobPackageIdentifier
-readGlobPkgId str = parseCheck parseGlobPackageId str "package identifier"
-
-parseGlobPackageId :: ReadP r GlobPackageIdentifier
-parseGlobPackageId =
-  fmap ExactPackageIdentifier parse
-     +++
-  (do n <- parse
-      _ <- string "-*"
-      return (GlobPackageIdentifier n))
+readGlobPkgId str
+  | "-*" `isSuffixOf` str =
+    GlobPackageIdentifier <$> parseCheck (init (init str)) "package identifier (glob)"
+  | otherwise = ExactPackageIdentifier <$> parseCheck str "package identifier (exact)"
 
 readPackageArg :: AsPackageArg -> String -> IO PackageArg
-readPackageArg AsUnitId str =
-    parseCheck (IUId `fmap` parse) str "installed package id"
-readPackageArg AsDefault str = Id `fmap` readGlobPkgId str
+readPackageArg AsUnitId str = IUId <$> parseCheck str "installed package id"
+readPackageArg AsDefault str = Id <$> readGlobPkgId str
 
 -- -----------------------------------------------------------------------------
 -- Package databases
@@ -1160,13 +1154,11 @@ parsePackageInfo
         -> IO (InstalledPackageInfo, [ValidateWarning])
 parsePackageInfo str =
   case parseInstalledPackageInfo str of
-    ParseOk warnings ok -> return (mungePackageInfo ok, ws)
+    Right (warnings, ok) -> pure (mungePackageInfo ok, ws)
       where
-        ws = [ msg | PWarning msg <- warnings
+        ws = [ msg | msg <- warnings
                    , not ("Unrecognized field pkgroot" `isPrefixOf` msg) ]
-    ParseFailed err -> case locatedErrorMsg err of
-                           (Nothing, s) -> die s
-                           (Just l, s) -> die (show l ++ ": " ++ s)
+    Left err -> die (unlines err)
 
 mungePackageInfo :: InstalledPackageInfo -> InstalledPackageInfo
 mungePackageInfo ipi = ipi
@@ -1352,7 +1344,7 @@ convertPackageInfoToCacheFormat pkg =
        GhcPkg.packageName        = packageName pkg,
        GhcPkg.packageVersion     = Version.Version (versionNumbers (packageVersion pkg)) [],
        GhcPkg.sourceLibName      =
-         fmap (mkPackageName . unUnqualComponentName) (sourceLibName pkg),
+         fmap (mkPackageName . unUnqualComponentName) (libraryNameString $ sourceLibName pkg),
        GhcPkg.depends            = depends pkg,
        GhcPkg.abiDepends         = map (\(AbiDependency k v) -> (k,unAbiHash v)) (abiDepends pkg),
        GhcPkg.abiHash            = unAbiHash (abiHash pkg),
@@ -1902,10 +1894,9 @@ checkPackageConfig pkg verbosity db_stack
 checkPackageId :: InstalledPackageInfo -> Validate ()
 checkPackageId ipi =
   let str = display (mungedId ipi) in
-  case [ x :: MungedPackageId | (x,ys) <- readP_to_S parse str, all isSpace ys ] of
-    [_] -> return ()
-    []  -> verror CannotForce ("invalid package identifier: " ++ str)
-    _   -> verror CannotForce ("ambiguous package identifier: " ++ str)
+  case Cabal.eitherParsec str :: Either String MungedPackageId of
+    Left e -> verror CannotForce ("invalid package identifier: '" ++ str ++ "': " ++ e)
+    Right _ -> pure ()
 
 checkUnitId :: InstalledPackageInfo -> PackageDBStack -> Bool
                 -> Validate ()