From 6f85e02f1ab5988f66eb338004abb0f8c6fdc0fb Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Mon, 26 Oct 2015 07:41:45 -0700
Subject: [PATCH] ui: show an error screen when reloading fails

---
 doc/manual.md                           |   6 ++
 hledger-ui/Hledger/UI/AccountsScreen.hs |  17 ++-
 hledger-ui/Hledger/UI/ErrorScreen.hs    | 134 ++++++++++++++++++++++++
 hledger-ui/Hledger/UI/RegisterScreen.hs |  17 ++-
 hledger-ui/Hledger/UI/UITypes.hs        |  10 +-
 hledger-ui/hledger-ui.1.md              |   8 +-
 hledger-ui/hledger-ui.cabal             |   1 +
 7 files changed, 179 insertions(+), 14 deletions(-)
 create mode 100644 hledger-ui/Hledger/UI/ErrorScreen.hs

diff --git a/doc/manual.md b/doc/manual.md
index 223c56b30..c9d24f63b 100644
--- a/doc/manual.md
+++ b/doc/manual.md
@@ -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>
diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs
index 8b2a332a5..ef5e43856 100644
--- a/hledger-ui/Hledger/UI/AccountsScreen.hs
+++ b/hledger-ui/Hledger/UI/AccountsScreen.hs
@@ -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
diff --git a/hledger-ui/Hledger/UI/ErrorScreen.hs b/hledger-ui/Hledger/UI/ErrorScreen.hs
new file mode 100644
index 000000000..c415318b5
--- /dev/null
+++ b/hledger-ui/Hledger/UI/ErrorScreen.hs
@@ -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"
+
diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs
index 03a92a334..764954f25 100644
--- a/hledger-ui/Hledger/UI/RegisterScreen.hs
+++ b/hledger-ui/Hledger/UI/RegisterScreen.hs
@@ -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)
diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs
index f2383414f..71fe8b11b 100644
--- a/hledger-ui/Hledger/UI/UITypes.hs
+++ b/hledger-ui/Hledger/UI/UITypes.hs
@@ -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>"
diff --git a/hledger-ui/hledger-ui.1.md b/hledger-ui/hledger-ui.1.md
index e09ff5a39..116c724ef 100644
--- a/hledger-ui/hledger-ui.1.md
+++ b/hledger-ui/hledger-ui.1.md
@@ -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**
diff --git a/hledger-ui/hledger-ui.cabal b/hledger-ui/hledger-ui.cabal
index ef4eabc8c..c22eb483f 100644
--- a/hledger-ui/hledger-ui.cabal
+++ b/hledger-ui/hledger-ui.cabal
@@ -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