HEADS UP: First go at cabalising hs-plugins build system. Bugs have been introduced though
This commit is contained in:
Don Stewart
218
plugins/System/Plugins/ParsePkgConfCabal.y
Normal file
218
plugins/System/Plugins/ParsePkgConfCabal.y
Normal file
@ -0,0 +1,218 @@
|
||||
--
|
||||
-- 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 Char ( isSpace, isAlpha, isAlphaNum, isUpper, isDigit )
|
||||
import 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
|
||||
|
||||
}
|
||||
Reference in New Issue
Block a user