From f25b9ee4ae88486ff889fbd10234871f80a1f71a Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Sun, 14 Jul 2024 12:34:20 +0100
Subject: [PATCH] imp: conf: rightmost of --conf/--no-conf options wins

---
 hledger/Hledger/Cli.hs      | 27 +++++++++++-------
 hledger/Hledger/Cli/Conf.hs | 56 ++++++++++++++++++++++---------------
 hledger/hledger.m4.md       |  2 ++
 hledger/test/cli/cli.test   |  8 ++++++
 4 files changed, 61 insertions(+), 32 deletions(-)

diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs
index 121e44c22..b575ddc4d 100644
--- a/hledger/Hledger/Cli.hs
+++ b/hledger/Hledger/Cli.hs
@@ -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.
diff --git a/hledger/Hledger/Cli/Conf.hs b/hledger/Hledger/Cli/Conf.hs
index a94bcf3a0..4312dbd12 100644
--- a/hledger/Hledger/Cli/Conf.hs
+++ b/hledger/Hledger/Cli/Conf.hs
@@ -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" $
diff --git a/hledger/hledger.m4.md b/hledger/hledger.m4.md
index 391edfcce..daa222399 100644
--- a/hledger/hledger.m4.md
+++ b/hledger/hledger.m4.md
@@ -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
diff --git a/hledger/test/cli/cli.test b/hledger/test/cli/cli.test
index 8d20afbb8..cb5a70c43 100644
--- a/hledger/test/cli/cli.test
+++ b/hledger/test/cli/cli.test
@@ -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