slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

extra: hledger-rewrite improvements

Browse Source
This commit is contained in:
Simon Michael 2014-02-05 13:56:49 -08:00
parent dc8b687056
commit 9ae7831f2d
1 changed files with 32 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
extra/hledger-rewrite.hs
View File

@ -1,11 +1,13 @@
#!/usr/bin/env runhaskell #!/usr/bin/env runhaskell
{-| {-|
hledger-rewrite PATTERNS --add-posting "ACCT AMTEXPR" ... hledger-rewrite [PATTERNS] [--add-posting "ACCT AMTEXPR"] ...
Skeleton for a minimal generic rewriter of journal entries. Skeleton for a minimal generic rewriter of journal entries.
Reads the default journal and prints the entries, like print, Reads the default journal and prints the entries, like print,
but adds the specified postings to any entries matching PATTERNS. but adds the specified postings to any entries matching PATTERNS.
Tested-with: hledger 0.22.2
|-} |-}
import Hledger.Data.Types (Journal(..)) import Hledger.Data.Types (Journal(..))
@ -13,18 +15,32 @@ import Hledger
import Hledger.Cli import Hledger.Cli
main = do main = do
putStrLn "(-f option not supported)" opts@CliOpts{reportopts_=ropts} <- getCliOpts (defCommandMode ["hledger-rewrite"])
opts <- getCliOpts (defCommandMode ["hledger-rewrite"]) d <- getCurrentDay
withJournalDo opts $ let
\opts j@Journal{jtxns=ts} -> print' opts j{jtxns=map rewrite ts} q = queryFromOpts d ropts
where -- parse added postings from args.. hard-coded here:
rewrite t = if matched t then t{tpostings=tpostings t ++ newps t} addps :: [(AccountName, Transaction -> MixedAmount)]
else t addps = [
matched t = Acct "^income" `matchesTransaction` t ("(Reserve)", (\t -> (t `firstAmountMatching` q) `divideMixedAmount` 10))
newps t = [generatePosting t "(Reserve)" (`divideMixedAmount` 10)] ]
generatePosting t acct amtfn = nullposting{paccount = accountNameWithoutPostingType acct
,ptype = accountNamePostingType acct withJournalDo opts $ \opts j@Journal{jtxns=ts} -> do
,pamount = amtfn amt -- rewrite matched transactions
} let j' = j{jtxns=map (\t -> if q `matchesTransaction` t then rewriteTransaction t addps else t) ts}
where -- print' opts j'
amt = pamount $ head $ filter (Acct "^income" `matchesPosting`) $ tpostings t -- print all transactions (without filtering)
putStr $ showTransactions ropts Any j'
rewriteTransaction :: Transaction -> [(AccountName, Transaction -> MixedAmount)] -> Transaction
rewriteTransaction t addps = t{tpostings=tpostings t ++ map (uncurry (generatePosting t)) addps}
generatePosting :: Transaction -> AccountName -> (Transaction -> MixedAmount) -> Posting
generatePosting t acct amtfn = nullposting{paccount = accountNameWithoutPostingType acct
,ptype = accountNamePostingType acct
,pamount = amtfn t
,ptransaction = Just t
}
firstAmountMatching :: Transaction -> Query -> MixedAmount
firstAmountMatching t q = pamount $ head $ filter (q `matchesPosting`) $ tpostings t