fix: fix multi-file account display order; improve file read logging (#1909)

hledger-lib/Hledger/Data/Journal.hs

@@ -29,6 +29,7 @@ module Hledger.Data.Journal (
   journalAddPricesFromEquity,
   journalReverse,
   journalSetLastReadTime,
+  journalRenumberAccountDeclarations,
   journalPivot,
   -- * Filtering
   filterJournalTransactions,
@@ -98,11 +99,13 @@ module Hledger.Data.Journal (
   -- * Misc
   canonicalStyleFrom,
   nulljournal,
+  journalConcat,
   journalNumberTransactions,
   journalNumberAndTieTransactions,
   journalUntieTransactions,
   journalModifyTransactions,
   journalApplyAliases,
+  dbgJournalAcctDeclOrder,
   -- * Tests
   samplejournal,
   samplejournalMaybeExplicit,
@@ -117,7 +120,7 @@ import Control.Monad.State.Strict (StateT)
 import Data.Char (toUpper, isDigit)
 import Data.Default (Default(..))
 import Data.Foldable (toList)
-import Data.List ((\\), find, foldl', sortBy, union)
+import Data.List ((\\), find, foldl', sortBy, union, intercalate)
 import Data.List.Extra (nubSort)
 import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList)
@@ -141,6 +144,7 @@ import Hledger.Data.Transaction
 import Hledger.Data.TransactionModifier
 import Hledger.Data.Valuation
 import Hledger.Query
+import System.FilePath (takeFileName)
 
 
 -- | A parser of text that runs in some monad, keeping a Journal as state.
@@ -188,9 +192,7 @@ instance Show Journal where
 -- The semigroup instance for Journal is useful for two situations.
 --
 -- 1. concatenating finalised journals, eg with multiple -f options:
--- FIRST <> SECOND. The second's list fields are appended to the
--- first's, map fields are combined, transaction counts are summed,
--- the parse state of the second is kept.
+-- FIRST <> SECOND.
 --
 -- 2. merging a child parsed journal, eg with the include directive:
 -- CHILD <> PARENT. A parsed journal's data is in reverse order, so
@@ -198,9 +200,21 @@ instance Show Journal where
 --
 -- Note that (<>) is right-biased, so nulljournal is only a left identity.
 -- In particular, this prevents Journal from being a monoid.
-instance Semigroup Journal where
-  j1 <> j2 =
+instance Semigroup Journal where j1 <> j2 = j1 `journalConcat` j2
+
+-- | Merge two journals into one.
+-- Transaction counts are summed, map fields are combined,
+-- the second's list fields are appended to the first's,
+-- the second's parse state is kept.
+journalConcat :: Journal -> Journal -> Journal
+journalConcat j1 j2 =
+  let
+    f1 = takeFileName $ journalFilePath j1
+    f2 = maybe "(unknown)" takeFileName $ headMay $ jincludefilestack j2  -- XXX more accurate than journalFilePath for some reason
+  in
+    dbgJournalAcctDeclOrder ("journalConcat: " <> f1 <> " <> " <> f2 <> ", acct decls renumbered: ") $
     journalRenumberAccountDeclarations $
+    dbgJournalAcctDeclOrder ("journalConcat: " <> f1 <> " <> " <> f2 <> ", acct decls           : ") $
     Journal {
      jparsedefaultyear          = jparsedefaultyear          j2
     ,jparsedefaultcommodity     = jparsedefaultcommodity     j2
@@ -228,13 +242,33 @@ instance Semigroup Journal where
     ,jlastreadtime              = max (jlastreadtime j1) (jlastreadtime j2)
     }
 
--- | Renumber all the account declarations. Call this after combining two journals into one,
--- so that account declarations have a total order again.
+-- | Renumber all the account declarations. This is useful to call when
+-- finalising or concatenating Journals, to give account declarations
+-- a total order across files.
 journalRenumberAccountDeclarations :: Journal -> Journal
 journalRenumberAccountDeclarations j = j{jdeclaredaccounts=jdas'}
   where
     jdas' = [(a, adi{adideclarationorder=n}) | (n, (a,adi)) <- zip [1..] $ jdeclaredaccounts j]
-    -- XXX the per-file declaration order saved during parsing is discarded; it seems unneeded
+    -- the per-file declaration order saved during parsing is discarded,
+    -- it seems unneeded except perhaps for debugging
+
+-- | Debug log the ordering of a journal's account declarations
+-- (at debug level 5+).
+dbgJournalAcctDeclOrder :: String -> Journal -> Journal
+dbgJournalAcctDeclOrder prefix
+  | debugLevel >= 5 = traceWith ((prefix++) . showAcctDeclsSummary . jdeclaredaccounts)
+  | otherwise       = id
+  where
+    showAcctDeclsSummary :: [(AccountName,AccountDeclarationInfo)] -> String
+    showAcctDeclsSummary adis
+      | length adis < (2*num+2) = "[" <> showadis adis <> "]"
+      | otherwise =
+          "[" <> showadis (take num adis) <> " ... " <> showadis (takelast num adis) <> "]"
+      where
+        num = 3
+        showadis = intercalate ", " . map showadi
+        showadi (a,adi) = "("<>show (adideclarationorder adi)<>","<>T.unpack a<>")"
+        takelast n = reverse . take n . reverse
 
 instance Default Journal where
   def = nulljournal

hledger-lib/Hledger/Read.hs

@@ -69,7 +69,7 @@ import Safe (headDef)
 import System.Directory (doesFileExist, getHomeDirectory)
 import System.Environment (getEnv)
 import System.Exit (exitFailure)
-import System.FilePath ((<.>), (</>), splitDirectories, splitFileName)
+import System.FilePath ((<.>), (</>), splitDirectories, splitFileName, takeFileName)
 import System.Info (os)
 import System.IO (hPutStr, stderr)
 
@@ -139,9 +139,8 @@ type PrefixedFilePath = FilePath
 -- since hledger 1.17, we prefer predictability.)
 readJournal :: InputOpts -> Maybe FilePath -> Text -> ExceptT String IO Journal
 readJournal iopts mpath txt = do
-  let r :: Reader IO =
-        fromMaybe JournalReader.reader $ findReader (mformat_ iopts) mpath
-  dbg6IO "trying reader" (rFormat r)
+  let r :: Reader IO = fromMaybe JournalReader.reader $ findReader (mformat_ iopts) mpath
+  dbg6IO "readJournal: trying reader" (rFormat r)
   rReadFn r iopts (fromMaybe "(string)" mpath) txt
 
 -- | Read a Journal from this file, or from stdin if the file path is -,
@@ -161,7 +160,9 @@ readJournalFile iopts prefixedfile = do
     (mfmt, f) = splitReaderPrefix prefixedfile
     iopts' = iopts{mformat_=asum [mfmt, mformat_ iopts]}
   liftIO $ requireJournalFileExists f
-  t <- liftIO $ readFileOrStdinPortably f
+  t <-
+    traceAt 6 ("readJournalFile: "++takeFileName f) $
+    liftIO $ readFileOrStdinPortably f
     -- <- T.readFile f  -- or without line ending translation, for testing
   j <- readJournal iopts' (Just f) t
   if new_ iopts

hledger-lib/Hledger/Read/Common.hs

@@ -148,6 +148,7 @@ import Hledger.Query (Query(..), filterQuery, parseQueryTerm, queryEndDate, quer
 import Hledger.Reports.ReportOptions (ReportOpts(..), queryFromFlags, rawOptsToReportOpts)
 import Hledger.Utils
 import Hledger.Read.InputOptions
+import System.FilePath (takeFileName)
 
 --- ** doctest setup
 -- $setup
@@ -324,6 +325,10 @@ journalFinalise iopts@InputOpts{..} f txt pj = do
       >>= journalBalanceTransactions balancingopts_                         -- Balance all transactions and maybe check balance assertions.
       <&> (if infer_equity_ then journalAddInferredEquityPostings else id)  -- Add inferred equity postings, after balancing and generating auto postings
       <&> journalInferMarketPricesFromTransactions       -- infer market prices from commodity-exchanging transactions
+      <&> traceAt 6 ("journalFinalise: " <> takeFileName f)  -- debug logging
+      <&> dbgJournalAcctDeclOrder ("journalFinalise: " <> takeFileName f <> "   acct decls           : ")
+      <&> journalRenumberAccountDeclarations
+      <&> dbgJournalAcctDeclOrder ("journalFinalise: " <> takeFileName f <> "   acct decls renumbered: ")
     when strict_ $ do
       journalCheckAccounts j                     -- If in strict mode, check all postings are to declared accounts
       journalCheckCommodities j                  -- and using declared commodities

hledger-lib/Hledger/Read/JournalReader.hs

@@ -187,9 +187,7 @@ reader = Reader
 parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
 parse iopts f = parseAndFinaliseJournal journalp' iopts f
   where
-    journalp' =
-      -- debug logging for account display order
-      dbgJournalAcctDeclOrder (takeFileName f <> " acct decls: ") <$> do
+    journalp' = do
       -- reverse parsed aliases to ensure that they are applied in order given on commandline
       mapM_ addAccountAlias (reverse $ aliasesFromOpts iopts)
       journalp
@@ -300,39 +298,35 @@ includedirectivep = do
       when (filepath `elem` parentfilestack) $
         Fail.fail ("Cyclic include: " ++ filepath)
 
-      childInput <- lift $ readFilePortably filepath
-                            `orRethrowIOError` (show parentpos ++ " reading " ++ filepath)
+      childInput <-
+        traceAt 6 ("parseChild: "++takeFileName filepath) $
+        lift $ readFilePortably filepath
+          `orRethrowIOError` (show parentpos ++ " reading " ++ filepath)
       let initChildj = newJournalWithParseStateFrom filepath parentj
 
       -- Choose a reader/parser based on the file path prefix or file extension,
       -- defaulting to JournalReader. Duplicating readJournal a bit here.
       let r = fromMaybe reader $ findReader Nothing (Just prefixedpath)
           parser = rParser r
-      dbg6IO "trying reader" (rFormat r)
+      dbg6IO "parseChild: trying reader" (rFormat r)
 
       -- Parse the file (of whichever format) to a Journal, with file path and source text attached.
-      updatedChildj <- (journalAddFile (filepath, childInput)) <$>
+      updatedChildj <- journalAddFile (filepath, childInput) <$>
                         parseIncludeFile parser initChildj filepath childInput
 
-      -- Merge this child journal into the parent journal using Journal's Semigroup instance
-      -- (with lots of debug logging for troubleshooting account display order).
+      -- Merge this child journal into the parent journal
+      -- (with debug logging for troubleshooting account display order).
+      -- The parent journal is the second argument to journalConcat; this means
+      -- its parse state is kept, and its lists are appended to child's (which
+      -- ultimately produces the right list order, because parent's and child's
+      -- lists are in reverse order at this stage. Cf #1909).
       let
         parentj' =
-          dbgJournalAcctDeclOrder (" " <> parentfilename <> " acct decls now : ")
-          $
-          (
-            -- The child journal has not yet been finalises and its lists are still reversed.
-            -- To help calculate account declaration order across files (#1909),
-            -- unreverse just the acct declarations without disturbing anything else.
-            -- XXX still shows wrong order in some cases
-            reverseAcctDecls $
-            dbgJournalAcctDeclOrder (childfilename <> " include file acct decls: ") updatedChildj
-          )
-          <>
-          dbgJournalAcctDeclOrder (" " <> parentfilename <> " acct decls were: ") parentj
+          dbgJournalAcctDeclOrder ("parseChild: child " <> childfilename <> " acct decls: ") updatedChildj
+          `journalConcat`
+          dbgJournalAcctDeclOrder ("parseChild: parent " <> parentfilename <> " acct decls: ") parentj
 
           where
-            reverseAcctDecls j = j{jdeclaredaccounts = reverse $ jdeclaredaccounts j}
             childfilename = takeFileName filepath
             parentfilename = maybe "" takeFileName $ headMay $ jincludefilestack parentj  -- more accurate than journalFilePath parentj somehow
 
@@ -352,22 +346,6 @@ includedirectivep = do
       ,jincludefilestack      = filepath : jincludefilestack j
       }
 
-dbgJournalAcctDeclOrder :: String -> Journal -> Journal
-dbgJournalAcctDeclOrder prefix
-  | debugLevel >= 5 = traceWith ((prefix++) . showAcctDeclsSummary . jdeclaredaccounts)
-  | otherwise       = id
-  where
-    showAcctDeclsSummary :: [(AccountName,AccountDeclarationInfo)] -> String
-    showAcctDeclsSummary adis
-      | length adis < (2*num+2) = "[" <> showadis adis <> "]"
-      | otherwise =
-          "[" <> showadis (take num adis) <> " ... " <> showadis (takelast num adis) <> "]"
-      where
-        num = 3
-        showadis = intercalate ", " . map showadi
-        showadi (a,adi) = "("<>show (adideclarationorder adi)<>","<>T.unpack a<>")"
-        takelast n = reverse . take n . reverse
-
 -- | Lift an IO action into the exception monad, rethrowing any IO
 -- error with the given message prepended.
 orRethrowIOError :: MonadIO m => IO a -> String -> TextParser m a
@@ -443,10 +421,7 @@ addAccountDeclaration (a,cmt,tags,pos) = do
                d     = (a, nullaccountdeclarationinfo{
                               adicomment          = cmt
                              ,aditags             = tags
-                              -- this restarts from 1 in each file, which is not that useful
-                              -- when there are multiple files; so it gets renumbered
-                              -- automatically when combining Journals with <>
-                             ,adideclarationorder = length decls + 1
+                             ,adideclarationorder = length decls + 1  -- gets renumbered when Journals are finalised or merged
                              ,adisourcepos        = pos
                              })
              in