imp:journal: use a symlink's target's directory for relative include paths

When reading a symbolically-linked journal file,
relative paths in include directives are now evaluated
relative to the directory of the real linked file,
not the directory of the symlink.

This also seems to fix an obscure case where stats did not report
absolute included file paths in certain circumstances (stdin, maybe no
terminal..)
This commit is contained in:
Simon Michael 2024-02-22 08:16:26 -10:00
parent f6a50923c2
commit 5a36362b33
2 changed files with 16 additions and 12 deletions

View File

@ -104,6 +104,7 @@ import qualified Hledger.Read.CsvReader as CsvReader (reader)
import qualified Hledger.Read.RulesReader as RulesReader (reader) import qualified Hledger.Read.RulesReader as RulesReader (reader)
import qualified Hledger.Read.TimeclockReader as TimeclockReader (reader) import qualified Hledger.Read.TimeclockReader as TimeclockReader (reader)
import qualified Hledger.Read.TimedotReader as TimedotReader (reader) import qualified Hledger.Read.TimedotReader as TimedotReader (reader)
import System.Directory (canonicalizePath)
--- ** doctest setup --- ** doctest setup
-- $setup -- $setup
@ -304,22 +305,24 @@ includedirectivep = do
where where
getFilePaths getFilePaths
:: MonadIO m => Int -> SourcePos -> FilePath -> JournalParser m [FilePath] :: MonadIO m => Int -> SourcePos -> FilePath -> JournalParser m [FilePath]
getFilePaths parseroff parserpos filename = do getFilePaths parseroff parserpos fileglobpattern = do
let curdir = takeDirectory (sourceName parserpos) -- Expand a ~ at the start of the glob pattern, if any.
filename' <- lift $ expandHomePath filename fileglobpattern' <- lift $ expandHomePath fileglobpattern
`orRethrowIOError` (show parserpos ++ " locating " ++ filename) `orRethrowIOError` (show parserpos ++ " locating " ++ fileglobpattern)
-- Compiling filename as a glob pattern works even if it is a literal -- Compile the glob pattern.
fileglob <- case tryCompileWith compDefault{errorRecovery=False} filename' of fileglob <- case tryCompileWith compDefault{errorRecovery=False} fileglobpattern' of
Right x -> pure x Right x -> pure x
Left e -> customFailure $ Left e -> customFailure $ parseErrorAt parseroff $ "Invalid glob pattern: " ++ e
parseErrorAt parseroff $ "Invalid glob pattern: " ++ e -- Get the directory of the including file. This will be used to resolve relative paths.
-- Get all matching files in the current working directory, sorting in let parentfilepath = sourceName parserpos
-- lexicographic order to simulate the output of 'ls'. realparentfilepath <- liftIO $ canonicalizePath parentfilepath -- Follow a symlink. If the path is already absolute, the operation never fails.
let curdir = takeDirectory realparentfilepath
-- Find all matched files, in lexicographic order mimicking the output of 'ls'.
filepaths <- liftIO $ sort <$> globDir1 fileglob curdir filepaths <- liftIO $ sort <$> globDir1 fileglob curdir
if (not . null) filepaths if (not . null) filepaths
then pure filepaths then pure filepaths
else customFailure $ parseErrorAt parseroff $ else customFailure $ parseErrorAt parseroff $
"No existing files match pattern: " ++ filename "No existing files match pattern: " ++ fileglobpattern
parseChild :: MonadIO m => SourcePos -> PrefixedFilePath -> ErroringJournalParser m () parseChild :: MonadIO m => SourcePos -> PrefixedFilePath -> ErroringJournalParser m ()
parseChild parentpos prefixedpath = do parseChild parentpos prefixedpath = do

View File

@ -8,4 +8,5 @@ $ hledger -f- stats
include a.j include a.j
include b.j include b.j
$ touch a.j b.j; hledger -f- stats; rm -f a.j b.j $ touch a.j b.j; hledger -f- stats; rm -f a.j b.j
> /Included files *: *\.\/a\.j/ > /Included files.*\/a\.j
.*\/b\.j/