lib: make getConf total; add getConf'
This commit is contained in:
parent
036be45c50
commit
03589e294b
@ -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" ()
|
||||||
|
|||||||
@ -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)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user