From 5739bff249c23d91ca6733a6c2cb71898f76deb5 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Tue, 25 Jun 2024 06:36:11 +0100
Subject: [PATCH] imp: config file: --conf, --no-conf/-n, improve debug output

---
 hledger.conf.sample               |  2 +
 hledger/Hledger/Cli.hs            | 22 +++++---
 hledger/Hledger/Cli/CliOptions.hs |  4 +-
 hledger/Hledger/Cli/Conf.hs       | 86 +++++++++++++++++++++----------
 4 files changed, 78 insertions(+), 36 deletions(-)

diff --git a/hledger.conf.sample b/hledger.conf.sample
index f0829d15b..4a7c3c225 100644
--- a/hledger.conf.sample
+++ b/hledger.conf.sample
@@ -1,8 +1,10 @@
+#!/usr/bin/env -S hledger --conf
 # hledger.conf - extra options(/arguments) to be added to hledger commands.
 
 # hledger looks for a hledger.conf file in the current directory or above,
 # or in your home directory with a dotted name: $HOME/.hledger.conf,
 # or in your XDG config directory: $HOME/.config/hledger/hledger.conf.
+# You can also execute a conf file with a shebang line like the one above.
 
 # 1. This first, unnamed section is typically used for general options.
 # These affect all commands, or when not supported will be ignored.
diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs
index 553e9f4ff..6ab8edc14 100644
--- a/hledger/Hledger/Cli.hs
+++ b/hledger/Hledger/Cli.hs
@@ -88,7 +88,7 @@ module Hledger.Cli (
 )
 where
 
-import Control.Monad (when)
+import Control.Monad (when, unless)
 import Data.List
 import qualified Data.List.NonEmpty as NE
 import Data.Time.Clock.POSIX (getPOSIXTime)
@@ -112,6 +112,7 @@ import Data.Bifunctor (second)
 import Data.Function ((&))
 import Data.Functor ((<&>))
 import Data.List.Extra (nubSort)
+import Data.Maybe (isJust)
 
 
 -- | The overall cmdargs mode describing hledger's command-line options and subcommands.
