Add h/j/k/l movement to hledger-ui

hledger-ui/Hledger/UI/AccountsScreen.hs

@@ -5,7 +5,7 @@
 
 module Hledger.UI.AccountsScreen
  (accountsScreen
- ,asInit
+ ,asInit_
  ,asSetSelectedAccount
  )
 where
@@ -35,22 +35,22 @@ import Hledger.UI.UIUtils
 import Hledger.UI.RegisterScreen
 import Hledger.UI.ErrorScreen
 
-accountsScreen :: Screen
+accountsScreen :: AccountsScreen
 accountsScreen = AccountsScreen{
-   sInit   = asInit
-  ,sDraw   = asDraw
-  ,sHandle = asHandle
+   asInit   = asInit_
+  ,asDraw   = asDraw_
+  ,asHandle = asHandle_
   ,_asList            = list "accounts" V.empty 1
   ,_asSelectedAccount = ""
   }
 
-asInit :: Day -> Bool -> UIState -> UIState
-asInit d reset ui@UIState{
+asInit_ :: Day -> Bool -> UIState -> UIState
+asInit_ d reset ui@UIState{
   aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}},
   ajournal=j,
-  aScreen=s@AccountsScreen{}
+  aScreen=AcctsScreen(s@AccountsScreen{})
   } =
-  ui{aopts=uopts', aScreen=s & asList .~ newitems'}
+  ui{aopts=uopts', aScreen=AcctsScreen (s & asList .~ newitems')}
    where
     newitems = list (Name "accounts") (V.fromList displayitems) 1
 
@@ -95,14 +95,14 @@ asInit d reset ui@UIState{
     displayitems = map displayitem items
 
 
-asInit _ _ _ = error "init function called with wrong screen type, should not happen"
+asInit_ _ _ _ = error "init function called with wrong screen type, should not happen"
 
-asDraw :: UIState -> [Widget]
-asDraw UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
-                           ,ajournal=j
-                           ,aScreen=s@AccountsScreen{}
-                           ,aMode=mode
-                           } =
+asDraw_ :: UIState -> [Widget]
+asDraw_ UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
+                            ,ajournal=j
+                            ,aScreen=AcctsScreen(s@AccountsScreen{})
+                            ,aMode=mode
+                            } =
   case mode of
     Help       -> [helpDialog, maincontent]
     -- Minibuffer e -> [minibuffer e, maincontent]
@@ -196,7 +196,7 @@ asDraw UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
           ,("q", "quit")
           ]
 
-asDraw _ = error "draw function called with wrong screen type, should not happen"
+asDraw_ _ = error "draw function called with wrong screen type, should not happen"
 
 asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget
 asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
@@ -225,9 +225,9 @@ asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
         sel | selected  = (<> "selected")
             | otherwise = id
 
