diff --git a/hledger-lib/Hledger/Data/AutoTransaction.hs b/hledger-lib/Hledger/Data/AutoTransaction.hs index 09b4c57c9..7bcacb894 100644 --- a/hledger-lib/Hledger/Data/AutoTransaction.hs +++ b/hledger-lib/Hledger/Data/AutoTransaction.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE CPP #-} {-| @@ -17,6 +18,9 @@ module Hledger.Data.AutoTransaction , mtvaluequery , jdatespan , periodTransactionInterval + + -- * Misc + , checkPeriodicTransactionStartDate ) where @@ -29,8 +33,8 @@ import qualified Data.Text as T import Hledger.Data.Types import Hledger.Data.Dates import Hledger.Data.Amount +import Hledger.Data.Posting (post) import Hledger.Data.Transaction -import Hledger.Utils.Parse import Hledger.Utils.UTF8IOCompat (error') import Hledger.Query -- import Hledger.Utils.Debug @@ -139,134 +143,189 @@ renderPostingCommentDates p = p { pcomment = comment' } | T.null datesComment = pcomment p | otherwise = T.intercalate "\n" $ filter (not . T.null) [T.strip $ pcomment p, "[" <> datesComment <> "]"] +-- doctest helper, too much hassle to define in the comment +-- XXX duplicates some logic in periodictransactionp +_ptgen str = do + let + t = T.pack str + (i,s) = parsePeriodExpr' nulldate t + case checkPeriodicTransactionStartDate i s t of + Just e -> error' e + Nothing -> + mapM_ (putStr . show) $ + runPeriodicTransaction + nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] } + nulldatespan + -- | Generate transactions from 'PeriodicTransaction' within a 'DateSpan' -- -- Note that new transactions require 'txnTieKnot' post-processing. -- --- >>> let gen str = mapM_ (putStr . show) $ runPeriodicTransaction (PeriodicTransaction str ["hi" `post` usd 1]) nulldatespan --- >>> gen "monthly from 2017/1 to 2017/4" --- 2017/01/01 Forecast transaction (monthly from 2017/1 to 2017/4) --- hi $1.00 +-- >>> _ptgen "monthly from 2017/1 to 2017/4" +-- 2017/01/01 +-- ; recur: monthly from 2017/1 to 2017/4 +-- a $1.00 -- --- 2017/02/01 Forecast transaction (monthly from 2017/1 to 2017/4) --- hi $1.00 +-- 2017/02/01 +-- ; recur: monthly from 2017/1 to 2017/4 +-- a $1.00 -- --- 2017/03/01 Forecast transaction (monthly from 2017/1 to 2017/4) --- hi $1.00 +-- 2017/03/01 +-- ; recur: monthly from 2017/1 to 2017/4 +-- a $1.00 -- --- >>> gen "monthly from 2017/1 to 2017/5" --- 2017/01/01 Forecast transaction (monthly from 2017/1 to 2017/5) --- hi $1.00 --- --- 2017/02/01 Forecast transaction (monthly from 2017/1 to 2017/5) --- hi $1.00 --- --- 2017/03/01 Forecast transaction (monthly from 2017/1 to 2017/5) --- hi $1.00 --- --- 2017/04/01 Forecast transaction (monthly from 2017/1 to 2017/5) --- hi $1.00 --- --- >>> gen "every 2nd day of month from 2017/02 to 2017/04" --- 2017/01/02 Forecast transaction (every 2nd day of month from 2017/02 to 2017/04) --- hi $1.00 --- --- 2017/02/02 Forecast transaction (every 2nd day of month from 2017/02 to 2017/04) --- hi $1.00 --- --- 2017/03/02 Forecast transaction (every 2nd day of month from 2017/02 to 2017/04) --- hi $1.00 --- --- >>> gen "every 30th day of month from 2017/1 to 2017/5" --- 2016/12/30 Forecast transaction (every 30th day of month from 2017/1 to 2017/5) --- hi $1.00 --- --- 2017/01/30 Forecast transaction (every 30th day of month from 2017/1 to 2017/5) --- hi $1.00 --- --- 2017/02/28 Forecast transaction (every 30th day of month from 2017/1 to 2017/5) --- hi $1.00 --- --- 2017/03/30 Forecast transaction (every 30th day of month from 2017/1 to 2017/5) --- hi $1.00 --- --- 2017/04/30 Forecast transaction (every 30th day of month from 2017/1 to 2017/5) --- hi $1.00 --- --- >>> gen "every 2nd Thursday of month from 2017/1 to 2017/4" --- 2016/12/08 Forecast transaction (every 2nd Thursday of month from 2017/1 to 2017/4) --- hi $1.00 --- --- 2017/01/12 Forecast transaction (every 2nd Thursday of month from 2017/1 to 2017/4) --- hi $1.00 --- --- 2017/02/09 Forecast transaction (every 2nd Thursday of month from 2017/1 to 2017/4) --- hi $1.00 --- --- 2017/03/09 Forecast transaction (every 2nd Thursday of month from 2017/1 to 2017/4) --- hi $1.00 --- --- >>> gen "every nov 29th from 2017 to 2019" --- 2016/11/29 Forecast transaction (every nov 29th from 2017 to 2019) --- hi $1.00 --- --- 2017/11/29 Forecast transaction (every nov 29th from 2017 to 2019) --- hi $1.00 --- --- 2018/11/29 Forecast transaction (every nov 29th from 2017 to 2019) --- hi $1.00 --- --- >>> gen "2017/1" --- 2017/01/01 Forecast transaction (2017/1) --- hi $1.00 --- --- >>> gen "" --- ... Failed to parse ... --- >>> gen "weekly from 2017" --- *** Exception: Unable to generate transactions according to "weekly from 2017" as 2017-01-01 is not a first day of the week --- >>> gen "monthly from 2017/5/4" --- *** Exception: Unable to generate transactions according to "monthly from 2017/5/4" as 2017-05-04 is not a first day of the month --- >>> gen "every quarter from 2017/1/2" --- *** Exception: Unable to generate transactions according to "every quarter from 2017/1/2" as 2017-01-02 is not a first day of the quarter --- >>> gen "yearly from 2017/1/14" --- *** Exception: Unable to generate transactions according to "yearly from 2017/1/14" as 2017-01-14 is not a first day of the year -- --- >>> let reportperiod="daily from 2018/01/03" in runPeriodicTransaction (PeriodicTransaction reportperiod [post "a" (usd 1)]) (DateSpan (Just $ parsedate "2018-01-01") (Just $ parsedate "2018-01-03")) +-- >>> _ptgen "monthly from 2017/1 to 2017/5" +-- 2017/01/01 +-- ; recur: monthly from 2017/1 to 2017/5 +-- a $1.00 +-- +-- 2017/02/01 +-- ; recur: monthly from 2017/1 to 2017/5 +-- a $1.00 +-- +-- 2017/03/01 +-- ; recur: monthly from 2017/1 to 2017/5 +-- a $1.00 +-- +-- 2017/04/01 +-- ; recur: monthly from 2017/1 to 2017/5 +-- a $1.00 +-- +-- +-- >>> _ptgen "every 2nd day of month from 2017/02 to 2017/04" +-- 2017/01/02 +-- ; recur: every 2nd day of month from 2017/02 to 2017/04 +-- a $1.00 +-- +-- 2017/02/02 +-- ; recur: every 2nd day of month from 2017/02 to 2017/04 +-- a $1.00 +-- +-- 2017/03/02 +-- ; recur: every 2nd day of month from 2017/02 to 2017/04 +-- a $1.00 +-- +-- +-- >>> _ptgen "every 30th day of month from 2017/1 to 2017/5" +-- 2016/12/30 +-- ; recur: every 30th day of month from 2017/1 to 2017/5 +-- a $1.00 +-- +-- 2017/01/30 +-- ; recur: every 30th day of month from 2017/1 to 2017/5 +-- a $1.00 +-- +-- 2017/02/28 +-- ; recur: every 30th day of month from 2017/1 to 2017/5 +-- a $1.00 +-- +-- 2017/03/30 +-- ; recur: every 30th day of month from 2017/1 to 2017/5 +-- a $1.00 +-- +-- 2017/04/30 +-- ; recur: every 30th day of month from 2017/1 to 2017/5 +-- a $1.00 +-- +-- +-- >>> _ptgen "every 2nd Thursday of month from 2017/1 to 2017/4" +-- 2016/12/08 +-- ; recur: every 2nd Thursday of month from 2017/1 to 2017/4 +-- a $1.00 +-- +-- 2017/01/12 +-- ; recur: every 2nd Thursday of month from 2017/1 to 2017/4 +-- a $1.00 +-- +-- 2017/02/09 +-- ; recur: every 2nd Thursday of month from 2017/1 to 2017/4 +-- a $1.00 +-- +-- 2017/03/09 +-- ; recur: every 2nd Thursday of month from 2017/1 to 2017/4 +-- a $1.00 +-- +-- +-- >>> _ptgen "every nov 29th from 2017 to 2019" +-- 2016/11/29 +-- ; recur: every nov 29th from 2017 to 2019 +-- a $1.00 +-- +-- 2017/11/29 +-- ; recur: every nov 29th from 2017 to 2019 +-- a $1.00 +-- +-- 2018/11/29 +-- ; recur: every nov 29th from 2017 to 2019 +-- a $1.00 +-- +-- +-- >>> _ptgen "2017/1" +-- 2017/01/01 +-- ; recur: 2017/1 +-- a $1.00 +-- +-- +-- >>> _ptgen "" +-- *** Exception: failed to parse... +-- ... +-- +-- >>> _ptgen "weekly from 2017" +-- *** Exception: Unable to generate transactions according to "weekly from 2017" because 2017-01-01 is not a first day of the week +-- +-- >>> _ptgen "monthly from 2017/5/4" +-- *** Exception: Unable to generate transactions according to "monthly from 2017/5/4" because 2017-05-04 is not a first day of the month +-- +-- >>> _ptgen "every quarter from 2017/1/2" +-- *** Exception: Unable to generate transactions according to "every quarter from 2017/1/2" because 2017-01-02 is not a first day of the quarter +-- +-- >>> _ptgen "yearly from 2017/1/14" +-- *** Exception: Unable to generate transactions according to "yearly from 2017/1/14" because 2017-01-14 is not a first day of the year +-- +-- >>> let reportperiod="daily from 2018/01/03" in let (i,s) = parsePeriodExpr' nulldate reportperiod in runPeriodicTransaction (nullperiodictransaction{ptperiodexpr=reportperiod, ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1]}) (DateSpan (Just $ parsedate "2018-01-01") (Just $ parsedate "2018-01-03")) -- [] +-- runPeriodicTransaction :: PeriodicTransaction -> DateSpan -> [Transaction] -runPeriodicTransaction pt requestedspan = - [ t{tdate=d} | (DateSpan (Just d) _) <- ptinterval `splitSpan` fillspan ] +runPeriodicTransaction PeriodicTransaction{..} requestedspan = + [ t{tdate=d} | (DateSpan (Just d) _) <- ptinterval `splitSpan` spantofill ] where - descr = T.pack $ "Forecast transaction (" ++ T.unpack periodexpr ++ ")" - t = nulltransaction { tpostings = ptpostings pt, tdescription = descr } - periodexpr = ptperiodicexpr pt - currentdateerr = error' $ "Current date cannot be referenced in " ++ show (T.unpack periodexpr) - (ptinterval, ptspan) = - case parsePeriodExpr currentdateerr periodexpr of - Left e -> error' $ "Failed to parse " ++ show (T.unpack periodexpr) ++ ": " ++ showDateParseError e - Right x -> checkPeriodTransactionStartDate periodexpr x - fillspan = spanIntervalIntersect ptinterval ptspan requestedspan + spantofill = spanIntervalIntersect ptinterval ptspan requestedspan + t = nulltransaction{ + tstatus = ptstatus + ,tcode = ptcode + ,tdescription = ptdescription + ,tcomment = (if T.null ptcomment then "\n" else ptcomment) <> "recur: " <> ptperiodexpr + ,ttags = ("recur", ptperiodexpr) : pttags + ,tpostings = ptpostings + } -checkPeriodTransactionStartDate :: T.Text -> (Interval, DateSpan) -> (Interval, DateSpan) -checkPeriodTransactionStartDate periodexpr (i,s) = - case (i,spanStart s) of +-- | Check that this date span begins at a boundary of this interval, +-- or return an explanatory error message including the provided period expression +-- (from which the span and interval are derived). +checkPeriodicTransactionStartDate :: Interval -> DateSpan -> T.Text -> Maybe String +checkPeriodicTransactionStartDate i s periodexpr = + case (i, spanStart s) of (Weeks _, Just d) -> checkStart d "week" (Months _, Just d) -> checkStart d "month" (Quarters _, Just d) -> checkStart d "quarter" (Years _, Just d) -> checkStart d "year" - _ -> (i,s) + _ -> Nothing where checkStart d x = let firstDate = fixSmartDate d ("","this",x) in - if d == firstDate then (i,s) - else error' $ "Unable to generate transactions according to "++(show periodexpr)++" as "++(show d)++" is not a first day of the "++x + if d == firstDate + then Nothing + else Just $ + "Unable to generate transactions according to "++show (T.unpack periodexpr) + ++" because "++show d++" is not a first day of the "++x -- | What is the interval of this 'PeriodicTransaction's period expression, if it can be parsed ? periodTransactionInterval :: PeriodicTransaction -> Maybe Interval periodTransactionInterval pt = let - expr = ptperiodicexpr pt + expr = ptperiodexpr pt err = error' $ "Current date cannot be referenced in " ++ show (T.unpack expr) in case parsePeriodExpr err expr of diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 2f22446ab..8ef5a58b4 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -69,7 +69,7 @@ instance Show ModifierTransaction where show t = "= " ++ T.unpack (mtvalueexpr t) ++ "\n" ++ unlines (map show (mtpostings t)) instance Show PeriodicTransaction where - show t = "~ " ++ T.unpack (ptperiodicexpr t) ++ "\n" ++ unlines (map show (ptpostings t)) + show t = "~ " ++ T.unpack (ptperiodexpr t) ++ "\n" ++ unlines (map show (ptpostings t)) sourceFilePath :: GenericSourcePos -> FilePath sourceFilePath = \case diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 45f4b6712..3cdba2793 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, DeriveDataTypeable, StandaloneDeriving, DeriveGeneric, TypeSynonymInstances, FlexibleInstances #-} +{-# LANGUAGE CPP, DeriveDataTypeable, StandaloneDeriving, DeriveGeneric, TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-} {-| Most data types are defined here to avoid import cycles. @@ -229,7 +229,10 @@ data GenericSourcePos = GenericSourcePos FilePath Int Int -- ^ file path, 1-b instance NFData GenericSourcePos -{-# ANN Transaction "HLint: ignore" #-} +--{-# ANN Transaction "HLint: ignore" #-} +-- Ambiguous type variable ‘p0’ arising from an annotation +-- prevents the constraint ‘(Data p0)’ from being solved. +-- Probable fix: use a type annotation to specify what ‘p0’ should be. data Transaction = Transaction { tindex :: Integer, -- ^ this transaction's 1-based position in the input stream, or 0 when not available tsourcepos :: GenericSourcePos, @@ -253,11 +256,32 @@ data ModifierTransaction = ModifierTransaction { instance NFData ModifierTransaction +-- ^ A periodic transaction rule, describing a transaction that recurs. data PeriodicTransaction = PeriodicTransaction { - ptperiodicexpr :: Text, + ptperiodexpr :: Text, -- ^ the period expression as written + ptinterval :: Interval, -- ^ the interval at which this transaction recurs + ptspan :: DateSpan, -- ^ the (possibly unbounded) period during which this transaction recurs. Contains a whole number of intervals. + -- + ptstatus :: Status, -- ^ some of Transaction's fields + ptcode :: Text, + ptdescription :: Text, + ptcomment :: Text, + pttags :: [Tag], ptpostings :: [Posting] } deriving (Eq,Typeable,Data,Generic) +nullperiodictransaction = PeriodicTransaction{ + ptperiodexpr = "" + ,ptinterval = def + ,ptspan = def + ,ptstatus = Unmarked + ,ptcode = "" + ,ptdescription = "" + ,ptcomment = "" + ,pttags = [] + ,ptpostings = [] +} + instance NFData PeriodicTransaction data TimeclockCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord,Typeable,Data,Generic) diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 36f7b9ddf..f7175251b 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -457,14 +457,45 @@ modifiertransactionp = do return $ ModifierTransaction valueexpr postings -- | Parse a periodic transaction -periodictransactionp :: JournalParser m PeriodicTransaction +periodictransactionp :: MonadIO m => JournalParser m PeriodicTransaction periodictransactionp = do char '~' "periodic transaction" - lift (skipMany spacenonewline) - periodexpr <- lift $ T.strip <$> descriptionp - _ <- lift followingcommentp - postings <- postingsp Nothing - return $ PeriodicTransaction periodexpr postings + lift $ skipMany spacenonewline + -- XXX periodexprp in Hledger.Data.Dates is a SimpleTextParser, which we can't call directly here. + -- Instead, read until two or more spaces and reparse that. More use of two spaces is not ideal. + pos <- getPosition + periodtxt <- lift singlespacedtextp + d <- liftIO getCurrentDay + (interval, span) <- + case parsePeriodExpr d periodtxt of + Right (i,s) -> return (i,s) + Left e -> + -- Show an informative error. XXX a bit unidiomatic, check for megaparsec helpers + fail $ -- XXX + showGenericSourcePos (genericSourcePos pos) ++ ":\n" ++ + (unlines $ drop 1 $ lines $ parseErrorPretty e) ++ + "while parsing a period expression in: "++T.unpack periodtxt++"\n" ++ + "2+ spaces are needed between period expression and any description/comment." + -- In periodic transactions, the period expression has an additional constraint: + case checkPeriodicTransactionStartDate interval span periodtxt of + Just e -> fail e -- XXX + Nothing -> do + status <- lift statusp + code <- lift codep + description <- lift $ T.strip <$> descriptionp + (comment, tags) <- lift transactioncommentp + postings <- postingsp (Just $ first3 $ toGregorian d) + return $ nullperiodictransaction{ + ptperiodexpr=periodtxt + ,ptinterval=interval + ,ptspan=span + ,ptstatus=status + ,ptcode=code + ,ptdescription=description + ,ptcomment=comment + ,pttags=tags + ,ptpostings=postings + } -- | Parse a (possibly unbalanced) transaction. transactionp :: JournalParser m Transaction diff --git a/hledger-lib/hledger_journal.m4.md b/hledger-lib/hledger_journal.m4.md index 678333e62..366026f59 100644 --- a/hledger-lib/hledger_journal.m4.md +++ b/hledger-lib/hledger_journal.m4.md @@ -916,37 +916,59 @@ Prior to hledger 1.0, legacy `account` and `end` spellings were also supported. ## Periodic transactions Periodic transaction rules describe transactions that recur. -They allow you to generate future transactions for forecast reports, without writing them out in the journal (with `--forecast`). -They can also be used to define budget goals (with `balance --budget`). +They allow you to generate future transactions for forecast reports (with `--forecast`), +without having to write them out explicitly in the journal. +Secondly, they also can be used to define budget goals (with `--budget`). A periodic transaction rule looks like a regular journal entry, -except the first line is a tilde (`~`) followed by a [period expression](manual.html#period-expressions) +with the date replaced by a tilde (`~`) followed by a [period expression](manual.html#period-expressions) (mnemonic: `~` looks like a repeating sine wave): ```journal -~ weekly - assets:bank:checking $400 ; paycheck - income:acme inc +~ monthly + expenses:rent $2000 + assets:bank:checking ``` +There is an additional constraint on the period expression: +the start date must fall on a natural boundary of the interval. +Eg `monthly from 2018/1/1` is valid, but `monthly from 2018/1/15` is not. + +Also, if you write a transaction description or same-line comment, +it must be separated from the period expression by **two or more spaces**. Eg: +```journal +; 2 or more spaces +; || +; vv +~ every 2 weeks from 2018/6 to 2018/9 paycheck + assets:bank:checking $1500 + income:acme inc +``` + +### Generating forecasts with periodic transactions With the `--forecast` flag, each periodic transaction rule generates future transactions recurring at the specified interval, beginning the day after the latest recorded journal transaction (or today, if there are no transactions), and ending 6 months from today (or at the report end date, if specified). +The generated transactions will appear in all reports. +They will have a "recur:" transaction tag added, with the generating period expression as its value. -Such generated transactions can be useful for forecasting balances in the future, +This can be useful for forecasting balances into the future, and experimenting with different scenarios, without having to write a lot of journal entries. -They can also help with data entry, by copying the output of `print --forecast`. +It can also help with data entry (describe most of your transactions with periodic rules, +and every so often copy the output of `print --forecast` to the journal). + +You can generate one-time transactions too; +just write a period expression specifying a date with no report interval. +You could use this to forecast an estimated transaction, that is automatically deactivated +once the actual transaction (or any other transaction on or after that date) is recorded. + +### Setting budget goals with periodic transactions With the `--budget` flag, currently supported by the balance command, each periodic transaction rule declares recurring budget goals for the specified accounts. -Eg the example above declares the goal of receiving $400 from `income:acme inc` -(and also, the goal of depositing $400 into `assets:bank:checking`) every week. -Goals and actual performance can then be displayed in [budget reports](/manual.html#budget-report). - -Periodic transaction rules can generate one-off transactions too; -just write a period expression with no report interval. -In some cases this could be more useful than an ordinary explicit transaction -(eg forecast an estimated amount until the actual transaction is recorded, automatically deactivating the forecasted one). +Eg the first example above declares a goal of spending $2000 on rent +(and also, a goal of depositing $2000 into checking) every month. +Goals and actual performance can then be compared in [budget reports](/manual.html#budget-report). For more details, see: [balance: Budget report](manual.html#budget-report)