-- 
-- 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 hiding (depends)
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

}