imp: conf: rightmost of --conf/--no-conf options wins

This commit is contained in:
Simon Michael 2024-07-14 12:34:20 +01:00
parent 098acb422b
commit f25b9ee4ae
4 changed files with 61 additions and 32 deletions

View File

@ -19,7 +19,7 @@ See also:
== About
hledger - a fast, reliable, user-friendly plain text accounting tool.
Copyright (c) 2007-2023 Simon Michael <simon@joyful.com> and contributors
Copyright (c) 2007-2024 Simon Michael <simon@joyful.com> and contributors
Released under GPL version 3 or later.
hledger is a Haskell rewrite of John Wiegley's "ledger".
@ -106,7 +106,7 @@ import System.Environment
import System.Exit
import System.FilePath
import System.Process
import Text.Megaparsec (optional, takeWhile1P)
import Text.Megaparsec (optional, takeWhile1P, eof)
import Text.Megaparsec.Char (char)
import Text.Printf
@ -487,12 +487,12 @@ moveFlagsAfterCommand args =
-- | isLongFlagArg a1 && any (takeWhile (/='=') `isPrefixOf`) longReqValFlagArgs_ ... -- try to move abbreviated long flags ?
| isFlagArg a1 = 1 -- an addon flag (or mistyped flag) we don't know, assume no value or value is joined
| otherwise = 0 -- not a flag
where
-- Is this string a valid --debug value ?
isDebugValue s = isRight $ parsewith isdebugvalp $ pack s
where isdebugvalp = optional (char '-') >> takeWhile1P Nothing isDigit :: TextParser m Text
moveFlagArgs (as, moved) = (as, moved)
-- Is this string a valid --debug value ?
isDebugValue s = isRight $ parsewith isdebugvalp $ pack s
where isdebugvalp = optional (char '-') >> takeWhile1P Nothing isDigit <* eof :: TextParser m Text
-- Flag arguments are command line arguments beginning with - or --
-- (followed by a short of long flag name, and possibly joined short flags or a joined value).
isFlagArg, isShortFlagArg, isLongFlagArg :: String -> Bool
@ -577,9 +577,16 @@ dropCliSpecificOpts = \case
-- | Given a hledger cmdargs mode and a list of command line arguments, try to drop any of the
-- arguments which seem to be flags not supported by this mode. Also drop their values if any.
--
-- >>> dropUnsupportedOpts confflagsmode ["--debug","1","-f","file"]
-- []
-- >>> dropUnsupportedOpts confflagsmode ["--debug","-f","file"]
-- []
dropUnsupportedOpts :: Mode RawOpts -> [String] -> [String]
dropUnsupportedOpts m = \case
[] -> []
"--debug":a:as | not (m `supportsFlag` "debug") ->
go $ if isDebugValue a then as else a:as
a:as -> if
| isLongFlagArg a,
let f = takeWhile (/='=') a,
@ -590,10 +597,10 @@ dropUnsupportedOpts m = \case
let as' = if isReqValFlagArg f && length a == 2 then drop 1 as else as
-> if m `supportsFlag` f then a : go as else go as'
| otherwise -> a : dropUnsupportedOpts m as
where
go = dropUnsupportedOpts m
isReqValFlagArg = (`elem` reqValFlagArgs)
supportsFlag m1 flagarg = elem flagarg $ map toFlagArg $ concatMap flagNames $ modeAndSubmodeFlags m1
where
go = dropUnsupportedOpts m
isReqValFlagArg = (`elem` reqValFlagArgs)
supportsFlag m1 flagarg = elem flagarg $ map toFlagArg $ concatMap flagNames $ modeAndSubmodeFlags m1
-- | Get all the flags defined in a mode or its immediate subcommands,
-- whether in named, unnamed or hidden groups.

View File

