From 9952f93e97787e88e19515fc5db23a74a62b860b Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Fri, 2 Dec 2016 15:36:23 -0800
Subject: [PATCH] ui: --watch date tracking fixes

- move the period only if it's "current" (contains the old "today" date)
- make it work on all screens, not just accounts
---
 hledger-lib/Hledger/Data/Dates.hs          |  6 ++++++
 hledger-ui/Hledger/UI/AccountsScreen.hs    |  5 +++--
 hledger-ui/Hledger/UI/ErrorScreen.hs       |  1 -
 hledger-ui/Hledger/UI/Main.hs              | 13 +++++++------
 hledger-ui/Hledger/UI/RegisterScreen.hs    |  3 ++-
 hledger-ui/Hledger/UI/TransactionScreen.hs |  3 ++-
 hledger-ui/Hledger/UI/UIState.hs           |  5 +++++
 hledger-ui/Hledger/UI/UITypes.hs           |  4 ++--
 8 files changed, 27 insertions(+), 13 deletions(-)

diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs
index b814d5c88..7133dcf2a 100644
--- a/hledger-lib/Hledger/Data/Dates.hs
+++ b/hledger-lib/Hledger/Data/Dates.hs
@@ -34,6 +34,7 @@ module Hledger.Data.Dates (
   getCurrentYear,
   nulldate,
   spanContainsDate,
+  periodContainsDate,
   parsedateM,
   parsedate,
   showDate,
@@ -212,6 +213,11 @@ spanContainsDate (DateSpan Nothing (Just e))  d = d < e
 spanContainsDate (DateSpan (Just b) Nothing)  d = d >= b
 spanContainsDate (DateSpan (Just b) (Just e)) d = d >= b && d < e
 
+-- | Does the period include the given date ?
+-- (Here to avoid import cycle).
+periodContainsDate :: Period -> Day -> Bool
+periodContainsDate p = spanContainsDate (periodAsDateSpan p)
+
 -- | Calculate the intersection of a number of datespans.
 spansIntersect [] = nulldatespan
 spansIntersect [d] = d
diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs
index 0e01235da..7a51e0783 100644
--- a/hledger-ui/Hledger/UI/AccountsScreen.hs
+++ b/hledger-ui/Hledger/UI/AccountsScreen.hs
@@ -289,9 +289,10 @@ asHandle ui0@UIState{
         -- EvKey (KChar 'l') [MCtrl] -> do
         VtyEvent (EvKey KEsc        []) -> continue $ resetScreens d ui
         VtyEvent (EvKey (KChar c)   []) | c `elem` ['?'] -> continue $ setMode Help ui
-        -- XXX handles FileChange/DateChange events only in Normal mode ?
+        -- XXX AppEvents currently handled only in Normal mode
         -- XXX be sure we don't leave unconsumed events piling up
-        AppEvent DateChange             -> continue $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
+        AppEvent (DateChange old _) | periodContainsDate (reportPeriod ui) old ->
+          continue $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
         e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
           liftIO (uiReloadJournal copts d ui) >>= continue
         VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
diff --git a/hledger-ui/Hledger/UI/ErrorScreen.hs b/hledger-ui/Hledger/UI/ErrorScreen.hs
index 92405f69c..967a1b98f 100644
--- a/hledger-ui/Hledger/UI/ErrorScreen.hs
+++ b/hledger-ui/Hledger/UI/ErrorScreen.hs
@@ -92,7 +92,6 @@ esHandle ui@UIState{
             (pos,f) = case parsewithString hledgerparseerrorpositionp esError of
                         Right (f,l,c) -> (Just (l, Just c),f)
                         Left  _       -> (endPos, journalFilePath j)
---         AppEvent DateChange             -> continue $ regenerateScreens j d ui
         e | e `elem` [VtyEvent (EvKey (KChar 'g') [])] ->
           liftIO (uiReloadJournal copts d (popScreen ui)) >>= continue . uiCheckBalanceAssertions d
 --           (ej, _) <- liftIO $ journalReloadIfChanged copts d j
diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs
index 6431ec0f3..e5d367d89 100644
--- a/hledger-ui/Hledger/UI/Main.hs
+++ b/hledger-ui/Hledger/UI/Main.hs
@@ -161,13 +161,14 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
     -- start a background thread reporting changes in the current date
     -- use async for proper child termination in GHCI
     let
-      watchDate lastd = do
+      watchDate old = do
         threadDelay 1000000 -- 1s
-        d <- getCurrentDay
-        when (d /= lastd) $ do
-          -- dbg1IO "datechange" DateChange -- XXX don't uncomment until dbg*IO fixed to use traceIO, GHC may block/end thread
-          writeChan eventChan DateChange
-        watchDate d
+        new <- getCurrentDay
+        when (new /= old) $ do
+          let dc = DateChange old new
+          -- dbg1IO "datechange" dc -- XXX don't uncomment until dbg*IO fixed to use traceIO, GHC may block/end thread
+          writeChan eventChan dc
+        watchDate new
 
     withAsync
       (getCurrentDay >>= watchDate)
diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs
index 88a595e74..542d8ae85 100644
--- a/hledger-ui/Hledger/UI/RegisterScreen.hs
+++ b/hledger-ui/Hledger/UI/RegisterScreen.hs
@@ -267,7 +267,8 @@ rsHandle ui@UIState{
         VtyEvent (EvKey (KChar 'q') []) -> halt ui
         VtyEvent (EvKey KEsc        []) -> continue $ resetScreens d ui
         VtyEvent (EvKey (KChar c)   []) | c `elem` ['?'] -> continue $ setMode Help ui
-        AppEvent DateChange             -> continue $ regenerateScreens j d ui
+        AppEvent (DateChange old _) | periodContainsDate (reportPeriod ui) old ->
+          continue $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
         e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
           liftIO (uiReloadJournal copts d ui) >>= continue
         VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs
index 27441533c..301fa6d99 100644
--- a/hledger-ui/Hledger/UI/TransactionScreen.hs
+++ b/hledger-ui/Hledger/UI/TransactionScreen.hs
@@ -129,7 +129,8 @@ tsHandle ui@UIState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
         VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j ui
           where
             (pos,f) = let GenericSourcePos f l c = tsourcepos t in (Just (l, Just c),f)
-        AppEvent DateChange             -> continue $ regenerateScreens j d ui
+        AppEvent (DateChange old _) | periodContainsDate (reportPeriod ui) old ->
+          continue $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
         e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> do
           d <- liftIO getCurrentDay
           ej <- liftIO $ journalReload copts
diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs
index a05641f4c..456380df3 100644
--- a/hledger-ui/Hledger/UI/UIState.hs
+++ b/hledger-ui/Hledger/UI/UIState.hs
@@ -104,6 +104,11 @@ moveReportPeriodToDate :: Day -> UIState -> UIState
 moveReportPeriodToDate d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{period_=p}}}} =
   ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=periodMoveTo d p}}}}
 
+-- | Get the report period.
+reportPeriod :: UIState -> Period
+reportPeriod UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ReportOpts{period_=p}}}} =
+  p
+
 -- | Set the report period.
 setReportPeriod :: Period -> UIState -> UIState
 setReportPeriod p ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs
index f46d92580..14667e799 100644
--- a/hledger-ui/Hledger/UI/UITypes.hs
+++ b/hledger-ui/Hledger/UI/UITypes.hs
@@ -83,8 +83,8 @@ data Name =
   deriving (Ord, Show, Eq)
 
 data AppEvent =
-    FileChange
-  | DateChange
+    FileChange          -- one of the Journal's files has been added/modified/removed
+  | DateChange Day Day  -- the current date has changed since last checked (with the old and new values)
   deriving (Eq, Show)
 
 -- | hledger-ui screen types & instances.