;fix:journal: including an unreadable file now shows a clearer error
showing the problem include directive (previously the line number was off by one). Likewise for other IO errors like when resolving ~ and a home directory can't be found.
This commit is contained in:
parent
3ad9f87e18
commit
12234e0b7e
@ -106,6 +106,7 @@ import Hledger.Read.CsvReader qualified as CsvReader (reader)
|
|||||||
import Hledger.Read.RulesReader qualified as RulesReader (reader)
|
import Hledger.Read.RulesReader qualified as RulesReader (reader)
|
||||||
import Hledger.Read.TimeclockReader qualified as TimeclockReader (reader)
|
import Hledger.Read.TimeclockReader qualified as TimeclockReader (reader)
|
||||||
import Hledger.Read.TimedotReader qualified as TimedotReader (reader)
|
import Hledger.Read.TimedotReader qualified as TimedotReader (reader)
|
||||||
|
import Data.Function ((&))
|
||||||
|
|
||||||
--- ** doctest setup
|
--- ** doctest setup
|
||||||
-- $setup
|
-- $setup
|
||||||
@ -342,7 +343,7 @@ includedirectivep iopts = do
|
|||||||
Just fmt -> map ((show fmt++":")++) paths
|
Just fmt -> map ((show fmt++":")++) paths
|
||||||
|
|
||||||
-- Parse each one, as if inlined here.
|
-- Parse each one, as if inlined here.
|
||||||
forM_ prefixedpaths $ parseIncludedFile iopts
|
forM_ prefixedpaths $ parseIncludedFile iopts eoff
|
||||||
|
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -375,7 +376,7 @@ includedirectivep iopts = do
|
|||||||
-- but it does search non-top-level dot directories. Eg ** will find the c file in a/.b/c.
|
-- but it does search non-top-level dot directories. Eg ** will find the c file in a/.b/c.
|
||||||
|
|
||||||
-- expand a tilde at the start of the glob pattern, or throw an error
|
-- expand a tilde at the start of the glob pattern, or throw an error
|
||||||
expandedglob <- lift $ expandHomePath globpattern `orRethrowIOError` "failed to expand ~"
|
expandedglob <- lift $ expandHomePath globpattern & handleIOError off "failed to expand ~"
|
||||||
|
|
||||||
-- get the directory of the including file
|
-- get the directory of the including file
|
||||||
let cwd = takeDirectory parentf
|
let cwd = takeDirectory parentf
|
||||||
@ -434,12 +435,12 @@ includedirectivep iopts = do
|
|||||||
|
|
||||||
-- Parse the given included file (and any deeper includes, recursively) as if it was inlined in the current (parent) file.
|
-- Parse the given included file (and any deeper includes, recursively) as if it was inlined in the current (parent) file.
|
||||||
-- The offset of the start of the include directive in the parent file is provided for error messages.
|
-- The offset of the start of the include directive in the parent file is provided for error messages.
|
||||||
parseIncludedFile :: MonadIO m => InputOpts -> PrefixedFilePath -> ErroringJournalParser m ()
|
parseIncludedFile :: MonadIO m => InputOpts -> Int -> PrefixedFilePath -> ErroringJournalParser m ()
|
||||||
parseIncludedFile iopts1 prefixedpath = do
|
parseIncludedFile iopts1 off prefixedpath = do
|
||||||
let (_mprefix,filepath) = splitReaderPrefix prefixedpath
|
let (_mprefix,filepath) = splitReaderPrefix prefixedpath
|
||||||
|
|
||||||
-- Read the file's content, or throw an error
|
-- Read the file's content, or throw an error
|
||||||
childInput <- lift $ readFilePortably filepath `orRethrowIOError` "failed to read a file"
|
childInput <- lift $ readFilePortably filepath & handleIOError off "failed to read a file"
|
||||||
parentj <- get
|
parentj <- get
|
||||||
let initChildj = newJournalWithParseStateFrom filepath parentj
|
let initChildj = newJournalWithParseStateFrom filepath parentj
|
||||||
|
|
||||||
@ -493,14 +494,14 @@ includedirectivep iopts = do
|
|||||||
sourcePosFilePath :: (MonadIO m) => SourcePos -> m FilePath
|
sourcePosFilePath :: (MonadIO m) => SourcePos -> m FilePath
|
||||||
sourcePosFilePath = liftIO . makeAbsolute . sourceName
|
sourcePosFilePath = liftIO . makeAbsolute . sourceName
|
||||||
|
|
||||||
-- | Lift an IO action into the exception monad, rethrowing any IO
|
-- | Lift an IO action into the exception monad, converting any IO error
|
||||||
-- error with the given message prepended.
|
-- to a parse error message at the given offset.
|
||||||
orRethrowIOError :: MonadIO m => IO a -> String -> TextParser m a
|
handleIOError :: MonadIO m => Int -> String -> IO a -> TextParser m a
|
||||||
orRethrowIOError io msg = do
|
handleIOError off msg io = do
|
||||||
eResult <- liftIO $ (Right <$> io) `C.catch` \(e::C.IOException) -> pure $ Left $ printf "%s:\n%s" msg (show e)
|
eResult <- liftIO $ (Right <$> io) `C.catch` \(e::C.IOException) -> pure $ Left $ printf "%s:\n%s" msg (show e)
|
||||||
case eResult of
|
case eResult of
|
||||||
Right res -> pure res
|
Right res -> pure res
|
||||||
Left errMsg -> fail errMsg
|
Left errMsg -> setOffset off >> fail errMsg
|
||||||
|
|
||||||
-- Parse an account directive, adding its info to the journal's
|
-- Parse an account directive, adding its info to the journal's
|
||||||
-- list of account declarations.
|
-- list of account declarations.
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user