imp: ui: fix a probable bug with detecting date change while running

This commit is contained in:
Simon Michael 2022-09-08 11:56:20 -10:00
parent b81c2395d5
commit fb0053c15f
8 changed files with 34 additions and 36 deletions

View File

@ -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 ->

View File

@ -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 ->

View File

@ -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

View File

@ -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 ->

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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
]