ui: extract journal reloading

This commit is contained in:
Simon Michael 2016-06-08 10:48:34 -07:00
parent 1e93feeff3
commit 70d596fb38
3 changed files with 16 additions and 17 deletions

View File

@ -37,7 +37,7 @@ import Hledger.UI.UIOptions
import Hledger.UI.UITypes import Hledger.UI.UITypes
import Hledger.UI.UIUtils import Hledger.UI.UIUtils
import qualified Hledger.UI.RegisterScreen as RS (screen, rsSetCurrentAccount) import qualified Hledger.UI.RegisterScreen as RS (screen, rsSetCurrentAccount)
import qualified Hledger.UI.ErrorScreen as ES (screen) import qualified Hledger.UI.ErrorScreen as ES (stReloadJournalIfChanged)
screen = AccountsScreen{ screen = AccountsScreen{
asState = (list "accounts" V.empty 1, "") asState = (list "accounts" V.empty 1, "")
@ -256,13 +256,7 @@ handleAccountsScreen st@AppState{
Vty.EvKey (Vty.KChar 'q') [] -> halt st' Vty.EvKey (Vty.KChar 'q') [] -> halt st'
-- Vty.EvKey (Vty.KChar 'l') [Vty.MCtrl] -> do -- Vty.EvKey (Vty.KChar 'l') [Vty.MCtrl] -> do
Vty.EvKey Vty.KEsc [] -> continue $ resetScreens d st' Vty.EvKey Vty.KEsc [] -> continue $ resetScreens d st'
Vty.EvKey (Vty.KChar 'g') [] -> liftIO (ES.stReloadJournalIfChanged copts d j st') >>= continue
Vty.EvKey (Vty.KChar 'g') [] -> do
(ej, _) <- liftIO $ journalReloadIfChanged copts d j
case ej of
Right j' -> continue $ reload j' d st'
Left err -> continue $ screenEnter d ES.screen{esState=err} st'
Vty.EvKey (Vty.KChar '-') [] -> continue $ regenerateScreens j d $ decDepth st' Vty.EvKey (Vty.KChar '-') [] -> continue $ regenerateScreens j d $ decDepth st'
Vty.EvKey (Vty.KChar '+') [] -> continue $ regenerateScreens j d $ incDepth st' Vty.EvKey (Vty.KChar '+') [] -> continue $ regenerateScreens j d $ incDepth st'
Vty.EvKey (Vty.KChar '=') [] -> continue $ regenerateScreens j d $ incDepth st' Vty.EvKey (Vty.KChar '=') [] -> continue $ regenerateScreens j d $ incDepth st'

View File

@ -3,7 +3,9 @@
{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} {-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
module Hledger.UI.ErrorScreen module Hledger.UI.ErrorScreen
(screen) (screen
,stReloadJournalIfChanged
)
where where
-- import Lens.Micro ((^.)) -- import Lens.Micro ((^.))
@ -123,3 +125,12 @@ handleErrorScreen st@AppState{
-- continue =<< handleEventLensed st someLens e -- continue =<< handleEventLensed st someLens e
handleErrorScreen _ _ = error "event handler called with wrong screen type, should not happen" handleErrorScreen _ _ = error "event handler called with wrong screen type, should not happen"
-- If journal file(s) have changed, reload the journal and regenerate all screens.
-- This is here so it can reference the error screen.
stReloadJournalIfChanged :: CliOpts -> Day -> Journal -> AppState -> IO AppState
stReloadJournalIfChanged copts d j st = do
(ej, _) <- journalReloadIfChanged copts d j
return $ case ej of
Right j' -> regenerateScreens j' d st
Left err -> screenEnter d screen{esState=err} st

View File

@ -33,7 +33,7 @@ import Hledger.UI.UIOptions
import Hledger.UI.UITypes import Hledger.UI.UITypes
import Hledger.UI.UIUtils import Hledger.UI.UIUtils
import qualified Hledger.UI.TransactionScreen as TS (screen) import qualified Hledger.UI.TransactionScreen as TS (screen)
import qualified Hledger.UI.ErrorScreen as ES (screen) import qualified Hledger.UI.ErrorScreen as ES (stReloadJournalIfChanged)
screen = RegisterScreen{ screen = RegisterScreen{
rsState = (list "register" V.empty 1, "") rsState = (list "register" V.empty 1, "")
@ -231,13 +231,7 @@ handleRegisterScreen st@AppState{
case ev of case ev of
Vty.EvKey (Vty.KChar 'q') [] -> halt st Vty.EvKey (Vty.KChar 'q') [] -> halt st
Vty.EvKey Vty.KEsc [] -> continue $ resetScreens d st Vty.EvKey Vty.KEsc [] -> continue $ resetScreens d st
Vty.EvKey (Vty.KChar 'g') [] -> liftIO (ES.stReloadJournalIfChanged copts d j st) >>= continue
Vty.EvKey (Vty.KChar 'g') [] -> do
(ej, _) <- liftIO $ journalReloadIfChanged copts d j
case ej of
Right j' -> continue $ regenerateScreens j' d st
Left err -> continue $ screenEnter d ES.screen{esState=err} st
Vty.EvKey (Vty.KChar 'E') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleEmpty st) Vty.EvKey (Vty.KChar 'E') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleEmpty st)
Vty.EvKey (Vty.KChar 'C') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleCleared st) Vty.EvKey (Vty.KChar 'C') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleCleared st)
Vty.EvKey (Vty.KChar 'U') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleUncleared st) Vty.EvKey (Vty.KChar 'U') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleUncleared st)