Make cabal-install use parsec parser

Author: phadej

Cabal/Distribution/PackageDescription/Parsec.hs

@@ -19,9 +19,11 @@ module Distribution.PackageDescription.Parsec (
     -- * Package descriptions
     readGenericPackageDescription,
     parseGenericPackageDescription,
+    parseGenericPackageDescriptionMaybe,
 
     -- ** Parsing
     ParseResult,
+    runParseResult,
 
     -- ** Supplementary build information
     -- readHookedBuildInfo,
@@ -105,6 +107,13 @@ parseGenericPackageDescription bs = case readFields' bs of
     -- TODO: better marshalling of errors
     Left perr -> parseFatalFailure (Position 0 0) (show perr)
 
+-- | 'Maybe' variant of 'parseGenericPackageDescription'
+parseGenericPackageDescriptionMaybe :: BS.ByteString -> Maybe GenericPackageDescription
+parseGenericPackageDescriptionMaybe =
+    trdOf3 . runParseResult . parseGenericPackageDescription
+  where
+    trdOf3 (_, _, x) = x
+
 runFieldParser :: FieldParser a -> [FieldLine Position] -> ParseResult a
 runFieldParser p ls = runFieldParser' pos p =<< fieldlinesToString pos ls
   where

Cabal/tests/ParserHackageTests.hs

@@ -30,7 +30,6 @@ import qualified Distribution.PackageDescription.Parse  as ReadP
 import qualified Distribution.PackageDescription.Parsec as Parsec
 import qualified Distribution.Parsec.Parser             as Parsec
 import qualified Distribution.Parsec.Types.Common       as Parsec
-import qualified Distribution.Parsec.Types.ParseResult  as Parsec
 import qualified Distribution.ParseUtils                as ReadP
 import qualified Distribution.Compat.DList              as DList
 
@@ -97,7 +96,7 @@ compareTest pfx fpath bsl
     let str = ignoreBOM $ fromUTF8LBS bsl
 
     putStrLn $ "::: " ++ fpath
-    (readp, readpWarnings)  <- case ReadP.parsePackageDescription str of
+    (readp, readpWarnings)  <- case ReadP.parseGenericPackageDescription str of
         ReadP.ParseOk ws x    -> return (x, ws)
         ReadP.ParseFailed err -> print err >> exitFailure
     traverse_ (putStrLn . ReadP.showPWarning fpath) readpWarnings
@@ -155,7 +154,7 @@ compareTest pfx fpath bsl
 parseReadpTest :: FilePath -> BSL.ByteString -> IO ()
 parseReadpTest fpath bsl = when (not $ any ($ fpath) problematicFiles) $ do
     let str = fromUTF8LBS bsl
-    case ReadP.parsePackageDescription str of
+    case ReadP.parseGenericPackageDescription str of
         ReadP.ParseOk _ _     -> return ()
         ReadP.ParseFailed err -> print err >> exitFailure
 

cabal-install/Distribution/Client/Check.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Client.Check
@@ -17,8 +18,12 @@ module Distribution.Client.Check (
 
 import Control.Monad ( when, unless )
 
-import Distribution.PackageDescription.Parse
-         ( readPackageDescription )
+#ifdef CABAL_PARSEC
+import Distribution.PackageDescription.Parsec ( readGenericPackageDescription )
+#else
+import Distribution.PackageDescription.Parse ( readGenericPackageDescription )
+#endif
+
 import Distribution.PackageDescription.Check
 import Distribution.PackageDescription.Configuration
          ( flattenPackageDescription )
@@ -30,7 +35,7 @@ import Distribution.Simple.Utils
 check :: Verbosity -> IO Bool
 check verbosity = do
     pdfile <- defaultPackageDesc verbosity
-    ppd <- readPackageDescription verbosity pdfile
+    ppd <- readGenericPackageDescription verbosity pdfile
     -- flatten the generic package description into a regular package
     -- description
     -- TODO: this may give more warnings than it should give;

cabal-install/Distribution/Client/Configure.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Client.Configure
@@ -67,8 +68,13 @@ import Distribution.Package
 import Distribution.Types.Dependency
          ( Dependency(..), thisPackageVersion )
 import qualified Distribution.PackageDescription as PkgDesc
+#ifdef CABAL_PARSEC
+import Distribution.PackageDescription.Parsec
+         ( readGenericPackageDescription )
+#else
 import Distribution.PackageDescription.Parse
-         ( readPackageDescription )
+         ( readGenericPackageDescription )
+#endif
 import Distribution.PackageDescription.Configuration
          ( finalizePD )
 import Distribution.Version
@@ -296,7 +302,7 @@ planLocalPackage :: Verbosity -> Compiler
                  -> IO (Progress String String SolverInstallPlan)
 planLocalPackage verbosity comp platform configFlags configExFlags
   installedPkgIndex (SourcePackageDb _ packagePrefs) pkgConfigDb = do
-  pkg <- readPackageDescription verbosity =<<
+  pkg <- readGenericPackageDescription verbosity =<<
             case flagToMaybe (configCabalFilePath configFlags) of
                 Nothing -> defaultPackageDesc verbosity
                 Just fp -> return fp

cabal-install/Distribution/Client/GenBounds.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Client.GenBounds
@@ -28,8 +29,13 @@ import Distribution.PackageDescription
          ( buildDepends )
 import Distribution.PackageDescription.Configuration
          ( finalizePD )
+#ifdef CABAL_PARSEC
+import Distribution.PackageDescription.Parsec
+         ( readGenericPackageDescription )
+#else
 import Distribution.PackageDescription.Parse
-         ( readPackageDescription )
+         ( readGenericPackageDescription )
+#endif
 import Distribution.Types.ComponentRequestedSpec
          ( defaultComponentRequestedSpec )
 import Distribution.Types.Dependency
@@ -109,7 +115,7 @@ genBounds verbosity packageDBs repoCtxt comp platform progdb mSandboxPkgInfo
 
     cwd <- getCurrentDirectory
     path <- tryFindPackageDesc cwd
-    gpd <- readPackageDescription verbosity path
+    gpd <- readGenericPackageDescription verbosity path
     -- NB: We don't enable tests or benchmarks, since often they
     -- don't really have useful bounds.
     let epd = finalizePD [] defaultComponentRequestedSpec

cabal-install/Distribution/Client/IndexUtils.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE BangPatterns #-}
@@ -51,30 +52,39 @@ import Distribution.Package
          , Package(..), packageVersion, packageName )
 import Distribution.Types.Dependency
 import Distribution.Simple.PackageIndex (InstalledPackageIndex)
-import qualified Distribution.PackageDescription.Parse as PackageDesc.Parse
 import Distribution.PackageDescription
          ( GenericPackageDescription )
-import Distribution.PackageDescription.Parse
-         ( parsePackageDescription )
 import Distribution.Simple.Compiler
          ( Compiler, PackageDBStack )
 import Distribution.Simple.Program
          ( ProgramDb )
 import qualified Distribution.Simple.Configure as Configure
          ( getInstalledPackages, getInstalledPackagesMonitorFiles )
-import Distribution.ParseUtils
-         ( ParseResult(..) )
 import Distribution.Version
          ( mkVersion, intersectVersionRanges )
 import Distribution.Text
          ( display, simpleParse )
 import Distribution.Verbosity
          ( Verbosity, normal, lessVerbose )
 import Distribution.Simple.Utils
-         ( die, warn, info, fromUTF8, ignoreBOM )
+         ( die, warn, info )
 import Distribution.Client.Setup
          ( RepoContext(..) )
 
+#ifdef CABAL_PARSEC
+import Distribution.PackageDescription.Parsec
+         ( parseGenericPackageDescriptionMaybe )
+import qualified Distribution.PackageDescription.Parsec as PackageDesc.Parse
+#else
+import Distribution.ParseUtils
+         ( ParseResult(..) )
+import Distribution.PackageDescription.Parse
+         ( parseGenericPackageDescription )
+import Distribution.Simple.Utils
+         ( fromUTF8, ignoreBOM )
+import qualified Distribution.PackageDescription.Parse as PackageDesc.Parse
+#endif
+
 import           Distribution.Solver.Types.PackageIndex (PackageIndex)
 import qualified Distribution.Solver.Types.PackageIndex as PackageIndex
 import           Distribution.Solver.Types.SourcePackage
@@ -434,12 +444,20 @@ extractPkg entry blockNo = case Tar.entryContent entry of
           Just ver -> Just . return $ Just (NormalPackage pkgid descr content blockNo)
             where
               pkgid  = PackageIdentifier (mkPackageName pkgname) ver
-              parsed = parsePackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack
+#ifdef CABAL_PARSEC
+              parsed = parseGenericPackageDescriptionMaybe (BS.toStrict content)
+              descr = case parsed of
+                  Just d  -> d
+                  Nothing -> error $ "Couldn't read cabal file "
+                                    ++ show fileName
+#else
+              parsed = parseGenericPackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack
                                                $ content
               descr  = case parsed of
                 ParseOk _ d -> d
                 _           -> error $ "Couldn't read cabal file "
                                     ++ show fileName
+#endif
           _ -> Nothing
         _ -> Nothing
 
@@ -451,7 +469,7 @@ extractPkg entry blockNo = case Tar.entryContent entry of
         result <- if not dirExists then return Nothing
                   else do
                     cabalFile <- tryFindAddSourcePackageDesc path "Error reading package index."
-                    descr     <- PackageDesc.Parse.readPackageDescription normal cabalFile
+                    descr     <- PackageDesc.Parse.readGenericPackageDescription normal cabalFile
                     return . Just $ BuildTreeRef (refTypeFromTypeCode typeCode) (packageId descr)
                                                  descr path blockNo
         return result
@@ -674,7 +692,7 @@ packageListFromCache mkPkg hnd Cache{..} mode = accum mempty [] mempty cacheEntr
       path <- liftM byteStringToFilePath . getEntryContent $ blockno
       pkg  <- do let err = "Error reading package index from cache."
                  file <- tryFindAddSourcePackageDesc path err
-                 PackageDesc.Parse.readPackageDescription normal file
+                 PackageDesc.Parse.readGenericPackageDescription normal file
       let srcpkg = mkPkg (BuildTreeRef refType (packageId pkg) pkg path blockno)
       accum srcpkgs (srcpkg:btrs) prefs entries
 
@@ -693,9 +711,15 @@ packageListFromCache mkPkg hnd Cache{..} mode = accum mempty [] mempty cacheEntr
 
     readPackageDescription :: ByteString -> IO GenericPackageDescription
     readPackageDescription content =
-      case parsePackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack $ content of
+#ifdef CABAL_PARSEC
+      case parseGenericPackageDescriptionMaybe (BS.toStrict content) of
+        Just gpd -> return gpd
+        Nothing  -> interror "failed to parse .cabal file"
+#else
+      case parseGenericPackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack $ content of
         ParseOk _ d -> return d
         _           -> interror "failed to parse .cabal file"
+#endif
 
     interror msg = die $ "internal error when reading package index: " ++ msg
                       ++ "The package index or index cache is probably "

cabal-install/Distribution/Client/ProjectConfig.hs

@@ -75,8 +75,13 @@ import Distribution.System
          ( Platform )
 import Distribution.PackageDescription
          ( SourceRepo(..) )
+#if CABAL_PARSEC
+import Distribution.PackageDescription.Parsec
+         ( readGenericPackageDescription )
+#else
 import Distribution.PackageDescription.Parse
-         ( readPackageDescription )
+         ( readGenericPackageDescription )
+#endif
 import Distribution.Simple.Compiler
          ( Compiler, compilerInfo )
 import Distribution.Simple.Program
@@ -866,7 +871,7 @@ readSourcePackage verbosity (ProjectPackageLocalCabalFile cabalFile) =
 readSourcePackage verbosity (ProjectPackageLocalDirectory dir cabalFile) = do
     monitorFiles [monitorFileHashed cabalFile]
     root <- askRoot
-    pkgdesc <- liftIO $ readPackageDescription verbosity (root </> cabalFile)
+    pkgdesc <- liftIO $ readGenericPackageDescription verbosity (root </> cabalFile)
     return SourcePackage {
       packageInfoId        = packageId pkgdesc,
       packageDescription   = pkgdesc,

cabal-install/Distribution/Client/Sandbox.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 -----------------------------------------------------------------------------
 -- |
@@ -79,7 +80,11 @@ import Distribution.Client.Utils              ( inDir, tryCanonicalizePath
                                               , tryFindAddSourcePackageDesc)
 import Distribution.PackageDescription.Configuration
                                               ( flattenPackageDescription )
-import Distribution.PackageDescription.Parse  ( readPackageDescription )
+#ifdef CABAL_PARSEC
+import Distribution.PackageDescription.Parsec ( readGenericPackageDescription )
+#else
+import Distribution.PackageDescription.Parse  ( readGenericPackageDescription )
+#endif
 import Distribution.Simple.Compiler           ( Compiler(..), PackageDB(..) )
 import Distribution.Simple.Configure          ( configCompilerAuxEx
                                               , getPackageDBContents
@@ -436,7 +441,7 @@ sandboxAddSourceSnapshot verbosity buildTreeRefs sandboxDir pkgEnv = do
   pkgs      <- forM buildTreeRefs $ \buildTreeRef ->
     inDir (Just buildTreeRef) $
     return . flattenPackageDescription
-            =<< readPackageDescription verbosity
+            =<< readGenericPackageDescription verbosity
             =<< defaultPackageDesc     verbosity
 
   -- Copy the package sources to "snapshots/$PKGNAME-$VERSION-tmp". If
@@ -735,7 +740,7 @@ withSandboxPackageInfo verbosity configFlags globalFlags
   let err = "Error reading sandbox package information."
   -- Get the package descriptions for all add-source deps.
   depsCabalFiles <- mapM (flip tryFindAddSourcePackageDesc err) buildTreeRefs
-  depsPkgDescs   <- mapM (readPackageDescription verbosity) depsCabalFiles
+  depsPkgDescs   <- mapM (readGenericPackageDescription verbosity) depsCabalFiles
   let depsMap           = M.fromList (zip buildTreeRefs depsPkgDescs)
       isInstalled pkgid = not . null
         . InstalledPackageIndex.lookupSourcePackageId installedPkgIndex $ pkgid

cabal-install/Distribution/Client/SetupWrapper.hs

@@ -39,8 +39,13 @@ import Distribution.PackageDescription
          ( GenericPackageDescription(packageDescription)
          , PackageDescription(..), specVersion
          , BuildType(..), knownBuildTypes, defaultRenaming )
+#ifdef CABAL_PARSEC
+import Distribution.PackageDescription.Parsec
+         ( readGenericPackageDescription )
+#else
 import Distribution.PackageDescription.Parse
-         ( readPackageDescription )
+         ( readGenericPackageDescription )
+#endif
 import Distribution.Simple.Configure
          ( configCompilerEx )
 import Distribution.Compiler
@@ -302,7 +307,7 @@ getSetup verbosity options mpkg = do
                }
   where
     getPkg = tryFindPackageDesc (fromMaybe "." (useWorkingDir options))
-         >>= readPackageDescription verbosity
+         >>= readGenericPackageDescription verbosity
          >>= return . packageDescription
 
     checkBuildType (UnknownBuildType name) =

cabal-install/Distribution/Client/SrcDist.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE NondecreasingIndentation #-}
 {-# LANGUAGE FlexibleContexts #-}
 -- Implements the \"@.\/cabal sdist@\" command, which creates a source
@@ -19,8 +20,13 @@ import Distribution.PackageDescription
          ( PackageDescription )
 import Distribution.PackageDescription.Configuration
          ( flattenPackageDescription )
+#ifdef CABAL_PARSEC
+import Distribution.PackageDescription.Parsec
+         ( readGenericPackageDescription )
+#else
 import Distribution.PackageDescription.Parse
-         ( readPackageDescription )
+         ( readGenericPackageDescription )
+#endif
 import Distribution.Simple.Utils
          ( createDirectoryIfMissingVerbose, defaultPackageDesc
          , warn, die, notice, withTempDirectory )
@@ -51,7 +57,7 @@ import Control.Exception                             (IOException, evaluate)
 sdist :: SDistFlags -> SDistExFlags -> IO ()
 sdist flags exflags = do
   pkg <- liftM flattenPackageDescription
-    (readPackageDescription verbosity =<< defaultPackageDesc verbosity)
+    (readGenericPackageDescription verbosity =<< defaultPackageDesc verbosity)
   let withDir :: (FilePath -> IO a) -> IO a
       withDir = if not needMakeArchive then \f -> f tmpTargetDir
                 else withTempDirectory verbosity tmpTargetDir "sdist."
@@ -156,7 +162,7 @@ allPackageSourceFiles verbosity setupOpts0 packageDir = do
   pkg <- do
     let err = "Error reading source files of package."
     desc <- tryFindAddSourcePackageDesc packageDir err
-    flattenPackageDescription `fmap` readPackageDescription verbosity desc
+    flattenPackageDescription `fmap` readGenericPackageDescription verbosity desc
   globalTmp <- getTemporaryDirectory
   withTempDirectory verbosity globalTmp "cabal-list-sources." $ \tempDir -> do
   let file      = tempDir </> "cabal-sdist-list-sources"