From 7f713f6a44fdaa5443cf973597a4ac4a875f2f7e Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sat, 29 Apr 2023 18:25:11 -1000 Subject: [PATCH] imp: Generated/modified txns/postings are now tagged only with --verbose-tags --- doc/common.m4 | 2 + hledger-lib/Hledger/Data/Journal.hs | 12 +-- .../Hledger/Data/PeriodicTransaction.hs | 21 ++--- hledger-lib/Hledger/Data/Posting.hs | 12 ++- hledger-lib/Hledger/Data/Transaction.hs | 6 +- .../Hledger/Data/TransactionModifier.hs | 41 +++++----- hledger-lib/Hledger/Read/Common.hs | 22 ++--- hledger-lib/Hledger/Read/InputOptions.hs | 2 + hledger-lib/Hledger/Reports/BudgetReport.hs | 4 +- hledger/Hledger/Cli/CliOptions.hs | 1 + hledger/Hledger/Cli/Commands/Print.hs | 2 +- hledger/Hledger/Cli/Commands/Rewrite.hs | 8 +- hledger/test/forecast.test | 8 +- hledger/test/journal/auto-postings.test | 80 +++++++++---------- hledger/test/journal/costs.test | 13 +-- .../journal/directive-default-commodity.test | 4 +- hledger/test/print/explicit.test | 8 +- hledger/test/rewrite.test | 63 ++++++++------- 18 files changed, 162 insertions(+), 147 deletions(-) diff --git a/doc/common.m4 b/doc/common.m4 index db9a8e810..01cb2e920 100644 --- a/doc/common.m4 +++ b/doc/common.m4 @@ -184,6 +184,8 @@ m4_define({{_reportingoptions_}}, {{ `--auto` : generate extra postings by applying [auto posting rules](hledger.html#auto-postings) to all txns (not just forecast txns) +`--verbose-tags` +: add visible tags indicating transactions or postings which have been generated/modified `--commodity-style` : Override the commodity style in the output for the specified commodity. For example 'EUR1.000,00'. diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 0aa8bfd07..86d84aaba 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -786,10 +786,10 @@ journalUntieTransactions t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ -- return the error message. A reference date is provided to help interpret -- relative dates in transaction modifier queries. -- The first argument selects whether to modify only generated (--forecast) transactions (False), --- or all transactions (True). -journalModifyTransactions :: Bool -> Day -> Journal -> Either String Journal -journalModifyTransactions alltxns d j = - case modifyTransactions predfn (journalAccountType j) (journalInheritedAccountTags j) (journalCommodityStyles j) d (jtxnmodifiers j) (jtxns j) of +-- or all transactions (True). The second adds visible tags if true. +journalModifyTransactions :: Bool -> Bool -> Day -> Journal -> Either String Journal +journalModifyTransactions alltxns verbosetags d j = + case modifyTransactions predfn (journalAccountType j) (journalInheritedAccountTags j) (journalCommodityStyles j) d verbosetags (jtxnmodifiers j) (jtxns j) of Right ts -> Right j{jtxns=ts} Left err -> Left err where @@ -920,8 +920,8 @@ journalToCost cost j@Journal{jtxns=ts} = j{jtxns=map (transactionToCost styles c styles = journalCommodityStyles j -- | Add inferred equity postings to a 'Journal' using transaction prices. -journalAddInferredEquityPostings :: Journal -> Journal -journalAddInferredEquityPostings j = journalMapTransactions (transactionAddInferredEquityPostings equityAcct) j +journalAddInferredEquityPostings :: Bool -> Journal -> Journal +journalAddInferredEquityPostings verbosetags j = journalMapTransactions (transactionAddInferredEquityPostings verbosetags equityAcct) j where equityAcct = journalConversionAccount j diff --git a/hledger-lib/Hledger/Data/PeriodicTransaction.hs b/hledger-lib/Hledger/Data/PeriodicTransaction.hs index e540a61f9..282238b41 100644 --- a/hledger-lib/Hledger/Data/PeriodicTransaction.hs +++ b/hledger-lib/Hledger/Data/PeriodicTransaction.hs @@ -11,6 +11,7 @@ module Hledger.Data.PeriodicTransaction ( ) where +import Data.Function ((&)) import Data.Maybe (isNothing) import qualified Data.Text as T import qualified Data.Text.IO as T @@ -34,7 +35,7 @@ _ptgen str = do t = T.pack str (i,s) = parsePeriodExpr' nulldate t mapM_ (T.putStr . showTransaction) $ - runPeriodicTransaction + runPeriodicTransaction True nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] } nulldatespan @@ -43,7 +44,7 @@ _ptgenspan str spn = do t = T.pack str (i,s) = parsePeriodExpr' nulldate t mapM_ (T.putStr . showTransaction) $ - runPeriodicTransaction + runPeriodicTransaction True nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] } spn @@ -186,7 +187,7 @@ instance Show PeriodicTransaction where -- a $1.00 -- -- --- >>> let reportperiod="daily from 2018/01/03" in let (i,s) = parsePeriodExpr' nulldate reportperiod in runPeriodicTransaction (nullperiodictransaction{ptperiodexpr=reportperiod, ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1]}) (DateSpan (Just $ Flex $ fromGregorian 2018 01 01) (Just $ Flex $ fromGregorian 2018 01 03)) +-- >>> let reportperiod="daily from 2018/01/03" in let (i,s) = parsePeriodExpr' nulldate reportperiod in runPeriodicTransaction True (nullperiodictransaction{ptperiodexpr=reportperiod, ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1]}) (DateSpan (Just $ Flex $ fromGregorian 2018 01 01) (Just $ Flex $ fromGregorian 2018 01 03)) -- [] -- -- >>> _ptgenspan "every 3 months from 2019-05" (DateSpan (Just $ Flex $ fromGregorian 2020 01 01) (Just $ Flex $ fromGregorian 2020 02 01)) @@ -211,8 +212,8 @@ instance Show PeriodicTransaction where -- a $1.00 -- -runPeriodicTransaction :: PeriodicTransaction -> DateSpan -> [Transaction] -runPeriodicTransaction PeriodicTransaction{..} requestedspan = +runPeriodicTransaction :: Bool -> PeriodicTransaction -> DateSpan -> [Transaction] +runPeriodicTransaction verbosetags PeriodicTransaction{..} requestedspan = [ t{tdate=d} | (DateSpan (Just efd) _) <- alltxnspans, let d = fromEFDay efd, spanContainsDate requestedspan d ] where t = nulltransaction{ @@ -220,11 +221,11 @@ runPeriodicTransaction PeriodicTransaction{..} requestedspan = ,tstatus = ptstatus ,tcode = ptcode ,tdescription = ptdescription - ,tcomment = ptcomment - `commentAddTagNextLine` ("generated-transaction",period) - ,ttags = ("_generated-transaction",period) : - ("generated-transaction" ,period) : - pttags + ,tcomment = ptcomment & + (if verbosetags then (`commentAddTagNextLine` ("generated-transaction",period)) else id) + ,ttags = pttags & + (("_generated-transaction",period) :) & + (if verbosetags then (("generated-transaction" ,period) :) else id) ,tpostings = ptpostings } period = "~ " <> ptperiodexpr diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 494720c0d..352f5656c 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -74,6 +74,7 @@ where import Data.Default (def) import Data.Foldable (asum) +import Data.Function ((&)) import qualified Data.Map as M import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.List (foldl', sort, union) @@ -439,8 +440,8 @@ postingToCost styles ToCost p -- | Generate inferred equity postings from a 'Posting' using transaction prices. -- Make sure not to generate equity postings when there are already matched -- conversion postings. -postingAddInferredEquityPostings :: Text -> Posting -> [Posting] -postingAddInferredEquityPostings equityAcct p +postingAddInferredEquityPostings :: Bool -> Text -> Posting -> [Posting] +postingAddInferredEquityPostings verbosetags equityAcct p | "_price-matched" `elem` map fst (ptags p) = [p] | otherwise = taggedPosting : concatMap conversionPostings priceAmounts where @@ -460,8 +461,11 @@ postingAddInferredEquityPostings equityAcct p cost = amountCost amt amtCommodity = commodity amt costCommodity = commodity cost - cp = p{ pcomment = pcomment p `commentAddTag` ("generated-posting","") - , ptags = [("_conversion-matched", ""), ("generated-posting", ""), ("_generated-posting", "")] + cp = p{ pcomment = pcomment p & (if verbosetags then (`commentAddTag` ("generated-posting","conversion")) else id) + , ptags = + ("_conversion-matched","") : -- implementation-specific internal tag, not for users + ("_generated-posting","conversion") : + (if verbosetags then [("generated-posting", "conversion")] else []) , pbalanceassertion = Nothing , poriginal = Nothing } diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 60f60e651..48a4a191b 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -222,9 +222,9 @@ transactionToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> Transa transactionToCost styles cost t = t{tpostings = mapMaybe (postingToCost styles cost) $ tpostings t} -- | Add inferred equity postings to a 'Transaction' using transaction prices. -transactionAddInferredEquityPostings :: AccountName -> Transaction -> Transaction -transactionAddInferredEquityPostings equityAcct t = - t{tpostings=concatMap (postingAddInferredEquityPostings equityAcct) $ tpostings t} +transactionAddInferredEquityPostings :: Bool -> AccountName -> Transaction -> Transaction +transactionAddInferredEquityPostings verbosetags equityAcct t = + t{tpostings=concatMap (postingAddInferredEquityPostings verbosetags equityAcct) $ tpostings t} type IdxPosting = (Int, Posting) diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index 71f40ced5..13b9b4b1d 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -14,6 +14,7 @@ where import Prelude hiding (Applicative(..)) import Control.Applicative (Applicative(..), (<|>)) +import Data.Function ((&)) import qualified Data.Map as M import Data.Maybe (catMaybes) import qualified Data.Text as T @@ -43,17 +44,20 @@ modifyTransactions :: (Transaction -> Bool) -> (AccountName -> Maybe AccountType) -> (AccountName -> [Tag]) -> M.Map CommoditySymbol AmountStyle - -> Day -> [TransactionModifier] -> [Transaction] + -> Day -> Bool -> [TransactionModifier] -> [Transaction] -> Either String [Transaction] -modifyTransactions predfn atypes atags styles d tmods ts = do - fs <- mapM (transactionModifierToFunction atypes atags styles d) tmods -- convert modifiers to functions, or return a parse error +modifyTransactions predfn atypes atags styles d verbosetags tmods ts = do + fs <- mapM (transactionModifierToFunction atypes atags styles d verbosetags) tmods -- convert modifiers to functions, or return a parse error let maybemodifytxn t = if predfn t then t'' else t where t' = foldr (flip (.)) id fs t -- apply each function in turn - t'' = if t' == t -- and add some tags if it was changed + t'' = if t' == t then t' - else t'{tcomment=tcomment t' `commentAddTag` ("modified",""), ttags=("modified","") : ttags t'} + else t'{tcomment=tcomment t' & (if verbosetags then (`commentAddTag` ("modified","")) else id) + ,ttags=ttags t' & (("_modified","") :) & (if verbosetags then (("modified","") :) else id) + } + Right $ map maybemodifytxn ts -- | Converts a 'TransactionModifier' to a 'Transaction'-transforming function @@ -70,7 +74,7 @@ modifyTransactions predfn atypes atags styles d tmods ts = do -- >>> import qualified Data.Text.IO as T -- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]} -- >>> tmpost acc amt = TMPostingRule (acc `post` amt) False --- >>> test = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction (const Nothing) (const []) mempty nulldate +-- >>> test = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction (const Nothing) (const []) mempty nulldate True -- >>> test $ TransactionModifier "" ["pong" `tmpost` usd 2] -- 0000-01-01 -- ping $1.00 @@ -89,12 +93,12 @@ modifyTransactions predfn atypes atags styles d tmods ts = do transactionModifierToFunction :: (AccountName -> Maybe AccountType) -> (AccountName -> [Tag]) -> M.Map CommoditySymbol AmountStyle - -> Day -> TransactionModifier + -> Day -> Bool -> TransactionModifier -> Either String (Transaction -> Transaction) -transactionModifierToFunction atypes atags styles refdate TransactionModifier{tmquerytxt, tmpostingrules} = do +transactionModifierToFunction atypes atags styles refdate verbosetags TransactionModifier{tmquerytxt, tmpostingrules} = do q <- simplifyQuery . fst <$> parseQuery refdate tmquerytxt let - fs = map (\tmpr -> addAccountTags . tmPostingRuleToFunction styles q tmquerytxt tmpr) tmpostingrules + fs = map (\tmpr -> addAccountTags . tmPostingRuleToFunction verbosetags styles q tmquerytxt tmpr) tmpostingrules addAccountTags p = p `postingAddTags` atags (paccount p) generatePostings p = p : map ($ p) (if matchesPostingExtra atypes q p then fs else []) Right $ \t@(tpostings -> ps) -> txnTieKnot t{tpostings=concatMap generatePostings ps} @@ -103,20 +107,19 @@ transactionModifierToFunction atypes atags styles refdate TransactionModifier{tm -- which will be used to make a new posting based on the old one (an "automated posting"). -- The new posting's amount can optionally be the old posting's amount multiplied by a constant. -- If the old posting had a total-priced amount, the new posting's multiplied amount will be unit-priced. --- The new posting will have two tags added: a normal generated-posting: tag which also appears in the comment, --- and a hidden _generated-posting: tag which does not. --- The TransactionModifier's query text is also provided, and saved --- as the tags' value. -tmPostingRuleToFunction :: M.Map CommoditySymbol AmountStyle -> Query -> T.Text -> TMPostingRule -> (Posting -> Posting) -tmPostingRuleToFunction styles query querytxt tmpr = +-- The new posting will have a hidden _generated-posting: tag added, +-- and with a true first argument, also a visible generated-posting: tag. +-- The provided TransactionModifier's query text is saved as the tags' value. +tmPostingRuleToFunction :: Bool -> M.Map CommoditySymbol AmountStyle -> Query -> T.Text -> TMPostingRule -> (Posting -> Posting) +tmPostingRuleToFunction verbosetags styles query querytxt tmpr = \p -> postingApplyCommodityStyles styles . renderPostingCommentDates $ pr { pdate = pdate pr <|> pdate p , pdate2 = pdate2 pr <|> pdate2 p , pamount = amount' p - , pcomment = pcomment pr `commentAddTag` ("generated-posting",qry) - , ptags = ("generated-posting", qry) : - ("_generated-posting",qry) : - ptags pr + , pcomment = pcomment pr & (if verbosetags then (`commentAddTag` ("generated-posting",qry)) else id) + , ptags = ptags pr + & (("_generated-posting",qry) :) + & (if verbosetags then (("generated-posting", qry) :) else id) } where pr = tmprPosting tmpr diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 6f46b0257..2a3ff62f0 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -214,6 +214,7 @@ rawOptsToInputOpts day rawopts = ,new_save_ = True ,pivot_ = stringopt "pivot" rawopts ,forecast_ = forecastPeriodFromRawOpts day rawopts + ,verbose_tags_ = boolopt "verbose-tags" rawopts ,reportspan_ = DateSpan (Exact <$> queryStartDate False datequery) (Exact <$> queryEndDate False datequery) ,auto_ = boolopt "auto" rawopts ,infer_equity_ = boolopt "infer-equity" rawopts && conversionop_ ropts /= Just ToCost @@ -322,16 +323,16 @@ journalFinalise iopts@InputOpts{..} f txt pj = do & journalReverse -- convert all lists to the order they were parsed & journalAddAccountTypes -- build a map of all known account types & journalApplyCommodityStyles -- Infer and apply commodity styles - should be done early - <&> journalAddForecast (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. >>= (if not (null $ jtxnmodifiers pj) - then journalAddAutoPostings auto_ _ioDay balancingopts_ -- Add auto postings if enabled, and account tags if needed + then journalAddAutoPostings auto_ verbose_tags_ _ioDay balancingopts_ -- Add auto postings if enabled, and account tags if needed else pure) -- >>= Right . dbg0With (concatMap (T.unpack.showTransaction).jtxns) -- debug >>= journalMarkRedundantCosts -- Mark redundant costs, to help journalBalanceTransactions ignore them >>= journalBalanceTransactions balancingopts_ -- Balance all transactions and maybe check balance assertions. >>= (if infer_costs_ then journalInferCostsFromEquity else pure) -- Maybe infer costs from equity postings where possible - <&> (if infer_equity_ then journalAddInferredEquityPostings else id) -- Maybe infer equity postings from costs where possible + <&> (if infer_equity_ then journalAddInferredEquityPostings verbose_tags_ else id) -- Maybe infer equity postings from costs where possible <&> journalInferMarketPricesFromTransactions -- infer market prices from commodity-exchanging transactions <&> traceOrLogAt 6 ("journalFinalise: " <> takeFileName f) -- debug logging <&> dbgJournalAcctDeclOrder ("journalFinalise: " <> takeFileName f <> " acct decls : ") @@ -347,28 +348,29 @@ journalFinalise iopts@InputOpts{..} f txt pj = do -- | Apply any auto posting rules to generate extra postings on this journal's transactions. -- With a true first argument, applies them to all transactions, otherwise only to generated transactions. -journalAddAutoPostings :: Bool -> Day -> BalancingOpts -> Journal -> Either String Journal -journalAddAutoPostings alltxns d bopts = +-- With a true second argument, adds visible tags to generated postings and modified transactions. +journalAddAutoPostings :: Bool -> Bool -> Day -> BalancingOpts -> Journal -> Either String Journal +journalAddAutoPostings alltxns verbosetags d bopts = -- Balance all transactions without checking balance assertions, journalBalanceTransactions bopts{ignore_assertions_=True} -- then add the auto postings -- (Note adding auto postings after balancing means #893b fails; -- adding them before balancing probably means #893a, #928, #938 fail.) - >=> journalModifyTransactions alltxns d + >=> journalModifyTransactions alltxns verbosetags d -- | Generate periodic transactions from all periodic transaction rules in the journal. -- These transactions are added to the in-memory Journal (but not the on-disk file). -- -- The start & end date for generated periodic transactions are determined in -- a somewhat complicated way; see the hledger manual -> Periodic transactions. -journalAddForecast :: Maybe DateSpan -> Journal -> Journal -journalAddForecast Nothing j = j -journalAddForecast (Just forecastspan) j = j{jtxns = jtxns j ++ forecasttxns} +journalAddForecast :: Bool -> Maybe DateSpan -> Journal -> Journal +journalAddForecast _ Nothing j = j +journalAddForecast verbosetags (Just forecastspan) j = j{jtxns = jtxns j ++ forecasttxns} where forecasttxns = map (txnTieKnot . transactionTransformPostings (postingApplyCommodityStyles $ journalCommodityStyles j)) . filter (spanContainsDate forecastspan . tdate) - . concatMap (`runPeriodicTransaction` forecastspan) + . concatMap (\pt -> runPeriodicTransaction verbosetags pt forecastspan) $ jperiodictxns j setYear :: Year -> JournalParser m () diff --git a/hledger-lib/Hledger/Read/InputOptions.hs b/hledger-lib/Hledger/Read/InputOptions.hs index d74a7480e..7357a624b 100644 --- a/hledger-lib/Hledger/Read/InputOptions.hs +++ b/hledger-lib/Hledger/Read/InputOptions.hs @@ -34,6 +34,7 @@ data InputOpts = InputOpts { ,new_save_ :: Bool -- ^ save latest new transactions state for next time ,pivot_ :: String -- ^ use the given field's value as the account name ,forecast_ :: Maybe DateSpan -- ^ span in which to generate forecast transactions + ,verbose_tags_ :: Bool -- ^ add user-visible tags when generating/modifying transactions & postings ? ,reportspan_ :: DateSpan -- ^ a dirty hack keeping the query dates in InputOpts. This rightfully lives in ReportSpec, but is duplicated here. ,auto_ :: Bool -- ^ generate automatic postings when journal is parsed ? ,infer_equity_ :: Bool -- ^ infer equity conversion postings from costs ? @@ -53,6 +54,7 @@ definputopts = InputOpts , new_save_ = True , pivot_ = "" , forecast_ = Nothing + , verbose_tags_ = False , reportspan_ = nulldatespan , auto_ = False , infer_equity_ = False diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index e30387cbd..e3974f482 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -81,7 +81,7 @@ budgetReport rspec bopts reportspan j = dbg4 "sortedbudgetreport" budgetreport expandAccountNames $ accountNamesFromPostings $ concatMap tpostings $ - concatMap (`runPeriodicTransaction` reportspan) $ + concatMap (\pt -> runPeriodicTransaction False pt reportspan) $ jperiodictxns j actualj = journalWithBudgetAccountNames budgetedaccts showunbudgeted j budgetj = journalAddBudgetGoalTransactions bopts ropts reportspan j @@ -156,7 +156,7 @@ journalAddBudgetGoalTransactions bopts ropts reportspan j = dbg5 "budget goal txns" $ [makeBudgetTxn t | pt <- budgetpts - , t <- runPeriodicTransaction pt budgetspan + , t <- runPeriodicTransaction False pt budgetspan ] makeBudgetTxn t = txnTieKnot $ t { tdescription = T.pack "Budget transaction" } diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 4aab86d72..16688ede7 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -211,6 +211,7 @@ reportflags = [ , "Also, in hledger-ui make future-dated transactions visible." ]) ,flagNone ["auto"] (setboolopt "auto") "Generate extra postings by applying auto posting rules to all txns (not just forecast txns)." + ,flagNone ["verbose-tags"] (setboolopt "verbose-tags") "Add visible tags indicating transactions or postings which have been generated/modified." -- general output-related ,flagReq ["commodity-style", "c"] (\s opts -> Right $ setopt "commodity-style" s opts) "COMM" diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index 96c300456..3b9bbe556 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -105,7 +105,7 @@ originalPostingPreservingAccount p = orig , pamount = pamount $ if isGenerated then p else orig } where orig = originalPosting p - isGenerated = "generated-posting" `elem` map fst (ptags p) + isGenerated = "_generated-posting" `elem` map fst (ptags p) -- XXX -- tests_showTransactions = [ diff --git a/hledger/Hledger/Cli/Commands/Rewrite.hs b/hledger/Hledger/Cli/Commands/Rewrite.hs index 8b902aa15..7cf2800c0 100644 --- a/hledger/Hledger/Cli/Commands/Rewrite.hs +++ b/hledger/Hledger/Cli/Commands/Rewrite.hs @@ -39,9 +39,11 @@ rewritemode = hledgerCommandMode rewrite opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j@Journal{jtxns=ts} = do -- rewrite matched transactions - let today = _rsDay rspec - let modifiers = transactionModifierFromOpts opts : jtxnmodifiers j - let j' = j{jtxns=either error' id $ modifyTransactions (const True) (journalAccountType j) (journalInheritedAccountTags j) mempty today modifiers ts} -- PARTIAL: + let + today = _rsDay rspec + verbosetags = boolopt "verbose-tags" rawopts + modifiers = transactionModifierFromOpts opts : jtxnmodifiers j + let j' = j{jtxns=either error' id $ modifyTransactions (const True) (journalAccountType j) (journalInheritedAccountTags j) mempty today verbosetags modifiers ts} -- PARTIAL: -- run the print command, showing all transactions, or show diffs printOrDiff rawopts opts{reportspec_=rspec{_rsQuery=Any}} j j' diff --git a/hledger/test/forecast.test b/hledger/test/forecast.test index 21e7147b2..deaa3c8e5 100644 --- a/hledger/test/forecast.test +++ b/hledger/test/forecast.test @@ -49,7 +49,6 @@ $ hledger print -b 2016-11 -e 2017-02 -f - --forecast assets:cash 2017-01-01 * marked cleared, and with a description - ; generated-transaction: ~ monthly from 2016/1 income $-1000 expenses:food $20 expenses:leisure $15 @@ -109,7 +108,8 @@ Y 2000 # 5. Y affects M/D partial dates in periodic transactions. # The recur tag shows the original period expression and is not modified. -$ hledger -f - print --forecast desc:forecast +# Also the --verbose-tags flag adds a visible tag. +$ hledger -f - print --forecast desc:forecast --verbose-tag 2000-02-01 forecast ; generated-transaction: ~ 2/1 @@ -126,7 +126,6 @@ Y 2000 # 6. Y also sets the month to 1, affecting D dates: $ hledger -f - print --forecast desc:forecast 2000-01-15 forecast - ; generated-transaction: ~ 15 >=0 @@ -141,7 +140,6 @@ Y 2000 # 7. Y also sets the day to 1, affecting relative dates: $ hledger -f - print --forecast desc:forecast 2000-02-01 forecast - ; generated-transaction: ~ next month >=0 @@ -210,7 +208,7 @@ $ hledger -f - reg --forecast date:202001 Costs # 11. Forecast transactions work with balance assignments -$ hledger -f - print -x --forecast -e 2021-11 +$ hledger -f - print -x --forecast -e 2021-11 --verbose-tags 2021-09-01 Normal Balance Assertion Works Checking -60 = -60 Costs 60 diff --git a/hledger/test/journal/auto-postings.test b/hledger/test/journal/auto-postings.test index d334b0dd8..6da1deb05 100644 --- a/hledger/test/journal/auto-postings.test +++ b/hledger/test/journal/auto-postings.test @@ -12,7 +12,8 @@ assets:bank # 1. print. Auto-generated postings are inserted below the matched one. -$ hledger print -f- --auto +# With --verbose-tags, informative tags will also be added. +$ hledger print -f- --auto --verbose-tags 2016-01-01 paycheck ; modified: income:remuneration $-100 (liabilities:tax) $-33 ; income tax, generated-posting: = ^income @@ -78,10 +79,10 @@ $ hledger register -f- --auto # 5. $ hledger print -f- --auto -2018-10-07 * MARKET ; modified: +2018-10-07 * MARKET expenses:groceries:food - [budget:groceries] $-20 ; generated-posting: = ^expenses:groceries - [assets:bank:checking] $20 ; generated-posting: = ^expenses:groceries + [budget:groceries] $-20 + [assets:bank:checking] $20 assets:bank:checking $-20 >= @@ -97,10 +98,10 @@ $ hledger print -f- --auto # 6. $ hledger -f- print --auto -x -2018-01-01 ; modified: +2018-01-01 (assets:billable:client1) 0.50h @ $90 - assets:receivable:client1 50.00h @ $90 ; generated-posting: = assets:billable:client1 - revenues:client1 $-4500 ; generated-posting: = assets:billable:client1 + assets:receivable:client1 50.00h @ $90 + revenues:client1 $-4500 >= @@ -115,10 +116,10 @@ $ hledger -f- print --auto -x # 7. $ hledger -f- print --auto -x -2018-01-01 ; modified: +2018-01-01 (assets:billable:client1) 0.50h - assets:receivable:client1 $50 ; generated-posting: = assets:billable:client1 - revenues:client1 $-50 ; generated-posting: = assets:billable:client1 + assets:receivable:client1 $50 + revenues:client1 $-50 >= @@ -133,10 +134,10 @@ $ hledger -f- print --auto -x # 8. $ hledger -f- print --auto -x -2018-01-01 ; modified: +2018-01-01 (assets:billable:client1) 0.50h @ $90 - assets:receivable:client1 0.50 "Client1 Hours" @ $100.00 ; generated-posting: = assets:billable:client1 - revenues:client1 $-50.00 ; generated-posting: = assets:billable:client1 + assets:receivable:client1 0.50 "Client1 Hours" @ $100.00 + revenues:client1 $-50.00 >= @@ -177,7 +178,7 @@ $ hledger print -f- --auto Assets:Joint:Bank -£50.00 # 10. -$ hledger -f- print --auto +$ hledger -f- print --auto --verbose-tags 2018-01-01 ; modified: Expenses:Joint:Widgets $100.00 @ £0.50 Expenses:Joint $-100.00 @ £0.50 ; generated-posting: = ^Expenses:Joint @@ -200,11 +201,11 @@ $ hledger -f- print --auto # 11. $ hledger -f- print --auto -2018-01-01 ; modified: +2018-01-01 Expenses:Joint:Widgets $100.00 @@ £50 - Expenses:Joint $-100.00 @@ £50 ; generated-posting: = ^Expenses:Joint - Liabilities:Joint:Bob $50.00 @@ £25 ; generated-posting: = ^Expenses:Joint - Liabilities:Joint:Bill $50.00 @@ £25 ; generated-posting: = ^Expenses:Joint + Expenses:Joint $-100.00 @@ £50 + Liabilities:Joint:Bob $50.00 @@ £25 + Liabilities:Joint:Bill $50.00 @@ £25 Assets:Joint:Bank £-50.00 >=0 @@ -229,11 +230,11 @@ $ hledger -f- print --auto # 12. $ hledger -f- print --auto -2018-01-01 ; modified: +2018-01-01 Expenses:Joint:Widgets $100.00 - Expenses:Joint $-100.00 @@ £50.00 ; generated-posting: = ^Expenses:Joint - Liabilities:Joint:Bob $50.00 @@ £25.00 ; generated-posting: = ^Expenses:Joint - Liabilities:Joint:Bill $50.00 @@ £25.00 ; generated-posting: = ^Expenses:Joint + Expenses:Joint $-100.00 @@ £50.00 + Liabilities:Joint:Bob $50.00 @@ £25.00 + Liabilities:Joint:Bill $50.00 @@ £25.00 Assets:Joint:Bank £-50.00 >=0 @@ -262,28 +263,26 @@ $ hledger print -f- --forecast -b 2016-01 -e 2016-03 income:gifts 2016-02-01 paycheck - ; generated-transaction: ~ monthly from 2016-01, modified: income:remuneration $-100 - (liabilities:tax) $-33 ; income tax, generated-posting: = ^income + (liabilities:tax) $-33 ; income tax income:donations $-15 - (liabilities:tax) $-4.95 ; income tax, generated-posting: = ^income + (liabilities:tax) $-4.95 ; income tax assets:bank >= # 14. With --auto, they affect all transactions: $ hledger print -f- --auto --forecast -b 2016-01 -e 2016-03 -2016-01-03 ; modified: +2016-01-03 assets:cash $100 income:gifts - (liabilities:tax) $-33 ; income tax, generated-posting: = ^income + (liabilities:tax) $-33 ; income tax 2016-02-01 paycheck - ; generated-transaction: ~ monthly from 2016-01, modified: income:remuneration $-100 - (liabilities:tax) $-33 ; income tax, generated-posting: = ^income + (liabilities:tax) $-33 ; income tax income:donations $-15 - (liabilities:tax) $-4.95 ; income tax, generated-posting: = ^income + (liabilities:tax) $-4.95 ; income tax assets:bank >= @@ -340,9 +339,9 @@ $ hledger -f- print -x --auto commodity 0. B $ hledger -f- print --auto -2020-01-20 ; modified: +2020-01-20 (a) 1 A - (b) 1.5 B ; generated-posting: = + (b) 1.5 B >=0 @@ -360,12 +359,12 @@ $ hledger -f- print --auto assets $ hledger -f- print --auto -2017-12-14 ; modified: +2017-12-14 revenue:job -10 EUR revenue:job -10 USD assets - (b:USD) 5 USD ; generated-posting: = assets cur:EUR - (b:USD) 10 USD ; generated-posting: = assets cur:USD + (b:USD) 5 USD + (b:USD) 10 USD >=0 @@ -380,11 +379,11 @@ $ hledger -f- print --auto assets $ hledger -f- print --auto -2017-12-14 ; modified: +2017-12-14 revenue:job -10 USD revenue:job -100 EUR assets - (b) 100 EUR ; generated-posting: = assets amt:>50 + (b) 100 EUR >=0 @@ -402,15 +401,14 @@ $ hledger -f- print --auto (Auto) *1 $ hledger -f- print --forecast --auto --explicit -2021-01-01 Fixed ; modified: +2021-01-01 Fixed Checking -10 Costs 10 - (Auto) 10 ; generated-posting: = acct:Costs + (Auto) 10 2021-01-02 Periodic - ; generated-transaction: ~ 2021-01-02, modified: Checking -10 Costs 10 - (Auto) 10 ; generated-posting: = acct:Costs + (Auto) 10 >=0 diff --git a/hledger/test/journal/costs.test b/hledger/test/journal/costs.test index 7b2ef3ab1..bbe25b881 100644 --- a/hledger/test/journal/costs.test +++ b/hledger/test/journal/costs.test @@ -25,12 +25,13 @@ $ hledger -f- print --explicit --cost expenses:foreign currency €100 @ $1.35 assets $-135.00 -# 3. --infer-equity generates conversion postings -$ hledger -f- print --infer-equity +# 3. --infer-equity generates conversion postings, +# and with --verbose-tags, they will be visibly tagged. +$ hledger -f- print --infer-equity --verbose-tags 2011-01-01 expenses:foreign currency €100 @ $1.35 - equity:conversion:$-€:€ €-100 ; generated-posting: - equity:conversion:$-€:$ $135.00 ; generated-posting: + equity:conversion:$-€:€ €-100 ; generated-posting: conversion + equity:conversion:$-€:$ $135.00 ; generated-posting: conversion assets $-135.00 >=0 @@ -365,8 +366,8 @@ account equity:trades ; type:V $ hledger -f- print --infer-equity 2011-01-01 expenses:foreign currency €100 @ $1.35 - equity:trades:$-€:€ €-100 ; generated-posting: - equity:trades:$-€:$ $135.00 ; generated-posting: + equity:trades:$-€:€ €-100 + equity:trades:$-€:$ $135.00 assets >=0 diff --git a/hledger/test/journal/directive-default-commodity.test b/hledger/test/journal/directive-default-commodity.test index 40a718d0a..830cd83ef 100644 --- a/hledger/test/journal/directive-default-commodity.test +++ b/hledger/test/journal/directive-default-commodity.test @@ -81,9 +81,9 @@ D $1000. (a) €1 $ hledger -f- print --auto -2018-01-01 ; modified: +2018-01-01 (a) €1 - (b) €2 ; generated-posting: = a + (b) €2 >=0 diff --git a/hledger/test/print/explicit.test b/hledger/test/print/explicit.test index f4815038f..59f702341 100644 --- a/hledger/test/print/explicit.test +++ b/hledger/test/print/explicit.test @@ -97,7 +97,7 @@ $ hledger -f - print --explicit >= 0 -# 9. Auto postings are always explicit +# 9. Auto postings are always given explicit amounts. < = a c *-0.453 @@ -107,10 +107,10 @@ $ hledger -f - print --explicit a 1000 EUR b $ hledger -f - print --auto -2021-09-01 ; modified: +2021-09-01 a 1000 EUR - c -453 EUR ; generated-posting: = a - d 453 EUR ; generated-posting: = a + c -453 EUR + d 453 EUR b >= 0 diff --git a/hledger/test/rewrite.test b/hledger/test/rewrite.test index 7fab9cb9a..a8c7832b7 100644 --- a/hledger/test/rewrite.test +++ b/hledger/test/rewrite.test @@ -1,5 +1,6 @@ # 1. Add proportional income tax (from documentation) +# With --verbose-tags, an informative extra tag is added. < 2016/1/1 paycheck income:remuneration $-100 @@ -9,7 +10,7 @@ 2016/1/1 withdraw assets:cash $20 assets:bank -$ hledger rewrite -f- ^income --add-posting '(liabilities:tax) *.33 ; income tax' +$ hledger rewrite -f- ^income --add-posting '(liabilities:tax) *.33 ; income tax' --verbose-tags 2016-01-01 paycheck ; modified: income:remuneration $-100 (liabilities:tax) $-33 ; income tax, generated-posting: = ^income @@ -38,10 +39,10 @@ $ hledger rewrite -f- expenses:gifts --add-posting '(budget:gifts) *-1' assets:cash $20 assets:bank -2016-01-01 gift ; modified: +2016-01-01 gift assets:cash $-15 expenses:gifts ; [1/2] - (budget:gifts) $-15 ; [2016-01-02], generated-posting: = expenses:gifts + (budget:gifts) $-15 ; [2016-01-02] >= 0 @@ -63,17 +64,17 @@ $ hledger rewrite -f- expenses:gifts --add-posting '(budget:gifts) *-1' = ^assets:unbilled:client2 (assets:to bill:client2) *150.00 CAD $ hledger rewrite -f- -2017-04-24 * 09:00-09:25 ; modified: +2017-04-24 * 09:00-09:25 (assets:unbilled:client1) 0.42h - (assets:to bill:client1) 42.00 CAD ; generated-posting: = ^assets:unbilled:client1 + (assets:to bill:client1) 42.00 CAD -2017-04-25 * 10:00-11:15 ; modified: +2017-04-25 * 10:00-11:15 (assets:unbilled:client1) 1.25h - (assets:to bill:client1) 125.00 CAD ; generated-posting: = ^assets:unbilled:client1 + (assets:to bill:client1) 125.00 CAD -2017-04-25 * 14:00-15:32 ; modified: +2017-04-25 * 14:00-15:32 (assets:unbilled:client2) 1.54h - (assets:to bill:client2) 231.00 CAD ; generated-posting: = ^assets:unbilled:client2 + (assets:to bill:client2) 231.00 CAD >= 0 @@ -98,20 +99,20 @@ $ hledger rewrite -f- assets:to bill:client2 *1.00 hours @ $150.00 income:consulting:client2 $ hledger rewrite -f- -B -2017-04-24 * 09:00-09:25 ; modified: +2017-04-24 * 09:00-09:25 (assets:unbilled:client1) 0.42h - assets:to bill:client1 $42.00 ; generated-posting: = ^assets:unbilled:client1 - income:consulting:client1 ; generated-posting: = ^assets:unbilled:client1 + assets:to bill:client1 $42.00 + income:consulting:client1 -2017-04-25 * 10:00-11:15 ; modified: +2017-04-25 * 10:00-11:15 (assets:unbilled:client1) 1.25h - assets:to bill:client1 $125.00 ; generated-posting: = ^assets:unbilled:client1 - income:consulting:client1 ; generated-posting: = ^assets:unbilled:client1 + assets:to bill:client1 $125.00 + income:consulting:client1 -2017-04-25 * 14:00-15:32 ; modified: +2017-04-25 * 14:00-15:32 (assets:unbilled:client2) 1.54h - assets:to bill:client2 $231.00 ; generated-posting: = ^assets:unbilled:client2 - income:consulting:client2 ; generated-posting: = ^assets:unbilled:client2 + assets:to bill:client2 $231.00 + income:consulting:client2 >= 0 @@ -131,17 +132,17 @@ $ hledger rewrite -f- -B # income:remuneration $-100 # assets:bank $ hledger rewrite -f- assets:bank and 'amt:<0' --add-posting 'expenses:fee $5' --add-posting 'assets:bank $-5' -2016-01-01 withdraw ; modified: +2016-01-01 withdraw assets:cash $20 assets:bank - expenses:fee $5 ; generated-posting: = assets:bank and "amt:<0" - assets:bank $-5 ; generated-posting: = assets:bank and "amt:<0" + expenses:fee $5 + assets:bank $-5 -2016-01-02 withdraw ; modified: +2016-01-02 withdraw assets:cash assets:bank $-30 - expenses:fee $5 ; generated-posting: = assets:bank and "amt:<0" - assets:bank $-5 ; generated-posting: = assets:bank and "amt:<0" + expenses:fee $5 + assets:bank $-5 >= 0 @@ -177,7 +178,7 @@ $ hledger rewrite -f- assets:bank and 'amt:<0' --add-posting 'expenses:fee $5' ; but relative order matters to refer-rewritten transactions = ^expenses not:housing not:grocery not:food (budget:misc) *-1 -$ hledger rewrite -f- date:2017/1 --add-posting 'Here comes Santa $0' +$ hledger rewrite -f- date:2017/1 --add-posting 'Here comes Santa $0' --verbose-tags 2016-12-31 ; modified: expenses:housing $600.00 (budget:housing) $-600.00 ; generated-posting: = ^expenses:housing @@ -225,15 +226,15 @@ $ hledger rewrite --diff -f- assets:bank and 'amt:<0' --add-posting 'expenses:fe +++ - @@ -1,3 +1,5 @@ -2016/01/01 withdraw -+2016-01-01 withdraw ; modified: ++2016-01-01 withdraw assets:cash $20 assets:bank -+ expenses:fee $5 ; generated-posting: = assets:bank and "amt:<0" -+ assets:bank $-5 ; generated-posting: = assets:bank and "amt:<0" ++ expenses:fee $5 ++ assets:bank $-5 @@ -5,3 +7,5 @@ -2016/01/02 withdraw -+2016-01-02 withdraw ; modified: ++2016-01-02 withdraw assets:cash assets:bank $-30 -+ expenses:fee $5 ; generated-posting: = assets:bank and "amt:<0" -+ assets:bank $-5 ; generated-posting: = assets:bank and "amt:<0" ++ expenses:fee $5 ++ assets:bank $-5