{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module Hledger.UI.ErrorScreen
(esNew
,esUpdate
,esDraw
,esHandle
,uiCheckBalanceAssertions
,uiReloadJournal
,uiReloadJournalIfChanged
)
where
import Brick
import Control.Monad
import Control.Monad.IO.Class (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 -> [Widget Name]
esDraw UIState{aScreen :: UIState -> Screen
aScreen=ES ESS{String
()
_essUnused :: ErrorScreenState -> ()
_essError :: ErrorScreenState -> String
_essUnused :: ()
_essError :: String
..}
,aMode :: UIState -> Mode
aMode=Mode
mode
} =
case Mode
mode of
Mode
Help -> [Widget Name
helpDialog, Widget Name
maincontent]
Mode
_ -> [Widget Name
maincontent]
where
maincontent :: Widget Name
maincontent = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy forall a b. (a -> b) -> a -> b
$ do
forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name -> Widget Name -> Widget Name
defaultLayout forall {n}. Widget n
toplabel Widget Name
bottomlabel forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withAttr (String -> AttrName
attrName String
"error") forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ String
_essError
where
toplabel :: Widget n
toplabel =
forall n. AttrName -> Widget n -> Widget n
withAttr (String -> AttrName
attrName String
"border" forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"bold") (forall n. String -> Widget n
str String
"Oops. Please fix this problem then press g to reload")
bottomlabel :: Widget Name
bottomlabel = Widget Name
quickhelp
where
quickhelp :: Widget Name
quickhelp = [(String, String)] -> Widget Name
borderKeysStr [
(String
"h", String
"help")
,(String
"ESC", String
"cancel/top")
,(String
"E", String
"editor")
,(String
"g", String
"reload")
,(String
"q", String
"quit")
]
esDraw UIState
_ = forall a. HasCallStack => String -> a
error String
"draw function called with wrong screen type, should not happen"
esHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
esHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
esHandle BrickEvent Name AppEvent
ev = do
UIState
ui0 <- EventM Name UIState UIState
get'
case UIState
ui0 of
ui :: UIState
ui@UIState{aScreen :: UIState -> Screen
aScreen=ES ESS{String
()
_essUnused :: ()
_essError :: String
_essUnused :: ErrorScreenState -> ()
_essError :: ErrorScreenState -> String
..}
,aopts :: UIState -> UIOpts
aopts=UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=CliOpts
copts}
,ajournal :: UIState -> Journal
ajournal=Journal
j
,aMode :: UIState -> Mode
aMode=Mode
mode
} ->
case Mode
mode of
Mode
Help ->
case BrickEvent Name AppEvent
ev of
VtyEvent (EvKey (KChar Char
'q') []) -> forall n s. EventM n s ()
halt
VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> forall n s. EventM n s ()
redraw
VtyEvent (EvKey (KChar Char
'z') [Modifier
MCtrl]) -> forall a s. Ord a => s -> EventM a s ()
suspend UIState
ui
BrickEvent Name AppEvent
_ -> BrickEvent Name AppEvent -> EventM Name UIState ()
helpHandle BrickEvent Name AppEvent
ev
Mode
_ -> do
Day
d <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Day
getCurrentDay
case BrickEvent Name AppEvent
ev of
VtyEvent (EvKey (KChar Char
'q') []) -> forall n s. EventM n s ()
halt
VtyEvent (EvKey Key
KEsc []) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
uiCheckBalanceAssertions Day
d forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
resetScreens Day
d UIState
ui
VtyEvent (EvKey (KChar Char
c) []) | Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'h',Char
'?'] -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Mode -> UIState -> UIState
setMode Mode
Help UIState
ui
VtyEvent (EvKey (KChar Char
'E') []) -> forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe TextPosition -> String -> IO ExitCode
runEditor Maybe TextPosition
pos String
f) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged CliOpts
copts Day
d Journal
j (UIState -> UIState
popScreen UIState
ui)
where
(Maybe TextPosition
pos,String
f) = case forall e a.
Parsec e String a -> String -> Either (ParseErrorBundle String e) a
parsewithString forall (t :: * -> *). ParsecT Void String t (String, Int, Int)
hledgerparseerrorpositionp String
_essError of
Right (String
f',Int
l,Int
c) -> (forall a. a -> Maybe a
Just (Int
l, forall a. a -> Maybe a
Just Int
c),String
f')
Left ParseErrorBundle String Void
_ -> (Maybe TextPosition
endPosition, Journal -> String
journalFilePath Journal
j)
BrickEvent Name AppEvent
e | BrickEvent Name AppEvent
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [forall n e. Event -> BrickEvent n e
VtyEvent (Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'g') []), forall n e. e -> BrickEvent n e
AppEvent AppEvent
FileChange] ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CliOpts -> Day -> UIState -> IO UIState
uiReloadJournal CliOpts
copts Day
d (UIState -> UIState
popScreen UIState
ui)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> UIState -> UIState
uiCheckBalanceAssertions Day
d
VtyEvent (EvKey (KChar Char
'I') []) -> UIState -> EventM Name UIState ()
put' forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
uiCheckBalanceAssertions Day
d (UIState -> UIState
popScreen forall a b. (a -> b) -> a -> b
$ UIState -> UIState
toggleIgnoreBalanceAssertions UIState
ui)
VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> forall n s. EventM n s ()
redraw
VtyEvent (EvKey (KChar Char
'z') [Modifier
MCtrl]) -> forall a s. Ord a => s -> EventM a s ()
suspend UIState
ui
BrickEvent Name AppEvent
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
UIState
_ -> forall a. String -> a
errorWrongScreenType String
"event handler"
hledgerparseerrorpositionp :: ParsecT Void String t (String, Int, Int)
hledgerparseerrorpositionp :: forall (t :: * -> *). ParsecT Void String t (String, Int, Int)
hledgerparseerrorpositionp = do
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"'
String
f <- forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'"',Char
'\n'])
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [
do
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
" (line "
Int
l <- forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
", column "
Int
c <- forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
forall (m :: * -> *) a. Monad m => a -> m a
return (String
f, Int
l, Int
c),
do
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
" (lines "
Int
l <- forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-'
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
')'
forall (m :: * -> *) a. Monad m => a -> m a
return (String
f, Int
l, Int
1)
]
uiReloadJournal :: CliOpts -> Day -> UIState -> IO UIState
uiReloadJournal :: CliOpts -> Day -> UIState -> IO UIState
uiReloadJournal CliOpts
copts Day
d UIState
ui = do
Either String Journal
ej <-
let copts' :: CliOpts
copts' = UIState -> CliOpts -> CliOpts
enableForecastPreservingPeriod UIState
ui CliOpts
copts
in forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ CliOpts -> ExceptT String IO Journal
journalReload CliOpts
copts'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either String Journal
ej of
Right Journal
j ->
Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d UIState
ui
Left String
err ->
case UIState
ui of
UIState{aScreen :: UIState -> Screen
aScreen=ES ErrorScreenState
_} -> UIState
ui{aScreen :: Screen
aScreen=String -> Screen
esNew String
err}
UIState
_ -> Screen -> UIState -> UIState
pushScreen (String -> Screen
esNew String
err) UIState
ui
uiReloadJournalIfChanged :: CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged :: CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged CliOpts
copts Day
d Journal
j UIState
ui = do
let copts' :: CliOpts
copts' = UIState -> CliOpts -> CliOpts
enableForecastPreservingPeriod UIState
ui CliOpts
copts
Either String (Journal, Bool)
ej <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ CliOpts -> Day -> Journal -> ExceptT String IO (Journal, Bool)
journalReloadIfChanged CliOpts
copts' Day
d Journal
j
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either String (Journal, Bool)
ej of
Right (Journal
j', Bool
_) -> Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j' Day
d UIState
ui
Left String
err -> case UIState -> Screen
aScreen UIState
ui of
ES ErrorScreenState
_ -> UIState
ui{aScreen :: Screen
aScreen=String -> Screen
esNew String
err}
Screen
_ -> Screen -> UIState -> UIState
pushScreen (String -> Screen
esNew String
err) UIState
ui
uiCheckBalanceAssertions :: Day -> UIState -> UIState
uiCheckBalanceAssertions :: Day -> UIState -> UIState
uiCheckBalanceAssertions Day
_d ui :: UIState
ui@UIState{ajournal :: UIState -> Journal
ajournal=Journal
j}
| UIState
uiforall s a. s -> Getting a s a -> a
^.forall c. HasBalancingOpts c => Lens' c Bool
ignore_assertions = UIState
ui
| Bool
otherwise =
case Journal -> Maybe String
journalCheckBalanceAssertions Journal
j of
Maybe String
Nothing -> UIState
ui
Just String
err ->
case UIState
ui of
UIState{aScreen :: UIState -> Screen
aScreen=ES ErrorScreenState
sst} -> UIState
ui{aScreen :: Screen
aScreen=ErrorScreenState -> Screen
ES ErrorScreenState
sst{_essError :: String
_essError=String
err}}
UIState
_ -> Screen -> UIState -> UIState
pushScreen (String -> Screen
esNew String
err) UIState
ui