slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ui: update for new brick branch, pgup/down works

Browse Source
This commit is contained in:
Simon Michael 2015-08-20 04:54:23 -07:00
parent 49e1840a0f
commit 5953978471
5 changed files with 96 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -15,14 +15,10 @@ import Data.List
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
import qualified Data.Vector as V import qualified Data.Vector as V
import qualified Graphics.Vty as Vty import qualified Graphics.Vty as Vty
import qualified Brick.Types as T import Brick
import qualified Brick.Main as M import Brick.Widgets.List
-- import qualified Brick.AttrMap as A import Brick.Widgets.Border
import qualified Brick.Widgets.Border as B import Brick.Widgets.Center
import qualified Brick.Widgets.Center as C
import qualified Brick.Widgets.List as L
-- import Brick.Util (fg, on)
import Brick.Widgets.Core
import Hledger import Hledger
import Hledger.Cli hiding (progname,prognameandversion,green) import Hledger.Cli hiding (progname,prognameandversion,green)
@ -33,7 +29,7 @@ import Hledger.UI.UIUtils
import qualified Hledger.UI.RegisterScreen as RS (screen) import qualified Hledger.UI.RegisterScreen as RS (screen)
screen = AccountsScreen{ screen = AccountsScreen{
asState = L.list "accounts" V.empty asState = list "accounts" V.empty 1
,sInitFn = initAccountsScreen ,sInitFn = initAccountsScreen
,sDrawFn = drawAccountsScreen ,sDrawFn = drawAccountsScreen
,sHandleFn = handleAccountsScreen ,sHandleFn = handleAccountsScreen
@ -43,7 +39,7 @@ initAccountsScreen :: Day -> [String] -> AppState -> AppState
initAccountsScreen d args st@AppState{aopts=opts, ajournal=j, aScreen=s@AccountsScreen{}} = initAccountsScreen d args st@AppState{aopts=opts, ajournal=j, aScreen=s@AccountsScreen{}} =
st{aScreen=s{asState=is'}} st{aScreen=s{asState=is'}}
where where
is' = L.list (T.Name "accounts") (V.fromList items) is' = list (Name "accounts") (V.fromList items) 1
(items,_total) = balanceReport ropts q j (items,_total) = balanceReport ropts q j
where where
q = queryFromOpts d ropts q = queryFromOpts d ropts
@ -58,21 +54,21 @@ initAccountsScreen _ _ _ = error "init function called with wrong screen type, s
drawAccountsScreen :: AppState -> [Widget] drawAccountsScreen :: AppState -> [Widget]
drawAccountsScreen st@AppState{aScreen=AccountsScreen{asState=is}} = [ui] drawAccountsScreen st@AppState{aScreen=AccountsScreen{asState=is}} = [ui]
where where
label = "Account " <+> cur <+> " of " <+> total label = str "Account " <+> cur <+> str " of " <+> total
cur = case is^.(L.listSelectedL) of cur = str (case is^.listSelectedL of
Nothing -> "-" Nothing -> "-"
Just i -> str (show (i + 1)) Just i -> show (i + 1))
total = str $ show $ length $ is^.(L.listElementsL) total = str $ show $ length $ is^.listElementsL
box = B.borderWithLabel label $ box = borderWithLabel label $
-- hLimit 25 $ -- hLimit 25 $
-- vLimit 15 $ -- vLimit 15 $
L.renderList is (drawAccountsItem fmt) 1 renderList is (drawAccountsItem fmt)
ui = box ui = box
_ui = C.vCenter $ vBox [ C.hCenter box _ui = vCenter $ vBox [ hCenter box
, " " , str " "
, C.hCenter "Press Esc to exit." , hCenter $ str "Press Esc to exit."
] ]
items = L.listElements is items = listElements is
flat = flat_ $ reportopts_ $ cliopts_ $ aopts st flat = flat_ $ reportopts_ $ cliopts_ $ aopts st
acctcolwidth = maximum $ acctcolwidth = maximum $
V.map V.map
@ -97,26 +93,29 @@ drawAccountsItem fmt sel item =
in in
selStr item 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 handleAccountsScreen st@AppState{aScreen=scr@AccountsScreen{asState=is}} e = do
d <- liftIO getCurrentDay d <- liftIO getCurrentDay
-- c <- getContext -- c <- getContext
-- let h = c^.availHeightL -- let h = c^.availHeightL
-- moveSel n l = L.listMoveBy n l -- moveSel n l = listMoveBy n l
case e of case e of
Vty.EvKey Vty.KEsc [] -> M.halt st Vty.EvKey Vty.KEsc [] -> halt st
Vty.EvKey (Vty.KChar 'q') [] -> M.halt st Vty.EvKey (Vty.KChar 'q') [] -> halt st
Vty.EvKey (Vty.KLeft) [] -> M.continue $ popScreen st Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st
Vty.EvKey (Vty.KRight) [] -> M.continue st' Vty.EvKey (Vty.KRight) [] -> continue st'
where where
st' = screenEnter d args RS.screen st st' = screenEnter d args RS.screen st
args = case L.listSelectedElement is of args = case listSelectedElement is of
Just (_, ((acct, _, _), _)) -> ["acct:"++accountNameToAccountRegex acct] Just (_, ((acct, _, _), _)) -> ["acct:"++accountNameToAccountRegex acct]
Nothing -> [] Nothing -> []
-- Vty.EvKey (Vty.KPageDown) [] -> 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) [] -> M.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) -- 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" handleAccountsScreen _ _ = error "event handler called with wrong screen type, should not happen"

