ui: --watch also tracks the current date, when appropriate

ie, when viewing a "current" period (the current day/week/month/quarter/year),
it will be moved to enclose the current date, if needed, whenever the system date changes.

hledger-lib/Hledger/Data/Period.hs

@@ -187,6 +187,18 @@ periodPreviousIn (DateSpan (Just b) _) p =
     me = periodEnd p'
 periodPreviousIn _ p = periodPrevious p
 
+-- | Move a period stepwise so that it encloses the given date.
+periodMoveTo :: Day -> Period -> Period
+periodMoveTo d (DayPeriod _) = DayPeriod d
+periodMoveTo d (WeekPeriod _) = WeekPeriod $ mondayBefore d
+periodMoveTo d (MonthPeriod _ _) = MonthPeriod y m where (y,m,_) = toGregorian d
+periodMoveTo d (QuarterPeriod _ _) = QuarterPeriod y q
+  where
+    (y,m,_) = toGregorian d
+    q = quarterContainingMonth m
+periodMoveTo d (YearPeriod _) = YearPeriod y where (y,_,_) = toGregorian d
+periodMoveTo _ p = p
+
 -- | Enlarge a standard period to the next larger enclosing standard period, if there is one.
 -- Eg, a day becomes the enclosing week.
 -- A week becomes whichever month the week's thursday falls into.

hledger-ui/Hledger/UI/AccountsScreen.hs

@@ -289,6 +289,9 @@ 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 be sure we don't leave unconsumed events piling up
+        AppEvent DateChange             -> 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)

hledger-ui/Hledger/UI/ErrorScreen.hs

@@ -92,7 +92,8 @@ esHandle ui@UIState{
             (pos,f) = case parsewithString hledgerparseerrorpositionp esError of
                         Right (f,l,c) -> (Just (l, Just c),f)
                         Left  _       -> (endPos, journalFilePath j)
-        e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
+--         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
 --           case ej of

hledger-ui/Hledger/UI/Main.hs

@@ -12,6 +12,7 @@ module Hledger.UI.Main where
 -- import Control.Applicative
 -- import Lens.Micro.Platform ((^.))
 import Control.Concurrent
+import Control.Concurrent.Async
 import Control.Monad
 -- import Control.Monad.IO.Class (liftIO)
 import Data.Default (def)
@@ -153,38 +154,54 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
   then
     void $ defaultMain brickapp ui
 
-  else
-    -- start one or more background jobs reporting changes in the directories of our files
-    -- XXX misses quick successive saves (still ? hard to reproduce now)
-    -- XXX then refuses to reload manually (should be fixed now ?)
-    --   withManagerConf defaultConfig{confDebounce=Debounce 1000} $ \mgr -> do
-    withManager $ \mgr -> do
-      dbg1IO "fsnotify using polling ?" $ isPollingManager mgr
-      files <- mapM canonicalizePath $ map fst $ jfiles j
-      let directories = nub $ sort $ map takeDirectory files
-      dbg1IO "files" files
-      dbg1IO "directories to watch" directories
+  else do
+    -- a channel for sending misc. events to the app
+    eventChan <- newChan
 
-      eventChan <- newChan
+    -- start a background thread reporting changes in the current date
+    -- use async for proper child termination in GHCI
+    let
+      watchDate lastd = 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
 
-      forM_ directories $ \d -> watchDir
-        mgr
-        d
-        -- predicate: ignore changes not involving our files
-        (\fev -> case fev of
-          Added    f _ -> f `elem` files
-          Modified f _ -> f `elem` files
-          Removed  f _ -> f `elem` files
-          )
-        -- action: send event to app
-        (\fev -> do
-          -- return $ dbglog "fsnotify" $ showFSNEvent fev -- not working
-          dbg1IO "fsnotify" $ showFSNEvent fev
-          writeChan eventChan FileChange
-          )
+    withAsync
+      (getCurrentDay >>= watchDate)
+      $ \_ -> do
 
-      -- must be inside the withManager block
-      void $ customMain (mkVty def) (Just eventChan) brickapp ui
+      -- start one or more background threads reporting changes in the directories of our files
+      -- XXX misses quick successive saves (still ? hard to reproduce now)
+      -- XXX then refuses to reload manually (should be fixed now ?)
+      --   withManagerConf defaultConfig{confDebounce=Debounce 1000} $ \mgr -> do
+      withManager $ \mgr -> do
+        dbg1IO "fsnotify using polling ?" $ isPollingManager mgr
+        files <- mapM canonicalizePath $ map fst $ jfiles j
+        let directories = nub $ sort $ map takeDirectory files
+        dbg1IO "files" files
+        dbg1IO "directories to watch" directories
+
+        forM_ directories $ \d -> watchDir
+          mgr
+          d
+          -- predicate: ignore changes not involving our files
+          (\fev -> case fev of
+            Added    f _ -> f `elem` files
+            Modified f _ -> f `elem` files
+            Removed  f _ -> f `elem` files
+            )
+          -- action: send event to app
+          (\fev -> do
+            -- return $ dbglog "fsnotify" $ showFSNEvent fev -- not working
+            dbg1IO "fsnotify" $ showFSNEvent fev
+            writeChan eventChan FileChange
+            )
+
+        -- and start the app. Must be inside the withManager block
+        void $ customMain (mkVty def) (Just eventChan) brickapp ui
 
 showFSNEvent (Added    f _) = "Added "    ++ show f
 showFSNEvent (Modified f _) = "Modified " ++ show f

hledger-ui/Hledger/UI/RegisterScreen.hs

@@ -267,6 +267,7 @@ 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
         e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
           liftIO (uiReloadJournal copts d ui) >>= continue
         VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)

