plugins-1.0: src/System/Plugins/ParsePkgConfCabal.y_in
--
-- Copyright (C) 2005 Sean Seefried - http://www.cse.unsw.edu.au/~sseefried
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this library; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
-- USA
--
--
-- Taken (apart from the most minor of alterations) from
-- ghc/utils/ghc-pkg/ParsePkgConfLite.hs from GHC 6.2.2 source tree
-- and then modified to mimic the behaviour of the parser within
-- ghc/compiler/main/ParsePkgConf.y in GHC 6.4, without importing
-- heavy-weight infrastructure from the GHC source tree such as module
-- FastString, Lexer, etc.
--
-- (c) Copyright 2002, The University Court of the University of Glasgow.
--
{
{-# OPTIONS -w #-}
module System.Plugins.ParsePkgConfCabal (
parsePkgConf, parseOnePkgConf
) where
import Distribution.InstalledPackageInfo
import Distribution.Package
import Distribution.Version
import Data.Char ( isSpace, isAlpha, isAlphaNum, isUpper, isDigit )
import Data.List ( break )
}
%token
'{' { ITocurly }
'}' { ITccurly }
'[' { ITobrack }
']' { ITcbrack }
',' { ITcomma }
'=' { ITequal }
VARID { ITvarid $$ }
CONID { ITconid $$ }
STRING { ITstring $$ }
INT { ITinteger $$ }
%name parse pkgconf
%name parseOne pkg
%tokentype { 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
{\p -> case $1 of
"package" -> p {package = $3}
_ -> error "unknown key in config file" }
| VARID '=' STRING { id }
-- we aren't interested in the string fields, they're all
-- boring (copyright, maintainer etc.)
| VARID '=' CONID
{ case $1 of {
"exposed" ->
case $3 of {
"True" -> (\p -> p {exposed=True});
"False" -> (\p -> p {exposed=False});
_ -> error "exposed must be either True or False" };
"license" -> id; -- not interested
_ -> error "unknown constructor" }
}
| VARID '=' CONID STRING { id }
-- another case of license
| VARID '=' strlist
{\p -> case $1 of
"exposedModules" -> p{exposedModules = $3}
"hiddenModules" -> p{hiddenModules = $3}
"importDirs" -> p{importDirs = $3}
"libraryDirs" -> p{libraryDirs = $3}
"hsLibraries" -> p{hsLibraries = $3}
"extraLibraries" -> p{extraLibraries = $3}
"includeDirs" -> p{includeDirs = $3}
"includes" -> p{includes = $3}
"hugsOptions" -> p{hugsOptions = $3}
"ccOptions" -> p{ccOptions = $3}
"ldOptions" -> p{ldOptions = $3}
"frameworkDirs" -> p{frameworkDirs = $3}
"frameworks" -> p{frameworks = $3}
"haddockInterfaces" -> p{haddockInterfaces = $3}
"haddockHTMLs" -> p{haddockHTMLs = $3}
"depends" -> p{depends = []}
-- empty list only, non-empty handled below
other -> p
}
| VARID '=' pkgidlist
{ case $1 of
"depends" -> (\p -> p{depends = $3})
_other -> error "unknown key in config file"
}
pkgid :: { PackageIdentifier }
: CONID '{' VARID '=' STRING ',' VARID '=' version '}'
{ PackageIdentifier{ pkgName = $5,
pkgVersion = $9 } }
version :: { Version }
: CONID '{' VARID '=' intlist ',' VARID '=' strlist '}'
{ Version{ versionBranch=$5, versionTags=$9 } }
pkgidlist :: { [PackageIdentifier] }
: '[' pkgids ']' { $2 }
-- empty list case is covered by strlist, to avoid conflicts
pkgids :: { [PackageIdentifier] }
: pkgid { [ $1 ] }
| pkgid ',' pkgids { $1 : $3 }
intlist :: { [Int] }
: '[' ']' { [] }
| '[' ints ']' { $2 }
ints :: { [Int] }
: INT { [ fromIntegral $1 ] }
| INT ',' ints { fromIntegral $1 : $3 }
strlist :: { [String] }
: '[' ']' { [] }
| '[' strs ']' { reverse $2 }
strs :: { [String] }
: STRING { [ $1 ] }
| strs ',' STRING { $3 : $1 }
{
type PackageConfig = InstalledPackageInfo
defaultPackageConfig = emptyInstalledPackageInfo
data Token
= ITocurly
| ITccurly
| ITobrack
| ITcbrack
| ITcomma
| ITequal
| ITvarid String
| ITconid String
| ITstring String
| ITinteger Int
lexer :: String -> [Token]
lexer [] = []
lexer ('{':cs) = ITocurly : lexer cs
lexer ('}':cs) = ITccurly : lexer cs
lexer ('[':cs) = ITobrack : lexer cs
lexer (']':cs) = ITcbrack : lexer cs
lexer (',':cs) = ITcomma : lexer cs
lexer ('=':cs) = ITequal : lexer cs
lexer ('"':cs) = lexString cs ""
lexer (c:cs)
| isSpace c = lexer cs
| isAlpha c = lexID (c:cs)
| isDigit c = lexInt (c:cs)
lexer _ = error ( "Unexpected token")
lexID cs = (if isUpper (head cs) then ITconid else ITvarid) id : lexer rest
where
(id,rest) = break (\c -> c /= '_' && not (isAlphaNum c)) cs
lexInt cs = let (intStr, rest) = span isDigit cs
in ITinteger (read intStr) : lexer rest
lexString ('"':cs) s = ITstring (reverse s) : lexer cs
lexString ('\\':c:cs) s = lexString cs (c:s)
lexString (c:cs) s = lexString cs (c:s)
happyError _ = error "Couldn't parse package configuration."
parsePkgConf :: String -> [PackageConfig]
parsePkgConf = parse . lexer
parseOnePkgConf :: String -> PackageConfig
parseOnePkgConf = parseOne . lexer
}