Skip to content

Commit

Permalink
Parse: Fix parsing of ghc-options and similar. Fixes haskell#1346.
Browse files Browse the repository at this point in the history
So far,
    ghc-options: -with-rtsopts="-A1000 -H1000 -K1000"
was parsed and run as as
    'ghc' ... '-with-rtsopts="-A1000' '-H1000' '-K1000"'
which will fail.

This is because we *tried* to parse quoted spaces (by leveraging
reads to parse them as Haskell Strings), but only at the beginning
of an option.

This commit fixes it by allowing String literals also in the middle
of options.

Note that because of the fact that we are still using reads,
    ghc-options: -with-rtsopts='-A1000 -H1000 -K1000'
(single quotes) will still fail.

The example from above now parses and runs successfully as
    'ghc' ... '-with-rtsopts="-A1000 -H1000 -K1000"'

This change applies to:
* ghc-options
* cc-options
* cpp-options
* ld-options
  • Loading branch information
nh2 committed May 24, 2013
1 parent 62857c6 commit 7c06162
Show file tree
Hide file tree
Showing 2 changed files with 29 additions and 20 deletions.
12 changes: 6 additions & 6 deletions Cabal/Distribution/PackageDescription/Parse.hs
Expand Up @@ -395,14 +395,14 @@ binfoFieldDescrs =
, commaListField "build-tools"
disp parseBuildTool
buildTools (\xs binfo -> binfo{buildTools=xs})
, spaceListField "cpp-options"
showToken parseTokenQ'
, externalOptsField "cpp-options"
showToken
cppOptions (\val binfo -> binfo{cppOptions=val})
, spaceListField "cc-options"
showToken parseTokenQ'
, externalOptsField "cc-options"
showToken
ccOptions (\val binfo -> binfo{ccOptions=val})
, spaceListField "ld-options"
showToken parseTokenQ'
, externalOptsField "ld-options"
showToken
ldOptions (\val binfo -> binfo{ldOptions=val})
, commaListField "pkgconfig-depends"
disp parsePkgconfigDependency
Expand Down
37 changes: 23 additions & 14 deletions Cabal/Distribution/ParseUtils.hs
Expand Up @@ -55,13 +55,13 @@ module Distribution.ParseUtils (
FieldDescr(..), ppField, ppFields, readFields, readFieldsFlat,
showFields, showSingleNamedField, showSimpleSingleNamedField,
parseFields, parseFieldsFlat,
parseFilePathQ, parseTokenQ, parseTokenQ',
parseFilePathQ, parseTokenQ,
parseModuleNameQ, parseBuildTool, parsePkgconfigDependency,
parseOptVersion, parsePackageNameQ, parseVersionRangeQ,
parseTestedWithQ, parseLicenseQ, parseLanguageQ, parseExtensionQ,
parseSepList, parseCommaList, parseOptCommaList,
showFilePath, showToken, showTestedWith, showFreeText, parseFreeText,
field, simpleField, listField, spaceListField, commaListField,
field, simpleField, listField, externalOptsField, commaListField,
optsField, liftField, boolField, parseQuoted,

UnrecFieldParser, warnUnrec, ignoreUnrec,
Expand Down Expand Up @@ -215,11 +215,26 @@ commaListField name showF readF get set =
where
set' xs b = set (get b ++ xs) b

spaceListField :: String -> (a -> Doc) -> ReadP [a] a
-> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
spaceListField name showF readF get set =
-- TODO This fact should go in user-visible documentation.

-- | Parses a single command line argument, like "-O2", seperated from its
-- environment by a space.
-- Can handle arguments which with spaces inside of quotes, as long as
-- the "string literal" looks like a Haskell string literal (reads is used).
-- Therefore it can also parse
-- -with-rtsopts="-N4 -A1000 -H1000 -K1000"
-- as a single command line argument (but not with 'single quotes' since
-- those are not used in Haskell string literals).
commandLineArgument :: ReadP r String
commandLineArgument = concat `fmap` many ((show `fmap` parseHaskellString) <++ singleNonSpace)
where
singleNonSpace = (:[]) `fmap` satisfy (not . isSpace)

externalOptsField :: String -> (String -> Doc)
-> (b -> [String]) -> ([String] -> b -> b) -> FieldDescr b
externalOptsField name showF get set =
liftField get set' $
field name (fsep . map showF) (parseSpaceList readF)
field name (fsep . map showF) (sepBy commandLineArgument (munch1 isSpace))
where
set' xs b = set (get b ++ xs) b

Expand All @@ -231,13 +246,14 @@ listField name showF readF get set =
where
set' xs b = set (get b ++ xs) b

-- | Parses a field for command line options, e.g. ghc-options or cpp-options.
optsField :: String -> CompilerFlavor -> (b -> [(CompilerFlavor,[String])])
-> ([(CompilerFlavor,[String])] -> b -> b) -> FieldDescr b
optsField name flavor get set =
liftField (fromMaybe [] . lookup flavor . get)
(\opts b -> set (reorder (update flavor opts (get b))) b) $
field name (hsep . map text)
(sepBy parseTokenQ' (munch1 isSpace))
(sepBy commandLineArgument (munch1 isSpace))
where
update _ opts l | all null opts = l --empty opts as if no opts
update f opts [] = [(f,opts)]
Expand Down Expand Up @@ -670,19 +686,12 @@ parseHaskellString = readS_to_P reads
parseTokenQ :: ReadP r String
parseTokenQ = parseHaskellString <++ munch1 (\x -> not (isSpace x) && x /= ',')

parseTokenQ' :: ReadP r String
parseTokenQ' = parseHaskellString <++ munch1 (not . isSpace)

parseSepList :: ReadP r b
-> ReadP r a -- ^The parser for the stuff between commas
-> ReadP r [a]
parseSepList sepr p = sepBy p separator
where separator = betweenSpaces sepr

parseSpaceList :: ReadP r a -- ^The parser for the stuff between commas
-> ReadP r [a]
parseSpaceList p = sepBy p skipSpaces

parseCommaList :: ReadP r a -- ^The parser for the stuff between commas
-> ReadP r [a]
parseCommaList = parseSepList (ReadP.char ',')
Expand Down

0 comments on commit 7c06162

Please sign in to comment.