From 5a36362b339d8b7052d98d35a04debc4e90e38f0 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Thu, 22 Feb 2024 08:16:26 -1000
Subject: [PATCH] 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..)
---
 hledger-lib/Hledger/Read/JournalReader.hs | 25 +++++++++++++----------
 hledger/test/stats.test                   |  3 ++-
 2 files changed, 16 insertions(+), 12 deletions(-)

diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs
index e8fa73d2a..ac7a8a0f9 100644
--- a/hledger-lib/Hledger/Read/JournalReader.hs
+++ b/hledger-lib/Hledger/Read/JournalReader.hs
@@ -104,6 +104,7 @@ import qualified Hledger.Read.CsvReader as CsvReader (reader)
 import qualified Hledger.Read.RulesReader as RulesReader (reader)
 import qualified Hledger.Read.TimeclockReader as TimeclockReader (reader)
 import qualified Hledger.Read.TimedotReader as TimedotReader (reader)
+import System.Directory (canonicalizePath)
 
 --- ** doctest setup
 -- $setup
@@ -304,22 +305,24 @@ includedirectivep = do
   where
     getFilePaths
       :: MonadIO m => Int -> SourcePos -> FilePath -> JournalParser m [FilePath]
-    getFilePaths parseroff parserpos filename = do
-        let curdir = takeDirectory (sourceName parserpos)
-        filename' <- lift $ expandHomePath filename
-                         `orRethrowIOError` (show parserpos ++ " locating " ++ filename)
-        -- Compiling filename as a glob pattern works even if it is a literal
-        fileglob <- case tryCompileWith compDefault{errorRecovery=False} filename' of
+    getFilePaths parseroff parserpos fileglobpattern = do
+        -- Expand a ~ at the start of the glob pattern, if any.
+        fileglobpattern' <- lift $ expandHomePath fileglobpattern
+                         `orRethrowIOError` (show parserpos ++ " locating " ++ fileglobpattern)
+        -- Compile the glob pattern.
+        fileglob <- case tryCompileWith compDefault{errorRecovery=False} fileglobpattern' of
             Right x -> pure x
-            Left e -> customFailure $
-                        parseErrorAt parseroff $ "Invalid glob pattern: " ++ e
-        -- Get all matching files in the current working directory, sorting in
-        -- lexicographic order to simulate the output of 'ls'.
+            Left e -> customFailure $ parseErrorAt parseroff $ "Invalid glob pattern: " ++ e
+        -- Get the directory of the including file. This will be used to resolve relative paths.
+        let parentfilepath = sourceName parserpos
+        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
         if (not . null) filepaths
             then pure filepaths
             else customFailure $ parseErrorAt parseroff $
-                   "No existing files match pattern: " ++ filename
+                   "No existing files match pattern: " ++ fileglobpattern
 
     parseChild :: MonadIO m => SourcePos -> PrefixedFilePath -> ErroringJournalParser m ()
     parseChild parentpos prefixedpath = do
diff --git a/hledger/test/stats.test b/hledger/test/stats.test
index 376451158..cdb7945b0 100644
--- a/hledger/test/stats.test
+++ b/hledger/test/stats.test
@@ -8,4 +8,5 @@ $ hledger -f- stats
 include a.j
 include 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/