-asHandle :: UIState -> Event -> EventM (Next UIState)
-asHandle ui0@UIState{
-   aScreen=scr@AccountsScreen{..}
+asHandle_ :: UIState -> Event -> EventM (Next UIState)
+asHandle_ ui0@UIState{
+   aScreen=AcctsScreen(scr@AccountsScreen{..})
   ,aopts=UIOpts{cliopts_=copts}
   ,ajournal=j
   ,aMode=mode
@@ -242,7 +242,7 @@ asHandle ui0@UIState{
     selacct = case listSelectedElement $ scr ^. asList of
                 Just (_, AccountsScreenItem{..}) -> asItemAccountName
                 Nothing -> scr ^. asSelectedAccount
-    ui = ui0{aScreen=scr & asSelectedAccount .~ selacct}
+    ui = ui0{aScreen=AcctsScreen (scr & asSelectedAccount .~ selacct)}
 
   case mode of
     Minibuffer ed ->
@@ -289,14 +289,14 @@ asHandle ui0@UIState{
         EvKey (KLeft) []     -> continue $ popScreen ui
         EvKey k           [] | k `elem` [KRight, KEnter] -> scrollTopRegister >> continue (screenEnter d scr ui)
           where
-            scr = rsSetAccount selacct registerScreen
+            scr = rsSetAccount selacct (RegScreen registerScreen)
 
         -- fall through to the list's event handler (handles up/down)
         ev                       -> do
                                      newitems <- handleEvent ev (scr ^. asList)
-                                     continue $ ui{aScreen=scr & asList .~ newitems
-                                                                & asSelectedAccount .~ selacct
-                                                                }
+                                     continue $ ui{aScreen=AcctsScreen (scr & asList .~ newitems
+                                                                            & asSelectedAccount .~ selacct
+                                                                       )}
                                  -- continue =<< handleEventLensed ui someLens ev
 
   where
@@ -308,8 +308,9 @@ asHandle ui0@UIState{
     scrollTop         = vScrollToBeginning $ viewportScroll "accounts"
     scrollTopRegister = vScrollToBeginning $ viewportScroll "register"
 
-asHandle _ _ = error "event handler called with wrong screen type, should not happen"
+asHandle_ _ _ = error "event handler called with wrong screen type, should not happen"
 
-asSetSelectedAccount a s@AccountsScreen{} = s & asSelectedAccount .~ a
+asSetSelectedAccount :: AccountName -> Screen -> Screen
+asSetSelectedAccount a (AcctsScreen s@AccountsScreen{}) = AcctsScreen (s & asSelectedAccount .~ a)
 asSetSelectedAccount _ s = s
 

hledger-ui/Hledger/UI/ErrorScreen.hs

@@ -20,21 +20,21 @@ import Hledger.UI.UITypes
 import Hledger.UI.UIState
 import Hledger.UI.UIUtils
 
-errorScreen :: Screen
+errorScreen :: ErrorScreen
 errorScreen = ErrorScreen{
-   sInit    = esInit
-  ,sDraw    = esDraw
-  ,sHandle  = esHandle
+   esInit    = esInit_
+  ,esDraw    = esDraw_
+  ,esHandle  = esHandle_
   ,esError  = ""
   }
 
-esInit :: Day -> Bool -> UIState -> UIState
-esInit _ _ ui@UIState{aScreen=ErrorScreen{}} = ui
-esInit _ _ _ = error "init function called with wrong screen type, should not happen"
+esInit_ :: Day -> Bool -> UIState -> UIState
+esInit_ _ _ ui@UIState{aScreen=ErrScreen{}} = ui
+esInit_ _ _ _ = error "init function called with wrong screen type, should not happen"
 
-esDraw :: UIState -> [Widget]
-esDraw UIState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}},
-                             aScreen=ErrorScreen{..}
+esDraw_ :: UIState -> [Widget]
+esDraw_ UIState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}},
+                             aScreen=ErrScreen (ErrorScreen{..})
                              ,aMode=mode} =
   case mode of
     Help       -> [helpDialog, maincontent]
@@ -55,11 +55,11 @@ esDraw UIState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropt
           ,("q", "quit")
           ]
 
-esDraw _ = error "draw function called with wrong screen type, should not happen"
+esDraw_ _ = error "draw function called with wrong screen type, should not happen"
 
