budget: periodic transactions support

bin/hledger-budget.hs

@@ -40,11 +40,21 @@ journalBalanceTransactions' opts j = do
 
 withJournalDo' :: CliOpts -> (CliOpts -> Journal -> IO ()) -> IO ()
 withJournalDo' opts = withJournalDo opts . wrapper where
-    wrapper f opts' j = f opts' =<< journalBalanceTransactions' opts' j{ jtxns = ts' } where
+    wrapper f opts' j = do
         -- use original transactions as input for journalBalanceTransactions to re-infer balances/prices
-        modifier = originalTransaction . foldr (flip (.) . fmap txnTieKnot . runModifierTransaction Any) id mtxns
+        let modifier = originalTransaction . foldr (flip (.) . runModifierTransaction') id mtxns
-        mtxns = jmodifiertxns j
+            runModifierTransaction' = fmap txnTieKnot . runModifierTransaction Any
-        ts' = map modifier $ jtxns j
+            mtxns = jmodifiertxns j
+            dates = jdatespan j
+            ts' = map modifier $ jtxns j
+            ts'' = [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'
 
 main :: IO ()
 main = do

hledger-lib/Hledger/Data/AutoTransaction.hs

@@ -9,9 +9,11 @@ module Hledger.Data.AutoTransaction
     (
     -- * Transaction processors
       runModifierTransaction
+    , runPeriodicTransaction
 
     -- * Accessors
     , mtvaluequery
+    , jdatespan
     )
 where
 
@@ -22,12 +24,15 @@ import qualified Data.Text as T
 import Hledger.Data.Types
 import Hledger.Data.Dates
 import Hledger.Data.Amount
+import Hledger.Data.Transaction
+import Hledger.Utils.Parse
+import Hledger.Utils.UTF8IOCompat (error')
 import Hledger.Query
 
 -- $setup
 -- >>> :set -XOverloadedStrings
 -- >>> import Hledger.Data.Posting
--- >>> import Hledger.Data.Transaction
+-- >>> import Hledger.Data.Journal
 
 -- | Builds a 'Transaction' transformer based on 'ModifierTransaction'.
 --
@@ -76,6 +81,29 @@ runModifierTransaction q mt = modifier where
 mtvaluequery :: ModifierTransaction -> (Day -> Query)
 mtvaluequery mt = fst . flip parseQuery (mtvalueexpr mt)
 
+-- | 'DateSpan' of all dates mentioned in 'Journal'
+--
+-- >>> jdatespan nulljournal
+-- DateSpan -
+-- >>> jdatespan nulljournal{jtxns=[nulltransaction{tdate=read "2016-01-01"}] }
+-- DateSpan 2016/01/01
+-- >>> jdatespan nulljournal{jtxns=[nulltransaction{tdate=read "2016-01-01", tpostings=[nullposting{pdate=Just $ read "2016-02-01"}]}] }
+-- DateSpan 2016/01/01-2016/02/01
+jdatespan :: Journal -> DateSpan
+jdatespan j
+        | null dates = nulldatespan
+        | otherwise = DateSpan (Just $ minimum dates) (Just $ 1 `addDays` maximum dates)
+    where
+        dates = concatMap tdates $ jtxns j
+
+-- | 'DateSpan' of all dates mentioned in 'Transaction'
+--
+-- >>> tdates nulltransaction
+-- [0000-01-01]
+tdates :: Transaction -> [Day]
+tdates t = tdate t : concatMap pdates (tpostings t) ++ maybeToList (tdate2 t) where
+    pdates p = catMaybes [pdate p, pdate2 p]
+
 postingScale :: Posting -> Maybe Quantity
 postingScale p =
     case amounts $ pamount p of
@@ -101,3 +129,28 @@ renderPostingCommentDates p = p { pcomment = comment' }
         comment'
             | T.null datesComment = pcomment p
             | otherwise = T.intercalate "\n" $ filter (not . T.null) [T.strip $ pcomment p, "[" <> datesComment <> "]"]
+
+-- | Generate transactions from 'PeriodicTransaction' within a 'DateSpan'
+--
+-- Note that new transactions require 'txnTieKnot' post-processing.
+--
+-- >>> mapM_ (putStr . show) $ runPeriodicTransaction (PeriodicTransaction "monthly from 2017/1 to 2017/4" ["hi" `post` usd 1]) nulldatespan
+-- 2017/01/01
+--     hi         $1.00
+-- <BLANKLINE>
+-- 2017/02/01
+--     hi         $1.00
+-- <BLANKLINE>
+-- 2017/03/01
+--     hi         $1.00
+-- <BLANKLINE>
+runPeriodicTransaction :: PeriodicTransaction -> (DateSpan -> [Transaction])
+runPeriodicTransaction pt = generate where
+    base = nulltransaction { tpostings = ptpostings pt }
+    periodExpr = ptperiodicexpr pt
+    errCurrent = error' $ "Current date cannot be referenced in " ++ show (T.unpack periodExpr)
+    (interval, effectspan) =
+        case parsePeriodExpr errCurrent periodExpr of
+            Left e -> error' $ "Failed to parse " ++ show (T.unpack periodExpr) ++ ": " ++ showDateParseError e
+            Right x -> x
+    generate jspan = [base {tdate=date} | span <- interval `splitSpan` spanIntersect effectspan jspan, let Just date = spanStart span]

tests/bin/budget.test

@@ -113,3 +113,52 @@ runghc ../../bin/hledger-budget.hs reg -f -
                                 assets:bank                  $0.40             0
 >>>2
 >>>=0
+
+# Periodical transactions within journal being applied with inverted sign in amounts
+runghc ../../bin/hledger-budget.hs bal -f - --no-total -DH expenses
+<<<
+~ daily from 2016/12/31
+    expenses:food  $8
+    assets
+
+~ weekly
+    expenses:leisure  $20
+    expenses:grocery  $50
+    expenses:housing  $250
+    expenses:fee  $10
+    assets
+
+= ^assets:bank$ date:2017/1 amt:<0
+    assets:bank  *0.008
+    expenses:fee  *-0.008  ; cash withdraw fee
+
+2016/12/31
+    expenses:housing  $600
+    assets:cash
+
+2017/1/1
+    expenses:food  $20
+    expenses:leisure  $15
+    expenses:grocery  $30
+    assets:cash
+
+2017/1/2
+    assets:cash  $200.00
+    assets:bank
+
+2017/1/4
+    assets:cash  $100.00
+    assets:bank
+>>>
+Ending balances (historical) in 2016/12/26-2017/01/04:
+
+                  ||  2016/12/26  2016/12/27  2016/12/28  2016/12/29  2016/12/30  2016/12/31  2017/01/01  2017/01/02  2017/01/03  2017/01/04 
+==================++=========================================================================================================================
+ expenses:fee     ||        $-10        $-10        $-10        $-10        $-10        $-10        $-10     $-18.40     $-18.40     $-17.60 
+ expenses:food    ||           0           0           0           0           0         $-8       $4.00      $-4.00     $-12.00     $-20.00 
+ expenses:grocery ||        $-50        $-50        $-50        $-50        $-50        $-50     $-20.00     $-70.00     $-70.00     $-70.00 
+ expenses:housing ||       $-250       $-250       $-250       $-250       $-250     $350.00     $350.00     $100.00     $100.00     $100.00 
+ expenses:leisure ||        $-20        $-20        $-20        $-20        $-20        $-20      $-5.00     $-25.00     $-25.00     $-25.00 
+
+>>>2
+>>>=0