Parse: Fix parsing of ghc-options and similar. Fixes haskell#1346.

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

Cabal/Distribution/PackageDescription/Parse.hs

@@ -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

Cabal/Distribution/ParseUtils.hs

@@ -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,
@@ -215,11 +215,32 @@ 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", separated 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).
+--
+-- Does not accept leading spaces.
+-- Does accept trailing spaces after Haskell String literals (and consumes
+-- them as such).
+commandLineArgument :: ReadP r String
+commandLineArgument = concat `fmap` many1 ((show `fmap` parseHaskellString) <++ singleNonSpace)
+
+-- | Parses a single non-space character and returns it as a string.
+singleNonSpace :: ReadP r String
+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
 
@@ -231,13 +252,17 @@ 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))
+                   -- Note that this will not accept trailing spaces after
+                   -- commandLineArgument, but it doesn't matter since
+                   -- runP throws them away anyway.
   where
         update _ opts l | all null opts = l  --empty opts as if no opts
         update f opts [] = [(f,opts)]
@@ -664,25 +689,24 @@ parseLanguageQ = parseQuoted parse <++ parse
 parseExtensionQ :: ReadP r Extension
 parseExtensionQ = parseQuoted parse <++ parse
 
+-- | Parses a Haskell String literal (using `reads`).
+-- Does not allow leading whitespace.
 parseHaskellString :: ReadP r String
-parseHaskellString = readS_to_P reads
+parseHaskellString = do
+    remaining <- look -- forbid leading whitespace (reads allows it)
+    case remaining of
+      '"':_ -> readS_to_P reads
+      _     -> pfail
 
 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 ',')