lib: --forecast=PERIODICEXPR. Fixes #835, #1236

hledger-lib/Hledger/Reports/ReportOptions.hs

@@ -22,6 +22,7 @@ module Hledger.Reports.ReportOptions (
   whichDateFromOpts,
   journalSelectingAmountFromOpts,
   intervalFromRawOpts,
+  forecastPeriodFromRawOpts,
   queryFromOpts,
   queryFromOptsOnly,
   queryOptsFromOpts,
@@ -124,7 +125,7 @@ data ReportOpts = ReportOpts {
       --   sign normalisation, converting normally negative subreports to
       --   normally positive for a more conventional display.
     ,color_          :: Bool
-    ,forecast_       :: Bool
+    ,forecast_       :: Maybe DateSpan
     ,transpose_      :: Bool
  } deriving (Show, Data, Typeable)
 
@@ -192,7 +193,7 @@ rawOptsToReportOpts rawopts = checkReportOpts <$> do
     ,invert_      = boolopt "invert" rawopts'
     ,pretty_tables_ = boolopt "pretty-tables" rawopts'
     ,color_       = color
-    ,forecast_    = boolopt "forecast" rawopts'
+    ,forecast_    = forecastPeriodFromRawOpts d rawopts'
     ,transpose_   = boolopt "transpose" rawopts'
     }
 
@@ -313,6 +314,18 @@ intervalFromRawOpts = lastDef NoInterval . collectopts intervalfromrawopt
       | n == "yearly"    = Just $ Years 1
       | otherwise = Nothing
 
+-- | get period expression from --forecast option
+forecastPeriodFromRawOpts :: Day -> RawOpts -> Maybe DateSpan
+forecastPeriodFromRawOpts d opts =
+  case 
+    dbg2 "forecastopt" $ maybestringopt "forecast" opts
+  of
+    Nothing -> Nothing
+    Just "" -> Just nulldatespan
+    Just str ->
+      either (\e -> usageError $ "could not parse forecast period : "++customErrorBundlePretty e) (Just . snd) $ 
+      parsePeriodExpr d $ stripquotes $ T.pack str
+    
 -- | Extract the interval from the parsed -p/--period expression.
 -- Return Nothing if an interval is not explicitly defined.
 extractIntervalOrNothing :: (Interval, DateSpan) -> Maybe Interval

hledger-lib/hledger_journal.m4.md

@@ -1414,7 +1414,7 @@ This can be used to match transactions generated "just now",
 rather than generated in the past and saved to the journal.
 
 Forecast transactions start on the first occurrence, and end on the last occurrence,
-of their interval within the forecast period. The forecast period:
+of their interval within the forecast period. The default forecast period:
 
 - begins on the later of
   - the report start date if specified with -b/-p/date:
@@ -1425,8 +1425,9 @@ of their interval within the forecast period. The forecast period:
   or 180 days from today.
 
 where "today" means the current date at report time.
-The "later of" rule ensures that forecast transactions do not overlap normal transactions in time;
+The "later of" rule ensures that by default forecast transactions do not overlap normal transactions in time;
-they will begin only after normal transactions end.
+they will begin only after normal transactions end. If you wish to use your own forecast period,
+you can provied it via `--forecast=PERIODICEXPR`.
 
 Forecasting can be useful for estimating balances into the future,
 and experimenting with different scenarios.

hledger-ui/Hledger/UI/AccountsScreen.hs

