mirror of
https://github.com/simonmichael/hledger.git
synced 2024-10-06 10:57:30 +03:00
imp: config file: --conf, --no-conf/-n, improve debug output
This commit is contained in:
parent
6180a162b2
commit
5739bff249
@ -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.
|
||||
|
@ -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.
|
||||
|
@ -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"
|
||||
|
@ -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.
|
||||
|
Loading…
Reference in New Issue
Block a user