From b7413edf2284ab1d1f1162c117b51edadd04b44c Mon Sep 17 00:00:00 2001 From: Dmitry Astapov Date: Tue, 2 Jun 2020 21:15:14 +0100 Subject: [PATCH] lib: --forecast=PERIODICEXPR. Fixes #835, #1236 --- hledger-lib/Hledger/Reports/ReportOptions.hs | 17 +++++++- hledger-lib/hledger_journal.m4.md | 7 +-- hledger-ui/Hledger/UI/AccountsScreen.hs | 8 ++-- hledger-ui/Hledger/UI/Main.hs | 2 +- hledger-ui/Hledger/UI/RegisterScreen.hs | 8 ++-- hledger-ui/Hledger/UI/UIState.hs | 10 +++-- hledger/Hledger/Cli/CliOptions.hs | 8 +++- hledger/Hledger/Cli/Utils.hs | 24 ++++++----- tests/forecast.test | 45 ++++++++++++++++++++ 9 files changed, 100 insertions(+), 29 deletions(-) diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index afa962880..00cbce188 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/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 diff --git a/hledger-lib/hledger_journal.m4.md b/hledger-lib/hledger_journal.m4.md index 1ee5ff461..668409456 100644 --- a/hledger-lib/hledger_journal.m4.md +++ b/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; -they will begin only after normal transactions end. +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. 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. diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index 093c02e04..5b9fe291a 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/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 False = -- not:date:tomorrow- not:tag:generated-transaction + excludeforecastq (Just _) = Any + 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 diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index 3ab1e9e37..2de17d69e 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/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) diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index e782e3b48..cb48e7f4c 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/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 False = -- not:date:tomorrow- not:tag:generated-transaction + excludeforecastq (Just _) = Any + 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 diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs index a09008ea8..38a34bd9d 100644 --- a/hledger-ui/Hledger/UI/UIState.hs +++ b/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 ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = +toggleForecast :: Day -> UIState -> UIState +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 diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index a9002d3e6..6037eb69c 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/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, diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 3185c307e..5f8a89fcb 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/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 forecastspan = DateSpan (Just forecaststart) (Just forecastend) + let forecastendDefault = dbg2 "forecastendDefault" $ fromMaybe (addDays 180 today) mspecifiedend + + 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 - then journalBalanceTransactions' opts j{ jtxns = concat [jtxns j, forecasttxns'] } - else j + case forecast_ ropts of + Just _ -> journalBalanceTransactions' iopts j{ jtxns = concat [jtxns j, forecasttxns'] } + Nothing -> j where - journalBalanceTransactions' opts j = - let assrt = not . ignore_assertions_ $ inputopts_ opts + journalBalanceTransactions' iopts j = + let assrt = not . ignore_assertions_ $ iopts in either error' id $ journalBalanceTransactions assrt j diff --git a/tests/forecast.test b/tests/forecast.test index d0aa35fd0..0be00ef0e 100644 --- a/tests/forecast.test +++ b/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