28
hledger-ui/Hledger/UI/Main.hs
View File

@ -9,6 +9,7 @@ reg: show a hledger-web-style register
-- --
switch to next brick release switch to next brick release
reg: use full width reg: use full width
reg: keep cursor at bottom of screen when jumping to end
page up/down page up/down
home/end home/end
search search
@ -36,14 +37,7 @@ import Control.Monad
import System.Exit import System.Exit
import qualified Graphics.Vty as V import qualified Graphics.Vty as V
-- import qualified Brick.Types as T import Brick
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 Hledger import Hledger
import Hledger.Cli hiding (progname,prognameandversion,green) import Hledger.Cli hiding (progname,prognameandversion,green)
@ -97,14 +91,14 @@ runBrickUi opts j = do
,aPrevScreens=[] ,aPrevScreens=[]
} }
app :: M.App (AppState) V.Event app :: App (AppState) V.Event
app = M.App { app = App {
M.appLiftVtyEvent = id appLiftVtyEvent = id
, M.appStartEvent = return , appStartEvent = return
, M.appAttrMap = const attrMap , appAttrMap = const customAttrMap
, M.appChooseCursor = M.showFirstCursor , appChooseCursor = showFirstCursor
, M.appHandleEvent = \st ev -> (sHandleFn $ aScreen st) st ev , appHandleEvent = \st ev -> (sHandleFn $ aScreen st) st ev
, M.appDraw = \st -> (sDrawFn $ aScreen st) st , appDraw = \st -> (sDrawFn $ aScreen st) st
} }
void $ M.defaultMain app st void $ defaultMain app st

