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.
This commit is contained in:
Simon Michael 2023-01-24 23:57:17 -10:00
parent 9c5bcfea85
commit de330bdfce
6 changed files with 56 additions and 24 deletions

View File

@ -12,6 +12,7 @@ module Hledger.Data.JournalChecks (
journalCheckAccounts, journalCheckAccounts,
journalCheckCommodities, journalCheckCommodities,
journalCheckPayees, journalCheckPayees,
journalCheckPairedConversionPostings,
journalCheckRecentAssertions, journalCheckRecentAssertions,
module Hledger.Data.JournalChecks.Ordereddates, module Hledger.Data.JournalChecks.Ordereddates,
module Hledger.Data.JournalChecks.Uniqueleafnames, module Hledger.Data.JournalChecks.Uniqueleafnames,
@ -32,7 +33,7 @@ import Hledger.Data.JournalChecks.Uniqueleafnames
import Hledger.Data.Posting (isVirtual, postingDate, postingStatus) import Hledger.Data.Posting (isVirtual, postingDate, postingStatus)
import Hledger.Data.Types import Hledger.Data.Types
import Hledger.Data.Amount (amountIsZero, amountsRaw, missingamt) 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.Time (Day, diffDays)
import Data.List.Extra import Data.List.Extra
import Hledger.Utils (chomp, textChomp, sourcePosPretty) import Hledger.Utils (chomp, textChomp, sourcePosPretty)
@ -156,6 +157,17 @@ journalCheckPayees j = mapM_ checkpayee (jtxns j)
col = T.length (showTransactionLineFirstPart t') + 2 col = T.length (showTransactionLineFirstPart t') + 2
col2 = col + T.length (transactionPayee t') - 1 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. -- | Information useful for checking the age and lag of an account's latest balance assertion.

View File

@ -32,6 +32,7 @@ module Hledger.Data.Transaction
, transactionApplyAliases , transactionApplyAliases
, transactionMapPostings , transactionMapPostings
, transactionMapPostingAmounts , transactionMapPostingAmounts
, partitionAndCheckConversionPostings
-- nonzerobalanceerror -- nonzerobalanceerror
-- * date operations -- * date operations
, transactionDate2 , transactionDate2
@ -235,9 +236,11 @@ type IdxPosting = (Int, Posting)
-- 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,
-- and will match the first such posting which matches one of the conversion amounts. -- 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 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 :: Bool -> M.Map AccountName AccountType -> Transaction -> Either String Transaction
transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTransaction t . T.unpack) $ do 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 f <- transformIndexedPostingsF (addCostsToPostings dryrun) conversionPairs stateps
return t{tpostings = map (snd . f) npostings} return t{tpostings = map (snd . f) npostings}
where where
@ -245,18 +248,6 @@ transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTra
npostings = zip [0..] $ tpostings t npostings = zip [0..] $ tpostings t
transformIndexedPostingsF f = evalStateT . fmap (appEndo . foldMap Endo) . traverse f 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 -- 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 -- costful and costless non-conversion postings, create a function which adds a conversion cost
-- to the posting which matches the conversion postings if necessary, -- 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:" 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:" 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 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 -- Delete a posting from the indexed list of postings based on either its
-- index or its posting amount. -- index or its posting amount.
@ -354,6 +338,31 @@ transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTra
deleteUniqueMatch _ [] = Nothing deleteUniqueMatch _ [] = Nothing
annotateWithPostings xs str = T.unlines $ str : postingsAsLines False xs 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. -- | 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. -- This can fail due to a bad replacement pattern in a regular expression alias.
transactionApplyAliases :: [AccountAlias] -> Transaction -> Either RegexError Transaction transactionApplyAliases :: [AccountAlias] -> Transaction -> Either RegexError Transaction

View File

@ -337,6 +337,8 @@ journalFinalise iopts@InputOpts{..} f txt pj = do
when strict_ $ do when strict_ $ do
journalCheckAccounts j -- If in strict mode, check all postings are to declared accounts journalCheckAccounts j -- If in strict mode, check all postings are to declared accounts
journalCheckCommodities j -- and using declared commodities journalCheckCommodities j -- and using declared commodities
journalCheckPairedConversionPostings j -- check conversion postings are in adjacent pairs
return j return j
-- | Apply any auto posting rules to generate extra postings on this journal's transactions. -- | Apply any auto posting rules to generate extra postings on this journal's transactions.

View File

@ -52,6 +52,9 @@ Or, they can be run by giving their names as arguments to `check`:
- **balancednoautoconversion** - transactions are balanced, possibly using - **balancednoautoconversion** - transactions are balanced, possibly using
explicit costs but not [inferred ones](#costs) 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 ### Other checks
These checks can be run only by giving their names as arguments to `check`. These checks can be run only by giving their names as arguments to `check`.

View File

@ -422,6 +422,7 @@ With the `-s`/`--strict` flag, additional checks are performed:
- Are all commodities declared with a `commodity` directive ? - Are all commodities declared with a `commodity` directive ?
([Commodity error checking](#commodity-error-checking)) ([Commodity error checking](#commodity-error-checking))
- Are all commodity conversions declared explicitly ? - 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 You can use the [check](#check) command to run individual checks -- the
ones listed above and some more. ones listed above and some more.

View File

@ -506,15 +506,20 @@ $ hledger -f- print --infer-costs
>=0 >=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 2011/01/01
expenses:foreign currency €100 @@ $135 expenses:foreign currency €100
equity:conversion €-100 equity:conversion €-100
assets $-135 assets $-135
equity:conversion $135 equity:conversion $135
$ hledger -f- print --infer-costs $ hledger -f- print -s
>2 /Conversion postings must occur in adjacent pairs/ >2 /Conversion postings must occur in adjacent pairs/
>=1 >=1