From c404800fbf0d85488a250cb34e95c973b29a3074 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Wed, 4 Aug 2021 11:55:42 +1000 Subject: [PATCH] ref!: forecast: Move forecast_ from ReportOpts to InputOpts. --- hledger-lib/Hledger/Read/Common.hs | 50 +++++++++++++------- hledger-lib/Hledger/Reports/ReportOptions.hs | 21 -------- hledger-ui/Hledger/UI/AccountsScreen.hs | 6 +-- hledger-ui/Hledger/UI/ErrorScreen.hs | 8 ++-- hledger-ui/Hledger/UI/Main.hs | 5 +- hledger-ui/Hledger/UI/RegisterScreen.hs | 2 +- hledger-ui/Hledger/UI/UIState.hs | 12 ++--- hledger-web/Hledger/Web/Test.hs | 8 +--- hledger/Hledger/Cli/CliOptions.hs | 2 +- hledger/Hledger/Cli/Utils.hs | 5 +- 10 files changed, 55 insertions(+), 64 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index fee013939..50e12e796 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -32,6 +32,7 @@ module Hledger.Read.Common ( InputOpts (..), definputopts, rawOptsToInputOpts, + forecastPeriodFromRawOpts, -- * parsing utilities runTextParser, @@ -204,6 +205,7 @@ data InputOpts = InputOpts { ,new_ :: Bool -- ^ read only new transactions since this file was last read ,new_save_ :: Bool -- ^ save latest new transactions state for next time ,pivot_ :: String -- ^ use the given field's value as the account name + ,forecast_ :: Maybe DateSpan -- ^ span in which to generate forecast transactions ,auto_ :: Bool -- ^ generate automatic postings when journal is parsed ,balancingopts_ :: BalancingOpts -- ^ options for balancing transactions ,strict_ :: Bool -- ^ do extra error checking (eg, all posted accounts are declared, no prices are inferred) @@ -220,29 +222,45 @@ definputopts = InputOpts , new_ = False , new_save_ = True , pivot_ = "" + , forecast_ = Nothing , auto_ = False , balancingopts_ = def , strict_ = False } -rawOptsToInputOpts :: RawOpts -> InputOpts -rawOptsToInputOpts rawopts = InputOpts{ - -- files_ = listofstringopt "file" rawopts - mformat_ = Nothing - ,mrules_file_ = maybestringopt "rules-file" rawopts - ,aliases_ = listofstringopt "alias" rawopts - ,anon_ = boolopt "anon" rawopts - ,new_ = boolopt "new" rawopts - ,new_save_ = True - ,pivot_ = stringopt "pivot" rawopts - ,auto_ = boolopt "auto" rawopts - ,balancingopts_ = def{ ignore_assertions_ = boolopt "ignore-assertions" rawopts - , infer_prices_ = not noinferprice - } - ,strict_ = boolopt "strict" rawopts - } +rawOptsToInputOpts :: RawOpts -> IO InputOpts +rawOptsToInputOpts rawopts = do + d <- getCurrentDay + + return InputOpts{ + -- files_ = listofstringopt "file" rawopts + mformat_ = Nothing + ,mrules_file_ = maybestringopt "rules-file" rawopts + ,aliases_ = listofstringopt "alias" rawopts + ,anon_ = boolopt "anon" rawopts + ,new_ = boolopt "new" rawopts + ,new_save_ = True + ,pivot_ = stringopt "pivot" rawopts + ,forecast_ = forecastPeriodFromRawOpts d rawopts + ,auto_ = boolopt "auto" rawopts + ,balancingopts_ = def{ ignore_assertions_ = boolopt "ignore-assertions" rawopts + , infer_prices_ = not noinferprice + } + ,strict_ = boolopt "strict" rawopts + } where noinferprice = boolopt "strict" rawopts || stringopt "args" rawopts == "balancednoautoconversion" +-- | get period expression from --forecast option +forecastPeriodFromRawOpts :: Day -> RawOpts -> Maybe DateSpan +forecastPeriodFromRawOpts d opts = + case 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 + --- ** parsing utilities -- | Run a text parser in the identity monad. See also: parseWithState. diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index fb85fbf44..cad046a51 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -42,7 +42,6 @@ module Hledger.Reports.ReportOptions ( mixedAmountApplyValuationAfterSumFromOptsWith, valuationAfterSum, intervalFromRawOpts, - forecastPeriodFromRawOpts, queryFromFlags, transactionDateFn, postingDateFn, @@ -156,7 +155,6 @@ data ReportOpts = ReportOpts { -- Influenced by the --color/colour flag (cf CliOptions), -- whether stdout is an interactive terminal, and the value of -- TERM and existence of NO_COLOR environment variables. - ,forecast_ :: Maybe DateSpan ,transpose_ :: Bool } deriving (Show) @@ -194,7 +192,6 @@ defreportopts = ReportOpts , invert_ = False , normalbalance_ = Nothing , color_ = False - , forecast_ = Nothing , transpose_ = False } @@ -241,7 +238,6 @@ rawOptsToReportOpts rawopts = do ,invert_ = boolopt "invert" rawopts ,pretty_tables_ = boolopt "pretty-tables" rawopts ,color_ = useColorOnStdout -- a lower-level helper - ,forecast_ = forecastPeriodFromRawOpts d rawopts ,transpose_ = boolopt "transpose" rawopts } @@ -411,17 +407,6 @@ 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 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 @@ -838,10 +823,6 @@ class HasReportOpts a where color__ = reportOptsNoUpdate.color__ {-# INLINE color__ #-} - forecast :: Lens' a (Maybe DateSpan) - forecast = reportOptsNoUpdate.forecast - {-# INLINE forecast #-} - transpose__ :: Lens' a Bool transpose__ = reportOptsNoUpdate.transpose__ {-# INLINE transpose__ #-} @@ -907,8 +888,6 @@ instance HasReportOpts ReportOpts where {-# INLINE normalbalance #-} color__ f ropts = (\x -> ropts{color_=x}) <$> f (color_ ropts) {-# INLINE color__ #-} - forecast f ropts = (\x -> ropts{forecast_=x}) <$> f (forecast_ ropts) - {-# INLINE forecast #-} transpose__ f ropts = (\x -> ropts{transpose_=x}) <$> f (transpose_ ropts) {-# INLINE transpose__ #-} diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index 66b9a2805..a3a213612 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -49,7 +49,7 @@ accountsScreen = AccountsScreen{ asInit :: Day -> Bool -> UIState -> UIState asInit d reset ui@UIState{ - aopts=UIOpts{cliopts_=CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}, + aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}, ajournal=j, aScreen=s@AccountsScreen{} } = @@ -77,7 +77,7 @@ asInit d reset ui@UIState{ as = map asItemAccountName displayitems -- Further restrict the query based on the current period and future/forecast mode. - rspec' = rspec{_rsQuery=simplifyQuery $ And [_rsQuery rspec, periodq, excludeforecastq (forecast_ ropts)]} + rspec' = rspec{_rsQuery=simplifyQuery $ And [_rsQuery rspec, periodq, excludeforecastq (forecast_ $ inputopts_ copts)]} where periodq = Date $ periodAsDateSpan $ period_ ropts -- Except in forecast mode, exclude future/forecast transactions. @@ -198,7 +198,7 @@ asDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}} -- ,("l", str "list") ,("-+", str "depth") ,("H", renderToggle (not ishistorical) "end-bals" "changes") - ,("F", renderToggle1 (isJust $ forecast_ ropts) "forecast") + ,("F", renderToggle1 (isJust . forecast_ $ inputopts_ copts) "forecast") --,("/", "filter") --,("DEL", "unfilter") --,("ESC", "cancel/top") diff --git a/hledger-ui/Hledger/UI/ErrorScreen.hs b/hledger-ui/Hledger/UI/ErrorScreen.hs index d34cbf10c..178ddb50e 100644 --- a/hledger-ui/Hledger/UI/ErrorScreen.hs +++ b/hledger-ui/Hledger/UI/ErrorScreen.hs @@ -182,13 +182,13 @@ uiReloadJournalIfChanged copts d j ui = do -- or in the provided UIState's startup options, -- it is preserved. enableForecastPreservingPeriod :: UIState -> CliOpts -> CliOpts -enableForecastPreservingPeriod ui copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}} = - copts{reportspec_=rspec{_rsReportOpts=ropts{forecast_=mforecast}}} +enableForecastPreservingPeriod ui copts@CliOpts{inputopts_=iopts} = + copts{inputopts_=iopts{forecast_=mforecast}} where mforecast = asum [mprovidedforecastperiod, mstartupforecastperiod, mdefaultforecastperiod] where - mprovidedforecastperiod = forecast_ ropts - mstartupforecastperiod = forecast_ $ _rsReportOpts $ reportspec_ $ cliopts_ $ astartupopts ui + mprovidedforecastperiod = forecast_ $ inputopts_ copts + mstartupforecastperiod = forecast_ $ inputopts_ $ cliopts_ $ astartupopts ui mdefaultforecastperiod = Just nulldatespan -- Re-check any balance assertions in the current journal, and if any diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index 9910cffc9..30182a091 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -8,6 +8,7 @@ Released under GPL version 3 or later. module Hledger.UI.Main where +import Control.Applicative ((<|>)) import Control.Concurrent (threadDelay) import Control.Concurrent.Async (withAsync) import Control.Monad (forM_, void, when) @@ -43,11 +44,11 @@ writeChan = BC.writeBChan main :: IO () main = do - opts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportspec_=rspec@ReportSpec{_rsReportOpts=ropts},rawopts_=rawopts}} <- getHledgerUIOpts + opts@UIOpts{cliopts_=copts@CliOpts{inputopts_=iopts,rawopts_=rawopts}} <- getHledgerUIOpts -- when (debug_ $ cliopts_ opts) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts) -- always generate forecasted periodic transactions; their visibility will be toggled by the UI. - let copts' = copts{reportspec_=rspec{_rsReportOpts=ropts{forecast_=Just $ fromMaybe nulldatespan (forecast_ ropts)}}} + let copts' = copts{inputopts_=iopts{forecast_=forecast_ iopts <|> Just nulldatespan}} 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 dbabe1235..0f1eb65f6 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -239,7 +239,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}} -- ,("l", str "list(-subs)") ,("H", renderToggle (not ishistorical) "historical" "period") - ,("F", renderToggle1 (isJust $ forecast_ ropts) "forecast") + ,("F", renderToggle1 (isJust . forecast_ . inputopts_ $ copts) "forecast") -- ,("a", "add") -- ,("g", "reload") -- ,("q", "quit") diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs index 7b5716c68..ebe5e067c 100644 --- a/hledger-ui/Hledger/UI/UIState.hs +++ b/hledger-ui/Hledger/UI/UIState.hs @@ -7,8 +7,8 @@ module Hledger.UI.UIState where import Brick.Widgets.Edit +import Control.Applicative ((<|>)) import Data.List ((\\), foldl', sort) -import Data.Maybe (fromMaybe) import Data.Semigroup (Max(..)) import qualified Data.Text as T import Data.Text.Zipper (gotoEOL) @@ -157,19 +157,19 @@ toggleHistorical ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec -- (which are usually but not necessarily future-dated). -- In normal mode, both of these are hidden. toggleForecast :: Day -> UIState -> UIState -toggleForecast d ui@UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=ReportSpec{_rsReportOpts=ropts}}}} = +toggleForecast d ui@UIState{aopts=UIOpts{cliopts_=copts@CliOpts{inputopts_=iopts}}} = uiSetForecast ui $ - case forecast_ ropts of + case forecast_ iopts of Just _ -> Nothing - Nothing -> Just $ fromMaybe nulldatespan $ forecastPeriodFromRawOpts d $ rawopts_ copts + Nothing -> forecastPeriodFromRawOpts d (rawopts_ copts) <|> Just nulldatespan -- | Helper: set forecast mode (with the given forecast period) on or off in the UI state. uiSetForecast :: UIState -> Maybe DateSpan -> UIState uiSetForecast - ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}} + ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=iopts}}} mforecast = -- we assume forecast mode has no effect on ReportSpec's derived fields - ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{_rsReportOpts=ropts{forecast_=mforecast}}}}} + ui{aopts=uopts{cliopts_=copts{inputopts_=iopts{forecast_=mforecast}}}} -- | Toggle between showing all and showing only real (non-virtual) items. toggleReal :: UIState -> UIState diff --git a/hledger-web/Hledger/Web/Test.hs b/hledger-web/Hledger/Web/Test.hs index 42a489f44..4662dc23c 100644 --- a/hledger-web/Hledger/Web/Test.hs +++ b/hledger-web/Hledger/Web/Test.hs @@ -79,14 +79,8 @@ hledgerWebTest = do -- yit "can add transactions" $ do - -- test with forecasted transactions - d <- getCurrentDay let - ropts = defreportopts{forecast_=Just nulldatespan} - rspec = case reportOptsToSpec d ropts of - Left e -> error $ "failed to set up report options for tests, shouldn't happen: " ++ show e - Right rs -> rs - copts = defcliopts{reportspec_=rspec, file_=[""]} -- non-empty, see file_ note above + copts = defcliopts{reportspec_=defreportspec, file_=[""]} -- non-empty, see file_ note above wopts = defwebopts{cliopts_=copts} j <- fmap (either error id . journalTransform copts) $ readJournal' (T.pack $ unlines -- PARTIAL: readJournal' should not fail ["~ monthly" diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 3df6b40b7..3fcb54d1a 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -454,7 +454,7 @@ replaceNumericFlags = map replace -- Also records the terminal width, if supported. rawOptsToCliOpts :: RawOpts -> IO CliOpts rawOptsToCliOpts rawopts = do - let iopts = rawOptsToInputOpts rawopts + iopts <- rawOptsToInputOpts rawopts rspec <- rawOptsToReportSpec rawopts mcolumns <- readMay <$> getEnvSafe "COLUMNS" mtermwidth <- diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 7ca609671..900ce3b75 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -123,7 +123,7 @@ anonymiseByOpts opts = -- journalAddForecast :: CliOpts -> Journal -> Either String Journal journalAddForecast CliOpts{inputopts_=iopts, reportspec_=rspec} j = - case forecast_ ropts of + case forecast_ iopts of Nothing -> return j Just _ -> do forecasttxns <- addAutoTxns =<< mapM (balanceTransaction (balancingopts_ iopts)) @@ -135,7 +135,6 @@ journalAddForecast CliOpts{inputopts_=iopts, reportspec_=rspec} j = journalBalanceTransactions (balancingopts_ iopts) j{ jtxns = concat [jtxns j, forecasttxns] } where today = _rsDay rspec - ropts = _rsReportOpts rspec styles = journalCommodityStyles j -- "They can start no earlier than: the day following the latest normal transaction in the journal (or today if there are none)." @@ -148,7 +147,7 @@ journalAddForecast CliOpts{inputopts_=iopts, reportspec_=rspec} j = forecastspan = dbg2 "forecastspan" $ spanDefaultsFrom - (fromMaybe nulldatespan $ dbg2 "forecastspan flag" $ forecast_ ropts) + (fromMaybe nulldatespan $ dbg2 "forecastspan flag" $ forecast_ iopts) (DateSpan (Just forecastbeginDefault) (Just forecastendDefault)) addAutoTxns = if auto_ iopts then modifyTransactions styles today (jtxnmodifiers j) else return