Merge pull request #6161 from haskell/gb/parse-config-multiline

Parse list fields in cabal config file

cabal-install/Distribution/Client/Config.hs

@@ -86,7 +86,7 @@ import Distribution.Simple.InstallDirs
  ( InstallDirs(..), defaultInstallDirs
  , PathTemplate, toPathTemplate )
 import Distribution.Deprecated.ParseUtils
- ( FieldDescr(..), liftField
+ ( FieldDescr(..), liftField, runP
  , ParseResult(..), PError(..), PWarning(..)
  , locatedErrorMsg, showPWarning
  , readFields, warning, lineNo
@@ -1097,7 +1097,7 @@ parseConfig src initial = \str -> do
  . nubBy ((==) `on` remoteRepoName)
  $ remoteRepoSections0
 
- return config {
+ return . fixConfigMultilines $ config {
  savedGlobalFlags = (savedGlobalFlags config) {
  globalRemoteRepos = toNubList remoteRepoSections,
  -- the global extra prog path comes from the configure flag prog path
@@ -1123,6 +1123,28 @@ parseConfig src initial = \str -> do
  isKnownSection (ParseUtils.Section _ "program-default-options" _ _) = True
  isKnownSection _ = False
 
+ -- attempt to split fields that can represent lists of paths into actual lists
+ -- on failure, leave the field untouched
+ splitMultiPath :: [String] -> [String]
+ splitMultiPath [s] = case runP 0 "" (parseOptCommaList parseTokenQ) s of
+ ParseOk _ res -> res
+ _ -> [s]
+ splitMultiPath xs = xs
+
+ -- This is a fixup, pending a full config parser rewrite, to ensure that
+ -- config fields which can be comma seperated lists actually parse as comma seperated lists
+ fixConfigMultilines conf = conf {
+ savedConfigureFlags =
+ let scf = savedConfigureFlags conf
+ in scf {
+ configProgramPathExtra = toNubList $ splitMultiPath (fromNubList $ configProgramPathExtra scf)
+ , configExtraLibDirs = splitMultiPath (configExtraLibDirs scf)
+ , configExtraFrameworkDirs = splitMultiPath (configExtraFrameworkDirs scf)
+ , configExtraIncludeDirs = splitMultiPath (configExtraIncludeDirs scf)
+ , configConfigureArgs = splitMultiPath (configConfigureArgs scf)
+ }
+ }
+
  parse = parseFields (configFieldDescriptions src
  ++ deprecatedFieldDescriptions) initial
 

cabal-install/Distribution/Client/ProjectConfig/Legacy.hs

@@ -72,16 +72,15 @@ import Distribution.Simple.LocalBuildInfo
 import Distribution.Deprecated.Text
 import qualified Distribution.Deprecated.ReadP as Parse
 import Distribution.Deprecated.ReadP
- ( ReadP, (+++), (<++) )
-import qualified Text.Read as Read
+ ( ReadP, (+++) )
 import qualified Text.PrettyPrint as Disp
 import Text.PrettyPrint
  ( Doc, ($+$) )
 import qualified Distribution.Deprecated.ParseUtils as ParseUtils (field)
 import Distribution.Deprecated.ParseUtils
  ( ParseResult(..), PError(..), syntaxError, PWarning(..), warning
- , simpleField, commaNewLineListField
- , showToken )
+ , simpleField, commaNewLineListField, newLineListField, parseTokenQ
+ , parseHaskellString, showToken )
 import Distribution.Client.ParseUtils
 import Distribution.Simple.Command
  ( CommandUI(commandOptions), ShowOrParseArgs(..)
@@ -1386,26 +1385,6 @@ remoteRepoSectionDescr =
 -- Local field utils
 --
 
---TODO: [code cleanup] all these utils should move to Distribution.Deprecated.ParseUtils
--- either augmenting or replacing the ones there
-
---TODO: [code cleanup] this is a different definition from listField, like
--- commaNewLineListField it pretty prints on multiple lines
-newLineListField :: String -> (a -> Doc) -> ReadP [a] a
- -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
-newLineListField = listFieldWithSep Disp.sep
-
---TODO: [code cleanup] local copy purely so we can use the fixed version
--- of parseOptCommaList below
-listFieldWithSep :: ([Doc] -> Doc) -> String -> (a -> Doc) -> ReadP [a] a
- -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
-listFieldWithSep separator name showF readF get' set =
- liftField get' set' $
- ParseUtils.field name showF' (parseOptCommaList readF)
- where
- set' xs b = set (get' b ++ xs) b
- showF' = separator . map showF
-
 -- | Parser combinator for simple fields which uses the field type's
 -- 'Monoid' instance for combining multiple occurences of the field.
 monoidField :: Monoid a => String -> (a -> Doc) -> ReadP a a
@@ -1415,15 +1394,6 @@ monoidField name showF readF get' set =
  where
  set' xs b = set (get' b `mappend` xs) b
 
---TODO: [code cleanup] local redefinition that should replace the version in
--- D.ParseUtils. This version avoid parse ambiguity for list element parsers
--- that have multiple valid parses of prefixes.
-parseOptCommaList :: ReadP r a -> ReadP r [a]
-parseOptCommaList p = Parse.sepBy p sep
- where
- -- The separator must not be empty or it introduces ambiguity
- sep = (Parse.skipSpaces >> Parse.char ',' >> Parse.skipSpaces)
- +++ (Parse.satisfy isSpace >> Parse.skipSpaces)
 
 --TODO: [code cleanup] local redefinition that should replace the version in
 -- D.ParseUtils called showFilePath. This version escapes "." and "--" which
@@ -1434,19 +1404,6 @@ showTokenQ x@('-':'-':_) = Disp.text (show x)
 showTokenQ x@('.':[]) = Disp.text (show x)
 showTokenQ x = showToken x
 
--- This is just a copy of parseTokenQ, using the fixed parseHaskellString
-parseTokenQ :: ReadP r String
-parseTokenQ = parseHaskellString
- <++ Parse.munch1 (\x -> not (isSpace x) && x /= ',')
-
---TODO: [code cleanup] use this to replace the parseHaskellString in
--- Distribution.Deprecated.ParseUtils. It turns out Read instance for String accepts
--- the ['a', 'b'] syntax, which we do not want. In particular it messes
--- up any token starting with [].
-parseHaskellString :: ReadP r String
-parseHaskellString =
- Parse.readS_to_P $
- Read.readPrec_to_S (do Read.String s <- Read.lexP; return s) 0
 
 -- Handy util
 addFields :: [FieldDescr a]

cabal-install/Distribution/Deprecated/ParseUtils.hs

@@ -28,14 +28,14 @@ module Distribution.Deprecated.ParseUtils (
  FieldDescr(..), ppField, ppFields, readFields, readFieldsFlat,
  showFields, showSingleNamedField, showSimpleSingleNamedField,
  parseFields, parseFieldsFlat,
- parseFilePathQ, parseTokenQ, parseTokenQ',
+ parseHaskellString, parseFilePathQ, parseTokenQ, parseTokenQ',
  parseModuleNameQ,
  parseFlagAssignment,
  parseOptVersion, parsePackageName,
  parseSepList, parseCommaList, parseOptCommaList,
  showFilePath, showToken, showTestedWith, showFreeText, parseFreeText,
  field, simpleField, listField, listFieldWithSep, spaceListField,
- commaListField, commaListFieldWithSep, commaNewLineListField,
+ commaListField, commaListFieldWithSep, commaNewLineListField, newLineListField,
  optsField, liftField, boolField, parseQuoted, parseMaybeQuoted,
  readPToMaybe,
 
@@ -58,13 +58,13 @@ import Distribution.Utils.Generic
 import Distribution.Version
 import Distribution.PackageDescription (FlagAssignment, mkFlagAssignment)
 
-import Data.Tree  as Tree (Tree (..), flatten)
+import Data.Tree as Tree (Tree (..), flatten)
 import System.FilePath (normalise)
 import Text.PrettyPrint
  (Doc, Mode (..), colon, comma, fsep, hsep, isEmpty, mode, nest, punctuate, render,
  renderStyle, sep, style, text, vcat, ($+$), (<+>))
-
-import qualified Data.Map  as Map
+import qualified Text.Read as Read
+import qualified Data.Map as Map
 
 import qualified Control.Monad.Fail as Fail
 
@@ -231,6 +231,12 @@ spaceListField name showF readF get set =
  set' xs b = set (get b ++ xs) b
  showF' = fsep . map showF
 
+-- this is a different definition from listField, like
+-- commaNewLineListField it pretty prints on multiple lines
+newLineListField :: String -> (a -> Doc) -> ReadP [a] a
+ -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
+newLineListField = listFieldWithSep sep
+
 listFieldWithSep :: Separator -> String -> (a -> Doc) -> ReadP [a] a
  -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b
 listFieldWithSep separator name showF readF get set =
@@ -622,8 +628,13 @@ parseOptVersion = parseMaybeQuoted ver
 -- particular, the type of <++ is ReadP r r -> ReadP r a -> ReadP r a
 -- Hence the trick above to make 'lic' polymorphic.
 
+-- Different than the naive version. it turns out Read instance for String accepts
+-- the ['a', 'b'] syntax, which we do not want. In particular it messes
+-- up any token starting with [].
 parseHaskellString :: ReadP r String
-parseHaskellString = readS_to_P reads
+parseHaskellString =
+ readS_to_P $
+ Read.readPrec_to_S (do Read.String s <- Read.lexP; return s) 0
 
 parseTokenQ :: ReadP r String
 parseTokenQ = parseHaskellString <++ munch1 (\x -> not (isSpace x) && x /= ',')
@@ -645,9 +656,14 @@ parseCommaList :: ReadP r a -- ^The parser for the stuff between commas
  -> ReadP r [a]
 parseCommaList = parseSepList (ReadP.char ',')
 
-parseOptCommaList :: ReadP r a -- ^The parser for the stuff between commas
- -> ReadP r [a]
-parseOptCommaList = parseSepList (optional (ReadP.char ','))
+-- This version avoid parse ambiguity for list element parsers
+-- that have multiple valid parses of prefixes.
+parseOptCommaList :: ReadP r a -> ReadP r [a]
+parseOptCommaList p = sepBy p localSep
+ where
+ -- The separator must not be empty or it introduces ambiguity
+ localSep = (skipSpaces >> char ',' >> skipSpaces)
+ +++ (satisfy isSpace >> skipSpaces)
 
 parseQuoted :: ReadP r a -> ReadP r a
 parseQuoted = between (ReadP.char '"') (ReadP.char '"')
@@ -705,4 +721,4 @@ parseFlagAssignment = mkFlagAssignment <$>
 -------------------------------------------------------------------------------
 
 showTestedWith :: (CompilerFlavor, VersionRange) -> Doc
-showTestedWith = pretty . pack' TestedWith
+showTestedWith = pretty . pack' TestedWith

cabal-install/changelog

@@ -3,6 +3,8 @@
 3.1.0.0 (current development version)
 
 3.0.0.0 TBD
+ * Parses comma-seperated lists for extra-prog-path, extra-lib-dirs, extra-framework-dirs, 
+ and extra-include-dirs as actual lists. (#5420)
  * `v2-repl` no longer changes directory to a randomized temporary folder
  when used outside of a project. (#5544)
  * `install-method` and `overwrite-policy` in `.cabal/config` now actually work. (#5942)

cabal-testsuite/PackageTests/UserConfig/cabal.out

@@ -6,3 +6,9 @@ cabal: <ROOT>/cabal.dist/cabal-config already exists.
 Writing default configuration to <ROOT>/cabal.dist/cabal-config
 # cabal user-config
 Writing default configuration to <ROOT>/cabal.dist/cabal-config2
+# cabal user-config
+Renaming <ROOT>/cabal.dist/cabal-config to <ROOT>/cabal.dist/cabal-config.backup.
+Writing merged config to <ROOT>/cabal.dist/cabal-config.
+# cabal user-config
+Renaming <ROOT>/cabal.dist/cabal-config to <ROOT>/cabal.dist/cabal-config.backup.
+Writing merged config to <ROOT>/cabal.dist/cabal-config.

cabal-testsuite/PackageTests/UserConfig/cabal.test.hs

@@ -11,3 +11,7 @@ main = cabalTest $ do
  withEnv [("CABAL_CONFIG", Just conf2)] $ do
  cabal "user-config" ["init"]
  shouldExist conf2
+ cabalG ["--config-file", conf] "user-config" ["update", "-f", "-a", "extra-prog-path: foo", "-a", "extra-prog-path: bar"]
+ assertFileDoesContain conf "foo,bar"
+ cabalG ["--config-file", conf] "user-config" ["update", "-f", "-a", "extra-prog-path: foo, bar"]
+ assertFileDoesContain conf "foo,bar"