From 59539784713bb43940c17a79af5742113c3e2dd6 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 20 Aug 2015 04:54:23 -0700 Subject: [PATCH] ui: update for new brick branch, pgup/down works --- hledger-ui/Hledger/UI/AccountsScreen.hs | 61 ++++++++++++------------- hledger-ui/Hledger/UI/Main.hs | 28 +++++------- hledger-ui/Hledger/UI/RegisterScreen.hs | 59 ++++++++++++------------ hledger-ui/Hledger/UI/UITypes.hs | 19 ++++---- hledger-ui/Hledger/UI/UIUtils.hs | 31 +++++++------ 5 files changed, 96 insertions(+), 102 deletions(-) diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index 2ea571cb9..60f232d6b 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -15,14 +15,10 @@ import Data.List import Data.Time.Calendar (Day) import qualified Data.Vector as V import qualified Graphics.Vty as Vty -import qualified Brick.Types as T -import qualified Brick.Main as M --- import qualified Brick.AttrMap as A -import qualified Brick.Widgets.Border as B -import qualified Brick.Widgets.Center as C -import qualified Brick.Widgets.List as L --- import Brick.Util (fg, on) -import Brick.Widgets.Core +import Brick +import Brick.Widgets.List +import Brick.Widgets.Border +import Brick.Widgets.Center import Hledger import Hledger.Cli hiding (progname,prognameandversion,green) @@ -33,7 +29,7 @@ import Hledger.UI.UIUtils import qualified Hledger.UI.RegisterScreen as RS (screen) screen = AccountsScreen{ - asState = L.list "accounts" V.empty + asState = list "accounts" V.empty 1 ,sInitFn = initAccountsScreen ,sDrawFn = drawAccountsScreen ,sHandleFn = handleAccountsScreen @@ -43,7 +39,7 @@ initAccountsScreen :: Day -> [String] -> AppState -> AppState initAccountsScreen d args st@AppState{aopts=opts, ajournal=j, aScreen=s@AccountsScreen{}} = st{aScreen=s{asState=is'}} where - is' = L.list (T.Name "accounts") (V.fromList items) + is' = list (Name "accounts") (V.fromList items) 1 (items,_total) = balanceReport ropts q j where q = queryFromOpts d ropts @@ -58,21 +54,21 @@ initAccountsScreen _ _ _ = error "init function called with wrong screen type, s drawAccountsScreen :: AppState -> [Widget] drawAccountsScreen st@AppState{aScreen=AccountsScreen{asState=is}} = [ui] where - label = "Account " <+> cur <+> " of " <+> total - cur = case is^.(L.listSelectedL) of - Nothing -> "-" - Just i -> str (show (i + 1)) - total = str $ show $ length $ is^.(L.listElementsL) - box = B.borderWithLabel label $ + label = str "Account " <+> cur <+> str " of " <+> total + cur = str (case is^.listSelectedL of + Nothing -> "-" + Just i -> show (i + 1)) + total = str $ show $ length $ is^.listElementsL + box = borderWithLabel label $ -- hLimit 25 $ -- vLimit 15 $ - L.renderList is (drawAccountsItem fmt) 1 + renderList is (drawAccountsItem fmt) ui = box - _ui = C.vCenter $ vBox [ C.hCenter box - , " " - , C.hCenter "Press Esc to exit." + _ui = vCenter $ vBox [ hCenter box + , str " " + , hCenter $ str "Press Esc to exit." ] - items = L.listElements is + items = listElements is flat = flat_ $ reportopts_ $ cliopts_ $ aopts st acctcolwidth = maximum $ V.map @@ -97,26 +93,29 @@ drawAccountsItem fmt sel item = in selStr item -handleAccountsScreen :: AppState -> Vty.Event -> M.EventM (M.Next AppState) +handleAccountsScreen :: AppState -> Vty.Event -> EventM (Next AppState) handleAccountsScreen st@AppState{aScreen=scr@AccountsScreen{asState=is}} e = do d <- liftIO getCurrentDay -- c <- getContext -- let h = c^.availHeightL - -- moveSel n l = L.listMoveBy n l + -- moveSel n l = listMoveBy n l case e of - Vty.EvKey Vty.KEsc [] -> M.halt st - Vty.EvKey (Vty.KChar 'q') [] -> M.halt st - Vty.EvKey (Vty.KLeft) [] -> M.continue $ popScreen st - Vty.EvKey (Vty.KRight) [] -> M.continue st' + Vty.EvKey Vty.KEsc [] -> halt st + Vty.EvKey (Vty.KChar 'q') [] -> halt st + Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st + Vty.EvKey (Vty.KRight) [] -> continue st' where st' = screenEnter d args RS.screen st - args = case L.listSelectedElement is of + args = case listSelectedElement is of Just (_, ((acct, _, _), _)) -> ["acct:"++accountNameToAccountRegex acct] Nothing -> [] - -- Vty.EvKey (Vty.KPageDown) [] -> M.continue $ st{aScreen=scr{asState=moveSel h is}} - -- Vty.EvKey (Vty.KPageUp) [] -> M.continue $ st{aScreen=scr{asState=moveSel (-h) is}} + -- Vty.EvKey (Vty.KPageDown) [] -> continue $ st{aScreen=scr{asState=moveSel h is}} + -- Vty.EvKey (Vty.KPageUp) [] -> continue $ st{aScreen=scr{asState=moveSel (-h) is}} -- fall through to the list's event handler (handles up/down) - ev -> M.continue st{aScreen=scr{asState=T.handleEvent ev is}} + ev -> do + is' <- handleEvent ev is + continue $ st{aScreen=scr{asState=is'}} + -- continue =<< handleEventLensed st someLens ev handleAccountsScreen _ _ = error "event handler called with wrong screen type, should not happen" diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index 05737c955..f423aa160 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -9,6 +9,7 @@ reg: show a hledger-web-style register -- switch to next brick release reg: use full width +reg: keep cursor at bottom of screen when jumping to end page up/down home/end search @@ -36,14 +37,7 @@ import Control.Monad import System.Exit import qualified Graphics.Vty as V --- import qualified Brick.Types as T -import qualified Brick.Main as M --- import qualified Brick.AttrMap as A --- import qualified Brick.Widgets.Border as B --- import qualified Brick.Widgets.Center as C --- import qualified Brick.Widgets.List as L --- import Brick.Util (fg, on) --- import Brick.Widgets.Core +import Brick import Hledger import Hledger.Cli hiding (progname,prognameandversion,green) @@ -97,14 +91,14 @@ runBrickUi opts j = do ,aPrevScreens=[] } - app :: M.App (AppState) V.Event - app = M.App { - M.appLiftVtyEvent = id - , M.appStartEvent = return - , M.appAttrMap = const attrMap - , M.appChooseCursor = M.showFirstCursor - , M.appHandleEvent = \st ev -> (sHandleFn $ aScreen st) st ev - , M.appDraw = \st -> (sDrawFn $ aScreen st) st + app :: App (AppState) V.Event + app = App { + appLiftVtyEvent = id + , appStartEvent = return + , appAttrMap = const customAttrMap + , appChooseCursor = showFirstCursor + , appHandleEvent = \st ev -> (sHandleFn $ aScreen st) st ev + , appDraw = \st -> (sDrawFn $ aScreen st) st } - void $ M.defaultMain app st + void $ defaultMain app st diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index d84eb7693..19363d91a 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -11,14 +11,10 @@ import Data.List import Data.Time.Calendar (Day) import qualified Data.Vector as V import qualified Graphics.Vty as Vty -import qualified Brick.Types as T -import qualified Brick.Main as M --- import qualified Brick.AttrMap as A -import qualified Brick.Widgets.Border as B -import qualified Brick.Widgets.Center as C -import qualified Brick.Widgets.List as L --- import Brick.Util (fg, on) -import Brick.Widgets.Core +import Brick +import Brick.Widgets.List +import Brick.Widgets.Border +import Brick.Widgets.Center import Hledger import Hledger.Cli hiding (progname,prognameandversion,green) @@ -27,7 +23,7 @@ import Hledger.UI.UITypes import Hledger.UI.UIUtils screen = RegisterScreen{ - rsState = L.list "register" V.empty + rsState = list "register" V.empty 1 ,sInitFn = initRegisterScreen ,sDrawFn = drawRegisterScreen ,sHandleFn = handleRegisterScreen @@ -38,8 +34,8 @@ initRegisterScreen d args st@AppState{aopts=opts, ajournal=j, aScreen=s@Register st{aScreen=s{rsState=is'}} where is' = - L.listMoveTo (length items) $ - L.list (T.Name "register") (V.fromList items) + listMoveTo (length items) $ + list (Name "register") (V.fromList items) 1 (_label,items) = postingsReport ropts q j where q = queryFromOpts d ropts @@ -53,20 +49,24 @@ initRegisterScreen _ _ _ = error "init function called with wrong screen type, s drawRegisterScreen :: AppState -> [Widget] drawRegisterScreen AppState{aopts=_opts, aScreen=RegisterScreen{rsState=is}} = [ui] where - label = "Posting " <+> cur <+> " of " <+> total <+> " in this account and subaccounts" -- " <+> str query <+> "and subaccounts" - cur = case is^.(L.listSelectedL) of - Nothing -> "-" - Just i -> str (show (i + 1)) - total = str $ show $ length $ is^.(L.listElementsL) + label = str "Posting " + <+> cur + <+> str " of " + <+> total + <+> str " in this account and subaccounts" -- " <+> str query <+> "and subaccounts" + cur = str $ case is^.(listSelectedL) of + Nothing -> "-" + Just i -> show (i + 1) + total = str $ show $ length $ is^.(listElementsL) -- query = query_ $ reportopts_ $ cliopts_ opts - box = B.borderWithLabel label $ + box = borderWithLabel label $ -- hLimit 25 $ -- vLimit 15 $ - L.renderList is drawRegisterItem 1 + renderList is drawRegisterItem ui = box - _ui = C.vCenter $ vBox [ C.hCenter box - , " " - , C.hCenter "Press Esc to exit." + _ui = vCenter $ vBox [ hCenter box + , str " " + , hCenter $ str "Press Esc to exit." ] drawRegisterScreen _ = error "draw function called with wrong screen type, should not happen" @@ -88,13 +88,16 @@ drawRegisterItem sel item = in selStr item -handleRegisterScreen :: AppState -> Vty.Event -> M.EventM (M.Next AppState) +handleRegisterScreen :: AppState -> Vty.Event -> EventM (Next AppState) handleRegisterScreen st@AppState{aScreen=s@RegisterScreen{rsState=is}} e = case e of - Vty.EvKey Vty.KEsc [] -> M.halt st - Vty.EvKey (Vty.KChar 'q') [] -> M.halt st - Vty.EvKey (Vty.KLeft) [] -> M.continue $ popScreen st - -- Vty.EvKey (Vty.KRight) [] -> error (show curItem) where curItem = L.listSelectedElement is - -- fall through to the list's event handler (handles up/down) - ev -> M.continue st{aScreen=s{rsState=T.handleEvent ev is}} + Vty.EvKey Vty.KEsc [] -> halt st + Vty.EvKey (Vty.KChar 'q') [] -> halt 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) + ev -> do + is' <- handleEvent ev is + continue $ st{aScreen=s{rsState=is'}} + -- continue =<< handleEventLensed st someLens ev handleRegisterScreen _ _ = error "event handler called with wrong screen type, should not happen" diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index 1aec5ba8d..a0f337f6a 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/hledger-ui/Hledger/UI/UITypes.hs @@ -2,11 +2,8 @@ module Hledger.UI.UITypes where import Data.Time.Calendar (Day) import qualified Graphics.Vty as V -import qualified Brick.Main as M -import qualified Brick.Widgets.List as L -import Brick.Widgets.Core - ( Widget(..) - ) +import Brick +import Brick.Widgets.List (List) import Hledger import Hledger.UI.Options @@ -14,7 +11,7 @@ import Hledger.UI.Options ---------------------------------------------------------------------- -- | hledger-ui's application state. This is part of, but distinct --- from, brick's M.App. +-- from, brick's App. data AppState = AppState { aopts :: UIOpts -- ^ command-line options at startup ,aargs :: [String] -- ^ command-line arguments at startup @@ -28,17 +25,17 @@ data AppState = AppState { -- of their state (hence the unique accessor names for the latter). data Screen = AccountsScreen { - asState :: L.List BalanceReportItem -- ^ the screen's state (data being displayed and widget state) + asState :: List BalanceReportItem -- ^ the screen's state (data being displayed and widget state) ,sInitFn :: Day -> [String] -> AppState -> AppState -- ^ function to initialise the screen's state on entry - ,sHandleFn :: AppState -> V.Event -> M.EventM (M.Next AppState) -- ^ brick event handler to use for this screen + ,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 :: L.List PostingsReportItem + rsState :: List PostingsReportItem ,sInitFn :: Day -> [String] -> AppState -> AppState - ,sHandleFn :: AppState -> V.Event -> M.EventM (M.Next AppState) + ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) ,sDrawFn :: AppState -> [Widget] } deriving (Show) -instance Show (L.List a) where show _ = "" +instance Show (List a) where show _ = "" diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index f76f8a27f..f7da5ef8f 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -1,7 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} -module Hledger.UI.UIUtils -where +module Hledger.UI.UIUtils ( + pushScreen + ,popScreen + ,screenEnter + ,attrMap + ,customAttrMap + ,customAttr + ) where -- import Control.Lens ((^.)) -- import Control.Monad @@ -9,13 +15,8 @@ where import Data.Monoid -- import Data.Time.Calendar (Day) import qualified Graphics.Vty as V --- import qualified Brick.Types as T --- import qualified Brick.Main as M -import qualified Brick.AttrMap as A --- import qualified Brick.Widgets.Border as B --- import qualified Brick.Widgets.Center as C -import qualified Brick.Widgets.List as L -import Brick.Util +import Brick +import Brick.Widgets.List import Hledger.UI.UITypes @@ -40,12 +41,12 @@ screenEnter d args scr st = (sInitFn scr) d args $ pushScreen scr st -attrMap :: A.AttrMap -attrMap = A.attrMap V.defAttr - [ (L.listAttr, V.white `on` V.blue) - , (L.listSelectedAttr, V.black `on` V.white) +customAttrMap :: AttrMap +customAttrMap = attrMap V.defAttr + [ (listAttr, V.white `on` V.blue) + , (listSelectedAttr, V.black `on` V.white) -- , (customAttr, fg V.cyan) ] -customAttr :: A.AttrName -customAttr = L.listSelectedAttr <> "custom" +customAttr :: AttrName +customAttr = listSelectedAttr <> "custom"