@@ -134,7 +135,10 @@ mainmode addons = defMode {
      -- flags in named groups: (keep synced with Hledger.Cli.CliOptions.highlightHelp)
      groupNamed = cligeneralflagsgroups1
      -- flags in the unnamed group, shown last:
-    ,groupUnnamed = []
+    ,groupUnnamed = [
+       flagReq  ["conf"]        (\s opts -> Right $ setopt "conf" s opts) "CONFFILE" "Use extra options defined in this config file. If not specified, searches upward and in XDG config dir for hledger.conf (or .hledger.conf in $HOME)."
+      ,flagNone ["no-conf","n"] (setboolopt "no-conf") "ignore any config file"
+    ]
      -- flags handled but not shown in the help:
     ,groupHidden =
         [detailedversionflag]
@@ -216,12 +220,14 @@ main = withGhcDebug' $ do
   -- For this we do a preliminary cmdargs parse of the command line arguments.
   -- If no command was provided, or if the command line contains a bad flag
   -- or a wrongly present/missing flag argument, cmd will be "".
+  -- (Also find any --conf-file/--no-conf options.)
   let
     -- cliargswithcmdfirst' = filter (/= "--debug") cliargswithcmdfirst
     -- XXX files --debug fails here, eg.
     -- How to parse the command name with cmdargs without passing unsupported flags that it will reject ?
     -- Is --debug the only flag like this ?
-    cmd = cmdargsParse cliargswithcmdfirst addons & stringopt "command"
+    rawopts0 = cmdargsParse cliargswithcmdfirst addons
+    cmd = stringopt "command" rawopts0
       -- XXX may need a better error message when cmdargs fails to parse (eg spaced/quoted/malformed flag values)
     badcmdprovided = null cmd && not nocmdprovided
     isaddoncmd = not (null cmd) && cmd `elem` addons
@@ -238,7 +244,7 @@ main = withGhcDebug' $ do
 
   -- Read any extra general and command-specific args/opts from a config file.
   -- Ignore any general opts not known to be supported by the command.
-  conf <- getConf
+  (conf, mconffile) <- getConf rawopts0
   let
     genargsfromconf = confLookup "general" conf
     supportedgenargsfromconf
@@ -248,9 +254,11 @@ main = withGhcDebug' $ do
     cmdargsfromconf
       | null cmd  = []
       | otherwise = confLookup cmd conf & if isaddoncmd then ("--":) else id
-  dbgIO1 "extra general args from config file" genargsfromconf
-  dbgIO1 "excluded general args from config file, not supported by this command" excludedgenargsfromconf
-  dbgIO1 "extra command args from config file" cmdargsfromconf
+  when (isJust mconffile) $ do
+    dbgIO1 "extra general args from config file" genargsfromconf
+    unless (null excludedgenargsfromconf) $
+      dbgIO1 "excluded general args from config file, not supported by this command" excludedgenargsfromconf
+    dbgIO1 "extra command args from config file" cmdargsfromconf
 
   ---------------------------------------------------------------
   -- Combine cli and config file args and parse with cmdargs.
diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs
index 98bcb0670..75f491e90 100644
--- a/hledger/Hledger/Cli/CliOptions.hs
+++ b/hledger/Hledger/Cli/CliOptions.hs
@@ -146,8 +146,8 @@ prognameandversion =
 -- | Common input-related flags: --file, --rules-file, --alias...
 inputflags :: [Flag RawOpts]
 inputflags = [
-   flagReq  ["file","f"]      (\s opts -> Right $ setopt "file" s opts) "FILE" "Read data from FILE, or from stdin if -. Can be specified more than once. If not specified, reads from $LEDGER_FILE or $HOME/.hledger.journal."
-  ,flagReq  ["rules-file"]    (\s opts -> Right $ setopt "rules-file" s opts) "RULEFILE" "Use conversion rules from this file for converting subsequent CSV/SSV/TSV files. If not specified, uses FILE.rules for each such FILE."
+   flagReq  ["file","f"]      (\s opts -> Right $ setopt "file" s opts) "[FMT:]FILE" "Read data from FILE, or from stdin if FILE is -, inferring format from extension or a FMT: prefix. Can be specified more than once. If not specified, reads from $LEDGER_FILE or $HOME/.hledger.journal."
+  ,flagReq  ["rules"]         (\s opts -> Right $ setopt "rules" s opts) "RULESFILE" "Use rules defined in this rules file for converting subsequent CSV/SSV/TSV files. If not specified, uses FILE.csv.rules for each FILE.csv."  -- see also hiddenflags
 
   ,flagReq  ["alias"]         (\s opts -> Right $ setopt "alias" s opts)  "A=B|/RGX/=RPL" "transform account names from A to B, or by replacing regular expression matches"
   ,flagNone ["auto"]          (setboolopt "auto") "generate extra postings by applying auto posting rules (\"=\") to all transactions"
diff --git a/hledger/Hledger/Cli/Conf.hs b/hledger/Hledger/Cli/Conf.hs
index c9e8d1b2c..adc9042a9 100644
--- a/hledger/Hledger/Cli/Conf.hs
+++ b/hledger/Hledger/Cli/Conf.hs
@@ -5,6 +5,7 @@ Read extra CLI arguments from a hledger config file.
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE MultiWayIf #-}
 
 module Hledger.Cli.Conf (
    getConf
@@ -25,7 +26,7 @@ import System.FilePath ((</>), takeDirectory)
 import Text.Megaparsec
 import Text.Megaparsec.Char
 
-import Hledger (error', strip, words')
+import Hledger (error', strip, words', RawOpts, boolopt, maybestringopt, expandPath)
 import Hledger.Read.Common
 import Hledger.Utils.Parse
 import Hledger.Utils.Debug
@@ -70,55 +71,86 @@ confLookup cmd Conf{confSections} =
   M.lookup cmd $
   M.fromList [(csName,csArgs) | ConfSection{csName,csArgs} <- confSections]
 
--- | Try to read a hledger config file from several places.
--- If no config file is found, this returns a null Conf.
+-- | Try to read a hledger config file from several places,
+-- or from a file specified by --conf,
+-- returning its path and a Conf parsed from it.
+-- If no config file is found, or --no-conf is used, this returns a null Conf.
 -- Any other IO or parse failure will raise an error.
-getConf :: IO Conf
-getConf = do
-  mconftxt <- confFilePaths >>= readFirstConfFile
-  case mconftxt of
-    Nothing -> return $ traceAt 1 "no config file found" nullconf
-    Just (f,s) ->
+getConf :: RawOpts -> IO (Conf, Maybe FilePath)
+getConf rawopts = do
+  defconfpaths <- confFilePaths
+  let noconf = boolopt "no-conf" rawopts
+  let mconffile0 = maybestringopt "conf" rawopts
+  mconffile <- case mconffile0 of
+    Just f  -> Just <$> (getCurrentDirectory >>= flip expandPath f)
+    Nothing -> return Nothing
+  let confpaths = maybe defconfpaths (:[]) mconffile
+  mconftxt <- readFirstConfFile confpaths
+  if
+    | noconf -> return $ traceAt 1 "ignoring config files" (nullconf, Nothing)
+    | Nothing <- mconftxt -> return $ traceAt 1 "no config file found" (nullconf, Nothing)
+    | Just (f,s) <- mconftxt ->
       case parseConf f (T.pack s) of
         Left err -> error' $ errorBundlePretty err -- customErrorBundlePretty err
-        Right ss -> return nullconf{
+        Right ss -> return (nullconf{
            confFile     = f
           ,confText     = s
           ,confFormat   = 1
           ,confSections = ss
-          }
+          }, Just f)
 
 -- | Get the possible paths for a hledger config file, depending on the current directory.
 confFilePaths :: IO [FilePath]
 confFilePaths = do
   ds   <- confDirs
   home <- getHomeDirectory
-  return $ dbg1 "possible config files" $
+  return $ dbg8 "possible config files" $
     flip map ds $ \d -> d </> if d==home then ".hledger.conf" else "hledger.conf"
 
 -- | Get the directories to check for a hledger config file.
 confDirs :: IO [FilePath]
 confDirs = do
-  dirs   <- getDirsUpToHomeOrRoot
-  xdgdir <- getXdgDirectory XdgConfig "hledger"
-  return $ dbg1 "conf dirs" $ dirs <> [xdgdir]
-
--- | Get this directory and all of its parents up to ~ or /.
-getDirsUpToHomeOrRoot :: IO [FilePath]
-getDirsUpToHomeOrRoot = do
+  xdgc <- getXdgDirectory XdgConfig "hledger"
   home <- getHomeDirectory
-  let
-    go d =
-      if d=="/" || d==home
-      then [d]
-      else d : go (takeDirectory d)
-  dbg1 "dirs up to home or root" .
-    go <$> getCurrentDirectory
+  here <- getCurrentDirectory
+  -- lowdirs <- getDirsUpToHomeOrRoot
+  -- highdirs <-
+  --   case lastMay lowdirs of
+  --     Just d | d==home -> getDirsUpToRoot $ takeDirectory d
+  --     _                -> return []
+  -- let dirs = lowdirs <> [xdgdir] <> highdirs
+  dirs <- getDirsUpToRoot here
+  let dirs2 = if home `elem` dirs then dirs else dirs <> [home]
+  let dirs3 = if xdgc `elem` dirs2 then dirs2 else dirs2 <> [xdgc]
+  return $ dbg1 "searching config dirs" dirs3
+
+-- -- | Get this directory and all of its parents up to ~ or /.
+-- getDirsUpToHomeOrRoot :: IO [FilePath]
+-- getDirsUpToHomeOrRoot = do
+--   home <- getHomeDirectory
+--   let
+--     go d =
+--       if d=="/" || d==home
+--       then [d]
+--       else d : go (takeDirectory d)
+--   dbg1 "dirs up to home or root" .
+--     go <$> getCurrentDirectory
+
+-- | Get this directory and all of its parents up to /.
+getDirsUpToRoot :: FilePath -> IO [FilePath]
+getDirsUpToRoot dir = return $ go [] dir
+  where
+    go seen d = if
+      | d `elem` seen || length seen >= 100 -> []  -- just in case
+      | d=="/"    -> [d]
+      | otherwise -> d : go (d:seen) (takeDirectory d)
+  -- dbg1 "dirs up to root" .
+  --   go <$> getCurrentDirectory
 
 -- | Read the first of these files that exists.
 readFirstConfFile :: [FilePath] -> IO (Maybe (FilePath, String))
 readFirstConfFile fs = do
-  let dd = dbg1With (("config file found: "<>).fst)
+  let dd = dbg1With (("using config file: "<>).fst)
   mapM (fmap (fmap dd).readConfFile) fs <&> headMay . catMaybes
 
 -- | Read this file and return its path and contents, if it exists.