From 3a632acea08194c83c95436cd4aabc7a9fd2eac8 Mon Sep 17 00:00:00 2001 From: Mykola Orliuk Date: Mon, 16 Jan 2017 16:26:04 +0200 Subject: [PATCH] budget: periodic transactions support --- bin/hledger-budget.hs | 18 +++++-- hledger-lib/Hledger/Data/AutoTransaction.hs | 55 ++++++++++++++++++++- tests/bin/budget.test | 49 ++++++++++++++++++ 3 files changed, 117 insertions(+), 5 deletions(-) diff --git a/bin/hledger-budget.hs b/bin/hledger-budget.hs index eb6a348b9..031d90a24 100755 --- a/bin/hledger-budget.hs +++ b/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 - mtxns = jmodifiertxns j - ts' = map modifier $ jtxns j + let modifier = originalTransaction . foldr (flip (.) . runModifierTransaction') id mtxns + runModifierTransaction' = fmap txnTieKnot . runModifierTransaction Any + 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 diff --git a/hledger-lib/Hledger/Data/AutoTransaction.hs b/hledger-lib/Hledger/Data/AutoTransaction.hs index 5bd77a0d8..83fbe94d5 100644 --- a/hledger-lib/Hledger/Data/AutoTransaction.hs +++ b/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 +-- +-- 2017/02/01 +-- hi $1.00 +-- +-- 2017/03/01 +-- hi $1.00 +-- +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] diff --git a/tests/bin/budget.test b/tests/bin/budget.test index 06d8e50b9..b6a68a41f 100644 --- a/tests/bin/budget.test +++ b/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