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

ui: misc enhancements, allow depth adjustment

Browse Source 
- clean up options a bit, enable -V/--value (affects the accounts screen)
- more informative top/bottom borders, including key help
- number keys adjust the depth limit (accounts screen)
- remove obsolete args parameter
This commit is contained in:
Simon Michael 2015-08-27 22:45:49 -07:00
parent d662df77f5
commit b51f45c675
7 changed files with 128 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,6 +1,7 @@
-- The accounts screen, showing accounts and balances like the CLI balance command.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.UI.AccountsScreen
(screen)
@ -11,6 +12,7 @@ import Control.Lens ((^.))
import Control.Monad.IO.Class
-- import Data.Default
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Time.Calendar (Day)
import System.FilePath (takeFileName)
@ -32,35 +34,52 @@ import qualified Hledger.UI.RegisterScreen2 as RS2 (screen)
screen = AccountsScreen{
asState = list "accounts" V.empty 1
,sInitFn = initAccountsScreen
,sInitFn = initAccountsScreen Nothing
,sDrawFn = drawAccountsScreen
,sHandleFn = handleAccountsScreen
}
initAccountsScreen :: Day -> [String] -> AppState -> AppState
initAccountsScreen d args st@AppState{aopts=opts, ajournal=j, aScreen=s@AccountsScreen{}} =
st{aScreen=s{asState=is'}}
initAccountsScreen :: Maybe AccountName -> Day -> AppState -> AppState
initAccountsScreen mselacct d st@AppState{aopts=opts, aargs=args, ajournal=j, aScreen=s@AccountsScreen{}} =
st{aScreen=s{asState=is''}}
where
is' = list (Name "accounts") (V.fromList items) 1
(items,_total) = balanceReport ropts q j
-- crazy hacks dept.
-- when we're adjusting depth, mselacct is the account that was selected previously,
-- in which case try and keep the selection near where it was
is'' = case mselacct of
Nothing -> is'
Just a -> -- vScrollToBeginning $ viewportScroll "accounts"
maybe is' (flip listMoveTo is') mi
where
mi = findIndex (\((acct,_,_),_) -> acct==a') items
a' = maybe a (flip clipAccountName a) $ depth_ ropts
q = queryFromOpts d ropts
-- query_="cur:\\$"} -- XXX limit to one commodity to ensure one-line items
--{query_=unwords' $ locArgs l}
ropts = (reportopts_ cliopts)
{
query_=unwords' args,
balancetype_=HistoricalBalance -- XXX balanceReport doesn't respect this yet
}
cliopts = cliopts_ opts
convert | value_ ropts = balanceReportValue j valuedate
| otherwise = id
where
q = queryFromOpts d ropts
-- query_="cur:\\$"} -- XXX limit to one commodity to ensure one-line items
--{query_=unwords' $ locArgs l}
ropts = (reportopts_ cliopts)
{
query_=unwords' args,
balancetype_=HistoricalBalance -- XXX balanceReport doesn't respect this yet
}
cliopts = cliopts_ opts
valuedate = fromMaybe d $ queryEndDate False q
(items,_total) = convert $ balanceReport ropts q j
initAccountsScreen _ _ _ = error "init function called with wrong screen type, should not happen"
drawAccountsScreen :: AppState -> [Widget]
drawAccountsScreen st@AppState{aopts=uopts, ajournal=j, aScreen=AccountsScreen{asState=is}} = [ui]
where
label = files
toplabel = files
<+> str " accounts"
<+> borderQuery querystr
<+> borderQueryStr querystr
<+> borderDepthStr depth
<+> str " ("
<+> cur
<+> str " of "
@ -72,6 +91,7 @@ drawAccountsScreen st@AppState{aopts=uopts, ajournal=j, aScreen=AccountsScreen{a
[f,_] -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str " (& 1 included file)"
f:fs -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str (" (& " ++ show (length fs) ++ " included files)")
querystr = query_ $ reportopts_ $ cliopts_ uopts
depth = depth_ $ reportopts_ $ cliopts_ uopts
cur = str (case is^.listSelectedL of
Nothing -> "-"
Just i -> show (i + 1))
@ -91,7 +111,14 @@ drawAccountsScreen st@AppState{aopts=uopts, ajournal=j, aScreen=AccountsScreen{a
, FormatField False (Just 40) Nothing TotalField
]
ui = defaultLayout label $ renderList is (drawAccountsItem fmt)
bottomlabel = borderKeysStr [
-- "up/down/pgup/pgdown/home/end: move"
"1-0: adjust depth limit"
,"right: show transactions"
,"q: quit"
]
ui = defaultLayout toplabel bottomlabel $ renderList is (drawAccountsItem fmt)
drawAccountsScreen _ = error "draw function called with wrong screen type, should not happen"
@ -109,18 +136,28 @@ handleAccountsScreen st@AppState{aargs=args, aScreen=scr@AccountsScreen{asState=
-- c <- getContext
-- let h = c^.availHeightL
-- moveSel n l = listMoveBy n l
let
acct = case listSelectedElement is of
Just (_, ((a, _, _), _)) -> a
Nothing -> ""
case e of
Vty.EvKey Vty.KEsc [] -> halt st
Vty.EvKey (Vty.KChar 'q') [] -> halt st
Vty.EvKey (Vty.KChar '0') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 0 st
Vty.EvKey (Vty.KChar '1') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 1 st
Vty.EvKey (Vty.KChar '2') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 2 st
Vty.EvKey (Vty.KChar '3') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 3 st
Vty.EvKey (Vty.KChar '4') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 4 st
Vty.EvKey (Vty.KChar '5') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 5 st
Vty.EvKey (Vty.KChar '6') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 6 st
Vty.EvKey (Vty.KChar '7') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 7 st
Vty.EvKey (Vty.KChar '8') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 8 st
Vty.EvKey (Vty.KChar '9') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 9 st
Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st
Vty.EvKey (Vty.KRight) [] -> do
let st' = screenEnter d args RS2.screen{rs2Acct=acct} st
vScrollToBeginning $ viewportScroll "register"
continue st'
where
acct = case listSelectedElement is of
Just (_, ((a, _, _), _)) -> a
Nothing -> ""
-- Vty.EvKey (Vty.KPageDown) [] -> continue $ st{aScreen=scr{asState=moveSel h is}}
-- Vty.EvKey (Vty.KPageUp) [] -> continue $ st{aScreen=scr{asState=moveSel (-h) is}}
@ -131,3 +168,10 @@ handleAccountsScreen st@AppState{aargs=args, aScreen=scr@AccountsScreen{asState=
continue $ st{aScreen=scr{asState=is'}}
-- continue =<< handleEventLensed st someLens ev
handleAccountsScreen _ _ = error "event handler called with wrong screen type, should not happen"
setDepth :: Int -> AppState -> AppState
setDepth depth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{..}}} =
st{aopts=uopts{cliopts_=copts{reportopts_=reportopts_{depth_=md}}}}
where
md | depth==0 = Nothing
| otherwise = Just depth

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

@ -65,7 +65,7 @@ runBrickUi opts j = do
maybestringopt "theme" $ rawopts_ $ cliopts_ opts
args = words' $ query_ $ reportopts_ $ cliopts_ opts
scr = AS.screen
st = (sInitFn scr) d args
st = (sInitFn scr) d
AppState{
aopts=opts
,aargs=args

12
hledger-ui/Hledger/UI/Options.hs
View File

@ -23,13 +23,13 @@ prognameandversion :: String
prognameandversion = progname ++ " " ++ version :: String
uiflags = [
flagNone ["debug-ui"] (\opts -> setboolopt "rules-file" opts) "run with no terminal output, showing console"
-- flagNone ["debug-ui"] (\opts -> setboolopt "rules-file" opts) "run with no terminal output, showing console"
flagReq ["theme"] (\s opts -> Right $ setopt "theme" s opts) "THEME" ("use this custom display theme ("++intercalate ", " themeNames++")")
,flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show full account names, unindented"
,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components"
,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format"
,flagReq ["theme"] (\s opts -> Right $ setopt "theme" s opts) "THEME" ("use this custom display theme ("++intercalate ", " themeNames++")")
,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "no eliding at all, stronger than --empty"
-- ,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total"
-- ,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components"
-- ,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format"
,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "don't compress empty parent accounts on one line"
,flagNone ["value","V"] (setboolopt "value") "show amounts as their market value in their default valuation commodity (accounts screen)"
]
--uimode :: Mode [([Char], [Char])]

24
hledger-ui/Hledger/UI/RegisterScreen2.hs
View File

@ -37,8 +37,8 @@ screen = RegisterScreen2{
,sHandleFn = handleRegisterScreen2
}
initRegisterScreen2 :: Day -> [String] -> AppState -> AppState
initRegisterScreen2 d args st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen2{rs2Acct=acct}} =
initRegisterScreen2 :: Day -> AppState -> AppState
initRegisterScreen2 d st@AppState{aargs=args, aopts=opts, ajournal=j, aScreen=s@RegisterScreen2{rs2Acct=acct}} =
st{aScreen=s{rs2State=l}}
where
-- gather arguments and queries
@ -71,7 +71,7 @@ initRegisterScreen2 d args st@AppState{aopts=opts, ajournal=j, aScreen=s@Registe
,case splitOn ", " otheracctsstr of
[s] -> s
ss -> intercalate ", " ss
-- _ -> "<split>"
-- _ -> "<split>" -- should do this if accounts field width < 30
,showMixedAmountOneLineWithoutPrice change
,showMixedAmountOneLineWithoutPrice bal
)
@ -83,15 +83,15 @@ initRegisterScreen2 d args st@AppState{aopts=opts, ajournal=j, aScreen=s@Registe
-- (listName someList)
initRegisterScreen2 _ _ _ = error "init function called with wrong screen type, should not happen"
initRegisterScreen2 _ _ = error "init function called with wrong screen type, should not happen"
drawRegisterScreen2 :: AppState -> [Widget]
drawRegisterScreen2 AppState{aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}},
aargs=_args, aScreen=RegisterScreen2{rs2State=l,rs2Acct=acct}} = [ui]
drawRegisterScreen2 AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}},
aScreen=RegisterScreen2{rs2State=l,rs2Acct=acct}} = [ui]
where
label = withAttr ("border" <> "bold") (str acct)
toplabel = withAttr ("border" <> "bold") (str acct)
<+> str " transactions"
<+> borderQuery querystr
-- <+> borderQueryStr querystr -- no, account transactions report shows all transactions in the acct ?
-- <+> str " and subs"
<+> str " ("
<+> cur
@ -149,10 +149,14 @@ drawRegisterScreen2 AppState{aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reporto
-- allocating equally.
descwidth = maxdescacctswidth `div` 2
acctswidth = maxdescacctswidth - descwidth
colwidths = (datewidth,descwidth,acctswidth,changewidth,balwidth)
render $ defaultLayout label $ renderList l (drawRegisterItem colwidths)
bottomlabel = borderKeysStr [
-- "up/down/pgup/pgdown/home/end: move"
"left: return to accounts"
]
render $ defaultLayout toplabel bottomlabel $ renderList l (drawRegisterItem colwidths)
drawRegisterScreen2 _ = error "draw function called with wrong screen type, should not happen"

1
hledger-ui/Hledger/UI/Theme.hs
View File

@ -69,6 +69,7 @@ themesList = [
(borderAttr , white `on` black & dim),
(borderAttr <> "bold", white `on` black & bold),
(borderAttr <> "query", yellow `on` black & bold),
(borderAttr <> "depth", cyan `on` black & bold),
-- ("normal" , black `on` white),
("list" , black `on` white), -- regular list items
("list" <> "selected" , white `on` blue & bold) -- selected list items

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

@ -26,20 +26,20 @@ data AppState = AppState {
data Screen =
AccountsScreen {
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 -> AppState -> AppState -- ^ function to initialise the screen's state on entry
,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 :: List PostingsReportItem
,sInitFn :: Day -> [String] -> AppState -> AppState
,sInitFn :: Day -> AppState -> AppState
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
,sDrawFn :: AppState -> [Widget]
}
| RegisterScreen2 {
rs2State :: List (String,String,String,String,String)
,rs2Acct :: AccountName -- ^ the account we are showing a register for
,sInitFn :: Day -> [String] -> AppState -> AppState
,sInitFn :: Day -> AppState -> AppState
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
,sDrawFn :: AppState -> [Widget]
}

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

@ -8,14 +8,18 @@ module Hledger.UI.UIUtils (
-- ,margin
,withBorderAttr
,topBottomBorderWithLabel
,topBottomBorderWithLabels
,defaultLayout
,borderQuery
,borderQueryStr
,borderDepthStr
,borderKeysStr
) where
import Control.Lens ((^.))
-- import Control.Monad
-- import Control.Monad.IO.Class
-- import Data.Default
import Data.List
import Data.Monoid
import Data.Time.Calendar (Day)
import Brick
@ -44,9 +48,9 @@ popScreen st = st
-- Extra args can be passed to the new screen's init function,
-- these can be eg query arguments.
screenEnter :: Day -> [String] -> Screen -> AppState -> AppState
screenEnter d args scr st = (sInitFn scr) d args $
screenEnter d args scr st = (sInitFn scr) d $
pushScreen scr
st
st{aargs=args}
-- | In the EventM monad, get the named current viewport's width and height,
-- or (0,0) if the named viewport is not found.
@ -59,8 +63,8 @@ getViewportSize name = do
-- liftIO $ putStrLn $ show (w,h)
return (w,h)
defaultLayout label =
topBottomBorderWithLabel label .
defaultLayout toplabel bottomlabel =
topBottomBorderWithLabels (str " "<+>toplabel<+>str " ") (str " "<+>bottomlabel<+>str " ") .
margin 1 0 Nothing
-- topBottomBorderWithLabel2 label .
-- padLeftRight 1 -- XXX should reduce inner widget's width by 2, but doesn't
@ -82,6 +86,22 @@ topBottomBorderWithLabel label = \wrapped ->
<=>
hBorder
topBottomBorderWithLabels toplabel bottomlabel = \wrapped ->
Widget Greedy Greedy $ do
c <- getContext
let (_w,h) = (c^.availWidthL, c^.availHeightL)
h' = h - 2
wrapped' = vLimit (h') wrapped
debugmsg =
""
-- " debug: "++show (_w,h')
render $
hBorderWithLabel (toplabel <+> str debugmsg)
<=>
wrapped'
<=>
hBorderWithLabel bottomlabel
-- XXX should be equivalent to the above, but isn't (page down goes offscreen)
_topBottomBorderWithLabel2 label = \wrapped ->
let debugmsg = ""
@ -123,6 +143,16 @@ withBorderAttr attr = updateAttrMap (applyAttrMappings [(borderAttr, attr)])
-- , hCenter $ str "Press Esc to exit."
-- ]
borderQuery :: String -> Widget
borderQuery "" = str ""
borderQuery qry = str " matching " <+> withAttr (borderAttr <> "query") (str qry)
borderQueryStr :: String -> Widget
borderQueryStr "" = str ""
borderQueryStr qry = str " matching " <+> withAttr (borderAttr <> "query") (str qry)
borderDepthStr :: Maybe Int -> Widget
borderDepthStr Nothing = str ""
borderDepthStr (Just d) = str " to " <+> withAttr (borderAttr <> "depth") (str $ "depth "++show d)
borderKeysStr :: [String] -> Widget
borderKeysStr keydescs = str $ intercalate sep keydescs
where
sep = " | "
-- sep = " "