From 1f08a8a94ee8fb56588bbb947d704b2467167dc0 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 14 Aug 2022 08:45:59 +0100 Subject: [PATCH] fix: fix multi-file account display order; improve file read logging (#1909) --- hledger-lib/Hledger/Data/Journal.hs | 52 ++++++++++++++++---- hledger-lib/Hledger/Read.hs | 11 +++-- hledger-lib/Hledger/Read/Common.hs | 5 ++ hledger-lib/Hledger/Read/JournalReader.hs | 59 +++++++---------------- 4 files changed, 71 insertions(+), 56 deletions(-) diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 908f7d124..0bf62ad86 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/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 diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index 6722e2cce..c5c2585e7 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/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 diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 02c2b1d93..917e943bb 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/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 diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 0c0bdd053..591154752 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/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