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:
		
							parent
							
								
									36c75841ee
								
							
						
					
					
						commit
						b09b3a7be6
					
				| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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,8 +66,8 @@ rawOptsToUIOpts :: RawOpts -> IO UIOpts | ||||
| rawOptsToUIOpts rawopts = checkUIOpts <$> do | ||||
|   cliopts <- rawOptsToCliOpts rawopts | ||||
|   return defuiopts { | ||||
|               debug_ui_ = boolopt "debug-ui" rawopts | ||||
|              ,cliopts_   = cliopts | ||||
|               watch_   = boolopt "watch" rawopts | ||||
|              ,cliopts_ = cliopts | ||||
|              } | ||||
| 
 | ||||
| checkUIOpts :: UIOpts -> UIOpts | ||||
|  | ||||
| @ -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, | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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- | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user