imp: conf: fail if --conf file is bad; improve debug output; refactor
This commit is contained in:
Simon Michael
parent
b54a31d585
commit
b33d2a8f91
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user