lib: make getConf total; add getConf'

This commit is contained in:
Simon Michael 2025-04-23 21:27:04 -10:00
parent 036be45c50
commit 03589e294b
2 changed files with 37 additions and 24 deletions

View File

@ -273,7 +273,7 @@ main = exitOnExceptions $ withGhcDebug' $ do
seq cliconfrawopts $ -- order debug output seq cliconfrawopts $ -- order debug output
if clicmdarg=="setup" -- the setup command checks config files, but never uses one itself if clicmdarg=="setup" -- the setup command checks config files, but never uses one itself
then return (nullconf,Nothing) then return (nullconf,Nothing)
else getConf cliconfrawopts else getConf' cliconfrawopts
--------------------------------------------------------------- ---------------------------------------------------------------
dbgIO "\n3. Identify a command name from config file or command line" () dbgIO "\n3. Identify a command name from config file or command line" ()

View File

@ -7,7 +7,10 @@ Read extra CLI arguments from a hledger config file.
{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE MultiWayIf #-}
module Hledger.Cli.Conf ( module Hledger.Cli.Conf (
getConf Conf
,SectionName
,getConf
,getConf'
,nullconf ,nullconf
,confLookup ,confLookup
,activeConfFile ,activeConfFile
@ -19,24 +22,24 @@ module Hledger.Cli.Conf (
) )
where where
import Control.Monad (void, forM, when) import Control.Exception (handle)
import Control.Monad (void, forM)
import Control.Monad.Identity (Identity) import Control.Monad.Identity (Identity)
import Data.Functor ((<&>)) import Data.Functor ((<&>))
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T (pack) import qualified Data.Text as T (pack)
import Safe (headMay) import Safe (headMay, lastDef)
import System.Directory (getHomeDirectory, getXdgDirectory, XdgDirectory (XdgConfig), doesFileExist, getCurrentDirectory) import System.Directory (getHomeDirectory, getXdgDirectory, XdgDirectory (XdgConfig), doesFileExist, getCurrentDirectory)
import System.FilePath ((</>), takeDirectory) import System.FilePath ((</>), takeDirectory)
import Text.Megaparsec import Text.Megaparsec as M
import Text.Megaparsec.Char import Text.Megaparsec.Char
import Hledger (error', strip, words', RawOpts, expandPath) import Hledger (error', strip, words', RawOpts, expandPath)
import Hledger.Read.Common import Hledger.Read.Common
import Hledger.Utils.Parse import Hledger.Utils.Parse
import Hledger.Utils.Debug import Hledger.Utils.Debug
import Safe (lastDef)
import Hledger.Data.RawOptions (collectopts) import Hledger.Data.RawOptions (collectopts)
@ -97,37 +100,47 @@ confLookup cmd Conf{confSections} =
-- | Try to read a hledger config from a config file specified by --conf, -- | Try to read a hledger config from a config file specified by --conf,
-- or the first config file found in any of several default file paths. -- or the first config file found in any of several default file paths.
-- If --no-conf was used, or if no file was specified or found, this returns a null Conf. -- If --no-conf was used, or if no file was specified or found, this returns a null Conf.
-- If a specified file, or the first file found, can not be read or parsed, this raises an error. -- If a specified file, or the first file found, can not be read or parsed, this returns an error message.
-- Otherwise this returns the parsed Conf, and the file path. -- Otherwise this returns the parsed Conf, and the file path.
getConf :: RawOpts -> IO (Conf, Maybe FilePath) getConf :: RawOpts -> IO (Either String (Conf, Maybe FilePath))
getConf rawopts = do getConf rawopts = do
-- As in Cli.hs, conf debug output always goes to stderr; -- As in Cli.hs, conf debug output always goes to stderr;
-- that's ok as conf is a hledger cli feature for now. -- that's ok as conf is a hledger cli feature for now.
case confFileSpecFromRawOpts rawopts of case confFileSpecFromRawOpts rawopts of
NoConfFile -> return $ traceAt 1 "ignoring config files" (nullconf, Nothing) NoConfFile -> return $ Right $ traceAt 1 "ignoring config files" (nullconf, Nothing)
SomeConfFile f -> getCurrentDirectory >>= flip expandPath f >>= readConfFile . dbg1 "using specified config file" SomeConfFile f -> getCurrentDirectory >>= flip expandPath f >>= readConfFile . dbg1 "using specified config file"
AutoConfFile -> do AutoConfFile -> do
fs <- confFiles fs <- confFiles
case fs of case fs of
f:_ -> dbg8IO "found config files" fs >> dbg1IO "using nearest config file" f >> readConfFile f f:_ -> dbg8IO "found config files" fs >> dbg1IO "using nearest config file" f >> readConfFile f
[] -> return $ traceAt 1 "no config file found" (nullconf, Nothing) [] -> return $ Right $ traceAt 1 "no config file found" (nullconf, Nothing)
-- | Read this config file and parse its contents, or raise an error. -- | Like getConf but throws an error on failure.
readConfFile :: FilePath -> IO (Conf, Maybe FilePath) getConf' :: RawOpts -> IO (Conf, Maybe FilePath)
readConfFile f = do getConf' rawopts = getConf rawopts >>= either (error' . show) return
-- | Read this config file and parse its contents, or return an error message.
readConfFile :: FilePath -> IO (Either String (Conf, Maybe FilePath))
readConfFile f = handle (\(e::IOError) -> return $ Left $ show e) $ do
-- avoid GHC 9.10.1's ugly stack trace when calling readFile on a nonexistent file -- avoid GHC 9.10.1's ugly stack trace when calling readFile on a nonexistent file
exists <- doesFileExist f exists <- doesFileExist f
when (not exists) $ error' $ f <> " does not exist" case exists of
ecs <- readFile f <&> parseConf f . T.pack False -> return $ Left $ f <> " does not exist"
case ecs of True -> do
Left err -> error' $ errorBundlePretty err -- customErrorBundlePretty err ecs <- readFile f <&> parseConf f . T.pack
Right cs -> return (nullconf{ case ecs of
confFile = f Left err -> return $ Left $ errorBundlePretty err -- customErrorBundlePretty err
,confFormat = 1 Right cs -> return $ Right (nullconf{
,confSections = cs confFile = f
}, ,confFormat = 1
Just f ,confSections = cs
) },
Just f
)
-- -- | Like readConf, but throw an error on failure.
-- readConfFile' :: FilePath -> IO (Conf, Maybe FilePath)
-- readConfFile' f = readConfFile f >>= either (error' . show) return
-- | Get the highest precedence config file, based on the current directory. -- | Get the highest precedence config file, based on the current directory.
activeConfFile :: IO (Maybe FilePath) activeConfFile :: IO (Maybe FilePath)