ui: update for new brick branch, pgup/down works
This commit is contained in:
Simon Michael
parent
49e1840a0f
commit
5953978471
@ -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
|
||||
label = str "Account " <+> cur <+> str " of " <+> total
|
||||
cur = str (case is^.listSelectedL of
|
||||
Nothing -> "-"
|
||||
Just i -> str (show (i + 1))
|
||||
total = str $ show $ length $ is^.(L.listElementsL)
|
||||
box = B.borderWithLabel label $
|
||||
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"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
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 -> str (show (i + 1))
|
||||
total = str $ show $ length $ is^.(L.listElementsL)
|
||||
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"
|
||||
|
||||
@ -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 _ = "<List>"
|
||||
instance Show (List a) where show _ = "<List>"
|
||||
|
||||
@ -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"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user