Commit f3fb330a authored by gershomb's avatar gershomb

append option for user-config command

parent ec418e53
......@@ -620,7 +620,7 @@ loadRawConfig verbosity configFileFlag = do
Nothing -> do
notice verbosity $ "Config file path source is " ++ sourceMsg source ++ "."
notice verbosity $ "Config file " ++ configFile ++ " not found."
createDefaultConfigFile verbosity configFile
createDefaultConfigFile verbosity [] configFile
Just (ParseOk ws conf) -> do
unless (null ws) $ warn verbosity $
unlines (map (showPWarning configFile) ws)
......@@ -669,12 +669,13 @@ readConfigFile initial file = handleNotExists $
then return Nothing
else ioError ioe
createDefaultConfigFile :: Verbosity -> FilePath -> IO SavedConfig
createDefaultConfigFile verbosity filePath = do
createDefaultConfigFile :: Verbosity -> [String] -> FilePath -> IO SavedConfig
createDefaultConfigFile verbosity extraLines filePath = do
commentConf <- commentSavedConfig
initialConf <- initialSavedConfig
extraConf <- parseExtraLines verbosity extraLines
notice verbosity $ "Writing default configuration to " ++ filePath
writeConfigFile filePath commentConf initialConf
writeConfigFile filePath commentConf (initialConf `mappend` extraConf)
return initialConf
writeConfigFile :: FilePath -> SavedConfig -> SavedConfig -> IO ()
......@@ -1155,16 +1156,30 @@ withProgramOptionsFields =
map viewAsFieldDescr $
programDbOptions defaultProgramDb ParseArgs id (++)
parseExtraLines :: Verbosity -> [String] -> IO SavedConfig
parseExtraLines verbosity extraLines =
case parseConfig (ConstraintSourceMainConfig "additional lines")
mempty (unlines extraLines) of
ParseFailed err ->
let (line, msg) = locatedErrorMsg err
in die' verbosity $
"Error parsing additional config lines\n"
++ maybe "" (\n -> ':' : show n) line ++ ":\n" ++ msg
ParseOk [] r -> return r
ParseOk ws _ -> die' verbosity $
unlines (map (showPWarning "Error parsing additional config lines") ws)
-- | Get the differences (as a pseudo code diff) between the user's
-- '~/.cabal/config' and the one that cabal would generate if it didn't exist.
userConfigDiff :: GlobalFlags -> IO [String]
userConfigDiff globalFlags = do
userConfigDiff :: Verbosity -> GlobalFlags -> [String] -> IO [String]
userConfigDiff verbosity globalFlags extraLines = do
userConfig <- loadRawConfig normal (globalConfigFile globalFlags)
extraConfig <- parseExtraLines verbosity extraLines
testConfig <- initialSavedConfig
return $ reverse . foldl' createDiff [] . M.toList
$ M.unionWith combine
(M.fromList . map justFst $ filterShow testConfig)
(M.fromList . map justSnd $ filterShow userConfig)
(M.fromList . map justSnd $ filterShow (userConfig `mappend` extraConfig))
where
justFst (a, b) = (a, (Just b, Nothing))
justSnd (a, b) = (a, (Nothing, Just b))
......@@ -1202,9 +1217,10 @@ userConfigDiff globalFlags = do
-- | Update the user's ~/.cabal/config' keeping the user's customizations.
userConfigUpdate :: Verbosity -> GlobalFlags -> IO ()
userConfigUpdate verbosity globalFlags = do
userConfigUpdate :: Verbosity -> GlobalFlags -> [String] -> IO ()
userConfigUpdate verbosity globalFlags extraLines = do
userConfig <- loadRawConfig normal (globalConfigFile globalFlags)
extraConfig <- parseExtraLines verbosity extraLines
newConfig <- initialSavedConfig
commentConf <- commentSavedConfig
cabalFile <- getConfigFilePath $ globalConfigFile globalFlags
......@@ -1212,4 +1228,4 @@ userConfigUpdate verbosity globalFlags = do
notice verbosity $ "Renaming " ++ cabalFile ++ " to " ++ backup ++ "."
renameFile cabalFile backup
notice verbosity $ "Writing merged config to " ++ cabalFile ++ "."
writeConfigFile cabalFile commentConf (newConfig `mappend` userConfig)
writeConfigFile cabalFile commentConf (newConfig `mappend` userConfig `mappend` extraConfig)
......@@ -2403,14 +2403,16 @@ instance Semigroup ExecFlags where
-- ------------------------------------------------------------
data UserConfigFlags = UserConfigFlags {
userConfigVerbosity :: Flag Verbosity,
userConfigForce :: Flag Bool
} deriving Generic
userConfigVerbosity :: Flag Verbosity,
userConfigForce :: Flag Bool,
userConfigAppendLines :: Flag [String]
} deriving Generic
instance Monoid UserConfigFlags where
mempty = UserConfigFlags {
userConfigVerbosity = toFlag normal,
userConfigForce = toFlag False
userConfigVerbosity = toFlag normal,
userConfigForce = toFlag False,
userConfigAppendLines = toFlag []
}
mappend = (<>)
......@@ -2446,6 +2448,12 @@ userConfigCommand = CommandUI {
"Overwrite the config file if it already exists."
userConfigForce (\v flags -> flags { userConfigForce = v })
trueArg
, option ['a'] ["append"]
"Additional line to append to the config file."
userConfigAppendLines (\v flags -> flags
{userConfigAppendLines =
Flag $ concat (flagToList (userConfigAppendLines flags) ++ flagToList v)})
(reqArg' "CONFIGLINE" (Flag . (:[])) (fromMaybe [] . flagToMaybe))
]
}
......
......@@ -29,6 +29,8 @@
* 'cabal configure' now supports '--enable-static', which can be
used to build static libaries with GHC via GHC's `-staticlib`
flag.
* 'cabal user-config now supports '--append' which can append
additional lines to a new or updated cabal config file.
* Added support for '--enable-tests' and '--enable-benchmarks' to
'cabal fetch' (#4948).
* Misspelled package-names on CLI will no longer be silently
......
......@@ -1179,17 +1179,18 @@ execAction execFlags extraArgs globalFlags = do
userConfigAction :: UserConfigFlags -> [String] -> Action
userConfigAction ucflags extraArgs globalFlags = do
let verbosity = fromFlag (userConfigVerbosity ucflags)
force = fromFlag (userConfigForce ucflags)
let verbosity = fromFlag (userConfigVerbosity ucflags)
force = fromFlag (userConfigForce ucflags)
extraLines = fromFlag (userConfigAppendLines ucflags)
case extraArgs of
("init":_) -> do
path <- configFile
fileExists <- doesFileExist path
if (not fileExists || (fileExists && force))
then void $ createDefaultConfigFile verbosity path
then void $ createDefaultConfigFile verbosity extraLines path
else die' verbosity $ path ++ " already exists."
("diff":_) -> mapM_ putStrLn =<< userConfigDiff globalFlags
("update":_) -> userConfigUpdate verbosity globalFlags
("diff":_) -> mapM_ putStrLn =<< userConfigDiff verbosity globalFlags extraLines
("update":_) -> userConfigUpdate verbosity globalFlags extraLines
-- Error handling.
[] -> die' verbosity $ "Please specify a subcommand (see 'help user-config')"
_ -> die' verbosity $ "Unknown 'user-config' subcommand: " ++ unwords extraArgs
......
......@@ -37,7 +37,7 @@ nullDiffOnCreateTest = bracketTest $ \configFile -> do
-- Create a new default config file in our test directory.
_ <- loadConfig silent (Flag configFile)
-- Now we read it in and compare it against the default.
diff <- userConfigDiff $ globalFlags configFile
diff <- userConfigDiff silent (globalFlags configFile) []
assertBool (unlines $ "Following diff should be empty:" : diff) $ null diff
......@@ -46,7 +46,7 @@ canDetectDifference = bracketTest $ \configFile -> do
-- Create a new default config file in our test directory.
_ <- loadConfig silent (Flag configFile)
appendFile configFile "verbose: 0\n"
diff <- userConfigDiff $ globalFlags configFile
diff <- userConfigDiff silent (globalFlags configFile) []
assertBool (unlines $ "Should detect a difference:" : diff) $
diff == [ "+ verbose: 0" ]
......@@ -56,7 +56,7 @@ canUpdateConfig = bracketTest $ \configFile -> do
-- Write a trivial cabal file.
writeFile configFile "tests: True\n"
-- Update the config file.
userConfigUpdate silent $ globalFlags configFile
userConfigUpdate silent (globalFlags configFile) []
-- Load it again.
updated <- loadConfig silent (Flag configFile)
assertBool ("Field 'tests' should be True") $
......@@ -68,7 +68,7 @@ doubleUpdateConfig = bracketTest $ \configFile -> do
-- Create a new default config file in our test directory.
_ <- loadConfig silent (Flag configFile)
-- Update it twice.
replicateM_ 2 . userConfigUpdate silent $ globalFlags configFile
replicateM_ 2 $ userConfigUpdate silent (globalFlags configFile) []
-- Load it again.
updated <- loadConfig silent (Flag configFile)
......@@ -85,7 +85,7 @@ newDefaultConfig = do
sysTmpDir <- getTemporaryDirectory
withTempDirectory silent sysTmpDir "cabal-test" $ \tmpDir -> do
let configFile = tmpDir </> "tmp.config"
_ <- createDefaultConfigFile silent configFile
_ <- createDefaultConfigFile silent [] configFile
exists <- doesFileExist configFile
assertBool ("Config file should be written to " ++ configFile) exists
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment