imp: conf: fail if --conf file is bad; improve debug output; refactor

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

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,
+-- | Try to read a hledger config from a config file specified by --conf,
--- or from a file specified by --conf,
+-- or the first config file found in any of several default file paths.
--- returning its path and a Conf parsed from it.
+-- If --no-conf was used, or if no file was specified or found, this returns a null Conf.
--- If no config file is found, or --no-conf is used, this returns a null Conf.
+-- If a specified file, or the first file found, can not be read or parsed, this raises an error.
--- Any other IO or parse failure will raise an error.
+-- Otherwise this returns the parsed Conf, and the file path.
 getConf :: RawOpts -> IO (Conf, Maybe FilePath)
-getConf rawopts = do
+getConf rawopts
-  defconfpaths <- confFilePaths
+  | noconf = return $ traceAt 1 "ignoring config files" (nullconf, Nothing)
-  existingconfpaths <- fmap catMaybes $ forM defconfpaths $ \f -> do
+  | otherwise = do
-    x <- doesFileExist f
+    defconfpaths <- confFilePaths
-    return $ if x then Just f else Nothing
+    defconffiles <- fmap catMaybes $ forM defconfpaths $ \f -> do
-  dbg1IO "found config files" existingconfpaths
+      exists <- doesFileExist f
-  let noconf = boolopt "no-conf" rawopts
+      return $ if exists then Just f else Nothing
-  let mconffile0 = maybestringopt "conf" rawopts
+    mspecifiedconf <- case maybestringopt "conf" rawopts of
-  mconffile <- case mconffile0 of
+      Just f  -> Just <$> (getCurrentDirectory >>= flip expandPath f)
-    Just f  -> Just <$> (getCurrentDirectory >>= flip expandPath f)
+      Nothing -> return Nothing
-    Nothing -> return Nothing
+    case (mspecifiedconf, defconffiles) of
-  let confpaths = maybe defconfpaths (:[]) mconffile
+      (Just f, _  ) -> readConfFile f
-  mconftxt <- readFirstConfFile confpaths
+      (Nothing,f:_) -> dbg1IO "found config files" defconffiles >> dbg1IO "using config file" f >> readConfFile f
-  if
+      (Nothing,[] ) -> return $ traceAt 1 "no config file found" (nullconf, Nothing)
-    | noconf -> return $ traceAt 1 "ignoring config files" (nullconf, Nothing)
+  where
-    | Nothing <- mconftxt -> return $ traceAt 1 "no config file found" (nullconf, Nothing)
+    noconf = boolopt "no-conf" rawopts
-    | Just (f,s) <- mconftxt ->
+
-      case parseConf f (T.pack s) of
+-- | Read this config file and parse its contents, or raise an error.
-        Left err -> error' $ errorBundlePretty err -- customErrorBundlePretty err
+readConfFile :: FilePath -> IO (Conf, Maybe FilePath)
-        Right ss -> return (nullconf{
+readConfFile f = do
-           confFile     = f
+  ecs <- readFile f <&> parseConf f . T.pack
-          ,confText     = s
+  case ecs of
-          ,confFormat   = 1
+    Left err -> error' $ errorBundlePretty err -- customErrorBundlePretty err
-          ,confSections = ss
+    Right cs -> return (nullconf{
-          }, Just f)
+        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