From de330bdfcecc57dcca66b224ebb05eec8c59af56 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 24 Jan 2023 23:57:17 -1000 Subject: [PATCH] imp: journal: check for adjacent conversion postings only in strict mode This avoids breaking existing journals if, say, they happen to have a single "equity:trading" posting somewhere. --- hledger-lib/Hledger/Data/JournalChecks.hs | 14 ++++++- hledger-lib/Hledger/Data/Transaction.hs | 49 ++++++++++++++--------- hledger-lib/Hledger/Read/Common.hs | 2 + hledger/Hledger/Cli/Commands/Check.md | 3 ++ hledger/hledger.m4.md | 1 + hledger/test/journal/costs.test | 11 +++-- 6 files changed, 56 insertions(+), 24 deletions(-) diff --git a/hledger-lib/Hledger/Data/JournalChecks.hs b/hledger-lib/Hledger/Data/JournalChecks.hs index cc546d9b4..0b1e85bfe 100644 --- a/hledger-lib/Hledger/Data/JournalChecks.hs +++ b/hledger-lib/Hledger/Data/JournalChecks.hs @@ -12,6 +12,7 @@ module Hledger.Data.JournalChecks ( journalCheckAccounts, journalCheckCommodities, journalCheckPayees, + journalCheckPairedConversionPostings, journalCheckRecentAssertions, module Hledger.Data.JournalChecks.Ordereddates, module Hledger.Data.JournalChecks.Uniqueleafnames, @@ -32,7 +33,7 @@ import Hledger.Data.JournalChecks.Uniqueleafnames import Hledger.Data.Posting (isVirtual, postingDate, postingStatus) import Hledger.Data.Types import Hledger.Data.Amount (amountIsZero, amountsRaw, missingamt) -import Hledger.Data.Transaction (transactionPayee, showTransactionLineFirstPart) +import Hledger.Data.Transaction (transactionPayee, showTransactionLineFirstPart, partitionAndCheckConversionPostings) import Data.Time (Day, diffDays) import Data.List.Extra import Hledger.Utils (chomp, textChomp, sourcePosPretty) @@ -156,6 +157,17 @@ journalCheckPayees j = mapM_ checkpayee (jtxns j) col = T.length (showTransactionLineFirstPart t') + 2 col2 = col + T.length (transactionPayee t') - 1 +-- | In each tranaction, check that any conversion postings occur in adjacent pairs. +journalCheckPairedConversionPostings :: Journal -> Either String () +journalCheckPairedConversionPostings j = + mapM_ (transactionCheckPairedConversionPostings (jaccounttypes j)) $ jtxns j + +transactionCheckPairedConversionPostings :: M.Map AccountName AccountType -> Transaction -> Either String () +transactionCheckPairedConversionPostings accttypes t = + case partitionAndCheckConversionPostings True accttypes (zip [0..] $ tpostings t) of + Left err -> Left $ T.unpack err + Right _ -> Right () + ---------- -- | Information useful for checking the age and lag of an account's latest balance assertion. diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 5a2e0e120..60f60e651 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -32,6 +32,7 @@ module Hledger.Data.Transaction , transactionApplyAliases , transactionMapPostings , transactionMapPostingAmounts +, partitionAndCheckConversionPostings -- nonzerobalanceerror -- * date operations , transactionDate2 @@ -235,9 +236,11 @@ type IdxPosting = (Int, Posting) -- If no postings with costs match, it will then search the postings without costs, -- and will match the first such posting which matches one of the conversion amounts. -- 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 +-- the costful and conversion postings, but don't add costs. transactionInferCostsFromEquity :: Bool -> M.Map AccountName AccountType -> Transaction -> Either String Transaction transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTransaction t . T.unpack) $ do - (conversionPairs, stateps) <- partitionPs npostings + (conversionPairs, stateps) <- partitionAndCheckConversionPostings False acctTypes npostings f <- transformIndexedPostingsF (addCostsToPostings dryrun) conversionPairs stateps return t{tpostings = map (snd . f) npostings} where @@ -245,18 +248,6 @@ transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTra npostings = zip [0..] $ tpostings t transformIndexedPostingsF f = evalStateT . fmap (appEndo . foldMap Endo) . traverse f - -- Sort posting numbers into three lists (stored in two pairs), like so: - -- (conversion postings, (costful postings, other postings)). - partitionPs = fmap fst . foldrM select (([], ([], [])), Nothing) - where - select np@(_, p) ((cs, others@(ps, os)), Nothing) - | isConversion p = Right ((cs, others), Just np) - | hasCost p = Right ((cs, (np:ps, os)), Nothing) - | otherwise = Right ((cs, (ps, np:os)), Nothing) - select np@(_, p) ((cs, others), Just lst) - | isConversion p = Right (((lst, np):cs, others), Nothing) - | otherwise = Left "Conversion postings must occur in adjacent pairs" - -- Given a pair of indexed conversion postings, and a state consisting of lists of -- costful and costless non-conversion postings, create a function which adds a conversion cost -- to the posting which matches the conversion postings if necessary, @@ -331,14 +322,7 @@ transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTra Just Amount{aprice=Just _} -> Left $ annotateWithPostings [p] "Conversion postings must not have a cost:" Nothing -> Left $ annotateWithPostings [p] "Conversion postings must have a single-commodity amount:" - -- Get a posting's amount if it is single-commodity. - postingSingleAmount p = case amountsRaw (pamount p) of - [a] -> Just a - _ -> Nothing - - hasCost p = isJust $ aprice =<< postingSingleAmount p amountMatches a b = acommodity a == acommodity b && aquantity a == aquantity b - isConversion p = M.lookup (paccount p) acctTypes == Just Conversion -- Delete a posting from the indexed list of postings based on either its -- index or its posting amount. @@ -354,6 +338,31 @@ transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTra deleteUniqueMatch _ [] = Nothing annotateWithPostings xs str = T.unlines $ str : postingsAsLines False xs +-- Using the provided account types map, sort the given indexed postings +-- into three lists of posting numbers (stored in two pairs), like so: +-- (conversion postings, (costful postings, other postings)). +-- A true first argument activates its secondary function: check that all +-- conversion postings occur in adjacent pairs, otherwise return an error. +partitionAndCheckConversionPostings :: Bool -> M.Map AccountName AccountType -> [IdxPosting] -> Either Text ( [(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]) ) +partitionAndCheckConversionPostings check acctTypes = fmap fst . foldrM select (([], ([], [])), Nothing) + where + select np@(_, p) ((cs, others@(ps, os)), Nothing) + | isConversion p = Right ((cs, others), Just np) + | hasCost p = Right ((cs, (np:ps, os)), Nothing) + | otherwise = Right ((cs, (ps, np:os)), Nothing) + select np@(_, p) ((cs, others@(ps,os)), Just lst) + | isConversion p = Right (((lst, np):cs, others), Nothing) + | check = Left "Conversion postings must occur in adjacent pairs" + | otherwise = Right ((cs, (ps, np:os)), Nothing) + isConversion p = M.lookup (paccount p) acctTypes == Just Conversion + hasCost p = isJust $ aprice =<< postingSingleAmount p + +-- | Get a posting's amount if it is single-commodity. +postingSingleAmount :: Posting -> Maybe Amount +postingSingleAmount p = case amountsRaw (pamount p) of + [a] -> Just a + _ -> Nothing + -- | Apply some account aliases to all posting account names in the transaction, as described by accountNameApplyAliases. -- This can fail due to a bad replacement pattern in a regular expression alias. transactionApplyAliases :: [AccountAlias] -> Transaction -> Either RegexError Transaction diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 3180e9582..129293d04 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -337,6 +337,8 @@ journalFinalise iopts@InputOpts{..} f txt pj = do when strict_ $ do journalCheckAccounts j -- If in strict mode, check all postings are to declared accounts journalCheckCommodities j -- and using declared commodities + journalCheckPairedConversionPostings j -- check conversion postings are in adjacent pairs + return j -- | Apply any auto posting rules to generate extra postings on this journal's transactions. diff --git a/hledger/Hledger/Cli/Commands/Check.md b/hledger/Hledger/Cli/Commands/Check.md index 9ca6dc969..d614b9c4d 100644 --- a/hledger/Hledger/Cli/Commands/Check.md +++ b/hledger/Hledger/Cli/Commands/Check.md @@ -52,6 +52,9 @@ Or, they can be run by giving their names as arguments to `check`: - **balancednoautoconversion** - transactions are balanced, possibly using explicit costs but not [inferred ones](#costs) +- **adjacentconversionpostings** - all [conversion postings](#equity-conversion-postings) + occur in adjacent pairs, as required for [inferring cost from equity postings](#inferring-cost-from-equity-postings). + ### Other checks These checks can be run only by giving their names as arguments to `check`. diff --git a/hledger/hledger.m4.md b/hledger/hledger.m4.md index e414733c2..ab3946c15 100644 --- a/hledger/hledger.m4.md +++ b/hledger/hledger.m4.md @@ -422,6 +422,7 @@ With the `-s`/`--strict` flag, additional checks are performed: - Are all commodities declared with a `commodity` directive ? ([Commodity error checking](#commodity-error-checking)) - Are all commodity conversions declared explicitly ? +- Are all commodity conversion equity postings occurring in adjacent pairs ? You can use the [check](#check) command to run individual checks -- the ones listed above and some more. diff --git a/hledger/test/journal/costs.test b/hledger/test/journal/costs.test index cef499aca..f399e0451 100644 --- a/hledger/test/journal/costs.test +++ b/hledger/test/journal/costs.test @@ -506,15 +506,20 @@ $ hledger -f- print --infer-costs >=0 -# 39. Conversion postings should come in adjacent pairs +# 39. In strict mode, conversion postings must be in adjacent pairs. < +account assets +account equity:conversion +account expenses:foreign currency +commodity €0. +commodity $0. 2011/01/01 - expenses:foreign currency €100 @@ $135 + expenses:foreign currency €100 equity:conversion €-100 assets $-135 equity:conversion $135 -$ hledger -f- print --infer-costs +$ hledger -f- print -s >2 /Conversion postings must occur in adjacent pairs/ >=1