57
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -11,14 +11,10 @@ import Data.List
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
import qualified Data.Vector as V import qualified Data.Vector as V
import qualified Graphics.Vty as Vty import qualified Graphics.Vty as Vty
import qualified Brick.Types as T import Brick
import qualified Brick.Main as M import Brick.Widgets.List
-- import qualified Brick.AttrMap as A import Brick.Widgets.Border
import qualified Brick.Widgets.Border as B import Brick.Widgets.Center
import qualified Brick.Widgets.Center as C
import qualified Brick.Widgets.List as L
-- import Brick.Util (fg, on)
import Brick.Widgets.Core
import Hledger import Hledger
import Hledger.Cli hiding (progname,prognameandversion,green) import Hledger.Cli hiding (progname,prognameandversion,green)
@ -27,7 +23,7 @@ import Hledger.UI.UITypes
import Hledger.UI.UIUtils import Hledger.UI.UIUtils
screen = RegisterScreen{ screen = RegisterScreen{
rsState = L.list "register" V.empty rsState = list "register" V.empty 1
,sInitFn = initRegisterScreen ,sInitFn = initRegisterScreen
,sDrawFn = drawRegisterScreen ,sDrawFn = drawRegisterScreen
,sHandleFn = handleRegisterScreen ,sHandleFn = handleRegisterScreen
@ -38,8 +34,8 @@ initRegisterScreen d args st@AppState{aopts=opts, ajournal=j, aScreen=s@Register
st{aScreen=s{rsState=is'}} st{aScreen=s{rsState=is'}}
where where
is' = is' =
L.listMoveTo (length items) $ listMoveTo (length items) $
L.list (T.Name "register") (V.fromList items) list (Name "register") (V.fromList items) 1
(_label,items) = postingsReport ropts q j (_label,items) = postingsReport ropts q j
where where
q = queryFromOpts d ropts q = queryFromOpts d ropts
@ -53,20 +49,24 @@ initRegisterScreen _ _ _ = error "init function called with wrong screen type, s
drawRegisterScreen :: AppState -> [Widget] drawRegisterScreen :: AppState -> [Widget]
drawRegisterScreen AppState{aopts=_opts, aScreen=RegisterScreen{rsState=is}} = [ui] drawRegisterScreen AppState{aopts=_opts, aScreen=RegisterScreen{rsState=is}} = [ui]
where where
label = "Posting " <+> cur <+> " of " <+> total <+> " in this account and subaccounts" -- " <+> str query <+> "and subaccounts" label = str "Posting "
cur = case is^.(L.listSelectedL) of <+> cur
<+> str " of "
<+> total
<+> str " in this account and subaccounts" -- " <+> str query <+> "and subaccounts"
cur = str $ case is^.(listSelectedL) of
Nothing -> "-" Nothing -> "-"
Just i -> str (show (i + 1)) Just i -> show (i + 1)
total = str $ show $ length $ is^.(L.listElementsL) total = str $ show $ length $ is^.(listElementsL)
-- query = query_ $ reportopts_ $ cliopts_ opts -- query = query_ $ reportopts_ $ cliopts_ opts
box = B.borderWithLabel label $ box = borderWithLabel label $
-- hLimit 25 $ -- hLimit 25 $
-- vLimit 15 $ -- vLimit 15 $
L.renderList is drawRegisterItem 1 renderList is drawRegisterItem
ui = box ui = box
_ui = C.vCenter $ vBox [ C.hCenter box _ui = vCenter $ vBox [ hCenter box
, " " , str " "
, C.hCenter "Press Esc to exit." , hCenter $ str "Press Esc to exit."
] ]
drawRegisterScreen _ = error "draw function called with wrong screen type, should not happen" drawRegisterScreen _ = error "draw function called with wrong screen type, should not happen"
@ -88,13 +88,16 @@ drawRegisterItem sel item =
in in
selStr item 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 = handleRegisterScreen st@AppState{aScreen=s@RegisterScreen{rsState=is}} e =
case e of case e of
Vty.EvKey Vty.KEsc [] -> M.halt st Vty.EvKey Vty.KEsc [] -> halt st
Vty.EvKey (Vty.KChar 'q') [] -> M.halt st Vty.EvKey (Vty.KChar 'q') [] -> halt st
Vty.EvKey (Vty.KLeft) [] -> M.continue $ popScreen st Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st
-- Vty.EvKey (Vty.KRight) [] -> error (show curItem) where curItem = L.listSelectedElement is -- Vty.EvKey (Vty.KRight) [] -> error (show curItem) where curItem = listSelectedElement is
-- fall through to the list's event handler (handles up/down) -- fall through to the list's event handler (handles [pg]up/down)
ev -> M.continue st{aScreen=s{rsState=T.handleEvent ev is}} 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" handleRegisterScreen _ _ = error "event handler called with wrong screen type, should not happen"

19
hledger-ui/Hledger/UI/UITypes.hs
View File

@ -2,11 +2,8 @@ module Hledger.UI.UITypes where
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
import qualified Graphics.Vty as V import qualified Graphics.Vty as V
import qualified Brick.Main as M import Brick
import qualified Brick.Widgets.List as L import Brick.Widgets.List (List)
import Brick.Widgets.Core
( Widget(..)
)
import Hledger import Hledger
import Hledger.UI.Options import Hledger.UI.Options
@ -14,7 +11,7 @@ import Hledger.UI.Options
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | hledger-ui's application state. This is part of, but distinct -- | hledger-ui's application state. This is part of, but distinct
-- from, brick's M.App. -- from, brick's App.
data AppState = AppState { data AppState = AppState {
aopts :: UIOpts -- ^ command-line options at startup aopts :: UIOpts -- ^ command-line options at startup
,aargs :: [String] -- ^ command-line arguments 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). -- of their state (hence the unique accessor names for the latter).
data Screen = data Screen =
AccountsScreen { 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 ,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 ,sDrawFn :: AppState -> [Widget] -- ^ brick renderer to use for this screen
} }
| RegisterScreen { | RegisterScreen {
rsState :: L.List PostingsReportItem rsState :: List PostingsReportItem
,sInitFn :: Day -> [String] -> AppState -> AppState ,sInitFn :: Day -> [String] -> AppState -> AppState
,sHandleFn :: AppState -> V.Event -> M.EventM (M.Next AppState) ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
,sDrawFn :: AppState -> [Widget] ,sDrawFn :: AppState -> [Widget]
} }
deriving (Show) deriving (Show)
instance Show (L.List a) where show _ = "<List>" instance Show (List a) where show _ = "<List>"

31
hledger-ui/Hledger/UI/UIUtils.hs
View File

@ -1,7 +1,13 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Hledger.UI.UIUtils module Hledger.UI.UIUtils (
where pushScreen
,popScreen
,screenEnter
,attrMap
,customAttrMap
,customAttr
) where
-- import Control.Lens ((^.)) -- import Control.Lens ((^.))
-- import Control.Monad -- import Control.Monad
@ -9,13 +15,8 @@ where
import Data.Monoid -- import Data.Monoid --
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
import qualified Graphics.Vty as V import qualified Graphics.Vty as V
-- import qualified Brick.Types as T import Brick
-- import qualified Brick.Main as M import Brick.Widgets.List
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 Hledger.UI.UITypes import Hledger.UI.UITypes
@ -40,12 +41,12 @@ screenEnter d args scr st = (sInitFn scr) d args $
pushScreen scr pushScreen scr
st st
attrMap :: A.AttrMap customAttrMap :: AttrMap
attrMap = A.attrMap V.defAttr customAttrMap = attrMap V.defAttr
[ (L.listAttr, V.white `on` V.blue) [ (listAttr, V.white `on` V.blue)
, (L.listSelectedAttr, V.black `on` V.white) , (listSelectedAttr, V.black `on` V.white)
-- , (customAttr, fg V.cyan) -- , (customAttr, fg V.cyan)
] ]
customAttr :: A.AttrName customAttr :: AttrName
customAttr = L.listSelectedAttr <> "custom" customAttr = listSelectedAttr <> "custom"