From b33d2a8f91d1589135c7720bfc37af20ca0243fc Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 1 Jul 2024 22:44:49 +0100 Subject: [PATCH] imp: conf: fail if --conf file is bad; improve debug output; refactor --- hledger/Hledger/Cli.hs | 8 +-- hledger/Hledger/Cli/Conf.hs | 102 +++++++++++++----------------------- 2 files changed, 38 insertions(+), 72 deletions(-) diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index 181a63c8e..fb81002f3 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -93,7 +93,7 @@ import Data.List import qualified Data.List.NonEmpty as NE import Data.Time.Clock.POSIX (getPOSIXTime) import Safe -import System.Console.CmdArgs.Explicit hiding (Name) -- don't clash with hledger-ui +import System.Console.CmdArgs.Explicit hiding (Name) import qualified System.Console.CmdArgs.Explicit as CmdArgs import System.Environment import System.Exit @@ -117,9 +117,6 @@ import Data.Maybe (isJust) verboseDebugLevel = 8 --- mainmodedesc = "main mode (+subcommands+generic addons)" --- mainmodedesc = "main mode" - -- | The overall cmdargs mode describing hledger's command-line options and subcommands. -- The names of known addons are provided so they too can be recognised as commands. mainmode addons = defMode { @@ -257,11 +254,10 @@ main = withGhcDebug' $ do -- For this parse with cmdargs again, this time with just the args that look conf-related. let cliconfargs = dropUnsupportedOpts confflagsmode cliargswithoutcmd dbgIO "cli args without command" cliargswithoutcmd - dbgIO "cli conf args" cliconfargs + -- dbgIO "cli conf args" cliconfargs let rawopts1 = cmdargsParse "to get conf file" confflagsmode cliconfargs -- Read extra general and command-specific args/opts from the config file if found. - -- XXX should error if reading a --conf-specified file fails. -- Ignore any general opts or cli-specific opts not known to be supported by the command. (conf, mconffile) <- getConf rawopts1 let diff --git a/hledger/Hledger/Cli/Conf.hs b/hledger/Hledger/Cli/Conf.hs index 66d2054c4..c9747ba7b 100644 --- a/hledger/Hledger/Cli/Conf.hs +++ b/hledger/Hledger/Cli/Conf.hs @@ -4,7 +4,6 @@ Read extra CLI arguments from a hledger config file. {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE MultiWayIf #-} module Hledger.Cli.Conf ( @@ -20,7 +19,6 @@ import qualified Data.Map as M import Data.Maybe (catMaybes) import Data.Text (Text) import qualified Data.Text as T (pack) -import Safe (headMay) import System.Directory (getHomeDirectory, getXdgDirectory, XdgDirectory (XdgConfig), doesFileExist, getCurrentDirectory) import System.FilePath ((), takeDirectory) import Text.Megaparsec @@ -35,7 +33,7 @@ import Hledger.Utils.Debug -- | A hledger config file. data Conf = Conf { confFile :: FilePath - ,confText :: String + -- ,confText :: String ,confFormat :: Int ,confSections :: [ConfSection] } deriving (Eq,Show) @@ -56,7 +54,6 @@ type Arg = String nullconf = Conf { confFile = "" - ,confText = "" ,confFormat = 1 ,confSections = [] } @@ -71,37 +68,42 @@ 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, --- 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. +-- | 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. +-- 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. +-- Otherwise this returns the parsed Conf, and the file path. getConf :: RawOpts -> IO (Conf, Maybe FilePath) -getConf rawopts = do - defconfpaths <- confFilePaths - existingconfpaths <- fmap catMaybes $ forM defconfpaths $ \f -> do - x <- doesFileExist f - return $ if x then Just f else Nothing - dbg1IO "found config files" existingconfpaths - 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{ - confFile = f - ,confText = s - ,confFormat = 1 - ,confSections = ss - }, Just f) +getConf rawopts + | 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:_) -> dbg1IO "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 + +-- | Read this config file and parse its contents, or raise an error. +readConfFile :: FilePath -> IO (Conf, Maybe FilePath) +readConfFile f = do + ecs <- readFile f <&> parseConf f . T.pack + case ecs of + Left err -> error' $ errorBundlePretty err -- customErrorBundlePretty err + Right cs -> return (nullconf{ + confFile = f + ,confFormat = 1 + ,confSections = cs + }, + Just f + ) -- | Get the possible paths for a hledger config file, depending on the current directory. confFilePaths :: IO [FilePath] @@ -117,29 +119,11 @@ confDirs = do xdgc <- getXdgDirectory XdgConfig "hledger" home <- getHomeDirectory 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 @@ -148,20 +132,6 @@ getDirsUpToRoot dir = return $ go [] dir | 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 (("using config file: "<>).fst) - mapM (fmap (fmap dd).readConfFile) fs <&> headMay . catMaybes - --- | Read this file and return its path and contents, if it exists. -readConfFile :: FilePath -> IO (Maybe (FilePath, String)) -readConfFile f = do - exists <- doesFileExist f - if exists then readFile f <&> (Just.(f,)) else return Nothing -- config file parsing