203 lines
8.0 KiB
Haskell
203 lines
8.0 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
|
||
(errorScreen
|
||
,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 (progname,prognameandversion)
|
||
import Hledger.UI.UIOptions
|
||
import Hledger.UI.UITypes
|
||
import Hledger.UI.UIState
|
||
import Hledger.UI.UIUtils
|
||
import Hledger.UI.Editor
|
||
|
||
errorScreen :: Screen
|
||
errorScreen = ErrorScreen{
|
||
sInit = esInit
|
||
,sDraw = esDraw
|
||
,sHandle = esHandle
|
||
,esError = ""
|
||
}
|
||
|
||
esInit :: Day -> Bool -> UIState -> UIState
|
||
esInit _ _ ui@UIState{aScreen=ErrorScreen{}} = ui
|
||
esInit _ _ _ = error "init function called with wrong screen type, should not happen" -- PARTIAL:
|
||
|
||
esDraw :: UIState -> [Widget Name]
|
||
esDraw UIState{aopts=UIOpts{uoCliOpts=copts}
|
||
,aScreen=ErrorScreen{..}
|
||
,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 $ esError
|
||
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=ErrorScreen{..}
|
||
,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 esError 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=s@ErrorScreen{}} -> ui{aScreen=s{esError=err}}
|
||
_ -> screenEnter d errorScreen{esError=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 ui of
|
||
UIState{aScreen=s@ErrorScreen{}} -> ui{aScreen=s{esError=err}}
|
||
_ -> screenEnter d errorScreen{esError=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=s@ErrorScreen{}} -> ui{aScreen=s{esError=err}}
|
||
_ -> screenEnter d errorScreen{esError=err} ui
|