a5f4d2fd6e
Follow-on from the brick 1.0 migration work (#1889, #1919). These new types aim to be more restrictive, allowing fewer invalid states, and easier to inspect and debug. The screen types store only state, not behaviour (functions), and there is no longer a circular dependency between UIState and Screen.
193 lines
7.5 KiB
Haskell
193 lines
7.5 KiB
Haskell
-- The error screen, showing a current error condition (such as a parse error after reloading the journal)
|
||
|
||
{-# LANGUAGE FlexibleContexts #-}
|
||
{-# LANGUAGE OverloadedStrings #-}
|
||
{-# LANGUAGE RecordWildCards #-}
|
||
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
|
||
|
||
module Hledger.UI.ErrorScreen
|
||
(esDraw
|
||
,esHandle
|
||
,uiCheckBalanceAssertions
|
||
,uiReloadJournal
|
||
,uiReloadJournalIfChanged
|
||
)
|
||
where
|
||
|
||
import Brick
|
||
-- import Brick.Widgets.Border ("border")
|
||
import Control.Monad
|
||
import Control.Monad.Except (liftIO)
|
||
import Data.Time.Calendar (Day)
|
||
import Data.Void (Void)
|
||
import Graphics.Vty (Event(..),Key(..),Modifier(..))
|
||
import Lens.Micro ((^.))
|
||
import Text.Megaparsec
|
||
import Text.Megaparsec.Char
|
||
|
||
import Hledger.Cli hiding (mode, progname,prognameandversion)
|
||
import Hledger.UI.UIOptions
|
||
import Hledger.UI.UITypes
|
||
import Hledger.UI.UIState
|
||
import Hledger.UI.UIUtils
|
||
import Hledger.UI.UIScreens
|
||
import Hledger.UI.Editor
|
||
|
||
esDraw :: UIState -> [Widget Name]
|
||
esDraw UIState{aopts=UIOpts{uoCliOpts=copts}
|
||
,aScreen=ES ESS{..}
|
||
,aMode=mode
|
||
} =
|
||
case mode of
|
||
Help -> [helpDialog copts, maincontent]
|
||
-- Minibuffer e -> [minibuffer e, maincontent]
|
||
_ -> [maincontent]
|
||
where
|
||
maincontent = Widget Greedy Greedy $ do
|
||
render $ defaultLayout toplabel bottomlabel $ withAttr (attrName "error") $ str $ _essError
|
||
where
|
||
toplabel =
|
||
withAttr (attrName "border" <> attrName "bold") (str "Oops. Please fix this problem then press g to reload")
|
||
-- <+> (if ignore_assertions_ copts then withAttr ("border" <> "query") (str " ignoring") else str " not ignoring")
|
||
|
||
bottomlabel = quickhelp
|
||
-- case mode of
|
||
-- Minibuffer ed -> minibuffer ed
|
||
-- _ -> quickhelp
|
||
where
|
||
quickhelp = borderKeysStr [
|
||
("h", "help")
|
||
,("ESC", "cancel/top")
|
||
,("E", "editor")
|
||
,("g", "reload")
|
||
,("q", "quit")
|
||
]
|
||
|
||
esDraw _ = error "draw function called with wrong screen type, should not happen" -- PARTIAL:
|
||
|
||
esHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
||
esHandle ev = do
|
||
ui0 <- get'
|
||
case ui0 of
|
||
ui@UIState{aScreen=ES ESS{..}
|
||
,aopts=UIOpts{uoCliOpts=copts}
|
||
,ajournal=j
|
||
,aMode=mode
|
||
} ->
|
||
case mode of
|
||
Help ->
|
||
case ev of
|
||
VtyEvent (EvKey (KChar 'q') []) -> halt
|
||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||
_ -> helpHandle ev
|
||
|
||
_ -> do
|
||
let d = copts^.rsDay
|
||
case ev of
|
||
VtyEvent (EvKey (KChar 'q') []) -> halt
|
||
VtyEvent (EvKey KEsc []) -> put' $ uiCheckBalanceAssertions d $ resetScreens d ui
|
||
VtyEvent (EvKey (KChar c) []) | c `elem` ['h','?'] -> put' $ setMode Help ui
|
||
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j (popScreen ui)
|
||
where
|
||
(pos,f) = case parsewithString hledgerparseerrorpositionp _essError of
|
||
Right (f',l,c) -> (Just (l, Just c),f')
|
||
Left _ -> (endPosition, journalFilePath j)
|
||
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
|
||
liftIO (uiReloadJournal copts d (popScreen ui)) >>= put' . uiCheckBalanceAssertions d
|
||
-- (ej, _) <- liftIO $ journalReloadIfChanged copts d j
|
||
-- case ej of
|
||
-- Left err -> continue ui{aScreen=s{esError=err}} -- show latest parse error
|
||
-- Right j' -> continue $ regenerateScreens j' d $ popScreen ui -- return to previous screen, and reload it
|
||
VtyEvent (EvKey (KChar 'I') []) -> put' $ uiCheckBalanceAssertions d (popScreen $ toggleIgnoreBalanceAssertions ui)
|
||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||
_ -> return ()
|
||
|
||
_ -> errorWrongScreenType "event handler"
|
||
|
||
-- | Parse the file name, line and column number from a hledger parse error message, if possible.
|
||
-- Temporary, we should keep the original parse error location. XXX
|
||
-- Keep in sync with 'Hledger.Data.Transaction.showGenericSourcePos'
|
||
hledgerparseerrorpositionp :: ParsecT Void String t (String, Int, Int)
|
||
hledgerparseerrorpositionp = do
|
||
anySingle `manyTill` char '"'
|
||
f <- anySingle `manyTill` (oneOf ['"','\n'])
|
||
choice [
|
||
do
|
||
string " (line "
|
||
l <- read <$> some digitChar
|
||
string ", column "
|
||
c <- read <$> some digitChar
|
||
return (f, l, c),
|
||
do
|
||
string " (lines "
|
||
l <- read <$> some digitChar
|
||
char '-'
|
||
some digitChar
|
||
char ')'
|
||
return (f, l, 1)
|
||
]
|
||
|
||
|
||
-- | Unconditionally reload the journal, regenerating the current screen
|
||
-- and all previous screens in the history as of the provided today-date.
|
||
-- If reloading fails, enter the error screen, or if we're already
|
||
-- on the error screen, update the error displayed.
|
||
-- Defined here so it can reference the error screen.
|
||
--
|
||
-- The provided CliOpts are used for reloading, and then saved in the
|
||
-- UIState if reloading is successful (otherwise the UIState keeps its old
|
||
-- CliOpts.) (XXX needed for.. ?)
|
||
--
|
||
-- Forecasted transactions are always generated, as at hledger-ui startup.
|
||
-- If a forecast period is specified in the provided opts, or was specified
|
||
-- at startup, it is preserved.
|
||
--
|
||
uiReloadJournal :: CliOpts -> Day -> UIState -> IO UIState
|
||
uiReloadJournal copts d ui = do
|
||
ej <-
|
||
let copts' = enableForecastPreservingPeriod ui copts
|
||
in runExceptT $ journalReload copts'
|
||
return $ case ej of
|
||
Right j -> regenerateScreens j d ui
|
||
Left err ->
|
||
case ui of
|
||
UIState{aScreen=ES _} -> ui{aScreen=esNew err}
|
||
_ -> pushScreen (esNew err) ui
|
||
-- XXX GHC 9.2 warning:
|
||
-- hledger-ui/Hledger/UI/ErrorScreen.hs:164:59: warning: [-Wincomplete-record-updates]
|
||
-- Pattern match(es) are non-exhaustive
|
||
-- In a record-update construct:
|
||
-- Patterns of type ‘Screen’ not matched:
|
||
-- AccountsScreen _ _ _ _ _
|
||
-- RegisterScreen _ _ _ _ _ _
|
||
-- TransactionScreen _ _ _ _ _ _
|
||
|
||
-- | Like uiReloadJournal, but does not re-parse the journal if the file(s)
|
||
-- have not changed since last loaded. Always regenerates the screens though,
|
||
-- since the provided options or today-date may have changed.
|
||
uiReloadJournalIfChanged :: CliOpts -> Day -> Journal -> UIState -> IO UIState
|
||
uiReloadJournalIfChanged copts d j ui = do
|
||
let copts' = enableForecastPreservingPeriod ui copts
|
||
ej <- runExceptT $ journalReloadIfChanged copts' d j
|
||
return $ case ej of
|
||
Right (j', _) -> regenerateScreens j' d ui
|
||
Left err -> case aScreen ui of
|
||
ES _ -> ui{aScreen=esNew err}
|
||
_ -> pushScreen (esNew err) ui
|
||
|
||
-- Re-check any balance assertions in the current journal, and if any
|
||
-- fail, enter (or update) the error screen. Or if balance assertions
|
||
-- are disabled, do nothing.
|
||
uiCheckBalanceAssertions :: Day -> UIState -> UIState
|
||
uiCheckBalanceAssertions _d ui@UIState{ajournal=j}
|
||
| ui^.ignore_assertions = ui
|
||
| otherwise =
|
||
case journalCheckBalanceAssertions j of
|
||
Nothing -> ui
|
||
Just err ->
|
||
case ui of
|
||
UIState{aScreen=ES sst} -> ui{aScreen=ES sst{_essError=err}}
|
||
_ -> pushScreen (esNew err) ui
|