lib: journal: allow descriptions/comments in periodic transactions

Also period expressions relative to today's date can now be used,
for what it's worth.

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
+-- >>> _ptgen "monthly from 2017/1 to 2017/4"
--- >>> gen "monthly from 2017/1 to 2017/4"
+-- 2017/01/01
--- 2017/01/01 Forecast transaction (monthly from 2017/1 to 2017/4)
+--     ; recur: monthly from 2017/1 to 2017/4
---     hi           $1.00
+--     a           $1.00
 -- <BLANKLINE>
--- 2017/02/01 Forecast transaction (monthly from 2017/1 to 2017/4)
+-- 2017/02/01
---     hi           $1.00
+--     ; recur: monthly from 2017/1 to 2017/4
+--     a           $1.00
 -- <BLANKLINE>
--- 2017/03/01 Forecast transaction (monthly from 2017/1 to 2017/4)
+-- 2017/03/01
---     hi           $1.00
+--     ; recur: monthly from 2017/1 to 2017/4
+--     a           $1.00
 -- <BLANKLINE>
--- >>> gen "monthly from 2017/1 to 2017/5"
--- 2017/01/01 Forecast transaction (monthly from 2017/1 to 2017/5)
---     hi           $1.00
--- <BLANKLINE>
--- 2017/02/01 Forecast transaction (monthly from 2017/1 to 2017/5)
---     hi           $1.00
--- <BLANKLINE>
--- 2017/03/01 Forecast transaction (monthly from 2017/1 to 2017/5)
---     hi           $1.00
--- <BLANKLINE>
--- 2017/04/01 Forecast transaction (monthly from 2017/1 to 2017/5)
---     hi           $1.00
--- <BLANKLINE>
--- >>> 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
--- <BLANKLINE>
--- 2017/02/02 Forecast transaction (every 2nd day of month from 2017/02 to 2017/04)
---     hi           $1.00
--- <BLANKLINE>
--- 2017/03/02 Forecast transaction (every 2nd day of month from 2017/02 to 2017/04)
---     hi           $1.00
--- <BLANKLINE>
--- >>> 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
--- <BLANKLINE>
--- 2017/01/30 Forecast transaction (every 30th day of month from 2017/1 to 2017/5)
---     hi           $1.00
--- <BLANKLINE>
--- 2017/02/28 Forecast transaction (every 30th day of month from 2017/1 to 2017/5)
---     hi           $1.00
--- <BLANKLINE>
--- 2017/03/30 Forecast transaction (every 30th day of month from 2017/1 to 2017/5)
---     hi           $1.00
--- <BLANKLINE>
--- 2017/04/30 Forecast transaction (every 30th day of month from 2017/1 to 2017/5)
---     hi           $1.00
--- <BLANKLINE>
--- >>> 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
--- <BLANKLINE>
--- 2017/01/12 Forecast transaction (every 2nd Thursday of month from 2017/1 to 2017/4)
---     hi           $1.00
--- <BLANKLINE>
--- 2017/02/09 Forecast transaction (every 2nd Thursday of month from 2017/1 to 2017/4)
---     hi           $1.00
--- <BLANKLINE>
--- 2017/03/09 Forecast transaction (every 2nd Thursday of month from 2017/1 to 2017/4)
---     hi           $1.00
--- <BLANKLINE>
--- >>> gen "every nov 29th from 2017 to 2019"
--- 2016/11/29 Forecast transaction (every nov 29th from 2017 to 2019)
---     hi           $1.00
--- <BLANKLINE>
--- 2017/11/29 Forecast transaction (every nov 29th from 2017 to 2019)
---     hi           $1.00
--- <BLANKLINE>
--- 2018/11/29 Forecast transaction (every nov 29th from 2017 to 2019)
---     hi           $1.00
--- <BLANKLINE>
--- >>> gen "2017/1"
--- 2017/01/01 Forecast transaction (2017/1)
---     hi           $1.00
--- <BLANKLINE>
--- >>> 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
+-- <BLANKLINE>
+-- 2017/02/01
+--     ; recur: monthly from 2017/1 to 2017/5
+--     a           $1.00
+-- <BLANKLINE>
+-- 2017/03/01
+--     ; recur: monthly from 2017/1 to 2017/5
+--     a           $1.00
+-- <BLANKLINE>
+-- 2017/04/01
+--     ; recur: monthly from 2017/1 to 2017/5
+--     a           $1.00
+-- <BLANKLINE>
+--
+-- >>> _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
+-- <BLANKLINE>
+-- 2017/02/02
+--     ; recur: every 2nd day of month from 2017/02 to 2017/04
+--     a           $1.00
+-- <BLANKLINE>
+-- 2017/03/02
+--     ; recur: every 2nd day of month from 2017/02 to 2017/04
+--     a           $1.00
+-- <BLANKLINE>
+--
+-- >>> _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
+-- <BLANKLINE>
+-- 2017/01/30
+--     ; recur: every 30th day of month from 2017/1 to 2017/5
+--     a           $1.00
+-- <BLANKLINE>
+-- 2017/02/28
+--     ; recur: every 30th day of month from 2017/1 to 2017/5
+--     a           $1.00
+-- <BLANKLINE>
+-- 2017/03/30
+--     ; recur: every 30th day of month from 2017/1 to 2017/5
+--     a           $1.00
+-- <BLANKLINE>
+-- 2017/04/30
+--     ; recur: every 30th day of month from 2017/1 to 2017/5
+--     a           $1.00
+-- <BLANKLINE>
+--
+-- >>> _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
+-- <BLANKLINE>
+-- 2017/01/12
+--     ; recur: every 2nd Thursday of month from 2017/1 to 2017/4
+--     a           $1.00
+-- <BLANKLINE>
+-- 2017/02/09
+--     ; recur: every 2nd Thursday of month from 2017/1 to 2017/4
+--     a           $1.00
+-- <BLANKLINE>
+-- 2017/03/09
+--     ; recur: every 2nd Thursday of month from 2017/1 to 2017/4
+--     a           $1.00
+-- <BLANKLINE>
+--
+-- >>> _ptgen "every nov 29th from 2017 to 2019"
+-- 2016/11/29
+--     ; recur: every nov 29th from 2017 to 2019
+--     a           $1.00
+-- <BLANKLINE>
+-- 2017/11/29
+--     ; recur: every nov 29th from 2017 to 2019
+--     a           $1.00
+-- <BLANKLINE>
+-- 2018/11/29
+--     ; recur: every nov 29th from 2017 to 2019
+--     a           $1.00
+-- <BLANKLINE>
+--
+-- >>> _ptgen "2017/1"
+-- 2017/01/01
+--     ; recur: 2017/1
+--     a           $1.00
+-- <BLANKLINE>
+--
+-- >>> _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 =
+runPeriodicTransaction PeriodicTransaction{..} requestedspan =
-    [ t{tdate=d} | (DateSpan (Just d) _) <- ptinterval `splitSpan` fillspan ]
+    [ t{tdate=d} | (DateSpan (Just d) _) <- ptinterval `splitSpan` spantofill ]
   where
