ui: with --watch, react to file changes in real time

Experimental, tested on OSX so far.
Rapid successive file changes can cause it to get stuck.
This commit is contained in:
Simon Michael 2016-11-24 11:03:32 -08:00
parent 36c75841ee
commit b09b3a7be6
13 changed files with 98 additions and 39 deletions

View File

@ -289,7 +289,8 @@ 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
VtyEvent (EvKey (KChar 'g') []) -> liftIO (uiReloadJournalIfChanged copts d j ui) >>= continue
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
liftIO (uiReloadJournalIfChanged copts d j ui) >>= continue
VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
VtyEvent (EvKey (KChar 'a') []) -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> uiReloadJournalIfChanged copts d j ui
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor endPos (journalFilePath j)) >> uiReloadJournalIfChanged copts d j ui

View File

@ -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)
VtyEvent (EvKey (KChar 'g') []) -> liftIO (uiReloadJournalIfChanged copts d j (popScreen ui)) >>= continue . uiCheckBalanceAssertions d
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
liftIO (uiReloadJournalIfChanged copts d j (popScreen ui)) >>= continue . uiCheckBalanceAssertions d
-- (ej, _) <- liftIO $ journalReloadIfChanged copts d j
-- case ej of
-- Left err -> continue ui{aScreen=s{esError=err}} -- show latest parse error

View File

@ -11,18 +11,22 @@ module Hledger.UI.Main where
-- import Control.Applicative
-- import Lens.Micro.Platform ((^.))
import Control.Concurrent
import Control.Monad
-- import Control.Monad.IO.Class (liftIO)
-- import Data.Default
import Data.Default (def)
-- import Data.Monoid --
import Data.List
import Data.Maybe
-- import Data.Text (Text)
import qualified Data.Text as T
-- import Data.Time.Calendar
import Graphics.Vty (mkVty)
import Safe
import System.Exit
import System.Directory
import System.FilePath
import System.FSNotify
import Brick
import Hledger
@ -143,5 +147,36 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
, appDraw = \ui -> sDraw (aScreen ui) ui
}
void $ defaultMain brickapp ui
-- start one or more background jobs reporting changes in the directories of our files
-- XXX misses quick successive saves (then refuses to reload manually)
-- withManagerConf defaultConfig{confDebounce=Debounce 1000} $ \mgr -> do
eventChan <- newChan
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
)
-- start the brick 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
showFSNEvent (Removed f _) = "Removed " ++ show f

View File

@ -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
VtyEvent (EvKey (KChar 'g') []) -> liftIO (uiReloadJournalIfChanged copts d j ui) >>= continue
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
liftIO (uiReloadJournalIfChanged copts d j ui) >>= continue
VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
VtyEvent (EvKey (KChar 'a') []) -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> uiReloadJournalIfChanged copts d j ui
VtyEvent (EvKey (KChar 't') []) -> continue $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui

View File

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

View File