hledger-ui/Hledger/UI/TransactionScreen.hs

@@ -129,6 +129,7 @@ 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
         e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> do
           d <- liftIO getCurrentDay
           ej <- liftIO $ journalReload copts

hledger-ui/Hledger/UI/UIState.hs

@@ -86,15 +86,23 @@ shrinkReportPeriod :: Day -> UIState -> UIState
 shrinkReportPeriod d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
   ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=periodShrink d $ period_ ropts}}}}
 
--- | Step the report start/end dates to the next period of same duration.
+-- | Step the report start/end dates to the next period of same duration,
+-- remaining inside the given enclosing span.
 nextReportPeriod :: DateSpan -> UIState -> UIState
-nextReportPeriod journalspan ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{period_=p}}}} =
-  ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=periodNextIn journalspan p}}}}
+nextReportPeriod enclosingspan ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{period_=p}}}} =
+  ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=periodNextIn enclosingspan p}}}}
 
--- | Step the report start/end dates to the next period of same duration.
+-- | Step the report start/end dates to the next period of same duration,
+-- remaining inside the given enclosing span.
 previousReportPeriod :: DateSpan -> UIState -> UIState
-previousReportPeriod journalspan ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{period_=p}}}} =
-  ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=periodPreviousIn journalspan p}}}}
+previousReportPeriod enclosingspan ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{period_=p}}}} =
+  ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=periodPreviousIn enclosingspan p}}}}
+
+-- | If a standard report period is set, step it forward/backward if needed so that
+-- it encloses the given date.
+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}}}}
 
 -- | Set the report period.
 setReportPeriod :: Period -> UIState -> UIState

hledger-ui/Hledger/UI/UITypes.hs

@@ -83,7 +83,8 @@ data Name =
   deriving (Ord, Show, Eq)
 
 data AppEvent =
-  FileChange
+    FileChange
+  | DateChange
   deriving (Eq, Show)
 
 -- | hledger-ui screen types & instances.

hledger-ui/doc/hledger-ui.1

@@ -40,7 +40,7 @@ Any QUERYARGS are interpreted as a hledger search query which filters
 the data.
 .TP
 .B \f[C]\-\-watch\f[]
-watch for data changes and reload automatically
+watch for data (and time) changes and reload automatically
 .RS
 .RE
 .TP
@@ -249,8 +249,11 @@ the transactions to be shown (by default, all are shown).
 report period durations: year, quarter, month, week, day.
 Then, \f[C]shift\-left/right\f[] moves to the previous/next period.
 \f[C]t\f[] sets the report period to today.
-(To set a non\-standard period, you can use \f[C]/\f[] and a
-\f[C]date:\f[] query).
+With the \f[C]\-\-watch\f[] option, when viewing a "current" period (the
+current day, week, month, quarter, or year), the period will move
+automatically to track the current date.
+To set a non\-standard period, you can use \f[C]/\f[] and a
+\f[C]date:\f[] query.
 .PP
 \f[C]/\f[] lets you set a general filter query limiting the data shown,
 using the same query terms as in hledger and hledger\-web.

hledger-ui/doc/hledger-ui.1.info

@@ -38,7 +38,7 @@ options as shown above.
 the data.
 
 `--watch'
-     watch for data changes and reload automatically
+     watch for data (and time) changes and reload automatically
 
 `--theme=default|terminal|greenterm'
      use this custom display theme