-    descr = T.pack $ "Forecast transaction (" ++ T.unpack periodexpr ++ ")"
+    spantofill = spanIntervalIntersect ptinterval ptspan requestedspan
-    t = nulltransaction { tpostings = ptpostings pt, tdescription = descr }
+    t = nulltransaction{
-    periodexpr = ptperiodicexpr pt
+           tstatus      = ptstatus
-    currentdateerr = error' $ "Current date cannot be referenced in " ++ show (T.unpack periodexpr)
+          ,tcode        = ptcode
-    (ptinterval, ptspan) =
+          ,tdescription = ptdescription 
-        case parsePeriodExpr currentdateerr periodexpr of
+          ,tcomment     = (if T.null ptcomment then "\n" else ptcomment) <> "recur: " <> ptperiodexpr
-            Left e  -> error' $ "Failed to parse " ++ show (T.unpack periodexpr) ++ ": " ++ showDateParseError e
+          ,ttags        = ("recur", ptperiodexpr) : pttags 
-            Right x -> checkPeriodTransactionStartDate periodexpr x
+          ,tpostings    = ptpostings
-    fillspan = spanIntervalIntersect ptinterval ptspan requestedspan
+          }
 
-checkPeriodTransactionStartDate :: T.Text -> (Interval, DateSpan) -> (Interval, DateSpan)
+-- | Check that this date span begins at a boundary of this interval, 
-checkPeriodTransactionStartDate periodexpr (i,s) = 
+-- 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)
+         if d == firstDate 
-         else error' $ "Unable to generate transactions according to "++(show periodexpr)++" as "++(show d)++" is not a first day of the "++x
+         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

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

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)

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)
+  lift $ skipMany spacenonewline
-  periodexpr <- lift $ T.strip <$> descriptionp
+  -- XXX periodexprp in Hledger.Data.Dates is a SimpleTextParser, which we can't call directly here.
-  _ <- lift followingcommentp
+  -- Instead, read until two or more spaces and reparse that. More use of two spaces is not ideal.
-  postings <- postingsp Nothing
+  pos <- getPosition
-  return $ PeriodicTransaction periodexpr postings
+  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

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 allow you to generate future transactions for forecast reports (with `--forecast`),
-They can also be used to define budget goals (with `balance --budget`).
+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
+~ monthly
-  assets:bank:checking   $400 ; paycheck
+    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`
+Eg the first example above declares a goal of spending $2000 on rent
-(and also, the goal of depositing $400 into `assets:bank:checking`) every week.
+(and also, a goal of depositing $2000 into checking) every month.
-Goals and actual performance can then be displayed in [budget reports](/manual.html#budget-report).
+Goals and actual performance can then be compared 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).
 
 For more details, see:
 [balance: Budget report](manual.html#budget-report)