@ -24,10 +24,12 @@ import System.FilePath ((</>), takeDirectory)
import Text.Megaparsec
import Text.Megaparsec.Char
import Hledger (error', strip, words', RawOpts, boolopt, maybestringopt, expandPath)
import Hledger (error', strip, words', RawOpts, expandPath)
import Hledger.Read.Common
import Hledger.Utils.Parse
import Hledger.Utils.Debug
import Safe (lastDef)
import Hledger.Data.RawOptions (collectopts)
-- | A hledger config file.
@ -58,6 +60,22 @@ nullconf = Conf {
,confSections = []
}
-- | The --conf or --no-conf or default config file specified by command line options.
data ConfFileSpec =
SomeConfFile FilePath -- ^ use config file specified with --conf
| NoConfFile -- ^ don't use any config file (--no-conf)
| AutoConfFile -- ^ use the config file found by directory search (default)
deriving (Eq,Show)
-- Get the conf file specification from options,
-- considering the rightmost --conf or --no-conf option if any.
confFileSpecFromRawOpts :: RawOpts -> ConfFileSpec
confFileSpecFromRawOpts = lastDef AutoConfFile . collectopts cfsFromRawOpt
where
cfsFromRawOpt ("conf",f) = Just $ SomeConfFile f
cfsFromRawOpt ("no-conf",_) = Just $ NoConfFile
cfsFromRawOpt _ = Nothing
-- config reading
-- | Fetch all the arguments/options defined in a section with this name, if it exists.
@ -74,24 +92,18 @@ confLookup cmd Conf{confSections} =
-- If a specified file, or the first file found, can not be read or parsed, this raises an error.
-- Otherwise this returns the parsed Conf, and the file path.
getConf :: RawOpts -> IO (Conf, Maybe FilePath)
getConf rawopts
-- As in Cli.hs, conf debug output always goes to stderr;
-- that's ok as conf is a hledger cli feature for now.
| noconf = return $ traceAt 1 "ignoring config files" (nullconf, Nothing)
| otherwise = do
defconfpaths <- confFilePaths
defconffiles <- fmap catMaybes $ forM defconfpaths $ \f -> do
exists <- doesFileExist f
return $ if exists then Just f else Nothing
mspecifiedconf <- case maybestringopt "conf" rawopts of
Just f -> Just <$> (getCurrentDirectory >>= flip expandPath f)
Nothing -> return Nothing
case (mspecifiedconf, defconffiles) of
(Just f, _ ) -> readConfFile f
(Nothing,f:_) -> dbg8IO "found config files" defconffiles >> dbg1IO "using config file" f >> readConfFile f
(Nothing,[] ) -> return $ traceAt 1 "no config file found" (nullconf, Nothing)
where
noconf = boolopt "no-conf" rawopts
getConf rawopts = do
defconfpaths <- defaultConfFilePaths
defconffiles <- fmap catMaybes $ forM defconfpaths $ \f -> do
exists <- doesFileExist f
return $ if exists then Just f else Nothing
case (confFileSpecFromRawOpts rawopts, defconffiles) of
-- As in Cli.hs, conf debug output always goes to stderr;
-- that's ok as conf is a hledger cli feature for now.
(SomeConfFile f, _) -> getCurrentDirectory >>= flip expandPath f >>= readConfFile
(NoConfFile, _) -> return $ traceAt 1 "ignoring config files" (nullconf, Nothing)
(AutoConfFile,f:_) -> dbg8IO "found config files" defconffiles >> dbg1IO "using config file" f >> readConfFile f
(AutoConfFile,[] ) -> return $ traceAt 1 "no config file found" (nullconf, Nothing)
-- | Read this config file and parse its contents, or raise an error.
readConfFile :: FilePath -> IO (Conf, Maybe FilePath)
@ -100,7 +112,7 @@ readConfFile f = do
case ecs of
Left err -> error' $ errorBundlePretty err -- customErrorBundlePretty err
Right cs -> return (nullconf{
confFile = f
confFile = f
,confFormat = 1
,confSections = cs
},
@ -108,8 +120,8 @@ readConfFile f = do
)
-- | Get the possible paths for a hledger config file, depending on the current directory.
confFilePaths :: IO [FilePath]
confFilePaths = do
defaultConfFilePaths :: IO [FilePath]
defaultConfFilePaths = do
ds <- confDirs
home <- getHomeDirectory
return $ dbg8 "possible config files" $

View File

@ -537,6 +537,8 @@ You can inspect the finding and processing of config files with `--debug` or `--
If you want to run hledger without a config file, to ensure standard defaults and behaviour, use the `-n/--no-conf` flag.
This is recommended when using hledger in scripts, and when troubleshooting problems.
When both `--conf` and `--no-conf` options are used, the last (right-most) wins.
*(in master, experimental)*
# Output

View File

@ -140,3 +140,11 @@ $ hledger --debug 1 check -f/dev/null
# ** 21. A short flag with joined value, or multiple valueless short flags joined together, are moved properly.
$ hledger -f/dev/null -BI check
>2 //
# ** 22. The rightmost --conf/--no-conf option wins.
$ hledger -f /dev/null --conf nosuchfile --no-conf check
# ** 23. The rightmost --conf/--no-conf option wins, 2.
$ hledger -f /dev/null --no-conf --conf nosuchfile check
>2 /nosuchfile.*No such file/
>=1