From d5c2ed4fa763c5c733a8bc04b7b5bd3d82c4b4a7 Mon Sep 17 00:00:00 2001 From: Mykola Orliuk Date: Tue, 17 Jan 2017 01:47:30 +0200 Subject: [PATCH] budget: bucketing --- bin/hledger-budget.hs | 53 ++++++++++++++++++++-- tests/bin/budget.test | 103 +++++++++++++++++++++++++++++++++++++++++- 2 files changed, 150 insertions(+), 6 deletions(-) diff --git a/bin/hledger-budget.hs b/bin/hledger-budget.hs index 031d90a24..82ec4ba19 100755 --- a/bin/hledger-budget.hs +++ b/bin/hledger-budget.hs @@ -5,14 +5,22 @@ --package text -} {-# LANGUAGE OverloadedStrings #-} +import Control.Arrow (first) +import Data.Maybe import Data.List import System.Console.CmdArgs import Hledger.Cli import Hledger.Cli.Main (mainmode) import Hledger.Data.AutoTransaction +budgetFlags :: [Flag RawOpts] +budgetFlags = + [ flagNone ["no-buckets"] (setboolopt "no-buckets") "show all accounts besides mentioned in periodic transactions" + , flagNone ["no-offset"] (setboolopt "no-offset") "do not add up periodic transactions" + ] + actions :: [(Mode RawOpts, CliOpts -> IO ())] -actions = +actions = first injectBudgetFlags <$> [ (manmode, man) , (infomode, info') , (balancemode, flip withJournalDo' balance) @@ -23,6 +31,21 @@ actions = , (printmode, flip withJournalDo' print') ] +injectBudgetFlags :: Mode RawOpts -> Mode RawOpts +injectBudgetFlags = injectFlags "\nBudgeting" budgetFlags + +-- maybe lenses will help... +injectFlags :: String -> [Flag RawOpts] -> Mode RawOpts -> Mode RawOpts +injectFlags section flags mode0 = mode' where + mode' = mode0 { modeGroupFlags = groupFlags' } + groupFlags0 = modeGroupFlags mode0 + groupFlags' = groupFlags0 { groupNamed = namedFlags' } + namedFlags0 = groupNamed groupFlags0 + namedFlags' = + case ((section ==) . fst) `partition` namedFlags0 of + ([g], gs) -> (fst g, snd g ++ flags) : gs + _ -> (section, flags) : namedFlags0 + cmdmode :: Mode RawOpts cmdmode = (mainmode []) { modeNames = ["hledger-budget"] @@ -47,21 +70,41 @@ withJournalDo' opts = withJournalDo opts . wrapper where mtxns = jmodifiertxns j dates = jdatespan j ts' = map modifier $ jtxns j - ts'' = [makeBudget t | pt <- jperiodictxns j, t <- runPeriodicTransaction pt dates] ++ ts' + ts'' | boolopt "no-offset" $ rawopts_ opts' = ts' + | otherwise= [makeBudget t | pt <- jperiodictxns j, t <- runPeriodicTransaction pt dates] ++ ts' makeBudget t = txnTieKnot $ t { tdescription = "Budget transaction" , tpostings = map makeBudgetPosting $ tpostings t } makeBudgetPosting p = p { pamount = negate $ pamount p } j' <- journalBalanceTransactions' opts' j{ jtxns = ts'' } - f opts' j' + + -- re-map account names into buckets from periodic transaction + let buckets = budgetBuckets j + remapAccount "" = "" + remapAccount an + | an `elem` buckets = an + | otherwise = remapAccount (parentAccountName an) + remapPosting p = p { paccount = remapAccount $ paccount p, porigin = Just . fromMaybe p $ porigin p } + remapTxn = mapPostings (map remapPosting) + let j'' | boolopt "no-buckets" $ rawopts_ opts' = j' + | null buckets = j' + | otherwise = j' { jtxns = remapTxn <$> jtxns j' } + + -- finally feed to real command + f opts' j'' + +budgetBuckets :: Journal -> [AccountName] +budgetBuckets = nub . map paccount . concatMap ptpostings . jperiodictxns + +mapPostings :: ([Posting] -> [Posting]) -> (Transaction -> Transaction) +mapPostings f t = txnTieKnot $ t { tpostings = f $ tpostings t } main :: IO () main = do rawopts <- fmap decodeRawOpts . processArgs $ cmdmode opts <- rawOptsToCliOpts rawopts - let cmd = command_ opts - case find (\e -> cmd `elem` modeNames (fst e)) actions of + case find (\e -> command_ opts `elem` modeNames (fst e)) actions of Just (amode, _) | "h" `elem` map fst (rawopts_ opts) -> print amode Just (_, action) -> action opts Nothing -> print cmdmode diff --git a/tests/bin/budget.test b/tests/bin/budget.test index b6a68a41f..ff8049482 100644 --- a/tests/bin/budget.test +++ b/tests/bin/budget.test @@ -115,6 +115,7 @@ runghc ../../bin/hledger-budget.hs reg -f - >>>=0 # Periodical transactions within journal being applied with inverted sign in amounts +# As well, accounts from periodic transaction being used for bucketing runghc ../../bin/hledger-budget.hs bal -f - --no-total -DH expenses <<< ~ daily from 2016/12/31 @@ -133,7 +134,7 @@ runghc ../../bin/hledger-budget.hs bal -f - --no-total -DH expenses expenses:fee *-0.008 ; cash withdraw fee 2016/12/31 - expenses:housing $600 + expenses:housing:rent $600 assets:cash 2017/1/1 @@ -162,3 +163,103 @@ Ending balances (historical) in 2016/12/26-2017/01/04: >>>2 >>>=0 + +# We still can disable bucketing keeping rewrites and budget offset +runghc ../../bin/hledger-budget.hs bal -f - --no-total --no-buckets -DH expenses +<<< +~ daily from 2016/12/31 + expenses:food $8 + assets + += ^assets:bank$ date:2017/1 amt:<0 + assets:bank *0.008 + expenses:fee *-0.008 ; cash withdraw fee + +2016/12/31 + expenses:housing:rent $600 + assets:bank + +2017/1/1 + expenses:food $20 + expenses:leisure $15 + expenses:grocery $30 + assets:bank +>>> +Ending balances (historical) in 2016/12/31-2017/01/01: + + || 2016/12/31 2017/01/01 +=======================++========================= + expenses:fee || 0 $1 + expenses:food || $-8 $4 + expenses:grocery || 0 $30 + expenses:housing:rent || $600 $600 + expenses:leisure || 0 $15 + +>>>2 +>>>=0 + +# We can disable offset keeping rewrites and bucketing +# Note that original account names used for query +runghc ../../bin/hledger-budget.hs bal -f - --no-total --no-offset -DH expenses +<<< +~ daily from 2016/12/31 + expenses:food $8 + assets + += ^assets:bank$ date:2017/1 amt:<0 + assets:bank *0.008 + expenses:fee *-0.008 ; cash withdraw fee + +2016/12/31 + expenses:housing:rent $600 + assets:bank + +2017/1/1 + expenses:food $20 + expenses:leisure $15 + expenses:grocery $30 + assets:bank +>>> +Ending balances (historical) in 2016/12/31-2017/01/01: + + || 2016/12/31 2017/01/01 +===============++========================= + || $600 $646 + expenses:food || 0 $20 + +>>>2 +>>>=0 + +# We can keep just rewrites +runghc ../../bin/hledger-budget.hs bal -f - --no-total --no-buckets --no-offset -DH expenses +<<< +~ daily from 2016/12/31 + expenses:food $8 + assets + += ^assets:bank$ date:2017/1 amt:<0 + assets:bank *0.008 + expenses:fee *-0.008 ; cash withdraw fee + +2016/12/31 + expenses:housing:rent $600 + assets:bank + +2017/1/1 + expenses:food $20 + expenses:leisure $15 + expenses:grocery $30 + assets:bank +>>> +Ending balances (historical) in 2016/12/31-2017/01/01: + + || 2016/12/31 2017/01/01 +=======================++========================= + expenses:fee || 0 $1 + expenses:food || 0 $20 + expenses:grocery || 0 $30 + expenses:housing:rent || $600 $600 + expenses:leisure || 0 $15 + +>>>2 +>>>=0