slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ui: show an error screen when reloading fails

Browse Source
This commit is contained in:
Simon Michael 2015-10-26 07:41:45 -07:00
parent 13b6d142c6
commit 6f85e02f1a
7 changed files with 179 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
doc/manual.md
View File

@ -2263,6 +2263,12 @@ hledger-web, and other accounting systems), rather than postings
if you have adjusted the report start date. Currently it always
shows the running total).
##### Error screen
This screen will appear if there is a problem, such as a parse error,
when you press g to reload. Once you have fixed the problem described,
press g again to reload and restore normal operation.
#### web
<style>

17
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -33,6 +33,7 @@ import Hledger.UI.UIOptions
import Hledger.UI.UITypes
import Hledger.UI.UIUtils
import qualified Hledger.UI.RegisterScreen as RS (screen)
import qualified Hledger.UI.ErrorScreen as ES (screen)
screen = AccountsScreen{
asState = list "accounts" V.empty 1
@ -213,12 +214,18 @@ handleAccountsScreen st@AppState{
Vty.EvKey Vty.KEsc [] -> halt st
Vty.EvKey (Vty.KChar 'q') [] -> halt st
-- Vty.EvKey (Vty.KChar 'l') [Vty.MCtrl] -> do
Vty.EvKey (Vty.KChar 'g') [] -> do
(ej, changed) <- liftIO $ journalReloadIfChanged copts j
case (changed, ej) of
(True, Right j') -> reload st{ajournal=j'}
-- (True, Left err) -> continue st{amsg=err} -- XXX report parse error
_ -> continue st
ej <- liftIO $ journalReload j
case ej of
Right j' -> reload st{ajournal=j'}
Left err -> continue $ screenEnter d ES.screen{esState=err} st
-- (ej, changed) <- liftIO $ journalReloadIfChanged copts j
-- case (changed, ej) of
-- (True, Right j') -> reload st{ajournal=j'}
-- -- (True, Left err) -> continue st{amsg=err} -- XXX report parse error
-- _ -> continue st
Vty.EvKey (Vty.KChar '-') [] -> reload $ decDepth st
Vty.EvKey (Vty.KChar '+') [] -> reload $ incDepth st
Vty.EvKey (Vty.KChar '=') [] -> reload $ incDepth st

134
hledger-ui/Hledger/UI/ErrorScreen.hs Normal file
View File

@ -0,0 +1,134 @@
-- The error screen, showing a current error condition (such as a parse error after reloading the journal)
{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
module Hledger.UI.ErrorScreen
(screen)
where
-- import Control.Lens ((^.))
import Control.Monad.IO.Class (liftIO)
import Data.Monoid
-- import Data.Maybe
import Data.Time.Calendar (Day)
import Graphics.Vty as Vty
import Brick
-- import Brick.Widgets.List
-- import Brick.Widgets.Border
-- import Brick.Widgets.Border.Style
-- import Brick.Widgets.Center
-- import Text.Printf
-- import Hledger
import Hledger.Cli hiding (progname,prognameandversion,green)
import Hledger.UI.UIOptions
-- import Hledger.UI.Theme
import Hledger.UI.UITypes
import Hledger.UI.UIUtils
screen = ErrorScreen{
esState = ""
,sInitFn = initErrorScreen
,sDrawFn = drawErrorScreen
,sHandleFn = handleErrorScreen
}
initErrorScreen :: Day -> AppState -> AppState
initErrorScreen _ st@AppState{aScreen=ErrorScreen{}} = st
initErrorScreen _ _ = error "init function called with wrong screen type, should not happen"
drawErrorScreen :: AppState -> [Widget]
drawErrorScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}},
aScreen=ErrorScreen{esState=err}} = [ui]
where
toplabel = withAttr ("border" <> "bold") (str "Problem - please fix then press g to reload")
-- <+> str " transactions"
-- <+> borderQueryStr querystr -- no, account transactions report shows all transactions in the acct ?
-- <+> str " and subs"
-- <+> str " ("
-- <+> cur
-- <+> str "/"
-- <+> total
-- <+> str ")"
-- cur = str $ case l^.listSelectedL of
-- Nothing -> "-"
-- Just i -> show (i + 1)
-- total = str $ show $ length displayitems
-- displayitems = V.toList $ l^.listElementsL
bottomlabel = borderKeysStr [
-- ("up/down/pgup/pgdown/home/end", "move")
("g", "reload")
-- ,("left", "return to accounts")
]
-- query = query_ $ reportopts_ $ cliopts_ opts
ui = Widget Greedy Greedy $ do
-- calculate column widths, based on current available width
-- c <- getContext
-- let
-- totalwidth = c^.availWidthL
-- - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils)
render $ defaultLayout toplabel bottomlabel $
vBox $ map str $ lines err
drawErrorScreen _ = error "draw function called with wrong screen type, should not happen"
-- drawErrorItem :: (Int,Int,Int,Int,Int) -> Bool -> (String,String,String,String,String) -> Widget
-- drawErrorItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected (date,desc,accts,change,bal) =
-- Widget Greedy Fixed $ do
-- render $
-- str (fitString (Just datewidth) (Just datewidth) True True date) <+>
-- str " " <+>
-- str (fitString (Just descwidth) (Just descwidth) True True desc) <+>
-- str " " <+>
-- str (fitString (Just acctswidth) (Just acctswidth) True True accts) <+>
-- str " " <+>
-- withAttr changeattr (str (fitString (Just changewidth) (Just changewidth) True False change)) <+>
-- str " " <+>
-- withAttr balattr (str (fitString (Just balwidth) (Just balwidth) True False bal))
-- where
-- changeattr | '-' `elem` change = sel $ "list" <> "amount" <> "decrease"
-- | otherwise = sel $ "list" <> "amount" <> "increase"
-- balattr | '-' `elem` bal = sel $ "list" <> "balance" <> "negative"
-- | otherwise = sel $ "list" <> "balance" <> "positive"
-- sel | selected = (<> "selected")
-- | otherwise = id
handleErrorScreen :: AppState -> Vty.Event -> EventM (Next AppState)
handleErrorScreen st@AppState{
aScreen=s@ErrorScreen{esState=_err}
,aopts=UIOpts{cliopts_=_copts}
,ajournal=j
} e = do
-- d <- liftIO getCurrentDay
-- let
-- reload = continue . initErrorScreen d
case e of
Vty.EvKey Vty.KEsc [] -> halt st
Vty.EvKey (Vty.KChar 'q') [] -> halt st
Vty.EvKey (Vty.KChar 'g') [] -> do
ej <- liftIO $ journalReload j
case ej of
Left err -> continue st{aScreen=s{esState=err}} -- show latest parse error
Right _j' -> continue $ popScreen st -- return to previous screen. XXX should reload it too
-- (ej, changed) <- liftIO $ journalReloadIfChanged copts j
-- case (changed, ej) of
-- (True, Right j') -> reload st{ajournal=j'}
-- -- (True, Left err) -> continue st{amsg=err} -- XXX report parse error
-- _ -> continue st
-- Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st
-- Vty.EvKey (Vty.KRight) [] -> error (show curItem) where curItem = listSelectedElement is
-- fall through to the list's event handler (handles [pg]up/down)
_ -> do continue st
-- is' <- handleEvent ev is
-- continue st{aScreen=s{rsState=is'}}
-- continue =<< handleEventLensed st someLens e
handleErrorScreen _ _ = error "event handler called with wrong screen type, should not happen"

17
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -28,6 +28,7 @@ import Hledger.UI.UIOptions
-- import Hledger.UI.Theme
import Hledger.UI.UITypes
import Hledger.UI.UIUtils
import qualified Hledger.UI.ErrorScreen as ES (screen)
screen = RegisterScreen{
rsState = list "register" V.empty 1
@ -193,12 +194,18 @@ handleRegisterScreen st@AppState{
case e of
Vty.EvKey Vty.KEsc [] -> halt st
Vty.EvKey (Vty.KChar 'q') [] -> halt st
Vty.EvKey (Vty.KChar 'g') [] -> do
(ej, changed) <- liftIO $ journalReloadIfChanged copts j
case (changed, ej) of
(True, Right j') -> reload st{ajournal=j'}
-- (True, Left err) -> continue st{amsg=err} -- XXX report parse error
_ -> continue st
ej <- liftIO $ journalReload j
case ej of
Right j' -> reload st{ajournal=j'}
Left err -> continue $ screenEnter d ES.screen{esState=err} st
-- (ej, changed) <- liftIO $ journalReloadIfChanged copts j
-- case (changed, ej) of
-- (True, Right j') -> reload st{ajournal=j'}
-- -- (True, Left err) -> continue st{amsg=err} -- XXX report parse error
-- _ -> continue st
Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st
-- Vty.EvKey (Vty.KRight) [] -> error (show curItem) where curItem = listSelectedElement is
-- fall through to the list's event handler (handles [pg]up/down)

10
hledger-ui/Hledger/UI/UITypes.hs
View File

@ -25,18 +25,24 @@ data AppState = AppState {
-- of their state (which must have unique accessor names).
data Screen =
AccountsScreen {
asState :: List (Int,String,String,[String]) -- ^ indent level, full account name, full or short account name to display, rendered amounts
asState :: List (Int,String,String,[String]) -- ^ list of (indent level, full account name, full or short account name to display, rendered amounts)
,sInitFn :: Day -> AppState -> AppState -- ^ function to initialise the screen's state on entry
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) -- ^ brick event handler to use for this screen
,sDrawFn :: AppState -> [Widget] -- ^ brick renderer to use for this screen
}
| RegisterScreen {
rsState :: List (String,String,String,String,String) -- ^ date, description, other accts, change amt, balance amt
rsState :: List (String,String,String,String,String) -- ^ list of (date, description, other accts, change amt, balance amt)
,rsAcct :: AccountName -- ^ the account we are showing a register for
,sInitFn :: Day -> AppState -> AppState
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
,sDrawFn :: AppState -> [Widget]
}
| ErrorScreen {
esState :: String -- ^ error message to display
,sInitFn :: Day -> AppState -> AppState
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
,sDrawFn :: AppState -> [Widget]
}
deriving (Show)
instance Show (List a) where show _ = "<List>"

8
hledger-ui/hledger-ui.1.md
View File

@ -109,8 +109,6 @@ The following common hledger options should also work:
# SCREENS
Currently there are two:
## Accounts screen
This is the screen shown at startup by default.
@ -152,6 +150,12 @@ hledger-web, and other accounting systems), rather than postings
if you have adjusted the report start date. Currently it always
shows the running total).
## Error screen
This screen will appear if there is a problem, such as a parse error,
when you press g to reload. Once you have fixed the problem described,
press g again to reload and restore normal operation.
# ENVIRONMENT
**LEDGER_FILE**

1
hledger-ui/hledger-ui.cabal
View File

@ -81,5 +81,6 @@ executable hledger-ui
Hledger.UI.UITypes
Hledger.UI.UIUtils
Hledger.UI.AccountsScreen
Hledger.UI.ErrorScreen
Hledger.UI.RegisterScreen
default-language: Haskell2010