@ -26,7 +26,8 @@ prognameandversion = progname ++ " " ++ version :: String
uiflags = [
-- flagNone ["debug-ui"] (\opts -> setboolopt "rules-file" opts) "run with no terminal output, showing console"
flagReq ["theme"] (\s opts -> Right $ setopt "theme" s opts) "THEME" ("use this custom display theme ("++intercalate ", " themeNames++")")
flagNone ["watch"] (\opts -> setboolopt "watch" opts) "watch for data changes and reload automatically"
,flagReq ["theme"] (\s opts -> Right $ setopt "theme" s opts) "THEME" ("use this custom display theme ("++intercalate ", " themeNames++")")
,flagReq ["register"] (\s opts -> Right $ setopt "register" s opts) "ACCTREGEX" "start in the (first) matched account's register"
,flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show full account names, unindented"
-- ,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components"
@ -51,7 +52,7 @@ uimode = (mode "hledger-ui" [("command","ui")]
-- hledger-ui options, used in hledger-ui and above
data UIOpts = UIOpts {
debug_ui_ :: Bool
watch_ :: Bool
,cliopts_ :: CliOpts
} deriving (Show)
@ -65,7 +66,7 @@ rawOptsToUIOpts :: RawOpts -> IO UIOpts
rawOptsToUIOpts rawopts = checkUIOpts <$> do
cliopts <- rawOptsToCliOpts rawopts
return defuiopts {
debug_ui_ = boolopt "debug-ui" rawopts
watch_ = boolopt "watch" rawopts
,cliopts_ = cliopts
}

View File

@ -82,7 +82,9 @@ data Name =
| RegisterList
deriving (Ord, Show, Eq)
data AppEvent = DummyEvent
data AppEvent =
FileChange
deriving (Eq, Show)
-- | hledger-ui screen types & instances.
-- Each screen type has generically named initialisation, draw, and event handling functions,

View File

@ -39,8 +39,13 @@ Note: if invoking hledger\-ui as a hledger subcommand, write
Any QUERYARGS are interpreted as a hledger search query which filters
the data.
.TP
.B \f[C]\-\-flat\f[]
show full account names, unindented
.B \f[C]\-\-watch\f[]
watch for data changes and reload automatically
.RS
.RE
.TP
.B \f[C]\-\-theme=default|terminal|greenterm\f[]
use this custom display theme
.RS
.RE
.TP
@ -49,8 +54,8 @@ start in the (first) matched account\[aq]s register screen
.RS
.RE
.TP
.B \f[C]\-\-theme=default|terminal|greenterm\f[]
use this custom display theme
.B \f[C]\-\-flat\f[]
show full account names, unindented
.RS
.RE
.TP

View File

@ -37,14 +37,17 @@ options as shown above.
Any QUERYARGS are interpreted as a hledger search query which filters
the data.
`--flat'
show full account names, unindented
`--watch'
watch for data changes and reload automatically
`--theme=default|terminal|greenterm'
use this custom display theme
`--register=ACCTREGEX'
start in the (first) matched account's register screen
`--theme=default|terminal|greenterm'
use this custom display theme
`--flat'
show full account names, unindented
`-V --value'
show amounts as their current market value in their default
@ -351,17 +354,17 @@ Tag Table:
Node: Top88
Node: OPTIONS823
Ref: #options922
Node: KEYS3786
Ref: #keys3883
Node: SCREENS6284
Ref: #screens6371
Node: Accounts screen6461
Ref: #accounts-screen6591
Node: Register screen8629
Ref: #register-screen8786
Node: Transaction screen10674
Ref: #transaction-screen10834
Node: Error screen11701
Ref: #error-screen11825
Node: KEYS3850
Ref: #keys3947
Node: SCREENS6348
Ref: #screens6435
Node: Accounts screen6525
Ref: #accounts-screen6655
Node: Register screen8693
Ref: #register-screen8850
Node: Transaction screen10738
Ref: #transaction-screen10898
Node: Error screen11765
Ref: #error-screen11889

End Tag Table

View File

@ -49,14 +49,17 @@ 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.
`--flat`
: show full account names, unindented
`--watch`
: watch for data changes and reload automatically
`--theme=default|terminal|greenterm`
: use this custom display theme
`--register=ACCTREGEX`
: start in the (first) matched account's register screen
`--theme=default|terminal|greenterm`
: use this custom display theme
`--flat`
: show full account names, unindented
`-V --value`
: show amounts as their current market value in their default valuation commodity

View File

@ -35,13 +35,16 @@ OPTIONS
Any QUERYARGS are interpreted as a hledger search query which filters
the data.
--flat show full account names, unindented
--watch
watch for data changes and reload automatically
--theme=default|terminal|greenterm
use this custom display theme
--register=ACCTREGEX
start in the (first) matched account's register screen
--theme=default|terminal|greenterm
use this custom display theme
--flat show full account names, unindented
-V --value
show amounts as their current market value in their default val-

View File

@ -65,7 +65,9 @@ executable hledger-ui
, cmdargs >= 0.8
, containers
, data-default
, directory
, filepath
, fsnotify >= 0.2 && < 0.3
, HUnit
, microlens >= 0.4 && < 0.5
, microlens-platform >= 0.2.3.1 && < 0.4

View File

@ -56,7 +56,9 @@ executables:
- cmdargs >= 0.8
- containers
- data-default
- directory
- filepath
- fsnotify >= 0.2 && < 0.3
- HUnit
- microlens >= 0.4 && < 0.5
- microlens-platform >= 0.2.3.1 && < 0.4