d685d1aa9b
This removes transactionModifierToFunction's extra query parameter; the rewrite command sets it in the TransactionModifier instead, which I think is equivalent. I had to change one functional test, but it seems correct now, so perhaps it wasn't working right before ?
290 lines
11 KiB
Haskell
Executable File
290 lines
11 KiB
Haskell
Executable File
{-# LANGUAGE OverloadedStrings, LambdaCase, DeriveTraversable, ViewPatterns, QuasiQuotes #-}
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Hledger.Cli.Commands.Rewrite (
|
|
rewritemode
|
|
,rewrite
|
|
)
|
|
where
|
|
|
|
#if !(MIN_VERSION_base(4,11,0))
|
|
import Control.Monad.Writer
|
|
#endif
|
|
import Data.Functor.Identity
|
|
import Data.List (sortOn, foldl')
|
|
import Data.String.Here
|
|
import qualified Data.Text as T
|
|
import Hledger
|
|
import Hledger.Cli.CliOptions
|
|
import Hledger.Cli.Commands.Print
|
|
import System.Console.CmdArgs.Explicit
|
|
import Text.Printf
|
|
import Text.Megaparsec
|
|
import qualified Data.Algorithm.Diff as D
|
|
|
|
rewritemode = hledgerCommandMode
|
|
[here| rewrite
|
|
Print all transactions, rewriting the postings of matched transactions.
|
|
For now the only rewrite available is adding new postings, like print --auto.
|
|
|
|
FLAGS
|
|
|
|
This is a start at a generic rewriter of transaction entries.
|
|
It reads the default journal and prints the transactions, like print,
|
|
but adds one or more specified postings to any transactions matching QUERY.
|
|
The posting amounts can be fixed, or a multiplier of the existing transaction's first posting amount.
|
|
|
|
Examples:
|
|
```
|
|
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.
|
|
|
|
More:
|
|
|
|
```shell
|
|
$ hledger rewrite -- [QUERY] --add-posting "ACCT AMTEXPR" ...
|
|
$ hledger rewrite -- ^income --add-posting '(liabilities:tax) *.33'
|
|
$ hledger rewrite -- expenses:gifts --add-posting '(budget:gifts) *-1"'
|
|
$ hledger rewrite -- ^income --add-posting '(budget:foreign currency) *0.25 JPY; diversify'
|
|
```
|
|
|
|
Argument for `--add-posting` option is a usual posting of transaction with an
|
|
exception for amount specification. More precisely, you can use `'*'` (star
|
|
symbol) before the amount to indicate that that this is a factor for an
|
|
amount of original matched posting. If the amount includes a commodity name,
|
|
the new posting amount will be in the new commodity; otherwise, it will be in
|
|
the matched posting amount's commodity.
|
|
|
|
#### 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`.
|
|
|
|
See also:
|
|
|
|
https://github.com/simonmichael/hledger/issues/99
|
|
|
|
#### rewrite vs. print --auto
|
|
|
|
This command predates print --auto, and currently does much the same thing,
|
|
but with these differences:
|
|
|
|
- with multiple files, rewrite lets rules in any file affect all other files.
|
|
print --auto uses standard directive scoping; rules affect only child files.
|
|
|
|
- rewrite's query limits which transactions can be rewritten; all are printed.
|
|
print --auto's query limits which transactions are printed.
|
|
|
|
- rewrite applies rules specified on command line or in the journal.
|
|
print --auto applies rules specified in the journal.
|
|
|
|
|]
|
|
[flagReq ["add-posting"] (\s opts -> Right $ setopt "add-posting" s opts) "'ACCT AMTEXPR'"
|
|
"add a posting to ACCT, which may be parenthesised. AMTEXPR is either a literal amount, or *N which means the transaction's first matched amount multiplied by N (a decimal number). Two spaces separate ACCT and AMTEXPR."
|
|
,flagNone ["diff"] (setboolopt "diff") "generate diff suitable as an input for patch tool"
|
|
]
|
|
[generalflagsgroup1]
|
|
[]
|
|
([], Just $ argsFlag "[QUERY] --add-posting \"ACCT AMTEXPR\" ...")
|
|
------------------------------------------------------------------------------
|
|
|
|
-- TODO regex matching and interpolating matched name in replacement
|
|
-- TODO interpolating match groups in replacement
|
|
-- TODO allow using this on unbalanced entries, eg to rewrite while editing
|
|
|
|
rewrite opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j@Journal{jtxns=ts} = do
|
|
-- create re-writer
|
|
let modifiers = transactionModifierFromOpts opts : jtxnmodifiers j
|
|
applyallmodifiers = foldr (flip (.) . transactionModifierToFunction) id modifiers
|
|
-- rewrite matched transactions
|
|
let j' = j{jtxns=map applyallmodifiers ts}
|
|
-- run the print command, showing all transactions, or show diffs
|
|
printOrDiff rawopts opts{reportopts_=ropts{query_=""}} j j'
|
|
|
|
-- | Build a 'TransactionModifier' from any query arguments and --add-posting flags
|
|
-- provided on the command line, or throw a parse error.
|
|
transactionModifierFromOpts :: CliOpts -> TransactionModifier
|
|
transactionModifierFromOpts CliOpts{rawopts_=rawopts,reportopts_=ropts} =
|
|
TransactionModifier{tmquerytxt=q, tmpostings=ps}
|
|
where
|
|
q = T.pack $ query_ ropts
|
|
ps = map (parseposting . stripquotes . T.pack) $ listofstringopt "add-posting" rawopts
|
|
parseposting t = either (error' . parseErrorPretty' t') id ep
|
|
where
|
|
ep = runIdentity (runJournalParser (postingp Nothing <* eof) t')
|
|
t' = " " <> t <> "\n" -- inject space and newline for proper parsing
|
|
|
|
printOrDiff :: RawOpts -> (CliOpts -> Journal -> Journal -> IO ())
|
|
printOrDiff opts
|
|
| boolopt "diff" opts = const diffOutput
|
|
| otherwise = flip (const print')
|
|
|
|
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
|
|
|
|
type Chunk = (GenericSourcePos, [DiffLine String])
|
|
|
|
-- | 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
|
|
|
|
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@(JournalSourcePos 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
|