From fb0053c15f836271ba5424558d7d027633320f67 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 8 Sep 2022 11:56:20 -1000 Subject: [PATCH] imp: ui: fix a probable bug with detecting date change while running --- hledger-ui/Hledger/UI/AccountsScreen.hs | 2 +- hledger-ui/Hledger/UI/BalancesheetScreen.hs | 2 +- hledger-ui/Hledger/UI/ErrorScreen.hs | 2 +- hledger-ui/Hledger/UI/MenuScreen.hs | 2 +- hledger-ui/Hledger/UI/RegisterScreen.hs | 2 +- hledger-ui/Hledger/UI/TransactionScreen.hs | 3 +- hledger-ui/Hledger/UI/UIScreens.hs | 47 ++++++++++----------- hledger-ui/Hledger/UI/UIUtils.hs | 10 ++--- 8 files changed, 34 insertions(+), 36 deletions(-) diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index 2acbf09e1..1efd923b8 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -181,7 +181,7 @@ asHandle ev = do nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ listElements $ _assList sst lastnonblankidx = max 0 (length nonblanks - 1) journalspan = journalDateSpan False j - d = copts^.rsDay + d <- liftIO getCurrentDay case mode of Minibuffer _ ed -> diff --git a/hledger-ui/Hledger/UI/BalancesheetScreen.hs b/hledger-ui/Hledger/UI/BalancesheetScreen.hs index e21b90b1c..489d543c8 100644 --- a/hledger-ui/Hledger/UI/BalancesheetScreen.hs +++ b/hledger-ui/Hledger/UI/BalancesheetScreen.hs @@ -181,7 +181,7 @@ bsHandle ev = do nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ listElements $ _bssList sst lastnonblankidx = max 0 (length nonblanks - 1) journalspan = journalDateSpan False j - d = copts^.rsDay + d <- liftIO getCurrentDay case mode of Minibuffer _ ed -> diff --git a/hledger-ui/Hledger/UI/ErrorScreen.hs b/hledger-ui/Hledger/UI/ErrorScreen.hs index b640ebe78..e619f56e2 100644 --- a/hledger-ui/Hledger/UI/ErrorScreen.hs +++ b/hledger-ui/Hledger/UI/ErrorScreen.hs @@ -85,7 +85,7 @@ esHandle ev = do _ -> helpHandle ev _ -> do - let d = copts^.rsDay + d <- liftIO getCurrentDay case ev of VtyEvent (EvKey (KChar 'q') []) -> halt VtyEvent (EvKey KEsc []) -> put' $ uiCheckBalanceAssertions d $ resetScreens d ui diff --git a/hledger-ui/Hledger/UI/MenuScreen.hs b/hledger-ui/Hledger/UI/MenuScreen.hs index 4967239ed..bc12123ec 100644 --- a/hledger-ui/Hledger/UI/MenuScreen.hs +++ b/hledger-ui/Hledger/UI/MenuScreen.hs @@ -182,7 +182,7 @@ msHandle ev = do nonblanks = V.takeWhile (not . T.null . msItemScreenName) $ listElements $ _mssList sst lastnonblankidx = max 0 (length nonblanks - 1) -- journalspan = journalDateSpan False j - d = copts^.rsDay + d <- liftIO getCurrentDay case mode of Minibuffer _ ed -> diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index cda9137d1..e65acb587 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -191,8 +191,8 @@ rsHandle ev = do ,ajournal=j ,aMode=mode } -> do + d <- liftIO getCurrentDay let - d = copts^.rsDay journalspan = journalDateSpan False j nonblanks = V.takeWhile (not . T.null . rsItemDate) $ listElements $ _rssList lastnonblankidx = max 0 (length nonblanks - 1) diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 9e930ba99..00335d970 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -18,7 +18,6 @@ import Data.List import Data.Maybe import qualified Data.Text as T import Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft)) -import Lens.Micro ((^.)) import Brick import Brick.Widgets.List (listMoveTo) @@ -131,8 +130,8 @@ tsHandle ev = do _ -> helpHandle ev _ -> do + d <- liftIO getCurrentDay let - d = copts^.rsDay (iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts (inext,tnext) = maybe (i,t) ((i+1),) $ lookup (i+1) nts case ev of diff --git a/hledger-ui/Hledger/UI/UIScreens.hs b/hledger-ui/Hledger/UI/UIScreens.hs index 721928767..92f693955 100644 --- a/hledger-ui/Hledger/UI/UIScreens.hs +++ b/hledger-ui/Hledger/UI/UIScreens.hs @@ -42,6 +42,7 @@ import Hledger.Cli hiding (mode, progname,prognameandversion) import Hledger.UI.UIOptions import Hledger.UI.UITypes import Hledger.UI.UIUtils +import Data.Function ((&)) -- | Regenerate the content of any screen from new options, reporting date and journal. @@ -93,7 +94,7 @@ msUpdate = dlogUiTrace "msUpdate`" asNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen asNew uopts d j macct = dlogUiTrace "asNew" $ - AS $ + AS $ asUpdate uopts d j $ ASS { _assSelectedAccount = fromMaybe "" macct @@ -129,11 +130,11 @@ asUpdate uopts d j ass = dlogUiTrace "asUpdate" ass{_assList=l} (items, _) = balanceReport rspec' j where rspec' = - -- Further restrict the query based on the current period and future/forecast mode. - (reportSpecSetFutureAndForecast d (forecast_ $ inputopts_ copts) rspec) - {_rsReportOpts=ropts{ - declared_=True -- always show declared accounts even if unused - }} + updateReportSpec + ropts{declared_=True} -- always show declared accounts even if unused + rspec{_rsDay=d} -- update to the given day, might have changed since program start + & either (error "asUpdate: adjusting the query, should not have failed") id -- PARTIAL: + & reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts) -- include/exclude future & forecast transactions -- pre-render a list item displayitem (fullacct, shortacct, indent, bal) = @@ -158,7 +159,7 @@ asUpdate uopts d j ass = dlogUiTrace "asUpdate" ass{_assList=l} bsNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen bsNew uopts d j macct = dlogUiTrace "bsNew" $ - BS $ + BS $ bsUpdate uopts d j $ BSS { _bssSelectedAccount = fromMaybe "" macct @@ -194,16 +195,14 @@ bsUpdate uopts d j bss = dlogUiTrace "bsUpdate" bss{_bssList=l} (items, _) = balanceReport rspec' j where rspec' = - -- XXX recalculate reportspec properly here - -- Further restrict the query based on the current period and future/forecast mode. - (reportSpecSetFutureAndForecast d (forecast_ $ inputopts_ copts) $ - reportSpecAddQuery (Type [Asset,Liability,Equity]) - rspec){ - _rsReportOpts=ropts{ - declared_=True -- always show declared accounts even if unused - ,balanceaccum_=Historical -- always show historical end balances - } - } + updateReportSpec + ropts{declared_=True -- always show declared accounts even if unused + ,balanceaccum_=Historical -- always show historical end balances + } + rspec{_rsDay=d} -- update to the given day, might have changed since program start + & either (error "bsUpdate: adjusting the query, should not have failed") id -- PARTIAL: + & reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts) -- include/exclude future & forecast transactions + & reportSpecAddQuery (Type [Asset,Liability,Equity]) -- restrict to balance sheet accounts -- pre-render a list item displayitem (fullacct, shortacct, indent, bal) = @@ -229,7 +228,7 @@ bsUpdate uopts d j bss = dlogUiTrace "bsUpdate" bss{_bssList=l} rsNew :: UIOpts -> Day -> Journal -> AccountName -> Bool -> Screen rsNew uopts d j acct forceinclusive = -- XXX forcedefaultselection - whether to force selecting the last transaction. dlogUiTrace "rsNew" $ - RS $ + RS $ rsUpdate uopts d j $ RSS { _rssAccount = replaceHiddenAccountsNameWith "*" acct @@ -240,7 +239,7 @@ rsNew uopts d j acct forceinclusive = -- XXX forcedefaultselection - whether to -- | Update a register screen from these options, reporting date, and journal. rsUpdate :: UIOpts -> Day -> Journal -> RegisterScreenState -> RegisterScreenState rsUpdate uopts d j rss@RSS{_rssAccount, _rssForceInclusive, _rssList=oldlist} = - dlogUiTrace "rsUpdate" + dlogUiTrace "rsUpdate" rss{_rssList=l'} where UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} = uopts @@ -252,10 +251,6 @@ rsUpdate uopts d j rss@RSS{_rssAccount, _rssForceInclusive, _rssList=oldlist} = mkregex = if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex -- adjust the report options and report spec, carefully as usual to avoid screwups (#1523) - rspec' = - reportSpecSetFutureAndForecast d (forecast_ $ inputopts_ copts) . - either (error "rsUpdate: adjusting the query for register, should not have failed") id $ -- PARTIAL: - updateReportSpec ropts' rspec{_rsDay=d} ropts' = ropts { -- ignore any depth limit, as in postingsReport; allows register's total to match accounts screen depth_=Nothing @@ -265,6 +260,10 @@ rsUpdate uopts d j rss@RSS{_rssAccount, _rssForceInclusive, _rssList=oldlist} = -- always show historical balance -- , balanceaccum_= Historical } + rspec' = + updateReportSpec ropts' rspec{_rsDay=d} + & either (error "rsUpdate: adjusting the query for register, should not have failed") id -- PARTIAL: + & reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts) -- gather transactions to display items = accountTransactionsReport rspec' j thisacctq @@ -344,7 +343,7 @@ rsUpdate uopts d j rss@RSS{_rssAccount, _rssForceInclusive, _rssList=oldlist} = -- Screen-specific arguments: the account whose transactions are being shown, -- the list of showable transactions, the currently shown transaction. tsNew :: AccountName -> [NumberedTransaction] -> NumberedTransaction -> Screen -tsNew acct nts nt = +tsNew acct nts nt = dlogUiTrace "tsNew" $ TS TSS{ _tssAccount = acct diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index 2b52803fc..54665823b 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -48,7 +48,7 @@ import Control.Monad.IO.Class import Data.Bifunctor (second) import Data.List import qualified Data.Text as T -import Data.Time (Day, addDays) +import Data.Time (addDays) import Graphics.Vty (Event(..),Key(..),Modifier(..),Vty(..),Color,Attr,currentAttr,refresh, displayBounds -- ,Output(displayBounds,mkDisplayContext),DisplayContext(..) @@ -377,11 +377,11 @@ reportSpecAddQuery :: Query -> ReportSpec -> ReportSpec reportSpecAddQuery q rspec = rspec{_rsQuery=simplifyQuery $ And [_rsQuery rspec, q]} --- | Update the ReportSpec's query to exclude future transactions (later than the given day) +-- | Update the ReportSpec's query to exclude future transactions (later than its "today" date) -- and forecast transactions (generated by --forecast), if the given forecast DateSpan is Nothing, -- and include them otherwise. -reportSpecSetFutureAndForecast :: Day -> Maybe DateSpan -> ReportSpec -> ReportSpec -reportSpecSetFutureAndForecast d fcast rspec = +reportSpecSetFutureAndForecast :: Maybe DateSpan -> ReportSpec -> ReportSpec +reportSpecSetFutureAndForecast fcast rspec = rspec{_rsQuery=simplifyQuery $ And [_rsQuery rspec, periodq, excludeforecastq fcast]} where periodq = Date . periodAsDateSpan . period_ $ _rsReportOpts rspec @@ -389,7 +389,7 @@ reportSpecSetFutureAndForecast d fcast rspec = excludeforecastq (Just _) = Any excludeforecastq Nothing = -- not:date:tomorrow- not:tag:generated-transaction And [ - Not (Date $ DateSpan (Just $ addDays 1 d) Nothing) + Not (Date $ DateSpan (Just $ addDays 1 $ _rsDay rspec) Nothing) ,Not generatedTransactionTag ]