Skip to content
Browse files

'cabal.config': allow 'program-default-options' and 'program-locations'.

For compatibility with '~/.cabal/config'.
  • Loading branch information...
1 parent 9a07756 commit a51f6d8ca3716327d0f7d89934325040c2c0e13f @23Skidoo 23Skidoo committed Feb 11, 2014
View
4 cabal-install/Distribution/Client/Config.hs
@@ -30,7 +30,9 @@ module Distribution.Client.Config (
commentSavedConfig,
initialSavedConfig,
configFieldDescriptions,
- installDirsFields
+ installDirsFields,
+ withProgramsFields,
+ withProgramOptionsFields
) where
View
66 cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs
@@ -30,27 +30,27 @@ module Distribution.Client.Sandbox.PackageEnvironment (
import Distribution.Client.Config ( SavedConfig(..), commentSavedConfig
, loadConfig, configFieldDescriptions
- , installDirsFields, defaultCompiler )
+ , installDirsFields, withProgramsFields
+ , withProgramOptionsFields
+ , defaultCompiler )
import Distribution.Client.ParseUtils ( parseFields, ppFields, ppSection )
import Distribution.Client.Setup ( GlobalFlags(..), ConfigExFlags(..)
, InstallFlags(..)
, defaultSandboxLocation )
-import Distribution.Simple.Command ( ShowOrParseArgs(..), viewAsFieldDescr )
import Distribution.Simple.Compiler ( Compiler, PackageDB(..)
, compilerFlavor, showCompilerId )
import Distribution.Simple.InstallDirs ( InstallDirs(..), PathTemplate
, defaultInstallDirs, combineInstallDirs
, fromPathTemplate, toPathTemplate )
-import Distribution.Simple.Program ( defaultProgramConfiguration )
import Distribution.Simple.Setup ( Flag(..), ConfigFlags(..)
- , programConfigurationOptions
, fromFlagOrDefault, toFlag, flagToMaybe )
import Distribution.Simple.Utils ( die, info, notice, warn, lowercase )
import Distribution.ParseUtils ( FieldDescr(..), ParseResult(..)
, commaListField
, liftField, lineNo, locatedErrorMsg
, parseFilePathQ, readFields
- , showPWarning, simpleField, syntaxError )
+ , showPWarning, simpleField
+ , syntaxError, warning )
import Distribution.System ( Platform )
import Distribution.Verbosity ( Verbosity, normal )
import Control.Monad ( foldM, liftM2, when, unless )
@@ -403,7 +403,6 @@ pkgEnvFieldDescrs = [
(\flags -> flags { configPreferences = v }))
]
++ map toPkgEnv configFieldDescriptions'
- ++ map toPkgEnv programOptionsFields
where
optional = Parse.option mempty . fmap toFlag
@@ -412,14 +411,6 @@ pkgEnvFieldDescrs = [
(\(FieldDescr name _ _) -> name /= "preference" && name /= "constraint")
configFieldDescriptions
- programOptionsFields :: [FieldDescr SavedConfig]
- programOptionsFields =
- map viewAsFieldDescr $
- programConfigurationOptions defaultProgramConfiguration ParseArgs
- (configProgramArgs . savedConfigureFlags)
- (\v cfg -> cfg { savedConfigureFlags =
- (savedConfigureFlags cfg) { configProgramArgs = v } })
-
toPkgEnv :: FieldDescr SavedConfig -> FieldDescr PackageEnvironment
toPkgEnv fieldDescr =
liftField pkgEnvSavedConfig
@@ -458,36 +449,61 @@ parsePackageEnvironment initial str = do
let config = pkgEnvSavedConfig pkgEnv
installDirs0 = savedUserInstallDirs config
-- 'install-dirs' is the only section that we care about.
- installDirs <- foldM parseSection installDirs0 knownSections
+ (installDirs, paths, args) <- foldM parseSections (installDirs0, [], [])
+ knownSections
return pkgEnv {
pkgEnvSavedConfig = config {
+ savedConfigureFlags = (savedConfigureFlags config) {
+ configProgramPaths = paths,
+ configProgramArgs = args
+ },
savedUserInstallDirs = installDirs,
savedGlobalInstallDirs = installDirs
}
}
where
isKnownSection :: ParseUtils.Field -> Bool
- isKnownSection (ParseUtils.Section _ "install-dirs" _ _) = True
- isKnownSection _ = False
+ isKnownSection (ParseUtils.Section _ "install-dirs" _ _) = True
+ isKnownSection (ParseUtils.Section _ "program-locations" _ _) = True
+ isKnownSection (ParseUtils.Section _ "program-default-options" _ _) = True
+ isKnownSection _ = False
parse :: [ParseUtils.Field] -> ParseResult PackageEnvironment
parse = parseFields pkgEnvFieldDescrs initial
- parseSection :: InstallDirs (Flag PathTemplate)
- -> ParseUtils.Field
- -> ParseResult (InstallDirs (Flag PathTemplate))
- parseSection accum (ParseUtils.Section line "install-dirs" name fs)
- | name' == "" = do accum' <- parseFields installDirsFields accum fs
- return accum'
+ parseSections :: SectionsAccum -> ParseUtils.Field
+ -> ParseResult SectionsAccum
+ parseSections (d,p,a) (ParseUtils.Section line "install-dirs" name fs)
+ | name' == "" = do d' <- parseFields installDirsFields d fs
+ return (d',p,a)
| otherwise =
syntaxError line $
"Named 'install-dirs' section: '" ++ name
++ "'. Note that named 'install-dirs' sections are not allowed in the '"
++ userPackageEnvironmentFile ++ "' file."
where name' = lowercase name
- parseSection _accum f =
- syntaxError (lineNo f) "Unrecognized stanza."
+ parseSections accum@(d,p,a)
+ (ParseUtils.Section _ "program-locations" name fs)
+ | name == "" = do p' <- parseFields withProgramsFields p fs
+ return (d, p', a)
+ | otherwise = do
+ warning "The 'program-locations' section should be unnamed"
+ return accum
+ parseSections accum@(d, p, a)
+ (ParseUtils.Section _ "program-default-options" name fs)
+ | name == "" = do a' <- parseFields withProgramOptionsFields a fs
+ return (d, p, a')
+ | otherwise = do
+ warning "The 'program-default-options' section should be unnamed"
+ return accum
+ parseSections accum f = do
+ warning $ "Unrecognized stanza on line " ++ show (lineNo f)
+ return accum
+
+-- | Accumulator type for 'parseSections'.
+type SectionsAccum = (InstallDirs (Flag PathTemplate)
+ , [(String, FilePath)], [(String, [String])])
-- | Write out the package environment file.
writePackageEnvironmentFile :: FilePath -> IncludeComments

0 comments on commit a51f6d8

Please sign in to comment.
Something went wrong with that request. Please try again.