-esHandle :: UIState -> Event -> EventM (Next UIState)
-esHandle ui@UIState{
-   aScreen=s@ErrorScreen{}
+esHandle_ :: UIState -> Event -> EventM (Next UIState)
+esHandle_ ui@UIState{
+   aScreen=ErrScreen(s@ErrorScreen{})
   ,aopts=UIOpts{cliopts_=copts}
   ,ajournal=j
   ,aMode=mode
@@ -79,11 +79,11 @@ esHandle ui@UIState{
         EvKey (KChar 'g') [] -> do
           (ej, _) <- liftIO $ journalReloadIfChanged copts d j
           case ej of
-            Left err -> continue ui{aScreen=s{esError=err}} -- show latest parse error
+            Left err -> continue ui{aScreen=ErrScreen(s{esError=err})} -- show latest parse error
             Right j' -> continue $ regenerateScreens j' d $ popScreen ui  -- return to previous screen, and reload it
         _ -> continue ui
 
-esHandle _ _ = error "event handler called with wrong screen type, should not happen"
+esHandle_ _ _ = error "event handler called with wrong screen type, should not happen"
 
 -- If journal file(s) have changed, reload the journal and regenerate all screens.
 -- This is here so it can reference the error screen.
@@ -92,5 +92,5 @@ uiReloadJournalIfChanged copts d j ui = do
   (ej, _) <- journalReloadIfChanged copts d j
   return $ case ej of
     Right j' -> regenerateScreens j' d ui
-    Left err -> screenEnter d errorScreen{esError=err} ui
+    Left err -> screenEnter d (ErrScreen errorScreen{esError=err}) ui
 

hledger-ui/Hledger/UI/Main.hs

@@ -14,7 +14,7 @@ module Hledger.UI.Main where
 import Control.Monad
 -- import Control.Monad.IO.Class (liftIO)
 -- import Data.Default
--- import Data.Monoid              -- 
+-- import Data.Monoid              --
 import Data.List
 import Data.Maybe
 -- import Data.Text (Text)
@@ -97,27 +97,27 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
     mregister = maybestringopt "register" $ rawopts_ copts
 
     (scr, prevscrs) = case mregister of
-      Nothing   -> (accountsScreen, [])
+      Nothing   -> (AcctsScreen accountsScreen, [])
       -- with --register, start on the register screen, and also put
       -- the accounts screen on the prev screens stack so you can exit
       -- to that as usual.
-      Just apat -> (rsSetAccount acct registerScreen, [ascr'])
+      Just apat -> (rsSetAccount acct (RegScreen registerScreen), [ascr'])
         where
           acct = headDef
                  (error' $ "--register "++apat++" did not match any account")
                  $ filter (regexMatches apat . T.unpack) $ journalAccountNames j
           -- Initialising the accounts screen is awkward, requiring
           -- another temporary UIState value..
           ascr' = aScreen $
-                  asInit d True $
+                  asInit_ d True $
                   UIState{
                     aopts=uopts'
                    ,ajournal=j
-                   ,aScreen=asSetSelectedAccount acct accountsScreen
+                   ,aScreen=asSetSelectedAccount acct (AcctsScreen accountsScreen)
                    ,aPrevScreens=[]
                    ,aMode=Normal
                    }
-  
+
     ui = (sInit scr) d True
          UIState{
             aopts=uopts'

hledger-ui/Hledger/UI/RegisterScreen.hs

@@ -35,21 +35,22 @@ import Hledger.UI.UIUtils
 import Hledger.UI.TransactionScreen
 import Hledger.UI.ErrorScreen
 
-registerScreen :: Screen
+registerScreen :: RegisterScreen
 registerScreen = RegisterScreen{
-   sInit   = rsInit
-  ,sDraw   = rsDraw
-  ,sHandle = rsHandle
+   rsInit   = rsInit_
+  ,rsDraw   = rsDraw_
+  ,rsHandle = rsHandle_
   ,rsList    = list "register" V.empty 1
   ,rsAccount = ""
   }
 
-rsSetAccount a scr@RegisterScreen{} = scr{rsAccount=replaceHiddenAccountsNameWith "*" a}
+rsSetAccount :: AccountName -> Screen -> Screen
+rsSetAccount a (RegScreen scr@RegisterScreen{}) = RegScreen (scr{rsAccount=replaceHiddenAccountsNameWith "*" a})
 rsSetAccount _ scr = scr
 
-rsInit :: Day -> Bool -> UIState -> UIState
-rsInit d reset ui@UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}, ajournal=j, aScreen=s@RegisterScreen{..}} =
-  ui{aScreen=s{rsList=newitems'}}
+rsInit_ :: Day -> Bool -> UIState -> UIState
+rsInit_ d reset ui@UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}, ajournal=j, aScreen=RegScreen(s@RegisterScreen{..})} =
+  ui{aScreen=RegScreen(s{rsList=newitems'})}
   where
     -- gather arguments and queries
     ropts' = ropts{
@@ -94,11 +95,11 @@ rsInit d reset ui@UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}, ajo
                                    -> fromMaybe endidx $ findIndex ((==ti) . tindex . rsItemTransaction) displayitems
         endidx = length displayitems
 
-rsInit _ _ _ = error "init function called with wrong screen type, should not happen"
+rsInit_ _ _ _ = error "init function called with wrong screen type, should not happen"
 
-rsDraw :: UIState -> [Widget]
-rsDraw UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
-                            ,aScreen=RegisterScreen{..}
+rsDraw_ :: UIState -> [Widget]
+rsDraw_ UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
+                            ,aScreen=RegScreen RegisterScreen{..}
                             ,aMode=mode
                             } =
   case mode of
@@ -157,7 +158,7 @@ rsDraw UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
         changewidthproportion = fromIntegral maxchangewidthseen / fromIntegral (maxchangewidthseen + maxbalwidthseen)
         maxchangewidth = round $ changewidthproportion * fromIntegral maxamtswidth
         maxbalwidth = maxamtswidth - maxchangewidth
-        changewidth = min maxchangewidth maxchangewidthseen 
+        changewidth = min maxchangewidth maxchangewidthseen
         balwidth = min maxbalwidth maxbalwidthseen
         -- assign the remaining space to the description and accounts columns
         -- maxdescacctswidth = totalwidth - (whitespacewidth - 4) - changewidth - balwidth
@@ -170,7 +171,7 @@ rsDraw UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
         -- descwidthproportion = (descwidth' + acctswidth') / descwidth'
         -- maxdescwidth = min (maxdescacctswidth - 7) (maxdescacctswidth / descwidthproportion)
         -- maxacctswidth = maxdescacctswidth - maxdescwidth
-        -- descwidth = min maxdescwidth descwidth' 
+        -- descwidth = min maxdescwidth descwidth'
         -- acctswidth = min maxacctswidth acctswidth'
         -- allocating equally.
         descwidth = maxdescacctswidth `div` 2
@@ -195,7 +196,7 @@ rsDraw UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
           ,("q", "quit")
           ]
 
-rsDraw _ = error "draw function called with wrong screen type, should not happen"
+rsDraw_ _ = error "draw function called with wrong screen type, should not happen"
 
 rsDrawItem :: (Int,Int,Int,Int,Int) -> Bool -> RegisterScreenItem -> Widget
 rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected RegisterScreenItem{..} =
@@ -218,9 +219,9 @@ rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected Regist
     sel | selected  = (<> "selected")
         | otherwise = id
 
-rsHandle :: UIState -> Event -> EventM (Next UIState)
-rsHandle ui@UIState{
-   aScreen=s@RegisterScreen{..}
+rsHandle_ :: UIState -> Event -> EventM (Next UIState)
+rsHandle_ ui@UIState{
+   aScreen=RegScreen(s@RegisterScreen{..})
   ,aopts=UIOpts{cliopts_=copts}
   ,ajournal=j
   ,aMode=mode
@@ -264,16 +265,16 @@ rsHandle ui@UIState{
                 numberedts = zip [1..] ts
                 i = fromIntegral $ maybe 0 (+1) $ elemIndex t ts -- XXX
               in
-                continue $ screenEnter d transactionScreen{tsTransaction=(i,t)
-                                                          ,tsTransactions=numberedts
-                                                          ,tsAccount=rsAccount} ui
+                continue $ screenEnter d (TransScreen (transactionScreen{tsTransaction=(i,t)
+                                                                        ,tsTransactions=numberedts
+                                                                        ,tsAccount=rsAccount})) ui
             Nothing -> continue ui
         -- fall through to the list's event handler (handles [pg]up/down)
         ev -> do newitems <- handleEvent ev rsList
-                 continue ui{aScreen=s{rsList=newitems}}
+                 continue ui{aScreen=RegScreen(s{rsList=newitems})}
                  -- continue =<< handleEventLensed ui someLens ev
       where
         -- Encourage a more stable scroll position when toggling list items (cf AccountsScreen.hs)
         scrollTop = vScrollToBeginning $ viewportScroll "register"
 
-rsHandle _ _ = error "event handler called with wrong screen type, should not happen"
+rsHandle_ _ _ = error "event handler called with wrong screen type, should not happen"