dev: ui: avoid MonadFail entirely, simplifying ghc version compat (#1889)

hledger-ui/Hledger/UI/AccountsScreen.hs

@@ -227,24 +227,25 @@ asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
 
 asHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
 asHandle ev = do
-  ui0@UIState{
+  ui0 <- get
+  case ui0 of
+    ui1@UIState{
       aScreen=scr@AccountsScreen{..}
       ,aopts=UIOpts{uoCliOpts=copts}
       ,ajournal=j
       ,aMode=mode
-  } <- get  -- PARTIAL: should not fail
+      } -> do
-  let
-    d = copts^.rsDay
-    nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ _asList^.listElementsL
-    lastnonblankidx = max 0 (length nonblanks - 1)
-    journalspan = journalDateSpan False j
 
-  -- save the currently selected account, in case we leave this screen and lose the selection
       let
+        -- save the currently selected account, in case we leave this screen and lose the selection
         selacct = case listSelectedElement _asList of
                     Just (_, AccountsScreenItem{..}) -> asItemAccountName
                     Nothing -> scr ^. asSelectedAccount
-    ui = ui0{aScreen=scr & asSelectedAccount .~ selacct}
+        ui = ui1{aScreen=scr & asSelectedAccount .~ selacct}
+        nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ _asList^.listElementsL
+        lastnonblankidx = max 0 (length nonblanks - 1)
+        journalspan = journalDateSpan False j
+        d = copts^.rsDay
 
       case mode of
         Minibuffer _ ed ->
@@ -334,7 +335,7 @@ asHandle ev = do
             -- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347
             -- just use it to move the selection
             MouseDown _n BLeft _mods Location{loc=(_x,y)} | not $ (=="") clickedacct -> do
-          case scr of AccountsScreen{} -> put ui{aScreen=scr}; _ -> fail ""  -- PARTIAL: should not happen
+              put ui{aScreen=scr}  -- XXX does this do anything ?
               where clickedacct = maybe "" asItemAccountName $ listElements _asList !? y
             -- and on MouseUp, enter the subscreen
             MouseUp _n (Just BLeft) Location{loc=(_x,y)} | not $ (=="") clickedacct -> do
@@ -343,7 +344,7 @@ asHandle ev = do
 
             -- when selection is at the last item, DOWN scrolls instead of moving, until maximally scrolled
             VtyEvent e | e `elem` moveDownEvents, isBlankElement mnextelement -> do
-          vScrollBy (viewportScroll $ _asList^.listNameL) 1 >> put ui
+              vScrollBy (viewportScroll $ _asList^.listNameL) 1
               where mnextelement = listSelectedElement $ listMoveDown _asList
 
             -- mouse scroll wheel scrolls the viewport up or down to its maximum extent,
@@ -351,7 +352,7 @@ asHandle ev = do
             MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do
               let scrollamt = if btn==BScrollUp then -1 else 1
               list' <- nestEventM' _asList $ listScrollPushingSelection name (asListSize _asList) scrollamt
-          case scr of AccountsScreen{} -> put ui{aScreen=scr{_asList=list'}}; _ -> fail ""  -- PARTIAL: should not fail
+              put ui{aScreen=scr{_asList=list'}}
 
             -- if page down or end leads to a blank padding item, stop at last non-blank
             VtyEvent e@(EvKey k           []) | k `elem` [KPageDown, KEnd] -> do
@@ -360,9 +361,9 @@ asHandle ev = do
               then do
                 let list' = listMoveTo lastnonblankidx list
                 scrollSelectionToMiddle list'
-            case scr of AccountsScreen{} -> put ui{aScreen=scr{_asList=list'}}; _ -> fail ""  -- PARTIAL: should not fail
+                put ui{aScreen=scr{_asList=list'}}
               else
-            case scr of AccountsScreen{} -> put ui{aScreen=scr{_asList=list}}; _ -> fail ""  -- PARTIAL: should not fail
+                put ui{aScreen=scr{_asList=list}}
 
             -- fall through to the list's event handler (handles up/down)
             VtyEvent ev -> do
@@ -373,6 +374,8 @@ asHandle ev = do
             MouseUp{}   -> put ui
             AppEvent _  -> put ui
 
+    _ -> errorWrongScreenType
+
 asEnterRegister d selacct ui = do
   rsCenterAndContinue $
   -- flip rsHandle (VtyEvent (EvKey (KChar 'l') [MCtrl])) $

hledger-ui/Hledger/UI/ErrorScreen.hs

@@ -77,11 +77,13 @@ esDraw _ = error "draw function called with wrong screen type, should not happen
 
 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
-                   } <- get
+              } ->
       case mode of
         Help ->
           case ev of
@@ -112,6 +114,8 @@ esHandle ev = do
             VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
             _ -> return ()
 
+    _ -> errorWrongScreenType
+
 -- | 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'

hledger-ui/Hledger/UI/RegisterScreen.hs

@@ -279,12 +279,14 @@ rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected Regist
 
 rsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
 rsHandle ev = do
+  ui0 <- get
+  case ui0 of
     ui@UIState{
       aScreen=s@RegisterScreen{..}
       ,aopts=UIOpts{uoCliOpts=copts}
       ,ajournal=j
       ,aMode=mode
-  } <- get
+      } -> do
       let
         d = copts^.rsDay
         journalspan = journalDateSpan False j
@@ -417,6 +419,8 @@ rsHandle ev = do
             MouseUp{}         -> put ui
             AppEvent _        -> put ui
 
+    _ -> errorWrongScreenType
+
 isBlankElement mel = ((rsItemDate . snd) <$> mel) == Just ""
 
 rsCenterAndContinue ui = do

hledger-ui/Hledger/UI/TransactionScreen.hs

@@ -143,11 +143,13 @@ tsDraw _ = error "draw function called with wrong screen type, should not happen
 
 tsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
 tsHandle ev = do
+  ui0 <- get
+  case ui0 of
     ui@UIState{aScreen=TransactionScreen{tsTransaction=(i,t), tsTransactions=nts}
                     ,aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}
                     ,ajournal=j
                     ,aMode=mode
-                   } <- get
+                    } ->
       case mode of
         Help ->
           case ev of
@@ -204,6 +206,8 @@ tsHandle ev = do
             VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
             _ -> return ()
 
+    _ -> errorWrongScreenType
+
 -- | Select a new transaction and update the previous register screen
 tsSelect i t ui@UIState{aScreen=s@TransactionScreen{}} = case aPrevScreens ui of
     x:xs -> ui'{aPrevScreens=rsSelect i x : xs}

hledger-ui/Hledger/UI/UITypes.hs

@@ -135,6 +135,9 @@ data Screen =
     }
   deriving (Show)
 
+-- | Error message to use in case statements adapting to the different Screen shapes.
+errorWrongScreenType = error' "handler called with wrong screen type, should not happen"
+
 -- | An item in the accounts screen's list of accounts and balances.
 data AccountsScreenItem = AccountsScreenItem {
    asItemIndentLevel        :: Int                -- ^ indent level
@@ -155,10 +158,6 @@ data RegisterScreenItem = RegisterScreenItem {
   }
   deriving (Show)
 
-instance MonadFail (EventM Name UIState) where fail _ = wrongScreenTypeError
-
-wrongScreenTypeError = error' "handler called with wrong screen type, should not happen"
-
 type NumberedTransaction = (Integer, Transaction)
 
 -- dummy monoid instance needed make lenses work with List fields not common across constructors