ui: consistently support vi & emacs movement keys

hjkl and CTRL-bfnp should now work wherever unmodified arrow keys work.
(You must still use arrow keys with SHIFT for adjusting report period).

hledger-ui/Hledger/UI/AccountsScreen.hs

@@ -336,13 +336,12 @@ asHandle ui0@UIState{
         VtyEvent (EvKey (KLeft)     [MShift]) -> continue $ regenerateScreens j d $ previousReportPeriod journalspan ui
         VtyEvent (EvKey (KChar '/') []) -> continue $ regenerateScreens j d $ showMinibuffer ui
         VtyEvent (EvKey k           []) | k `elem` [KBS, KDel] -> (continue $ regenerateScreens j d $ resetFilter ui)
-        VtyEvent (EvKey k           []) | k `elem` [KLeft, KChar 'h']  -> continue $ popScreen ui
+        VtyEvent e | e `elem` moveLeftEvents -> continue $ popScreen ui
         VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle _asList >> invalidateCache >> continue ui
 
         -- enter register screen for selected account (if there is one), 
         -- centering its selected transaction if possible
-        VtyEvent (EvKey k           []) 
+        VtyEvent e | e `elem` moveRightEvents 
-          | k `elem` [KRight, KChar 'l']
                    , not $ isBlankElement $ listSelectedElement _asList->
           -- TODO center selection after entering register screen; neither of these works till second time entering; easy strictifications didn't help 
           rsCenterAndContinue $  
@@ -374,17 +373,11 @@ asHandle ui0@UIState{
             continue ui{aScreen=scr{_asList=list}}
           
         -- fall through to the list's event handler (handles up/down)
-        VtyEvent ev ->
+        VtyEvent ev -> do
-              do
+          newitems <- handleListEvent (normaliseMovementKeys ev) _asList
-                let ev' = case ev of
-                            EvKey (KChar 'k') [] -> EvKey (KUp) []
-                            EvKey (KChar 'j') [] -> EvKey (KDown) []
-                            _                    -> ev
-                newitems <- handleListEvent ev' _asList
           continue $ ui{aScreen=scr & asList .~ newitems
                                     & asSelectedAccount .~ selacct
                                     }
-                -- continue =<< handleEventLensed ui someLens ev
 
         AppEvent _        -> continue ui
         MouseDown _ _ _ _ -> continue ui

hledger-ui/Hledger/UI/RegisterScreen.hs

@@ -317,11 +317,11 @@ rsHandle ui@UIState{
         VtyEvent (EvKey (KRight)    [MShift]) -> continue $ regenerateScreens j d $ nextReportPeriod journalspan ui
         VtyEvent (EvKey (KLeft)     [MShift]) -> continue $ regenerateScreens j d $ previousReportPeriod journalspan ui
         VtyEvent (EvKey k           []) | k `elem` [KBS, KDel] -> (continue $ regenerateScreens j d $ resetFilter ui)
-        VtyEvent (EvKey k           []) | k `elem` [KLeft, KChar 'h']  -> continue $ popScreen ui
+        VtyEvent e | e `elem` moveLeftEvents  -> continue $ popScreen ui
         VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle rsList >> invalidateCache >> continue ui
 
         -- enter transaction screen for selected transaction
-        VtyEvent (EvKey k           []) | k `elem` [KRight, KChar 'l'] -> do
+        VtyEvent e | e `elem` moveRightEvents -> do
           case listSelectedElement rsList of
             Just (_, RegisterScreenItem{rsItemTransaction=t}) ->
               let
@@ -336,7 +336,7 @@ rsHandle ui@UIState{
 
         -- prevent moving down over blank padding items;
         -- instead scroll down by one, until maximally scrolled - shows the end has been reached
-        VtyEvent (EvKey (KDown)     []) | isBlankElement mnextelement -> do
+        VtyEvent e | e `elem` moveDownEvents, isBlankElement mnextelement -> do
           vScrollBy (viewportScroll $ rsList^.listNameL) 1 
           continue ui
           where 
@@ -355,13 +355,9 @@ rsHandle ui@UIState{
           
         -- fall through to the list's event handler (handles other [pg]up/down events)
         VtyEvent ev -> do
-                let ev' = case ev of
+          let ev' = normaliseMovementKeys ev
-                            EvKey (KChar 'k') [] -> EvKey (KUp) []
-                            EvKey (KChar 'j') [] -> EvKey (KDown) []
-                            _                    -> ev
           newitems <- handleListEvent ev' rsList
           continue ui{aScreen=s{rsList=newitems}}
-                -- continue =<< handleEventLensed ui someLens ev
 
         AppEvent _        -> continue ui
         MouseDown _ _ _ _ -> continue ui

hledger-ui/Hledger/UI/TransactionScreen.hs

@@ -168,9 +168,9 @@ tsHandle ui@UIState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
         -- EvKey (KChar 'E') [] -> continue $ regenerateScreens j d $ stToggleEmpty ui
         -- EvKey (KChar 'C') [] -> continue $ regenerateScreens j d $ stToggleCleared ui
         -- EvKey (KChar 'R') [] -> continue $ regenerateScreens j d $ stToggleReal ui
-        VtyEvent (EvKey k           []) | k `elem` [KUp, KChar 'k']   -> continue $ regenerateScreens j d ui{aScreen=s{tsTransaction=(iprev,tprev)}}
+        VtyEvent e | e `elem` moveUpEvents   -> continue $ regenerateScreens j d ui{aScreen=s{tsTransaction=(iprev,tprev)}}
-        VtyEvent (EvKey k           []) | k `elem` [KDown, KChar 'j'] -> continue $ regenerateScreens j d ui{aScreen=s{tsTransaction=(inext,tnext)}}
+        VtyEvent e | e `elem` moveDownEvents -> continue $ regenerateScreens j d ui{aScreen=s{tsTransaction=(inext,tnext)}}
-        VtyEvent (EvKey k           []) | k `elem` [KLeft, KChar 'h'] -> continue ui''
+        VtyEvent e | e `elem` moveLeftEvents -> continue ui''
           where
             ui'@UIState{aScreen=scr} = popScreen ui
             ui'' = ui'{aScreen=rsSelect (fromIntegral i) scr}

hledger-ui/Hledger/UI/UIUtils.hs

@@ -15,7 +15,7 @@ import Brick.Widgets.List
 import Data.List
 import Data.Maybe
 import Data.Monoid
-import Graphics.Vty (Event(..),Key(..),Color,Attr,currentAttr)
+import Graphics.Vty (Event(..),Key(..),Modifier(..),Color,Attr,currentAttr)
 import Lens.Micro.Platform
 import System.Process
 
@@ -44,10 +44,11 @@ helpDialog copts =
               padLeftRight 1 $
                 vBox [
                    str "NAVIGATION"
-                  ,renderKey ("UP/DOWN/k/j/PGUP/PGDN/HOME/END", "")
+                  ,renderKey ("UP/DOWN/PGUP/PGDN/HOME/END", "")
                   ,str "  move selection"
-                  ,renderKey ("RIGHT/l", "more detail")
+                  ,renderKey ("RIGHT", "more detail")
-                  ,renderKey ("LEFT/h", "previous screen")
+                  ,renderKey ("LEFT", "previous screen")
+                  ,str "  (or vi/emacs movement keys)"
                   ,renderKey ("ESC", "cancel / reset to top")
                   ,str " "
                   ,str "MISC"
@@ -125,7 +126,7 @@ helpDialog copts =
 helpHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)
 helpHandle ui ev =
   case ev of
-    VtyEvent (EvKey k []) | k `elem` [KEsc, KLeft, KChar 'h', KChar '?'] -> continue $ setMode Normal ui
+    VtyEvent e | e `elem` (moveLeftEvents ++ [EvKey KEsc [], EvKey (KChar '?') []]) -> continue $ setMode Normal ui
     VtyEvent (EvKey (KChar 't') []) -> suspendAndResume $ runHelp >> return ui'
     VtyEvent (EvKey (KChar 'm') []) -> suspendAndResume $ runMan  >> return ui'
     VtyEvent (EvKey (KChar 'i') []) -> suspendAndResume $ runInfo >> return ui'
@@ -285,3 +286,16 @@ scrollSelectionToMiddle list = do
         toprow       = dbg4 "toprow" $ max 0 (selectedrow - (itemsperpage `div` 2)) -- assuming ViewportScroll's row offset is measured in list items not screen rows
       setTop (viewportScroll vpname) toprow 
     _ -> return ()
+
+--                 arrow keys      vi keys               emacs keys
+moveUpEvents    = [EvKey KUp []  , EvKey (KChar 'k') [], EvKey (KChar 'p') [MCtrl]]
+moveDownEvents  = [EvKey KDown [], EvKey (KChar 'j') [], EvKey (KChar 'n') [MCtrl]]
+moveLeftEvents  = [EvKey KLeft [], EvKey (KChar 'h') [], EvKey (KChar 'b') [MCtrl]]
+moveRightEvents = [EvKey KLeft [], EvKey (KChar 'l') [], EvKey (KChar 'f') [MCtrl]]
+
+normaliseMovementKeys ev
+  | ev `elem` moveUpEvents    = EvKey KUp []
+  | ev `elem` moveDownEvents  = EvKey KDown []
+  | ev `elem` moveLeftEvents  = EvKey KLeft []
+  | ev `elem` moveRightEvents = EvKey KRight []
+  | otherwise = ev