@@ -177,8 +177,10 @@ limiting the transactions to be shown (by default, all are shown).
 `shift-down/up' steps downward and upward through these standard report
 period durations: year, quarter, month, week, day. Then,
 `shift-left/right' moves to the previous/next period. `t' sets the
-report period to today. (To set a non-standard period, you can use `/'
-and a `date:' query).
+report period to today. With the `--watch' option, when viewing a
+"current" period (the current day, week, month, quarter, or year), the
+period will move automatically to track the current date. To set a
+non-standard period, you can use `/' and a `date:' query.
 
    `/' lets you set a general filter query limiting the data shown,
 using the same query terms as in hledger and hledger-web. While editing
@@ -358,17 +360,17 @@ Tag Table:
 Node: Top88
 Node: OPTIONS823
 Ref: #options922
-Node: KEYS3945
-Ref: #keys4042
-Node: SCREENS6443
-Ref: #screens6530
-Node: Accounts screen6620
-Ref: #accounts-screen6750
-Node: Register screen8788
-Ref: #register-screen8945
-Node: Transaction screen10833
-Ref: #transaction-screen10993
-Node: Error screen11860
-Ref: #error-screen11984
+Node: KEYS3956
+Ref: #keys4053
+Node: SCREENS6623
+Ref: #screens6710
+Node: Accounts screen6800
+Ref: #accounts-screen6930
+Node: Register screen8968
+Ref: #register-screen9125
+Node: Transaction screen11013
+Ref: #transaction-screen11173
+Node: Error screen12040
+Ref: #error-screen12164
 
 End Tag Table

hledger-ui/doc/hledger-ui.1.m4.md

@@ -50,7 +50,7 @@ Note: if invoking hledger-ui as a hledger subcommand, write `--` before options
 Any QUERYARGS are interpreted as a hledger search query which filters the data.
 
 `--watch`
-: watch for data changes and reload automatically
+: watch for data (and time) changes and reload automatically
 
 `--theme=default|terminal|greenterm`
 : use this custom display theme
@@ -98,7 +98,10 @@ limiting the transactions to be shown (by default, all are shown).
 year, quarter, month, week, day.
 Then, `shift-left/right` moves to the previous/next period.
 `t` sets the report period to today.
-(To set a non-standard period, you can use `/` and a `date:` query).
+With the `--watch` option, when viewing a "current" period 
+(the current day, week, month, quarter, or year),
+the period will move automatically to track the current date.
+To set a non-standard period, you can use `/` and a `date:` query.
 
 `/` lets you set a general filter query limiting the data shown,
 using the same [query terms](/hledger.html#queries) as in hledger and hledger-web.

hledger-ui/doc/hledger-ui.1.txt

@@ -36,7 +36,7 @@ OPTIONS
        the data.
 
        --watch
-              watch for data changes and reload automatically
+              watch for data (and time) changes and reload automatically
 
        --theme=default|terminal|greenterm
               use this custom display theme
@@ -163,8 +163,10 @@ KEYS
        shift-down/up  steps  downward and upward through these standard report
        period   durations:   year,   quarter,   month,   week,   day.    Then,
        shift-left/right  moves to the previous/next period.  t sets the report
-       period to today.  (To set a non-standard period, you can use  /  and  a
-       date: query).
+       period to today.  With the --watch option,  when  viewing  a  "current"
+       period  (the  current  day,  week, month, quarter, or year), the period
+       will move automatically to track the current date.  To set a  non-stan-
+       dard period, you can use / and a date: query.
 
        /  lets  you  set a general filter query limiting the data shown, using
        the same query terms as in hledger and hledger-web.  While editing  the

hledger-ui/hledger-ui.cabal

@@ -60,6 +60,7 @@ executable hledger-ui
       hledger >= 1.0.1 && < 1.1
     , hledger-lib >= 1.0.1 && < 1.1
     , ansi-terminal >= 0.6.2.3 && < 0.7
+    , async
     , base >= 4.8 && < 5
     , base-compat >= 0.8.1
     , cmdargs >= 0.8

hledger-ui/package.yaml

@@ -51,6 +51,7 @@ executables:
       - hledger >= 1.0.1 && < 1.1
       - hledger-lib >= 1.0.1 && < 1.1
       - ansi-terminal >= 0.6.2.3 && < 0.7
+      - async
       - base >= 4.8 && < 5
       - base-compat >= 0.8.1
       - cmdargs >= 0.8