Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/906cd6cd36506c651bec127924c4ee05a1a961ed >--------------------------------------------------------------- commit 906cd6cd36506c651bec127924c4ee05a1a961ed Author: Duncan Coutts <[email protected]> Date: Tue May 24 13:20:59 2011 +0000 Simpler flat (no sections) parsing for installed package info files Otherwise we cannot use '{' '}' chars in field contents, as they get interpreted as layout syntax. We want this for things like: library-dirs: ${pkgroot}/../libfoo/ >--------------------------------------------------------------- Distribution/InstalledPackageInfo.hs | 4 ++-- Distribution/ParseUtils.hs | 26 +++++++++++++++++++++++--- 2 files changed, 25 insertions(+), 5 deletions(-) diff --git a/Distribution/InstalledPackageInfo.hs b/Distribution/InstalledPackageInfo.hs index ec90a08..f878405 100644 --- a/Distribution/InstalledPackageInfo.hs +++ b/Distribution/InstalledPackageInfo.hs @@ -66,7 +66,7 @@ module Distribution.InstalledPackageInfo ( import Distribution.ParseUtils ( FieldDescr(..), ParseResult(..), PError(..), PWarning , simpleField, listField, parseLicenseQ - , showFields, showSingleNamedField, parseFields + , showFields, showSingleNamedField, parseFieldsFlat , parseFilePathQ, parseTokenQ, parseModuleNameQ, parsePackageNameQ , showFilePath, showToken, boolField, parseOptVersion , parseFreeText, showFreeText ) @@ -170,7 +170,7 @@ noVersion = Version{ versionBranch=[], versionTags=[] } -- Parsing parseInstalledPackageInfo :: String -> ParseResult InstalledPackageInfo -parseInstalledPackageInfo = parseFields all_fields emptyInstalledPackageInfo +parseInstalledPackageInfo = parseFieldsFlat all_fields emptyInstalledPackageInfo -- ----------------------------------------------------------------------------- -- Pretty-printing diff --git a/Distribution/ParseUtils.hs b/Distribution/ParseUtils.hs index 37b574c..5145321 100644 --- a/Distribution/ParseUtils.hs +++ b/Distribution/ParseUtils.hs @@ -52,8 +52,8 @@ module Distribution.ParseUtils ( LineNo, PError(..), PWarning(..), locatedErrorMsg, syntaxError, warning, runP, runE, ParseResult(..), catchParseError, parseFail, showPWarning, Field(..), fName, lineNo, - FieldDescr(..), ppField, ppFields, readFields, - showFields, showSingleNamedField, parseFields, + FieldDescr(..), ppField, ppFields, readFields, readFieldsFlat, + showFields, showSingleNamedField, parseFields, parseFieldsFlat, parseFilePathQ, parseTokenQ, parseTokenQ', parseModuleNameQ, parseBuildTool, parsePkgconfigDependency, parseOptVersion, parsePackageNameQ, parseVersionRangeQ, @@ -278,7 +278,14 @@ showSingleNamedField fields f = parseFields :: [FieldDescr a] -> a -> String -> ParseResult a parseFields fields initial = \str -> - readFields str >>= foldM setField initial + readFields str >>= accumFields fields initial + +parseFieldsFlat :: [FieldDescr a] -> a -> String -> ParseResult a +parseFieldsFlat fields initial = \str -> + readFieldsFlat str >>= accumFields fields initial + +accumFields :: [FieldDescr a] -> a -> [Field] -> ParseResult a +accumFields fields = foldM setField where fieldMap = Map.fromList [ (name, f) | f@(FieldDescr name _ _) <- fields ] @@ -355,6 +362,12 @@ readFields input = ifelse where ls = (lines . normaliseLineEndings) input tokens = (concatMap tokeniseLine . trimLines) ls +readFieldsFlat :: String -> ParseResult [Field] +readFieldsFlat input = mapM (mkField 0) + =<< mkTree tokens + where ls = (lines . normaliseLineEndings) input + tokens = (concatMap tokeniseLineFlat . trimLines) ls + -- attach line number and determine indentation trimLines :: [String] -> [(LineNo, Indent, HasTabs, String)] trimLines ls = [ (lineno, indent, hastabs, (trimTrailing l')) @@ -428,6 +441,13 @@ tokeniseLine (n0, i, t, l) = case split n0 l of | otherwise = Span n s' : ss where s' = trimTrailing (trimLeading s) +tokeniseLineFlat :: (LineNo, Indent, HasTabs, String) -> [Token] +tokeniseLineFlat (n0, i, t, l) + | null l' = [] + | otherwise = [Line n0 i t l'] + where + l' = trimTrailing (trimLeading l) + trimLeading, trimTrailing :: String -> String trimLeading = dropWhile isSpace trimTrailing = reverse . dropWhile isSpace . reverse _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
