Commit 856b6e1b authored by Oleg Grenrus's avatar Oleg Grenrus

Make cabal-install use parsec parser

parent 3fca557e
......@@ -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
......
......@@ -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
......
{-# 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;
......
{-# 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
......
{-# 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
......
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE BangPatterns #-}
......@@ -51,19 +52,14 @@ 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
......@@ -71,10 +67,24 @@ import Distribution.Text
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 "
......
......@@ -76,8 +76,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
......@@ -867,7 +872,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,
......
{-# 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
......
......@@ -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) =
......
{-# 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"
......
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
......@@ -81,22 +82,30 @@ import Distribution.Client.GlobalFlags
import Distribution.PackageDescription
( GenericPackageDescription, parseFlagAssignment )
import Distribution.PackageDescription.Parse
( readPackageDescription, parsePackageDescription, ParseResult(..) )
import Distribution.Version
( nullVersion, thisVersion, anyVersion, isAnyVersion )
import Distribution.Text
( Text(..), display )
import Distribution.Verbosity (Verbosity)
import Distribution.Simple.Utils
( die, warn, fromUTF8, lowercase, ignoreBOM )
( die, warn, lowercase )
#ifdef CABAL_PARSEC
import Distribution.PackageDescription.Parsec
( readGenericPackageDescription, parseGenericPackageDescriptionMaybe )
#else
import Distribution.PackageDescription.Parse
( readGenericPackageDescription, parseGenericPackageDescription, ParseResult(..) )
import Distribution.Simple.Utils
( fromUTF8, ignoreBOM )
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
#endif
-- import Data.List ( find, nub )
import Data.Either
( partitionEithers )
import qualified Data.Map as Map
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
import qualified Distribution.Client.GZipUtils as GZipUtils
import Control.Monad (mapM)
import qualified Distribution.Compat.ReadP as Parse
......@@ -483,7 +492,7 @@ readPackageTarget verbosity = traverse modifyLocation
LocalUnpackedPackage dir -> do
pkg <- tryFindPackageDesc dir (localPackageError dir) >>=
readPackageDescription verbosity
readGenericPackageDescription verbosity
return $ SourcePackage {
packageInfoId = packageId pkg,
packageDescription = pkg,
......@@ -549,11 +558,15 @@ readPackageTarget verbosity = traverse modifyLocation
_ -> False
parsePackageDescription' :: BS.ByteString -> Maybe GenericPackageDescription
#ifdef CABAL_PARSEC
parsePackageDescription' bs =
parseGenericPackageDescriptionMaybe (BS.toStrict bs)
#else
parsePackageDescription' content =
case parsePackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack $ content of
case parseGenericPackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack $ content of
ParseOk _ pkg -> Just pkg
_ -> Nothing
#endif
-- ------------------------------------------------------------
-- * Checking package targets
......
......@@ -134,8 +134,12 @@ import Distribution.Client.Utils (determineNumJobs
import Distribution.Package (packageId)
import Distribution.PackageDescription
( BuildType(..), Executable(..), buildable )
import Distribution.PackageDescription.Parse
( readPackageDescription )
#ifdef CABAL_PARSEC
import Distribution.PackageDescription.Parsec ( readGenericPackageDescription )
#else
import Distribution.PackageDescription.Parse ( readGenericPackageDescription )
#endif
import Distribution.PackageDescription.PrettyPrint
( writeGenericPackageDescription )
import qualified Distribution.Simple as Simple
......@@ -983,7 +987,7 @@ formatAction verbosityFlag extraArgs _globalFlags = do
[] -> do cwd <- getCurrentDirectory
tryFindPackageDesc cwd
(p:_) -> return p
pkgDesc <- readPackageDescription verbosity path
pkgDesc <- readGenericPackageDescription verbosity path
-- Uses 'writeFileAtomic' under the hood.
writeGenericPackageDescription path pkgDesc
......
......@@ -194,6 +194,11 @@ Flag debug-tracetree
description: Compile in support for tracetree (used to debug the solver)
default: False
flag parsec
description: Use parsec parser
default: False
manual: True
executable cabal
main-is: Main.hs
ghc-options: -Wall -fwarn-tabs -rtsopts
......@@ -404,6 +409,9 @@ executable cabal
cpp-options: -DDEBUG_TRACETREE
build-depends: tracetree >= 0.1 && < 0.2
if flag(parsec)
cpp-options: -DCABAL_PARSEC
default-language: Haskell2010
-- Small, fast running tests.
......
......@@ -139,7 +139,7 @@ setup' cmd args = do
then runProgramM cabalProgram full_args
else do
pdfile <- liftIO $ tryFindPackageDesc (testCurrentDir env)
pdesc <- liftIO $ readPackageDescription (testVerbosity env) pdfile
pdesc <- liftIO $ readGenericPackageDescription (testVerbosity env) pdfile
if buildType (packageDescription pdesc) == Just Simple
then runM (testSetupPath env) full_args
-- Run the Custom script!
......
......@@ -53,6 +53,10 @@ extra-deps:
- vector-0.12.0.0
- zlib-0.6.1.1
flags:
Cabal:
parsec: true
cabal-install:
parsec: true
time-locale-compat:
old-locale: false
nix:
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment