budget: bucketing

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 "" = "<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 -> command_ opts `elem` modeNames (fst e)) actions of
-    case find (\e -> cmd `elem` modeNames (fst e)) actions of
         Just (amode, _) | "h" `elem` map fst (rawopts_ opts) -> print amode
         Just (_, action) -> action opts
         Nothing -> print cmdmode

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 
+===============++=========================
+ <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