@@ -86,8 +86,8 @@ asInit d reset ui@UIState{
     q = And [queryFromOpts d ropts, excludeforecastq (forecast_ ropts)]
       where
         -- Except in forecast mode, exclude future/forecast transactions.
-        excludeforecastq True = Any
+        excludeforecastq (Just _) = Any
-        excludeforecastq False =  -- not:date:tomorrow- not:tag:generated-transaction
+        excludeforecastq Nothing  =  -- not:date:tomorrow- not:tag:generated-transaction
           And [
              Not (Date $ DateSpan (Just $ addDays 1 d) Nothing)
             ,Not (Tag "generated-transaction" Nothing)
@@ -218,7 +218,7 @@ asDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
               ,("-+", str "depth")
               ,("T", renderToggle (tree_ ropts) "flat" "tree")
               ,("H", renderToggle (not ishistorical) "end-bals" "changes")
-              ,("F", renderToggle1 (forecast_ ropts) "forecast")
+              ,("F", renderToggle1 (isJust $ forecast_ ropts) "forecast")
               --,("/", "filter")
               --,("DEL", "unfilter")
               --,("ESC", "cancel/top")
@@ -339,7 +339,7 @@ asHandle ui0@UIState{
         VtyEvent (EvKey (KChar 'U') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleUnmarked ui
         VtyEvent (EvKey (KChar 'P') []) -> asCenterAndContinue $ regenerateScreens j d $ togglePending ui
         VtyEvent (EvKey (KChar 'C') []) -> asCenterAndContinue $ regenerateScreens j d $ toggleCleared ui
-        VtyEvent (EvKey (KChar 'F') []) -> continue $ regenerateScreens j d $ toggleForecast ui
+        VtyEvent (EvKey (KChar 'F') []) -> continue $ regenerateScreens j d $ toggleForecast d ui
 
         VtyEvent (EvKey (KDown)     [MShift]) -> continue $ regenerateScreens j d $ shrinkReportPeriod d ui
         VtyEvent (EvKey (KUp)       [MShift]) -> continue $ regenerateScreens j d $ growReportPeriod d ui

hledger-ui/Hledger/UI/Main.hs

@@ -66,7 +66,7 @@ main = do
 
   -- always include forecasted periodic transactions when loading data;
   -- they will be toggled on and off in the UI.
-  let copts' = copts{reportopts_=ropts{forecast_=True}}
+  let copts' = copts{reportopts_=ropts{forecast_=Just $ fromMaybe nulldatespan (forecast_ ropts)}}
 
   case True of
     _ | "help"            `inRawOpts` rawopts -> putStr (showModeUsage uimode)

hledger-ui/Hledger/UI/RegisterScreen.hs

@@ -72,8 +72,8 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportopts_=ropts
     q = And [queryFromOpts d ropts', excludeforecastq (forecast_ ropts)]
       where
         -- Except in forecast mode, exclude future/forecast transactions.
-        excludeforecastq True = Any
+        excludeforecastq (Just _) = Any
-        excludeforecastq False =  -- not:date:tomorrow- not:tag:generated-transaction
+        excludeforecastq Nothing  =  -- not:date:tomorrow- not:tag:generated-transaction
           And [
              Not (Date $ DateSpan (Just $ addDays 1 d) Nothing)
             ,Not (Tag "generated-transaction" Nothing)
@@ -237,7 +237,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
 --              ,("RIGHT", str "transaction")
               ,("T", renderToggle (tree_ ropts) "flat(-subs)" "tree(+subs)") -- rsForceInclusive may override, but use tree_ to ensure a visible toggle effect
               ,("H", renderToggle (not ishistorical) "historical" "period")
-              ,("F", renderToggle1 (forecast_ ropts) "forecast")
+              ,("F", renderToggle1 (isJust $ forecast_ ropts) "forecast")
 --               ,("a", "add")
 --               ,("g", "reload")
 --               ,("q", "quit")
@@ -336,7 +336,7 @@ rsHandle ui@UIState{
         VtyEvent (EvKey (KChar 'U') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleUnmarked ui
         VtyEvent (EvKey (KChar 'P') []) -> rsCenterAndContinue $ regenerateScreens j d $ togglePending ui
         VtyEvent (EvKey (KChar 'C') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleCleared ui
-        VtyEvent (EvKey (KChar 'F') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleForecast ui
+        VtyEvent (EvKey (KChar 'F') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleForecast d ui
 
         VtyEvent (EvKey (KChar '/') []) -> continue $ regenerateScreens j d $ showMinibuffer ui
         VtyEvent (EvKey (KDown)     [MShift]) -> continue $ regenerateScreens j d $ shrinkReportPeriod d ui

hledger-ui/Hledger/UI/UIState.hs

@@ -164,11 +164,15 @@ toggleHistorical ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts
 -- overkill, probably we should just hide/show the periodic
 -- transactions with a query for their special tag.
 --
-toggleForecast :: UIState -> UIState
+toggleForecast :: Day -> UIState -> UIState
-toggleForecast ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
+toggleForecast d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
   ui{aopts=uopts{cliopts_=copts'}}
   where
-    copts' = copts{reportopts_=ropts{forecast_=not $ forecast_ ropts}}
+    copts' = copts{reportopts_=ropts{forecast_=forecast'}}
+    forecast' =
+      case forecast_ ropts of
+        Just _  -> Nothing
+        Nothing -> forecastPeriodFromRawOpts d $ rawopts_ copts
 
 -- | Toggle between showing all and showing only real (non-virtual) items.
 toggleReal :: UIState -> UIState

hledger/Hledger/Cli/CliOptions.hs

@@ -181,8 +181,12 @@ reportflags = [
 
   -- generated postings/transactions
  ,flagNone ["auto"]          (setboolopt "auto") "apply automated posting rules to modify transactions"
- ,flagNone ["forecast"]      (setboolopt "forecast") "generate future transactions from periodic transaction rules, for the next 6 months or till report end date. In hledger-ui, also make ordinary future transactions visible."
+ ,flagOpt "" ["forecast"]    (\s opts -> Right $ setopt "forecast" s opts) "PERIODEXP" 
-
+  (unlines
+   [ "Generate periodic transactions (from periodic transaction rules). By default these begin after the latest recorded transaction, and end 6 months from today, or at the report end date."
+   , "Also, in hledger-ui, make future transactions visible."
+   , "Note that = (and not a space) is required before PERIODEXP if you wish to supply it."
+   ])
  ]
 
 -- | Common flags that are accepted but not shown in --help,

hledger/Hledger/Cli/Utils.hs

@@ -114,18 +114,22 @@ anonymiseByOpts opts =
 -- from today if unspecified.
 --
 journalAddForecast :: CliOpts -> Journal -> IO Journal
-journalAddForecast opts@CliOpts{inputopts_=iopts, reportopts_=ropts} j = do
+journalAddForecast CliOpts{inputopts_=iopts, reportopts_=ropts} j = do
   today <- getCurrentDay
 
   -- "They can start no earlier than: the day following the latest normal transaction in the journal (or today if there are none)."
   let mjournalend   = dbg2 "journalEndDate" $ journalEndDate False j  -- ignore secondary dates
-      forecaststart = dbg2 "forecaststart" $ fromMaybe today mjournalend
+      forecastbeginDefault = dbg2 "forecastbeginDefault" $ fromMaybe today mjournalend
 
   -- "They end on or before the specified report end date, or 180 days from today if unspecified."
   mspecifiedend <-  snd . dbg2 "specifieddates" <$> specifiedStartEndDates ropts
-  let forecastend = dbg2 "forecastend" $ fromMaybe (addDays 180 today) mspecifiedend
+  let forecastendDefault = dbg2 "forecastendDefault" $ fromMaybe (addDays 180 today) mspecifiedend
-
+      
-  let forecastspan = DateSpan (Just forecaststart) (Just forecastend)
+  let forecastspan = dbg2 "forecastspan" $
+        spanDefaultsFrom
+          (fromMaybe nulldatespan $ dbg2 "forecastspan flag" $ forecast_ ropts)
+          (DateSpan (Just forecastbeginDefault) (Just forecastendDefault))
+          
       forecasttxns =
         [ txnTieKnot t | pt <- jperiodictxns j
                        , t <- runPeriodicTransaction pt forecastspan
@@ -135,12 +139,12 @@ journalAddForecast opts@CliOpts{inputopts_=iopts, reportopts_=ropts} j = do
       forecasttxns' = (if auto_ iopts then modifyTransactions (jtxnmodifiers j) else id) forecasttxns
 
   return $
-    if forecast_ ropts
+    case forecast_ ropts of
-      then journalBalanceTransactions' opts j{ jtxns = concat [jtxns j, forecasttxns'] }
+      Just _  -> journalBalanceTransactions' iopts j{ jtxns = concat [jtxns j, forecasttxns'] }
-      else j
+      Nothing -> j
   where
-    journalBalanceTransactions' opts j =
+    journalBalanceTransactions' iopts j =
-      let assrt = not . ignore_assertions_ $ inputopts_ opts
+      let assrt = not . ignore_assertions_ $ iopts
       in
        either error' id $ journalBalanceTransactions assrt j
 

tests/forecast.test

@@ -156,3 +156,48 @@ Y 2000
 
 >>>2
 >>>=0
+
+
+# 8. A balance report with forecast-begin enabling transaction before report end
+hledger bal -M -b 2016-10 -e 2017-02 -f - --forecast=20160801-
+<<<
+2016/12/31
+    expenses:housing  $600
+    assets:cash
+
+~ monthly from 2016/1  salary
+    income  $-1000
+    assets:cash
+>>>
+Balance changes in 2016-10-01-2017-01-31:
+
+                  ||    Oct     Nov     Dec     Jan 
+==================++================================
+ assets:cash      ||  $1000   $1000    $400   $1000 
+ expenses:housing ||      0       0    $600       0 
+ income           || $-1000  $-1000  $-1000  $-1000 
+------------------++--------------------------------
+                  ||      0       0       0       0 
+>>>2
+>>>=0
+
+# 9. Parse error in malformed forecast period expression
+hledger bal -M -b 2016-10 -e 2017-02 -f - --forecast=20160801-foobar
+<<<
+2016/12/31
+    expenses:housing  $600
+    assets:cash
+
+~ monthly from 2016/1  salary
+    income  $-1000
+    assets:cash
+>>>
+>>>2
+hledger: could not parse forecast period : 1:10:
+  |
+1 | 20160801-foobar
+  |          ^
+unexpected 'f'
+expecting end of input
+ (use -h to see usage)
+>>>=1