Commit 1dc3f293 authored by Simon Marlow's avatar Simon Marlow
Browse files

Remove the old package.conf parser, use read instead (fixed #3410)

Performance isn't an issue for reading the old-style package.conf
files, so we might as well revert to using read and fix a bug at the
same time.
parent a2797404
......@@ -319,7 +319,6 @@ Library
InteractiveEval
PackageConfig
Packages
ParsePkgConf
PprTyThing
StaticFlags
StaticFlagParser
......
......@@ -36,7 +36,6 @@ where
#include "HsVersions.h"
import PackageConfig
import ParsePkgConf ( loadPackageConfig )
import DynFlags ( dopt, DynFlag(..), DynFlags(..), PackageFlag(..) )
import StaticFlags
import Config ( cProjectVersion )
......@@ -237,7 +236,8 @@ readPackageConfig dflags conf_file = do
ghcError $ InstallationError $
"can't find a package database at " ++ conf_file
debugTraceMsg dflags 2 (text "Using package config file:" <+> text conf_file)
loadPackageConfig dflags conf_file
str <- readFile conf_file
return (map installedPackageInfoToPackageConfig $ read str)
let
top_dir = topDir dflags
......
{
{-# OPTIONS -fno-warn-unused-binds -fno-warn-unused-matches -fno-warn-missing-signatures -fno-warn-incomplete-patterns -Wwarn #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
module ParsePkgConf( loadPackageConfig ) where
#include "HsVersions.h"
import Distribution.Package hiding ( depends )
import PackageConfig
import Lexer
import Module
import DynFlags
import FastString
import StringBuffer
import ErrUtils ( mkLocMessage )
import SrcLoc
import Outputable
import Panic
}
%expect 0
%token
'{' { L _ ITocurly }
'}' { L _ ITccurly }
'[' { L _ ITobrack }
']' { L _ ITcbrack }
',' { L _ ITcomma }
'=' { L _ ITequal }
VARID { L _ (ITvarid $$) }
CONID { L _ (ITconid $$) }
STRING { L _ (ITstring $$) }
INT { L _ (ITinteger $$) }
%monad { P } { >>= } { return }
%lexer { lexer } { L _ ITeof }
%name parse
%tokentype { Located Token }
%%
pkgconf :: { [ PackageConfig ] }
: '[' ']' { [] }
| '[' pkgs ']' { reverse $2 }
pkgs :: { [ PackageConfig ] }
: pkg { [ $1 ] }
| pkgs ',' pkg { $3 : $1 }
pkg :: { PackageConfig }
: CONID '{' fields '}' { $3 defaultPackageConfig }
fields :: { PackageConfig -> PackageConfig }
: field { \p -> $1 p }
| fields ',' field { \p -> $1 ($3 p) }
field :: { PackageConfig -> PackageConfig }
: VARID '=' pkgid
{% case unpackFS $1 of
"sourcePackageId" -> return (\p -> p{sourcePackageId = $3})
_ -> happyError
}
| VARID '=' STRING { id }
-- we aren't interested in the string fields, they're all
-- boring (copyright, maintainer etc.)
| VARID '=' CONID
{% case unpackFS $1 of {
"exposed" ->
case unpackFS $3 of {
"True" -> return (\p -> p{exposed=True});
"False" -> return (\p -> p{exposed=False});
_ -> happyError };
"license" -> return id; -- not interested
_ -> happyError }
}
| VARID '=' CONID STRING
{ \p -> case unpackFS $1 of
"installedPackageId" ->
p{installedPackageId = InstalledPackageId (unpackFS $4)}
_ -> p -- another case of license
}
| VARID '=' strlist
{\p -> case unpackFS $1 of
"exposedModules" -> p{exposedModules = map mkModuleNameFS $3}
"hiddenModules" -> p{hiddenModules = map mkModuleNameFS $3}
"importDirs" -> p{importDirs = map unpackFS $3}
"libraryDirs" -> p{libraryDirs = map unpackFS $3}
"hsLibraries" -> p{hsLibraries = map unpackFS $3}
"extraLibraries" -> p{extraLibraries = map unpackFS $3}
"extraGHCiLibraries"-> p{extraGHCiLibraries= map unpackFS $3}
"includeDirs" -> p{includeDirs = map unpackFS $3}
"includes" -> p{includes = map unpackFS $3}
"hugsOptions" -> p{hugsOptions = map unpackFS $3}
"ccOptions" -> p{ccOptions = map unpackFS $3}
"ldOptions" -> p{ldOptions = map unpackFS $3}
"frameworkDirs" -> p{frameworkDirs = map unpackFS $3}
"frameworks" -> p{frameworks = map unpackFS $3}
"haddockInterfaces" -> p{haddockInterfaces = map unpackFS $3}
"haddockHTMLs" -> p{haddockHTMLs = map unpackFS $3}
"depends" -> p{depends = []}
-- empty list only, non-empty handled below
_ -> p
}
| VARID '=' ipidlist
{% case unpackFS $1 of
"depends" -> return (\p -> p{depends = $3})
_ -> happyError
}
pkgid :: { PackageIdentifier }
: CONID '{' VARID '=' CONID STRING ',' VARID '=' version '}'
{% case unpackFS $5 of
"PackageName" ->
return $ PackageIdentifier {
pkgName = PackageName (unpackFS $6),
pkgVersion = $10
}
_ -> happyError
}
version :: { Version }
: CONID '{' VARID '=' intlist ',' VARID '=' strlist '}'
{ Version{ versionBranch=$5,
versionTags=map unpackFS $9 } }
ipid :: { InstalledPackageId }
: CONID STRING
{% case unpackFS $1 of
"InstalledPackageId" -> return (InstalledPackageId (unpackFS $2))
_ -> happyError
}
ipidlist :: { [InstalledPackageId] }
: '[' ipids ']' { $2 }
-- empty list case is covered by strlist, to avoid conflicts
ipids :: { [InstalledPackageId] }
: ipid { [ $1 ] }
| ipid ',' ipids { $1 : $3 }
intlist :: { [Int] }
: '[' ']' { [] }
| '[' ints ']' { $2 }
ints :: { [Int] }
: INT { [ fromIntegral $1 ] }
| INT ',' ints { fromIntegral $1 : $3 }
strlist :: { [FastString] }
: '[' ']' { [] }
| '[' strs ']' { $2 }
strs :: { [FastString] }
: STRING { [ $1 ] }
| STRING ',' strs { $1 : $3 }
{
happyError :: P a
happyError = srcParseFail
loadPackageConfig :: DynFlags -> FilePath -> IO [PackageConfig]
loadPackageConfig dflags conf_filename = do
buf <- hGetStringBuffer conf_filename
let loc = mkSrcLoc (mkFastString conf_filename) 1 0
case unP parse (mkPState buf loc dflags) of
PFailed span err ->
ghcError (InstallationError (showSDoc (mkLocMessage span err)))
POk _ pkg_details -> do
return pkg_details
}
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