budget: bucketing
This commit is contained in:
Mykola Orliuk
Simon Michael
parent
3a632acea0
commit
d5c2ed4fa7
@ -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 "" = "<unbucketed>"
|
||||
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
|
||||
|
||||
@ -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
|
||||
===============++=========================
|
||||
<unbucketed> || $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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user