fix: a slowdown with many txns and many accounts since 1.29 [#2153]
When processing costs and equity postings in transactions during journal finalisation, we now pass just the conversion account name(s) rather than the entire map of account types. This slowdown was severe for some users/data/machines.
This commit is contained in:
parent
53431d9ac6
commit
a38af98c9e
@ -96,6 +96,7 @@ module Hledger.Data.Journal (
|
|||||||
journalPostingsAddAccountTags,
|
journalPostingsAddAccountTags,
|
||||||
-- journalPrices,
|
-- journalPrices,
|
||||||
journalConversionAccount,
|
journalConversionAccount,
|
||||||
|
journalConversionAccounts,
|
||||||
-- * Misc
|
-- * Misc
|
||||||
canonicalStyleFrom,
|
canonicalStyleFrom,
|
||||||
nulljournal,
|
nulljournal,
|
||||||
@ -519,13 +520,6 @@ letterPairs :: String -> [String]
|
|||||||
letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest)
|
letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest)
|
||||||
letterPairs _ = []
|
letterPairs _ = []
|
||||||
|
|
||||||
-- | The 'AccountName' to use for automatically generated conversion postings.
|
|
||||||
journalConversionAccount :: Journal -> AccountName
|
|
||||||
journalConversionAccount =
|
|
||||||
headDef (T.pack "equity:conversion")
|
|
||||||
. M.findWithDefault [] Conversion
|
|
||||||
. jdeclaredaccounttypes
|
|
||||||
|
|
||||||
-- Newer account type code.
|
-- Newer account type code.
|
||||||
|
|
||||||
journalAccountType :: Journal -> AccountName -> Maybe AccountType
|
journalAccountType :: Journal -> AccountName -> Maybe AccountType
|
||||||
@ -557,7 +551,7 @@ journalAccountTypes j = M.fromList [(a,acctType) | (a, Just (acctType,_)) <- fla
|
|||||||
then mparenttype
|
then mparenttype
|
||||||
else (,False) <$> accountNameInferType a <|> mparenttype
|
else (,False) <$> accountNameInferType a <|> mparenttype
|
||||||
|
|
||||||
-- | Build a map of the account types explicitly declared.
|
-- | Build a map of the account types explicitly declared for each account.
|
||||||
journalDeclaredAccountTypes :: Journal -> M.Map AccountName AccountType
|
journalDeclaredAccountTypes :: Journal -> M.Map AccountName AccountType
|
||||||
journalDeclaredAccountTypes Journal{jdeclaredaccounttypes} =
|
journalDeclaredAccountTypes Journal{jdeclaredaccounttypes} =
|
||||||
M.fromList $ concat [map (,t) as | (t,as) <- M.toList jdeclaredaccounttypes]
|
M.fromList $ concat [map (,t) as | (t,as) <- M.toList jdeclaredaccounttypes]
|
||||||
@ -569,6 +563,19 @@ journalPostingsAddAccountTags :: Journal -> Journal
|
|||||||
journalPostingsAddAccountTags j = journalMapPostings addtags j
|
journalPostingsAddAccountTags j = journalMapPostings addtags j
|
||||||
where addtags p = p `postingAddTags` (journalInheritedAccountTags j $ paccount p)
|
where addtags p = p `postingAddTags` (journalInheritedAccountTags j $ paccount p)
|
||||||
|
|
||||||
|
-- | The account to use for automatically generated conversion postings in this journal:
|
||||||
|
-- the first of the journalConversionAccounts.
|
||||||
|
journalConversionAccount :: Journal -> AccountName
|
||||||
|
journalConversionAccount = headDef defaultConversionAccount . journalConversionAccounts
|
||||||
|
|
||||||
|
-- | All the accounts declared or inferred as Conversion type in this journal.
|
||||||
|
journalConversionAccounts :: Journal -> [AccountName]
|
||||||
|
journalConversionAccounts = M.keys . M.filter (==Conversion) . jaccounttypes
|
||||||
|
|
||||||
|
-- The fallback account to use for automatically generated conversion postings
|
||||||
|
-- if no account is declared with the Conversion type.
|
||||||
|
defaultConversionAccount = "equity:conversion"
|
||||||
|
|
||||||
-- Various kinds of filtering on journals. We do it differently depending
|
-- Various kinds of filtering on journals. We do it differently depending
|
||||||
-- on the command.
|
-- on the command.
|
||||||
|
|
||||||
@ -943,9 +950,11 @@ journalInferEquityFromCosts verbosetags j = journalMapTransactions (transactionA
|
|||||||
-- See hledger manual > Cost reporting.
|
-- See hledger manual > Cost reporting.
|
||||||
journalInferCostsFromEquity :: Journal -> Either String Journal
|
journalInferCostsFromEquity :: Journal -> Either String Journal
|
||||||
journalInferCostsFromEquity j = do
|
journalInferCostsFromEquity j = do
|
||||||
ts <- mapM (transactionInferCostsFromEquity False $ jaccounttypes j) $ jtxns j
|
ts <- mapM (transactionInferCostsFromEquity False conversionaccts) $ jtxns j
|
||||||
return j{jtxns=ts}
|
return j{jtxns=ts}
|
||||||
|
where conversionaccts = journalConversionAccounts j
|
||||||
|
|
||||||
|
-- XXX duplication of the above
|
||||||
-- | Do just the internal tagging that is normally done by journalInferCostsFromEquity,
|
-- | Do just the internal tagging that is normally done by journalInferCostsFromEquity,
|
||||||
-- identifying equity conversion postings and, in particular, postings which have redundant costs.
|
-- identifying equity conversion postings and, in particular, postings which have redundant costs.
|
||||||
-- Tagging the latter is useful as it allows them to be ignored during transaction balancedness checking.
|
-- Tagging the latter is useful as it allows them to be ignored during transaction balancedness checking.
|
||||||
@ -953,8 +962,9 @@ journalInferCostsFromEquity j = do
|
|||||||
-- when it will have more information (amounts) to work with.
|
-- when it will have more information (amounts) to work with.
|
||||||
journalMarkRedundantCosts :: Journal -> Either String Journal
|
journalMarkRedundantCosts :: Journal -> Either String Journal
|
||||||
journalMarkRedundantCosts j = do
|
journalMarkRedundantCosts j = do
|
||||||
ts <- mapM (transactionInferCostsFromEquity True $ jaccounttypes j) $ jtxns j
|
ts <- mapM (transactionInferCostsFromEquity True conversionaccts) $ jtxns j
|
||||||
return j{jtxns=ts}
|
return j{jtxns=ts}
|
||||||
|
where conversionaccts = journalConversionAccounts j
|
||||||
|
|
||||||
-- -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol.
|
-- -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol.
|
||||||
-- journalCanonicalCommodities :: Journal -> M.Map String CommoditySymbol
|
-- journalCanonicalCommodities :: Journal -> M.Map String CommoditySymbol
|
||||||
|
|||||||
@ -219,11 +219,12 @@ builtinTags = [
|
|||||||
-- | In each tranaction, check that any conversion postings occur in adjacent pairs.
|
-- | In each tranaction, check that any conversion postings occur in adjacent pairs.
|
||||||
journalCheckPairedConversionPostings :: Journal -> Either String ()
|
journalCheckPairedConversionPostings :: Journal -> Either String ()
|
||||||
journalCheckPairedConversionPostings j =
|
journalCheckPairedConversionPostings j =
|
||||||
mapM_ (transactionCheckPairedConversionPostings (jaccounttypes j)) $ jtxns j
|
mapM_ (transactionCheckPairedConversionPostings conversionaccts) $ jtxns j
|
||||||
|
where conversionaccts = journalConversionAccounts j
|
||||||
|
|
||||||
transactionCheckPairedConversionPostings :: M.Map AccountName AccountType -> Transaction -> Either String ()
|
transactionCheckPairedConversionPostings :: [AccountName] -> Transaction -> Either String ()
|
||||||
transactionCheckPairedConversionPostings accttypes t =
|
transactionCheckPairedConversionPostings conversionaccts t =
|
||||||
case partitionAndCheckConversionPostings True accttypes (zip [0..] $ tpostings t) of
|
case partitionAndCheckConversionPostings True conversionaccts (zip [0..] $ tpostings t) of
|
||||||
Left err -> Left $ T.unpack err
|
Left err -> Left $ T.unpack err
|
||||||
Right _ -> Right ()
|
Right _ -> Right ()
|
||||||
|
|
||||||
|
|||||||
@ -274,6 +274,7 @@ type IdxPosting = (Int, Posting)
|
|||||||
label s = ((s <> ": ")++)
|
label s = ((s <> ": ")++)
|
||||||
|
|
||||||
-- | Add costs inferred from equity postings in this transaction.
|
-- | Add costs inferred from equity postings in this transaction.
|
||||||
|
-- The name(s) of conversion equity accounts should be provided.
|
||||||
-- For every adjacent pair of conversion postings, it will first search the postings
|
-- For every adjacent pair of conversion postings, it will first search the postings
|
||||||
-- with costs to see if any match. If so, it will tag these as matched.
|
-- with costs to see if any match. If so, it will tag these as matched.
|
||||||
-- If no postings with costs match, it will then search the postings without costs,
|
-- If no postings with costs match, it will then search the postings without costs,
|
||||||
@ -281,13 +282,13 @@ label s = ((s <> ": ")++)
|
|||||||
-- If it finds a match, it will add a cost and then tag it.
|
-- If it finds a match, it will add a cost and then tag it.
|
||||||
-- If the first argument is true, do a dry run instead: identify and tag
|
-- If the first argument is true, do a dry run instead: identify and tag
|
||||||
-- the costful and conversion postings, but don't add costs.
|
-- the costful and conversion postings, but don't add costs.
|
||||||
transactionInferCostsFromEquity :: Bool -> M.Map AccountName AccountType -> Transaction -> Either String Transaction
|
transactionInferCostsFromEquity :: Bool -> [AccountName] -> Transaction -> Either String Transaction
|
||||||
transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTransaction t . T.unpack) $ do
|
transactionInferCostsFromEquity dryrun conversionaccts t = first (annotateErrorWithTransaction t . T.unpack) $ do
|
||||||
-- number the postings
|
-- number the postings
|
||||||
let npostings = zip [0..] $ tpostings t
|
let npostings = zip [0..] $ tpostings t
|
||||||
|
|
||||||
-- Identify all pairs of conversion postings and all other postings (with and without costs) in the transaction.
|
-- Identify all pairs of conversion postings and all other postings (with and without costs) in the transaction.
|
||||||
(conversionPairs, otherps) <- partitionAndCheckConversionPostings False acctTypes npostings
|
(conversionPairs, otherps) <- partitionAndCheckConversionPostings False conversionaccts npostings
|
||||||
|
|
||||||
-- Generate a pure function that can be applied to each of this transaction's postings,
|
-- Generate a pure function that can be applied to each of this transaction's postings,
|
||||||
-- possibly modifying it, to produce the following end result:
|
-- possibly modifying it, to produce the following end result:
|
||||||
@ -434,13 +435,13 @@ dbgShowAmountPrecision a =
|
|||||||
Precision n -> show n
|
Precision n -> show n
|
||||||
NaturalPrecision -> show $ decimalPlaces $ normalizeDecimal $ aquantity a
|
NaturalPrecision -> show $ decimalPlaces $ normalizeDecimal $ aquantity a
|
||||||
|
|
||||||
-- Using the provided account types map, sort the given indexed postings
|
-- Given the names of conversion equity accounts, sort the given indexed postings
|
||||||
-- into three lists of posting numbers (stored in two pairs), like so:
|
-- into three lists of posting numbers (stored in two pairs), like so:
|
||||||
-- (conversion postings, (costful other postings, costless other postings)).
|
-- (conversion postings, (costful other postings, costless other postings)).
|
||||||
-- A true first argument activates its secondary function: check that all
|
-- A true first argument activates its secondary function: check that all
|
||||||
-- conversion postings occur in adjacent pairs, otherwise return an error.
|
-- conversion postings occur in adjacent pairs, otherwise return an error.
|
||||||
partitionAndCheckConversionPostings :: Bool -> M.Map AccountName AccountType -> [IdxPosting] -> Either Text ( [(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]) )
|
partitionAndCheckConversionPostings :: Bool -> [AccountName] -> [IdxPosting] -> Either Text ( [(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]) )
|
||||||
partitionAndCheckConversionPostings check acctTypes =
|
partitionAndCheckConversionPostings check conversionaccts =
|
||||||
-- Left fold processes postings in parse order, so that eg inferred costs
|
-- Left fold processes postings in parse order, so that eg inferred costs
|
||||||
-- will be added to the first (top-most) posting, not the last one.
|
-- will be added to the first (top-most) posting, not the last one.
|
||||||
foldlM select (([], ([], [])), Nothing)
|
foldlM select (([], ([], [])), Nothing)
|
||||||
@ -455,7 +456,7 @@ partitionAndCheckConversionPostings check acctTypes =
|
|||||||
| isConversion p = Right (((lst, np):cs, others), Nothing)
|
| isConversion p = Right (((lst, np):cs, others), Nothing)
|
||||||
| check = Left "Conversion postings must occur in adjacent pairs"
|
| check = Left "Conversion postings must occur in adjacent pairs"
|
||||||
| otherwise = Right ((cs, (ps, np:os)), Nothing)
|
| otherwise = Right ((cs, (ps, np:os)), Nothing)
|
||||||
isConversion p = M.lookup (paccount p) acctTypes == Just Conversion
|
isConversion p = paccount p `elem` conversionaccts
|
||||||
hasCost p = isJust $ acost =<< postingSingleAmount p
|
hasCost p = isJust $ acost =<< postingSingleAmount p
|
||||||
|
|
||||||
-- | Get a posting's amount if it is single-commodity.
|
-- | Get a posting's amount if it is single-commodity.
|
||||||
|
|||||||
@ -332,7 +332,9 @@ journalFinalise iopts@InputOpts{..} f txt pj = do
|
|||||||
& journalStyleAmounts -- Infer and apply commodity styles (but don't round) - should be done early
|
& journalStyleAmounts -- Infer and apply commodity styles (but don't round) - should be done early
|
||||||
<&> journalAddForecast (verbose_tags_) (forecastPeriod iopts pj) -- Add forecast transactions if enabled
|
<&> journalAddForecast (verbose_tags_) (forecastPeriod iopts pj) -- Add forecast transactions if enabled
|
||||||
<&> journalPostingsAddAccountTags -- Add account tags to postings, so they can be matched by auto postings.
|
<&> journalPostingsAddAccountTags -- Add account tags to postings, so they can be matched by auto postings.
|
||||||
>>= journalMarkRedundantCosts -- Mark redundant costs, to help journalBalanceTransactions ignore them
|
>>= journalMarkRedundantCosts -- Mark redundant costs, to help journalBalanceTransactions ignore them.
|
||||||
|
-- (Later, journalInferEquityFromCosts will do a similar pass, adding missing equity postings.)
|
||||||
|
|
||||||
>>= (if auto_ && not (null $ jtxnmodifiers pj)
|
>>= (if auto_ && not (null $ jtxnmodifiers pj)
|
||||||
then journalAddAutoPostings verbose_tags_ _ioDay balancingopts_ -- Add auto postings if enabled, and account tags if needed. Does preliminary transaction balancing.
|
then journalAddAutoPostings verbose_tags_ _ioDay balancingopts_ -- Add auto postings if enabled, and account tags if needed. Does preliminary transaction balancing.
|
||||||
else pure)
|
else pure)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user