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

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

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

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

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

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)

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

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.
+                  updateReportSpec
-                  (reportSpecSetFutureAndForecast d (forecast_ $ inputopts_ copts) rspec)
+                    ropts{declared_=True}  -- always show declared accounts even if unused
-                    {_rsReportOpts=ropts{
+                    rspec{_rsDay=d}        -- update to the given day, might have changed since program start
-                       declared_=True                     -- always show declared accounts even if unused
+                  & 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
+                  updateReportSpec
-                  -- Further restrict the query based on the current period and future/forecast mode.
+                    ropts{declared_=True            -- always show declared accounts even if unused
-                  (reportSpecSetFutureAndForecast d (forecast_ $ inputopts_ copts) $
+                         ,balanceaccum_=Historical  -- always show historical end balances
-                  reportSpecAddQuery (Type [Asset,Liability,Equity])
+                         }
-                  rspec){
+                    rspec{_rsDay=d}                 -- update to the given day, might have changed since program start
-                    _rsReportOpts=ropts{
+                  & either (error "bsUpdate: adjusting the query, should not have failed") id -- PARTIAL:
-                       declared_=True                     -- always show declared accounts even if unused
+                  & reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts)  -- include/exclude future & forecast transactions
-                      ,balanceaccum_=Historical           -- always show historical end balances
+                  & 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

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 :: Maybe DateSpan -> ReportSpec -> ReportSpec
-reportSpecSetFutureAndForecast d fcast rspec =
+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
       ]