From 7437c96ff6afd45f5a587a6ea7c4025503e661e1 Mon Sep 17 00:00:00 2001 From: Mykola Orliuk Date: Fri, 20 Jan 2017 17:33:24 +0200 Subject: [PATCH] Make hledger-rewrite tool suitable for re-factoring original journals (#490) * cli: fix bug in pivot for postings without tag Without this fix for postings without tag query checked effective account which is always empty text (""). * rewrite: inherit dates, change application order For budgeting it is important to inherit actual date of posting if it differs from date of transaction. These dates will be added as a separate line of comment. More natural order of rewrites is when result of first defined one is available for all next rewrites. * rewrite: factor out Hledger.Data.AutoTransaction * rewrite: add diff output With this option you can modify your original files without loosing inter-transaction comments etc. I.e. you can run: hledger-rewrite --diff Agency \ --add-posting 'Expenses:Taxes *0.17' \ | patch As result multiple files should be updated. Also it is nice to review your changes using colordiff instead of patch. * lib: track source lines range for journal * doc: auto entries and diff output for rewrite --- bin/hledger-rewrite.hs | 146 +++++++++++++++----- hledger-lib/Hledger/Data/AutoTransaction.hs | 103 ++++++++++++++ hledger-lib/Hledger/Data/Journal.hs | 5 +- hledger-lib/Hledger/Data/Transaction.hs | 28 +++- hledger-lib/Hledger/Data/Types.hs | 4 +- hledger-lib/Hledger/Read/Common.hs | 7 + hledger-lib/Hledger/Read/JournalReader.hs | 4 +- hledger-lib/hledger-lib.cabal | 3 + hledger-lib/package.yaml | 1 + hledger/Hledger/Cli/Print.hs | 1 + hledger/doc/commands.m4.md | 83 +++++++++++ tests/bin/rewrite.test | 47 +++++-- tests/journal/balance-assertions.test | 4 +- 13 files changed, 387 insertions(+), 49 deletions(-) create mode 100644 hledger-lib/Hledger/Data/AutoTransaction.hs diff --git a/bin/hledger-rewrite.hs b/bin/hledger-rewrite.hs index 9d40685dc..f4d17bf24 100755 --- a/bin/hledger-rewrite.hs +++ b/bin/hledger-rewrite.hs @@ -4,8 +4,9 @@ --package hledger --package megaparsec --package text + --package Diff -} -{-# LANGUAGE OverloadedStrings, LambdaCase #-} +{-# LANGUAGE OverloadedStrings, LambdaCase, DeriveTraversable, ViewPatterns #-} {- hledger-rewrite [PATTERNS] --add-posting "ACCT AMTEXPR" ... @@ -16,8 +17,16 @@ but adds the specified postings to any entries matching PATTERNS. Examples: -hledger-rewrite.hs ^income --add-posting '(liabilities:tax) *.33' --add-posting '(reserve:gifts) $100' +hledger-rewrite.hs ^income --add-posting '(liabilities:tax) *.33 ; income tax' --add-posting '(reserve:gifts) $100' hledger-rewrite.hs expenses:gifts --add-posting '(reserve:gifts) *-1"' +hledger-rewrite.hs -f rewrites.hledger + +rewrites.hledger may consist of entries like: += ^income amt:<0 date:2017 + (liabilities:tax) *0.33 ; tax on income + (reserve:grocery) *0.25 ; reserve 25% for grocery + (reserve:) *0.25 ; reserve 25% for grocery + Note the single quotes to protect the dollar sign from bash, and the two spaces between account and amount. See the command-line help for more details. @@ -32,16 +41,19 @@ TODO: -} -import Data.Monoid +import Control.Monad.Writer +import Data.List (sortOn, foldl') import qualified Data.Text as T -- hledger lib, cli and cmdargs utils -import Hledger.Cli +import Hledger.Cli hiding (outputflags) -- more utils for parsing -- #if !MIN_VERSION_base(4,8,0) -- import Control.Applicative.Compat ((<*)) -- #endif +import Text.Printf import Text.Megaparsec -import Text.Megaparsec.Text +import qualified Data.Algorithm.Diff as D +import Hledger.Data.AutoTransaction (runModifierTransaction) cmdmode :: Mode RawOpts cmdmode = (defCommandMode ["hledger-rewrite"]) { @@ -49,6 +61,7 @@ cmdmode = (defCommandMode ["hledger-rewrite"]) { ,modeHelp = "print all journal entries, with custom postings added to the matched ones" ,modeGroupFlags = Group { groupNamed = [("Input", inputflags) + ,("Output", outputflags) ,("Reporting", reportflags) ,("Misc", helpflags) ] @@ -58,6 +71,9 @@ cmdmode = (defCommandMode ["hledger-rewrite"]) { } } +outputflags :: [Flag RawOpts] +outputflags = [flagNone ["diff"] (setboolopt "diff") "generate diff suitable as an input for patch tool"] + postingp' :: T.Text -> IO Posting postingp' t = runErroringJournalParser (postingp Nothing <* eof) t' >>= \case Left err -> fail err @@ -70,41 +86,109 @@ modifierTransactionFromOpts opts = do return ModifierTransaction { mtvalueexpr = T.empty, mtpostings = postings } -post' :: AccountName -> Amount -> Posting -post' acct amt = (accountNameWithoutPostingType acct `post` amt) { ptype = accountNamePostingType acct } +outputFromOpts :: RawOpts -> (CliOpts -> Journal -> Journal -> IO ()) +outputFromOpts opts + | boolopt "diff" opts = const diffOutput + | otherwise = flip (const print') --- mtvaluequery :: ModifierTransaction -> Day -> Query -mtvaluequery mod = fst . flip parseQuery (mtvalueexpr mod) +diffOutput :: Journal -> Journal -> IO () +diffOutput j j' = do + let changed = [(originalTransaction t, originalTransaction t') | (t, t') <- zip (jtxns j) (jtxns j'), t /= t'] + putStr $ renderPatch $ map (uncurry $ diffTxn j) changed -postingScale :: Posting -> Maybe Quantity -postingScale p = - case amounts $ pamount p of - [a] | acommodity a == "*" -> Just $ aquantity a - _ -> Nothing +type Chunk = (GenericSourcePos, [DiffLine String]) -runModifierPosting :: Posting -> (Posting -> Posting) -runModifierPosting p' = - case postingScale p' of - Nothing -> \p -> p' { ptransaction = ptransaction p } - Just n -> \p -> p' { pamount = pamount p `divideMixedAmount` (1/n), ptransaction = ptransaction p } +-- | Render list of changed lines as a unified diff +-- +-- >>> putStr $ renderPatch [(GenericSourcePos "a" 1 1, [D.First "x", D.Second "y"])] +-- --- a +-- +++ a +-- @@ -1,1 +1,1 @@ +-- -x +-- +y +-- >>> putStr $ renderPatch [(GenericSourcePos "a" 1 1, [D.Both "x" "x", D.Second "y"]), (GenericSourcePos "a" 5 1, [D.Second "z"])] +-- --- a +-- +++ a +-- @@ -1,1 +1,2 @@ +-- x +-- +y +-- @@ -5,0 +6,1 @@ +-- +z +-- >>> putStr $ renderPatch [(GenericSourcePos "a" 1 1, [D.Both "x" "x", D.Second "y"]), (GenericSourcePos "b" 5 1, [D.Second "z"])] +-- --- a +-- +++ a +-- @@ -1,1 +1,2 @@ +-- x +-- +y +-- --- b +-- +++ b +-- @@ -5,0 +5,1 @@ +-- +z +renderPatch :: [Chunk] -> String +renderPatch = go Nothing . sortOn fst where + go _ [] = "" + go Nothing cs@((sourceFilePath -> fp, _):_) = fileHeader fp ++ go (Just (fp, 0)) cs + go (Just (fp, _)) cs@((sourceFilePath -> fp', _):_) | fp /= fp' = go Nothing cs + go (Just (fp, offs)) ((sourceFirstLine -> lineno, diffs):cs) = chunkHeader ++ chunk ++ go (Just (fp, offs + adds - dels)) cs + where + chunkHeader = printf "@@ -%d,%d +%d,%d @@\n" lineno dels (lineno+offs) adds where + (dels, adds) = foldl' countDiff (0, 0) diffs + chunk = concatMap renderLine diffs + fileHeader fp = printf "--- %s\n+++ %s\n" fp fp -runModifierTransaction :: Query -> ModifierTransaction -> (Transaction -> Transaction) -runModifierTransaction q mod = modifier where - q' = simplifyQuery $ And [q, mtvaluequery mod (error "query cannot depend on current time")] - mods = map runModifierPosting $ mtpostings mod - generatePostings ps = [mod p | p <- ps, q' `matchesPosting` p, mod <- mods] - modifier t@Transaction{ tpostings = ps } = t { tpostings = ps ++ generatePostings ps } + countDiff (dels, adds) = \case + Del _ -> (dels + 1, adds) + Add _ -> (dels , adds + 1) + Ctx _ -> (dels + 1, adds + 1) + renderLine = \case + Del s -> '-' : s ++ "\n" + Add s -> '+' : s ++ "\n" + Ctx s -> ' ' : s ++ "\n" + +diffTxn :: Journal -> Transaction -> Transaction -> Chunk +diffTxn j t t' = + case tsourcepos t of + GenericSourcePos fp lineno _ -> (GenericSourcePos fp (lineno+1) 1, diffs) where + -- TODO: use range and produce two chunks: one removes part of + -- original file, other adds transaction to new file with + -- suffix .ledger (generated). I.e. move transaction from one file to another. + diffs :: [DiffLine String] + diffs = concat . map (traverse showPostingLines . mapDiff) $ D.getDiff (tpostings t) (tpostings t') + pos@(LedgerSourcePos fp (line, line')) -> (pos, diffs) where + -- We do diff for original lines vs generated ones. Often leads + -- to big diff because of re-format effect. + diffs :: [DiffLine String] + diffs = map mapDiff $ D.getDiff source changed' + source | Just contents <- lookup fp $ jfiles j = map T.unpack . drop (line-1) . take line' $ T.lines contents + | otherwise = [] + changed = lines $ showTransactionUnelided t' + changed' | null changed = changed + | null $ last changed = init changed + | otherwise = changed + +data DiffLine a = Del a | Add a | Ctx a + deriving (Show, Functor, Foldable, Traversable) + +mapDiff :: D.Diff a -> DiffLine a +mapDiff = \case + D.First x -> Del x + D.Second x -> Add x + D.Both x _ -> Ctx x + +main :: IO () main = do opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} <- getCliOpts cmdmode d <- getCurrentDay let q = queryFromOpts d ropts - mod <- modifierTransactionFromOpts rawopts - withJournalDo opts $ \opts j@Journal{jtxns=ts} -> do + modifier <- modifierTransactionFromOpts rawopts + withJournalDo opts $ \opts' j@Journal{jtxns=ts} -> do -- create re-writer - let mods = jmodifiertxns j ++ [mod] - modifier = foldr (.) id $ map (runModifierTransaction q) mods + let modifiers = modifier : jmodifiertxns j + -- Note that some query matches require transaction. Thus modifiers + -- pipeline should include txnTieKnot on every step. + modifier' = foldr (flip (.) . fmap txnTieKnot . runModifierTransaction q) id modifiers -- rewrite matched transactions - let j' = j{jtxns=map modifier ts} + let j' = j{jtxns=map modifier' ts} -- run the print command, showing all transactions - print' opts{reportopts_=ropts{query_=""}} j' + outputFromOpts rawopts opts'{reportopts_=ropts{query_=""}} j j' diff --git a/hledger-lib/Hledger/Data/AutoTransaction.hs b/hledger-lib/Hledger/Data/AutoTransaction.hs new file mode 100644 index 000000000..5bd77a0d8 --- /dev/null +++ b/hledger-lib/Hledger/Data/AutoTransaction.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE OverloadedStrings, ViewPatterns #-} +{-| + +This module provides utilities for applying automated transactions like +'ModifierTransaction' and 'PeriodicTransaction'. + +-} +module Hledger.Data.AutoTransaction + ( + -- * Transaction processors + runModifierTransaction + + -- * Accessors + , mtvaluequery + ) +where + +import Data.Maybe +import Data.Monoid ((<>)) +import Data.Time.Calendar +import qualified Data.Text as T +import Hledger.Data.Types +import Hledger.Data.Dates +import Hledger.Data.Amount +import Hledger.Query + +-- $setup +-- >>> :set -XOverloadedStrings +-- >>> import Hledger.Data.Posting +-- >>> import Hledger.Data.Transaction + +-- | Builds a 'Transaction' transformer based on 'ModifierTransaction'. +-- +-- 'Query' parameter allows injection of additional restriction on posting +-- match. Don't forget to call 'txnTieKnot'. +-- +-- >>> runModifierTransaction Any (ModifierTransaction "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} +-- 0000/01/01 +-- ping $1.00 +-- pong $2.00 +-- +-- +-- >>> runModifierTransaction Any (ModifierTransaction "miss" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} +-- 0000/01/01 +-- ping $1.00 +-- +-- +-- >>> runModifierTransaction None (ModifierTransaction "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]} +-- 0000/01/01 +-- ping $1.00 +-- +-- +-- >>> runModifierTransaction Any (ModifierTransaction "ping" ["pong" `post` amount{acommodity="*", aquantity=3}]) nulltransaction{tpostings=["ping" `post` usd 2]} +-- 0000/01/01 +-- ping $2.00 +-- pong $6.00 +-- +-- +runModifierTransaction :: Query -> ModifierTransaction -> (Transaction -> Transaction) +runModifierTransaction q mt = modifier where + q' = simplifyQuery $ And [q, mtvaluequery mt (error "query cannot depend on current time")] + mods = map runModifierPosting $ mtpostings mt + generatePostings ps = [m p | p <- ps, q' `matchesPosting` p, m <- mods] + modifier t@(tpostings -> ps) = t { tpostings = ps ++ generatePostings ps } + +-- | Extract 'Query' equivalent of 'mtvalueexpr' from 'ModifierTransaction' +-- +-- >>> mtvaluequery (ModifierTransaction "" []) undefined +-- Any +-- >>> mtvaluequery (ModifierTransaction "ping" []) undefined +-- Acct "ping" +-- >>> mtvaluequery (ModifierTransaction "date:2016" []) undefined +-- Date (DateSpan 2016) +-- >>> mtvaluequery (ModifierTransaction "date:today" []) (read "2017-01-01") +-- Date (DateSpan 2017/01/01) +mtvaluequery :: ModifierTransaction -> (Day -> Query) +mtvaluequery mt = fst . flip parseQuery (mtvalueexpr mt) + +postingScale :: Posting -> Maybe Quantity +postingScale p = + case amounts $ pamount p of + [a] | acommodity a == "*" -> Just $ aquantity a + _ -> Nothing + +runModifierPosting :: Posting -> (Posting -> Posting) +runModifierPosting p' = modifier where + modifier p = renderPostingCommentDates $ p' + { pdate = pdate p + , pdate2 = pdate2 p + , pamount = amount' p + } + amount' = + case postingScale p' of + Nothing -> const $ pamount p' + Just n -> \p -> pamount p `divideMixedAmount` (1/n) + +renderPostingCommentDates :: Posting -> Posting +renderPostingCommentDates p = p { pcomment = comment' } + where + datesComment = T.concat $ catMaybes [T.pack . showDate <$> pdate p, ("=" <>) . T.pack . showDate <$> pdate2 p] + comment' + | T.null datesComment = pcomment p + | otherwise = T.intercalate "\n" $ filter (not . T.null) [T.strip $ pcomment p, "[" <> datesComment <> "]"] diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 96f195f52..aea6fe9de 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -529,9 +529,8 @@ checkBalanceAssertion p@Posting{ pbalanceassertion = Just ass} amt ]) (case ptransaction p of Nothing -> ":" -- shouldn't happen - Just t -> printf " in \"%s\" (line %d, column %d):\nin transaction:\n%s" - f l c (chomp $ show t) :: String - where GenericSourcePos f l c = tsourcepos t) + Just t -> printf " in %s:\nin transaction:\n%s" + (showGenericSourcePos $ tsourcepos t) (chomp $ show t) :: String) (showPostingLine p) (showDate $ postingDate p) (T.unpack $ paccount p) -- XXX pack diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index ab84d390f..13fcb3a6b 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -8,7 +8,7 @@ tags. -} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, LambdaCase #-} module Hledger.Data.Transaction ( -- * Transaction @@ -37,6 +37,11 @@ module Hledger.Data.Transaction ( showTransactionUnelided, showTransactionUnelidedOneLineAmounts, showPostingLine, + showPostingLines, + -- * GenericSourcePos + sourceFilePath, + sourceFirstLine, + showGenericSourcePos, -- * misc. tests_Hledger_Data_Transaction ) @@ -66,6 +71,21 @@ instance Show ModifierTransaction where instance Show PeriodicTransaction where show t = "~ " ++ T.unpack (ptperiodicexpr t) ++ "\n" ++ unlines (map show (ptpostings t)) +sourceFilePath :: GenericSourcePos -> FilePath +sourceFilePath = \case + GenericSourcePos fp _ _ -> fp + JournalSourcePos fp _ -> fp + +sourceFirstLine :: GenericSourcePos -> Int +sourceFirstLine = \case + GenericSourcePos _ line _ -> line + JournalSourcePos _ (line, _) -> line + +showGenericSourcePos :: GenericSourcePos -> String +showGenericSourcePos = \case + GenericSourcePos fp line column -> show fp ++ " (line " ++ show line ++ ", column " ++ show column ++ ")" + JournalSourcePos fp (line, line') -> show fp ++ " (lines " ++ show line ++ "-" ++ show line' ++ ")" + nullsourcepos :: GenericSourcePos nullsourcepos = GenericSourcePos "" 1 1 @@ -222,6 +242,12 @@ showPostingLine p = " " ++ showMixedAmountOneLine (pamount p) +-- | Produce posting line with all comment lines associated with it +showPostingLines :: Posting -> [String] +showPostingLines p = postingAsLines False False ps p where + ps | Just t <- ptransaction p = tpostings t + | otherwise = [p] + tests_postingAsLines = [ "postingAsLines" ~: do let p `gives` ls = assertEqual (show p) ls (postingAsLines False False [p] p) diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index d479b8a54..09f7b3fbe 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -212,8 +212,8 @@ instance Eq Posting where (==) (Posting a1 b1 c1 d1 e1 f1 g1 h1 i1 _ _) (Posting a2 b2 c2 d2 e2 f2 g2 h2 i2 _ _) = a1==a2 && b1==b2 && c1==c2 && d1==d2 && e1==e2 && f1==f2 && g1==g2 && h1==h2 && i1==i2 -- | The position of parse errors (eg), like parsec's SourcePos but generic. --- File name, 1-based line number and 1-based column number. -data GenericSourcePos = GenericSourcePos FilePath Int Int +data GenericSourcePos = GenericSourcePos FilePath Int Int -- ^ name, 1-based line number and 1-based column number. + | JournalSourcePos FilePath (Int, Int) -- ^ file name, inclusive range of 1-based line numbers (first, last). deriving (Eq, Read, Show, Ord, Data, Generic, Typeable) instance NFData GenericSourcePos diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index ce520bf30..b21940479 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -68,6 +68,13 @@ rejp = runErroringJournalParser genericSourcePos :: SourcePos -> GenericSourcePos genericSourcePos p = GenericSourcePos (sourceName p) (fromIntegral . unPos $ sourceLine p) (fromIntegral . unPos $ sourceColumn p) +journalSourcePos :: SourcePos -> SourcePos -> GenericSourcePos +journalSourcePos p p' = JournalSourcePos (sourceName p) (fromIntegral . unPos $ sourceLine p, fromIntegral $ line') + where line' + | (unPos $ sourceColumn p') == 1 = unPos (sourceLine p') - 1 + | otherwise = unPos $ sourceLine p' -- might be at end of file withat last new-line + + -- | Given a megaparsec ParsedJournal parser, balance assertion flag, file -- path and file content: parse and post-process a Journal, or give an error. parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> Bool diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 37b582631..e76f53f3c 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -426,7 +426,7 @@ periodictransactionp = do transactionp :: MonadIO m => ErroringJournalParser m Transaction transactionp = do -- ptrace "transactionp" - sourcepos <- genericSourcePos <$> getPosition + pos <- getPosition date <- datep "transaction" edate <- optional (secondarydatep date) "secondary date" lookAhead (lift spacenonewline <|> newline) "whitespace or newline" @@ -436,6 +436,8 @@ transactionp = do comment <- try followingcommentp <|> (newline >> return "") let tags = commentTags comment postings <- postingsp (Just date) + pos' <- getPosition + let sourcepos = journalSourcePos pos pos' return $ txnTieKnot $ Transaction 0 sourcepos date edate status code description comment tags postings "" #ifdef TESTS diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index c8be33e84..f2dea1ac1 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -116,6 +116,7 @@ library Hledger.Data.RawOptions Hledger.Data.Timeclock Hledger.Data.Transaction + Hledger.Data.AutoTransaction Hledger.Data.Types Hledger.Query Hledger.Read @@ -197,6 +198,7 @@ test-suite doctests Hledger.Data.Account Hledger.Data.AccountName Hledger.Data.Amount + Hledger.Data.AutoTransaction Hledger.Data.Commodity Hledger.Data.Dates Hledger.Data.Journal @@ -295,6 +297,7 @@ test-suite hunittests Hledger.Data.Account Hledger.Data.AccountName Hledger.Data.Amount + Hledger.Data.AutoTransaction Hledger.Data.Commodity Hledger.Data.Dates Hledger.Data.Journal diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index bb0add8b1..4094e7b40 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -97,6 +97,7 @@ library: - Hledger.Data.RawOptions - Hledger.Data.Timeclock - Hledger.Data.Transaction + - Hledger.Data.AutoTransaction - Hledger.Data.Types - Hledger.Query - Hledger.Read diff --git a/hledger/Hledger/Cli/Print.hs b/hledger/Hledger/Cli/Print.hs index d89d103d6..0c1f91250 100644 --- a/hledger/Hledger/Cli/Print.hs +++ b/hledger/Hledger/Cli/Print.hs @@ -10,6 +10,7 @@ module Hledger.Cli.Print ( printmode ,print' ,entriesReportAsText + ,originalTransaction ,tests_Hledger_Cli_Print ) where diff --git a/hledger/doc/commands.m4.md b/hledger/doc/commands.m4.md index 7830de7a7..c6881f71b 100644 --- a/hledger/doc/commands.m4.md +++ b/hledger/doc/commands.m4.md @@ -931,6 +931,89 @@ $ hledger rewrite -- ^income --add-posting '(liabilities:tax) *.33' $ hledger rewrite -- expenses:gifts --add-posting '(budget:gifts) *-1"' ``` +Argument for `--add-posting` option is a usual posting of transaction with an +exception for amount specification. More precisely you can use `'*'` (star +symbol) in place of currency to indicate that that this is a factor for an +amount of original matched posting. + +### Re-write rules in a file + +During the run this tool will execute so called +["Automated Transactions"](http://ledger-cli.org/3.0/doc/ledger3.html#Automated-Transactions) +found in any journal it process. I.e instead of specifying this operations in +command line you can put them in a journal file. + +```shell +$ rewrite-rules.journal +``` + +Make contents look like this: + +```journal += ^income + (liabilities:tax) *.33 + += expenses:gifts + budget:gifts *-1 + assets:budget *1 +``` + +Note that `'='` (equality symbol) that is used instead of date in transactions +you usually write. It indicates the query by which you want to match the +posting to add new ones. + +```shell +$ hledger rewrite -- -f input.journal -f rewrite-rules.journal > rewritten-tidy-output.journal +``` + +This is something similar to the commands pipeline: + +```shell +$ hledger rewrite -- -f input.journal '^income' --add-posting '(liabilities:tax) *.33' \ + | hledger rewrite -- -f - expenses:gifts --add-posting 'budget:gifts *-1' \ + --add-posting 'assets:budget *1' \ + > rewritten-tidy-output.journal +``` + +It is important to understand that relative order of such entries in journal is +important. You can re-use result of previously added postings. + +### Diff output format + +To use this tool for batch modification of your journal files you may find +useful output in form of unified diff. + +```shell +$ hledger rewrite -- --diff -f examples/sample.journal '^income' --add-posting '(liabilities:tax) *.33' +``` + +Output might look like: + +```diff +--- /tmp/examples/sample.journal ++++ /tmp/examples/sample.journal +@@ -18,3 +18,4 @@ + 2008/01/01 income +- assets:bank:checking $1 ++ assets:bank:checking $1 + income:salary ++ (liabilities:tax) 0 +@@ -22,3 +23,4 @@ + 2008/06/01 gift +- assets:bank:checking $1 ++ assets:bank:checking $1 + income:gifts ++ (liabilities:tax) 0 +``` + +If you'll pass this through `patch` tool you'll get transactions containing the +posting that matches your query be updated. Note that multiple files might be +update according to list of input files specified via `--file` options and +`include` directives inside of these files. + +Be careful. Whole transaction being re-formatted in a style of output from +`hledger print`. + ## ui Curses-style interface, see [hledger-ui](hledger-ui.html). diff --git a/tests/bin/rewrite.test b/tests/bin/rewrite.test index 6adbf3833..11d210da1 100644 --- a/tests/bin/rewrite.test +++ b/tests/bin/rewrite.test @@ -35,7 +35,7 @@ runghc ../../bin/hledger-rewrite.hs -f- expenses:gifts --add-posting '(budget:gi 2016/1/1 gift assets:cash $-15 - expenses:gifts + expenses:gifts ; [1/2] >>> 2016/01/01 withdraw assets:cash $20 @@ -43,8 +43,8 @@ runghc ../../bin/hledger-rewrite.hs -f- expenses:gifts --add-posting '(budget:gi 2016/01/01 gift assets:cash $-15 - expenses:gifts - (budget:gifts) $-15 + expenses:gifts ; [1/2] + (budget:gifts) $-15 ; [2016/01/02] >>>2 >>>=0 @@ -83,9 +83,12 @@ runghc ../../bin/hledger-rewrite.hs -f- assets:bank and 'amt:<0' --add-posting ' # Rewrite rule within journal runghc ../../bin/hledger-rewrite.hs -f- date:2017/1 --add-posting 'Here comes Santa $0' <<< += ^assets:bank$ date:2017/1 amt:<0 + assets:bank *0.008 + expenses:fee *-0.008 ; cash withdraw fee = ^expenses:housing (budget:housing) *-1 -= ^expenses:grocery or ^expenses:food += ^expenses:grocery ^expenses:food (budget:food) *-1 2016/12/31 @@ -106,12 +109,10 @@ runghc ../../bin/hledger-rewrite.hs -f- date:2017/1 --add-posting 'Here comes S assets:cash $100.00 assets:bank +; order with normal entries doesn't matter +; but relative order matters to refer-rewritten transactions = ^expenses not:housing not:grocery not:food (budget:misc) *-1 - -= ^assets:bank$ date:2017/1 amt:<0 - assets:bank *0.008 - expenses:fee *-0.008 ; cash withdraw fee >>> 2016/12/31 expenses:housing $600.00 @@ -126,9 +127,9 @@ runghc ../../bin/hledger-rewrite.hs -f- date:2017/1 --add-posting 'Here comes S Here comes Santa 0 Here comes Santa 0 Here comes Santa 0 - (budget:misc) $-15.00 (budget:food) $-20.00 (budget:food) $-30.00 + (budget:misc) $-15.00 2017/01/02 assets:cash $200.00 @@ -145,3 +146,31 @@ runghc ../../bin/hledger-rewrite.hs -f- date:2017/1 --add-posting 'Here comes S >>>2 >>>=0 + +# Rewrite using diff output +runghc ../../bin/hledger-rewrite.hs --diff -f- assets:bank and 'amt:<0' --add-posting 'expenses:fee $5' --add-posting 'assets:bank $-5' +<<< +2016/01/01 withdraw + assets:cash $20 + assets:bank + +2016/01/02 withdraw + assets:cash + assets:bank $-30 +>>> +--- - ++++ - +@@ -1,3 +1,5 @@ + 2016/01/01 withdraw + assets:cash $20 + assets:bank ++ expenses:fee $5 ++ assets:bank $-5 +@@ -5,3 +7,5 @@ + 2016/01/02 withdraw + assets:cash + assets:bank $-30 ++ expenses:fee $5 ++ assets:bank $-5 +>>>2 +>>>=0 diff --git a/tests/journal/balance-assertions.test b/tests/journal/balance-assertions.test index 682c2021a..a1e566c49 100755 --- a/tests/journal/balance-assertions.test +++ b/tests/journal/balance-assertions.test @@ -57,7 +57,7 @@ hledger -f - stats b $-1 = $-3 >>> ->>>2 /balance assertion error.*line 9, column 1/ +>>>2 /balance assertion error.*lines 9-12/ >>>=1 # 4. should also work without commodity symbols @@ -307,4 +307,4 @@ hledger -f - stats b = 0 zorkmids >>> /Transactions/ >>>2 ->>>=0 \ No newline at end of file +>>>=0