From e3a7f6697edfbb027bda2e208683339ef5e55042 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 1 Dec 2016 19:26:17 -0800 Subject: [PATCH] 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 | 12 ++++ hledger-ui/Hledger/UI/AccountsScreen.hs | 3 + hledger-ui/Hledger/UI/ErrorScreen.hs | 3 +- hledger-ui/Hledger/UI/Main.hs | 75 +++++++++++++--------- hledger-ui/Hledger/UI/RegisterScreen.hs | 1 + hledger-ui/Hledger/UI/TransactionScreen.hs | 1 + hledger-ui/Hledger/UI/UIState.hs | 20 ++++-- hledger-ui/Hledger/UI/UITypes.hs | 3 +- hledger-ui/doc/hledger-ui.1 | 9 ++- hledger-ui/doc/hledger-ui.1.info | 32 ++++----- hledger-ui/doc/hledger-ui.1.m4.md | 7 +- hledger-ui/doc/hledger-ui.1.txt | 8 ++- hledger-ui/hledger-ui.cabal | 1 + hledger-ui/package.yaml | 1 + 14 files changed, 116 insertions(+), 60 deletions(-) diff --git a/hledger-lib/Hledger/Data/Period.hs b/hledger-lib/Hledger/Data/Period.hs index 38ccfa46a..4c3a39561 100644 --- a/hledger-lib/Hledger/Data/Period.hs +++ b/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. diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index aac1cd703..0e01235da 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/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) diff --git a/hledger-ui/Hledger/UI/ErrorScreen.hs b/hledger-ui/Hledger/UI/ErrorScreen.hs index a45ff3c18..92405f69c 100644 --- a/hledger-ui/Hledger/UI/ErrorScreen.hs +++ b/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 diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index 8c214fbfd..6431ec0f3 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/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 diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 1a080e64f..88a595e74 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/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) diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index cad5e75c2..27441533c 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/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 diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs index 0f23433cb..a05641f4c 100644 --- a/hledger-ui/Hledger/UI/UIState.hs +++ b/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 diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index 491c946e9..f46d92580 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/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. diff --git a/hledger-ui/doc/hledger-ui.1 b/hledger-ui/doc/hledger-ui.1 index 2cc8dbbb9..c82138535 100644 --- a/hledger-ui/doc/hledger-ui.1 +++ b/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. diff --git a/hledger-ui/doc/hledger-ui.1.info b/hledger-ui/doc/hledger-ui.1.info index 6a22e44c3..a77e5e1b1 100644 --- a/hledger-ui/doc/hledger-ui.1.info +++ b/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 diff --git a/hledger-ui/doc/hledger-ui.1.m4.md b/hledger-ui/doc/hledger-ui.1.m4.md index 829b1242b..1ef7cba4f 100644 --- a/hledger-ui/doc/hledger-ui.1.m4.md +++ b/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. diff --git a/hledger-ui/doc/hledger-ui.1.txt b/hledger-ui/doc/hledger-ui.1.txt index bbdbef1e2..e32bb7b97 100644 --- a/hledger-ui/doc/hledger-ui.1.txt +++ b/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 diff --git a/hledger-ui/hledger-ui.cabal b/hledger-ui/hledger-ui.cabal index 5be1503bf..4a9d82fd8 100644 --- a/hledger-ui/hledger-ui.cabal +++ b/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 diff --git a/hledger-ui/package.yaml b/hledger-ui/package.yaml index a4d49a78f..7db925af8 100644 --- a/hledger-ui/package.yaml +++ b/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