diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs index 51ff20a443321fe54fa6c14759536dbc72f4b3cc..59ae0ff36a626370f2ed12f3654f2767dbfa63e8 100644 --- a/cabal-install/Distribution/Client/Config.hs +++ b/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 diff --git a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs index 865305a0873e8b7d2f715403561b71fed8c51dee..1904d51be9d72d1432314a436e4cadfea247bc14 100644 --- a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs +++ b/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] diff --git a/cabal-install/Distribution/Deprecated/ParseUtils.hs b/cabal-install/Distribution/Deprecated/ParseUtils.hs index f6c5c45878408a6e82105bb4b22c645013d66d2c..cda1e5bde7ca561b659ce0397cf2e3b81d983704 100644 --- a/cabal-install/Distribution/Deprecated/ParseUtils.hs +++ b/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 \ No newline at end of file diff --git a/cabal-install/changelog b/cabal-install/changelog index c41c8a15142d800cfac6ac03934a42d66e4d353c..12c115eab1270bc507c841481f195acecc737ac3 100644 --- a/cabal-install/changelog +++ b/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) diff --git a/cabal-testsuite/PackageTests/UserConfig/cabal.out b/cabal-testsuite/PackageTests/UserConfig/cabal.out index 7887050e85c2812c798e53e7bb8baa414e1eb2da..8dc64f170e1c4946cdbe43790a952f15c24a3186 100644 --- a/cabal-testsuite/PackageTests/UserConfig/cabal.out +++ b/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. diff --git a/cabal-testsuite/PackageTests/UserConfig/cabal.test.hs b/cabal-testsuite/PackageTests/UserConfig/cabal.test.hs index 32ad84982e1a35575b0dace40f4ce4df1dc1cee9..85d67212d4ced80f618208784cdaaab3df23dc1f 100644 --- a/cabal-testsuite/PackageTests/UserConfig/cabal.test.hs +++ b/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"