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
This commit is contained in:
parent
c61de771d4
commit
7437c96ff6
@ -4,8 +4,9 @@
|
|||||||
--package hledger
|
--package hledger
|
||||||
--package megaparsec
|
--package megaparsec
|
||||||
--package text
|
--package text
|
||||||
|
--package Diff
|
||||||
-}
|
-}
|
||||||
{-# LANGUAGE OverloadedStrings, LambdaCase #-}
|
{-# LANGUAGE OverloadedStrings, LambdaCase, DeriveTraversable, ViewPatterns #-}
|
||||||
{-
|
{-
|
||||||
|
|
||||||
hledger-rewrite [PATTERNS] --add-posting "ACCT AMTEXPR" ...
|
hledger-rewrite [PATTERNS] --add-posting "ACCT AMTEXPR" ...
|
||||||
@ -16,8 +17,16 @@ but adds the specified postings to any entries matching PATTERNS.
|
|||||||
|
|
||||||
Examples:
|
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 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.
|
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.
|
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
|
import qualified Data.Text as T
|
||||||
-- hledger lib, cli and cmdargs utils
|
-- hledger lib, cli and cmdargs utils
|
||||||
import Hledger.Cli
|
import Hledger.Cli hiding (outputflags)
|
||||||
-- more utils for parsing
|
-- more utils for parsing
|
||||||
-- #if !MIN_VERSION_base(4,8,0)
|
-- #if !MIN_VERSION_base(4,8,0)
|
||||||
-- import Control.Applicative.Compat ((<*))
|
-- import Control.Applicative.Compat ((<*))
|
||||||
-- #endif
|
-- #endif
|
||||||
|
import Text.Printf
|
||||||
import Text.Megaparsec
|
import Text.Megaparsec
|
||||||
import Text.Megaparsec.Text
|
import qualified Data.Algorithm.Diff as D
|
||||||
|
import Hledger.Data.AutoTransaction (runModifierTransaction)
|
||||||
|
|
||||||
cmdmode :: Mode RawOpts
|
cmdmode :: Mode RawOpts
|
||||||
cmdmode = (defCommandMode ["hledger-rewrite"]) {
|
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"
|
,modeHelp = "print all journal entries, with custom postings added to the matched ones"
|
||||||
,modeGroupFlags = Group {
|
,modeGroupFlags = Group {
|
||||||
groupNamed = [("Input", inputflags)
|
groupNamed = [("Input", inputflags)
|
||||||
|
,("Output", outputflags)
|
||||||
,("Reporting", reportflags)
|
,("Reporting", reportflags)
|
||||||
,("Misc", helpflags)
|
,("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.Text -> IO Posting
|
||||||
postingp' t = runErroringJournalParser (postingp Nothing <* eof) t' >>= \case
|
postingp' t = runErroringJournalParser (postingp Nothing <* eof) t' >>= \case
|
||||||
Left err -> fail err
|
Left err -> fail err
|
||||||
@ -70,41 +86,109 @@ modifierTransactionFromOpts opts = do
|
|||||||
return
|
return
|
||||||
ModifierTransaction { mtvalueexpr = T.empty, mtpostings = postings }
|
ModifierTransaction { mtvalueexpr = T.empty, mtpostings = postings }
|
||||||
|
|
||||||
post' :: AccountName -> Amount -> Posting
|
outputFromOpts :: RawOpts -> (CliOpts -> Journal -> Journal -> IO ())
|
||||||
post' acct amt = (accountNameWithoutPostingType acct `post` amt) { ptype = accountNamePostingType acct }
|
outputFromOpts opts
|
||||||
|
| boolopt "diff" opts = const diffOutput
|
||||||
|
| otherwise = flip (const print')
|
||||||
|
|
||||||
-- mtvaluequery :: ModifierTransaction -> Day -> Query
|
diffOutput :: Journal -> Journal -> IO ()
|
||||||
mtvaluequery mod = fst . flip parseQuery (mtvalueexpr mod)
|
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
|
type Chunk = (GenericSourcePos, [DiffLine String])
|
||||||
postingScale p =
|
|
||||||
case amounts $ pamount p of
|
|
||||||
[a] | acommodity a == "*" -> Just $ aquantity a
|
|
||||||
_ -> Nothing
|
|
||||||
|
|
||||||
runModifierPosting :: Posting -> (Posting -> Posting)
|
-- | Render list of changed lines as a unified diff
|
||||||
runModifierPosting p' =
|
--
|
||||||
case postingScale p' of
|
-- >>> putStr $ renderPatch [(GenericSourcePos "a" 1 1, [D.First "x", D.Second "y"])]
|
||||||
Nothing -> \p -> p' { ptransaction = ptransaction p }
|
-- --- a
|
||||||
Just n -> \p -> p' { pamount = pamount p `divideMixedAmount` (1/n), ptransaction = ptransaction p }
|
-- +++ 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)
|
countDiff (dels, adds) = \case
|
||||||
runModifierTransaction q mod = modifier where
|
Del _ -> (dels + 1, adds)
|
||||||
q' = simplifyQuery $ And [q, mtvaluequery mod (error "query cannot depend on current time")]
|
Add _ -> (dels , adds + 1)
|
||||||
mods = map runModifierPosting $ mtpostings mod
|
Ctx _ -> (dels + 1, adds + 1)
|
||||||
generatePostings ps = [mod p | p <- ps, q' `matchesPosting` p, mod <- mods]
|
|
||||||
modifier t@Transaction{ tpostings = ps } = t { tpostings = ps ++ generatePostings ps }
|
|
||||||
|
|
||||||
|
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
|
main = do
|
||||||
opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} <- getCliOpts cmdmode
|
opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} <- getCliOpts cmdmode
|
||||||
d <- getCurrentDay
|
d <- getCurrentDay
|
||||||
let q = queryFromOpts d ropts
|
let q = queryFromOpts d ropts
|
||||||
mod <- modifierTransactionFromOpts rawopts
|
modifier <- modifierTransactionFromOpts rawopts
|
||||||
withJournalDo opts $ \opts j@Journal{jtxns=ts} -> do
|
withJournalDo opts $ \opts' j@Journal{jtxns=ts} -> do
|
||||||
-- create re-writer
|
-- create re-writer
|
||||||
let mods = jmodifiertxns j ++ [mod]
|
let modifiers = modifier : jmodifiertxns j
|
||||||
modifier = foldr (.) id $ map (runModifierTransaction q) mods
|
-- 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
|
-- rewrite matched transactions
|
||||||
let j' = j{jtxns=map modifier ts}
|
let j' = j{jtxns=map modifier' ts}
|
||||||
-- run the print command, showing all transactions
|
-- run the print command, showing all transactions
|
||||||
print' opts{reportopts_=ropts{query_=""}} j'
|
outputFromOpts rawopts opts'{reportopts_=ropts{query_=""}} j j'
|
||||||
|
|||||||
103
hledger-lib/Hledger/Data/AutoTransaction.hs
Normal file
103
hledger-lib/Hledger/Data/AutoTransaction.hs
Normal file
@ -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
|
||||||
|
-- <BLANKLINE>
|
||||||
|
-- <BLANKLINE>
|
||||||
|
-- >>> runModifierTransaction Any (ModifierTransaction "miss" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
|
||||||
|
-- 0000/01/01
|
||||||
|
-- ping $1.00
|
||||||
|
-- <BLANKLINE>
|
||||||
|
-- <BLANKLINE>
|
||||||
|
-- >>> runModifierTransaction None (ModifierTransaction "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
|
||||||
|
-- 0000/01/01
|
||||||
|
-- ping $1.00
|
||||||
|
-- <BLANKLINE>
|
||||||
|
-- <BLANKLINE>
|
||||||
|
-- >>> 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
|
||||||
|
-- <BLANKLINE>
|
||||||
|
-- <BLANKLINE>
|
||||||
|
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 <> "]"]
|
||||||
@ -529,9 +529,8 @@ checkBalanceAssertion p@Posting{ pbalanceassertion = Just ass} amt
|
|||||||
])
|
])
|
||||||
(case ptransaction p of
|
(case ptransaction p of
|
||||||
Nothing -> ":" -- shouldn't happen
|
Nothing -> ":" -- shouldn't happen
|
||||||
Just t -> printf " in \"%s\" (line %d, column %d):\nin transaction:\n%s"
|
Just t -> printf " in %s:\nin transaction:\n%s"
|
||||||
f l c (chomp $ show t) :: String
|
(showGenericSourcePos $ tsourcepos t) (chomp $ show t) :: String)
|
||||||
where GenericSourcePos f l c = tsourcepos t)
|
|
||||||
(showPostingLine p)
|
(showPostingLine p)
|
||||||
(showDate $ postingDate p)
|
(showDate $ postingDate p)
|
||||||
(T.unpack $ paccount p) -- XXX pack
|
(T.unpack $ paccount p) -- XXX pack
|
||||||
|
|||||||
@ -8,7 +8,7 @@ tags.
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings, LambdaCase #-}
|
||||||
|
|
||||||
module Hledger.Data.Transaction (
|
module Hledger.Data.Transaction (
|
||||||
-- * Transaction
|
-- * Transaction
|
||||||
@ -37,6 +37,11 @@ module Hledger.Data.Transaction (
|
|||||||
showTransactionUnelided,
|
showTransactionUnelided,
|
||||||
showTransactionUnelidedOneLineAmounts,
|
showTransactionUnelidedOneLineAmounts,
|
||||||
showPostingLine,
|
showPostingLine,
|
||||||
|
showPostingLines,
|
||||||
|
-- * GenericSourcePos
|
||||||
|
sourceFilePath,
|
||||||
|
sourceFirstLine,
|
||||||
|
showGenericSourcePos,
|
||||||
-- * misc.
|
-- * misc.
|
||||||
tests_Hledger_Data_Transaction
|
tests_Hledger_Data_Transaction
|
||||||
)
|
)
|
||||||
@ -66,6 +71,21 @@ instance Show ModifierTransaction where
|
|||||||
instance Show PeriodicTransaction where
|
instance Show PeriodicTransaction where
|
||||||
show t = "~ " ++ T.unpack (ptperiodicexpr t) ++ "\n" ++ unlines (map show (ptpostings t))
|
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
|
||||||
nullsourcepos = GenericSourcePos "" 1 1
|
nullsourcepos = GenericSourcePos "" 1 1
|
||||||
|
|
||||||
@ -222,6 +242,12 @@ showPostingLine p =
|
|||||||
" " ++
|
" " ++
|
||||||
showMixedAmountOneLine (pamount 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 = [
|
tests_postingAsLines = [
|
||||||
"postingAsLines" ~: do
|
"postingAsLines" ~: do
|
||||||
let p `gives` ls = assertEqual (show p) ls (postingAsLines False False [p] p)
|
let p `gives` ls = assertEqual (show p) ls (postingAsLines False False [p] p)
|
||||||
|
|||||||
@ -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
|
(==) (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.
|
-- | 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 -- ^ name, 1-based line number and 1-based column number.
|
||||||
data GenericSourcePos = GenericSourcePos FilePath Int Int
|
| JournalSourcePos FilePath (Int, Int) -- ^ file name, inclusive range of 1-based line numbers (first, last).
|
||||||
deriving (Eq, Read, Show, Ord, Data, Generic, Typeable)
|
deriving (Eq, Read, Show, Ord, Data, Generic, Typeable)
|
||||||
|
|
||||||
instance NFData GenericSourcePos
|
instance NFData GenericSourcePos
|
||||||
|
|||||||
@ -68,6 +68,13 @@ rejp = runErroringJournalParser
|
|||||||
genericSourcePos :: SourcePos -> GenericSourcePos
|
genericSourcePos :: SourcePos -> GenericSourcePos
|
||||||
genericSourcePos p = GenericSourcePos (sourceName p) (fromIntegral . unPos $ sourceLine p) (fromIntegral . unPos $ sourceColumn p)
|
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
|
-- | Given a megaparsec ParsedJournal parser, balance assertion flag, file
|
||||||
-- path and file content: parse and post-process a Journal, or give an error.
|
-- path and file content: parse and post-process a Journal, or give an error.
|
||||||
parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> Bool
|
parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> Bool
|
||||||
|
|||||||
@ -426,7 +426,7 @@ periodictransactionp = do
|
|||||||
transactionp :: MonadIO m => ErroringJournalParser m Transaction
|
transactionp :: MonadIO m => ErroringJournalParser m Transaction
|
||||||
transactionp = do
|
transactionp = do
|
||||||
-- ptrace "transactionp"
|
-- ptrace "transactionp"
|
||||||
sourcepos <- genericSourcePos <$> getPosition
|
pos <- getPosition
|
||||||
date <- datep <?> "transaction"
|
date <- datep <?> "transaction"
|
||||||
edate <- optional (secondarydatep date) <?> "secondary date"
|
edate <- optional (secondarydatep date) <?> "secondary date"
|
||||||
lookAhead (lift spacenonewline <|> newline) <?> "whitespace or newline"
|
lookAhead (lift spacenonewline <|> newline) <?> "whitespace or newline"
|
||||||
@ -436,6 +436,8 @@ transactionp = do
|
|||||||
comment <- try followingcommentp <|> (newline >> return "")
|
comment <- try followingcommentp <|> (newline >> return "")
|
||||||
let tags = commentTags comment
|
let tags = commentTags comment
|
||||||
postings <- postingsp (Just date)
|
postings <- postingsp (Just date)
|
||||||
|
pos' <- getPosition
|
||||||
|
let sourcepos = journalSourcePos pos pos'
|
||||||
return $ txnTieKnot $ Transaction 0 sourcepos date edate status code description comment tags postings ""
|
return $ txnTieKnot $ Transaction 0 sourcepos date edate status code description comment tags postings ""
|
||||||
|
|
||||||
#ifdef TESTS
|
#ifdef TESTS
|
||||||
|
|||||||
@ -116,6 +116,7 @@ library
|
|||||||
Hledger.Data.RawOptions
|
Hledger.Data.RawOptions
|
||||||
Hledger.Data.Timeclock
|
Hledger.Data.Timeclock
|
||||||
Hledger.Data.Transaction
|
Hledger.Data.Transaction
|
||||||
|
Hledger.Data.AutoTransaction
|
||||||
Hledger.Data.Types
|
Hledger.Data.Types
|
||||||
Hledger.Query
|
Hledger.Query
|
||||||
Hledger.Read
|
Hledger.Read
|
||||||
@ -197,6 +198,7 @@ test-suite doctests
|
|||||||
Hledger.Data.Account
|
Hledger.Data.Account
|
||||||
Hledger.Data.AccountName
|
Hledger.Data.AccountName
|
||||||
Hledger.Data.Amount
|
Hledger.Data.Amount
|
||||||
|
Hledger.Data.AutoTransaction
|
||||||
Hledger.Data.Commodity
|
Hledger.Data.Commodity
|
||||||
Hledger.Data.Dates
|
Hledger.Data.Dates
|
||||||
Hledger.Data.Journal
|
Hledger.Data.Journal
|
||||||
@ -295,6 +297,7 @@ test-suite hunittests
|
|||||||
Hledger.Data.Account
|
Hledger.Data.Account
|
||||||
Hledger.Data.AccountName
|
Hledger.Data.AccountName
|
||||||
Hledger.Data.Amount
|
Hledger.Data.Amount
|
||||||
|
Hledger.Data.AutoTransaction
|
||||||
Hledger.Data.Commodity
|
Hledger.Data.Commodity
|
||||||
Hledger.Data.Dates
|
Hledger.Data.Dates
|
||||||
Hledger.Data.Journal
|
Hledger.Data.Journal
|
||||||
|
|||||||
@ -97,6 +97,7 @@ library:
|
|||||||
- Hledger.Data.RawOptions
|
- Hledger.Data.RawOptions
|
||||||
- Hledger.Data.Timeclock
|
- Hledger.Data.Timeclock
|
||||||
- Hledger.Data.Transaction
|
- Hledger.Data.Transaction
|
||||||
|
- Hledger.Data.AutoTransaction
|
||||||
- Hledger.Data.Types
|
- Hledger.Data.Types
|
||||||
- Hledger.Query
|
- Hledger.Query
|
||||||
- Hledger.Read
|
- Hledger.Read
|
||||||
|
|||||||
@ -10,6 +10,7 @@ module Hledger.Cli.Print (
|
|||||||
printmode
|
printmode
|
||||||
,print'
|
,print'
|
||||||
,entriesReportAsText
|
,entriesReportAsText
|
||||||
|
,originalTransaction
|
||||||
,tests_Hledger_Cli_Print
|
,tests_Hledger_Cli_Print
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|||||||
@ -931,6 +931,89 @@ $ hledger rewrite -- ^income --add-posting '(liabilities:tax) *.33'
|
|||||||
$ hledger rewrite -- expenses:gifts --add-posting '(budget:gifts) *-1"'
|
$ 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
|
## ui
|
||||||
Curses-style interface, see [hledger-ui](hledger-ui.html).
|
Curses-style interface, see [hledger-ui](hledger-ui.html).
|
||||||
|
|
||||||
|
|||||||
@ -35,7 +35,7 @@ runghc ../../bin/hledger-rewrite.hs -f- expenses:gifts --add-posting '(budget:gi
|
|||||||
|
|
||||||
2016/1/1 gift
|
2016/1/1 gift
|
||||||
assets:cash $-15
|
assets:cash $-15
|
||||||
expenses:gifts
|
expenses:gifts ; [1/2]
|
||||||
>>>
|
>>>
|
||||||
2016/01/01 withdraw
|
2016/01/01 withdraw
|
||||||
assets:cash $20
|
assets:cash $20
|
||||||
@ -43,8 +43,8 @@ runghc ../../bin/hledger-rewrite.hs -f- expenses:gifts --add-posting '(budget:gi
|
|||||||
|
|
||||||
2016/01/01 gift
|
2016/01/01 gift
|
||||||
assets:cash $-15
|
assets:cash $-15
|
||||||
expenses:gifts
|
expenses:gifts ; [1/2]
|
||||||
(budget:gifts) $-15
|
(budget:gifts) $-15 ; [2016/01/02]
|
||||||
|
|
||||||
>>>2
|
>>>2
|
||||||
>>>=0
|
>>>=0
|
||||||
@ -83,9 +83,12 @@ runghc ../../bin/hledger-rewrite.hs -f- assets:bank and 'amt:<0' --add-posting '
|
|||||||
# Rewrite rule within journal
|
# Rewrite rule within journal
|
||||||
runghc ../../bin/hledger-rewrite.hs -f- date:2017/1 --add-posting 'Here comes Santa $0'
|
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
|
= ^expenses:housing
|
||||||
(budget:housing) *-1
|
(budget:housing) *-1
|
||||||
= ^expenses:grocery or ^expenses:food
|
= ^expenses:grocery ^expenses:food
|
||||||
(budget:food) *-1
|
(budget:food) *-1
|
||||||
|
|
||||||
2016/12/31
|
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:cash $100.00
|
||||||
assets:bank
|
assets:bank
|
||||||
|
|
||||||
|
; order with normal entries doesn't matter
|
||||||
|
; but relative order matters to refer-rewritten transactions
|
||||||
= ^expenses not:housing not:grocery not:food
|
= ^expenses not:housing not:grocery not:food
|
||||||
(budget:misc) *-1
|
(budget:misc) *-1
|
||||||
|
|
||||||
= ^assets:bank$ date:2017/1 amt:<0
|
|
||||||
assets:bank *0.008
|
|
||||||
expenses:fee *-0.008 ; cash withdraw fee
|
|
||||||
>>>
|
>>>
|
||||||
2016/12/31
|
2016/12/31
|
||||||
expenses:housing $600.00
|
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
|
Here comes Santa 0
|
||||||
Here comes Santa 0
|
Here comes Santa 0
|
||||||
(budget:misc) $-15.00
|
|
||||||
(budget:food) $-20.00
|
(budget:food) $-20.00
|
||||||
(budget:food) $-30.00
|
(budget:food) $-30.00
|
||||||
|
(budget:misc) $-15.00
|
||||||
|
|
||||||
2017/01/02
|
2017/01/02
|
||||||
assets:cash $200.00
|
assets:cash $200.00
|
||||||
@ -145,3 +146,31 @@ runghc ../../bin/hledger-rewrite.hs -f- date:2017/1 --add-posting 'Here comes S
|
|||||||
|
|
||||||
>>>2
|
>>>2
|
||||||
>>>=0
|
>>>=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
|
||||||
|
|||||||
@ -57,7 +57,7 @@ hledger -f - stats
|
|||||||
b $-1 = $-3
|
b $-1 = $-3
|
||||||
|
|
||||||
>>>
|
>>>
|
||||||
>>>2 /balance assertion error.*line 9, column 1/
|
>>>2 /balance assertion error.*lines 9-12/
|
||||||
>>>=1
|
>>>=1
|
||||||
|
|
||||||
# 4. should also work without commodity symbols
|
# 4. should also work without commodity symbols
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user