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

feat: ui: add income statement accounts screen

Browse Source
This commit is contained in:
Simon Michael 2022-09-09 16:22:34 -10:00
parent 9fc92cefe4
commit e51d4059db
12 changed files with 266 additions and 197 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -50,110 +50,110 @@ import Control.Arrow ((>>>))
asDraw :: UIState -> [Widget Name] asDraw :: UIState -> [Widget Name]
asDraw ui = dlogUiTrace "asDraw 1" $ asDrawHelper ui ropts' scrname showbalchgkey asDraw ui = dlogUiTrace "asDraw" $ asDrawHelper ui ropts' scrname showbalchgkey
where where
ropts' = _rsReportOpts $ reportspec_ $ uoCliOpts $ aopts ui ropts' = _rsReportOpts $ reportspec_ $ uoCliOpts $ aopts ui
scrname = "account " ++ if ishistorical then "balances" else "changes" scrname = "account " ++ if ishistorical then "balances" else "changes"
where ishistorical = balanceaccum_ ropts' == Historical where ishistorical = balanceaccum_ ropts' == Historical
showbalchgkey = True showbalchgkey = True
-- | Help draw any accounts-screen-like screen. -- | Help draw any accounts-like screen (all accounts, balance sheet, income statement..).
-- The provided ReportOpts are used instead of the ones in the UIState. -- The provided ReportOpts are used instead of the ones in the UIState.
-- The other arguments are the screen display name and whether to show a key -- The other arguments are the screen display name and whether to show a key
-- for toggling between end balance and balance change mode. -- for toggling between end balance and balance change mode.
asDrawHelper :: UIState -> ReportOpts -> String -> Bool -> [Widget Name] asDrawHelper :: UIState -> ReportOpts -> String -> Bool -> [Widget Name]
asDrawHelper UIState{aopts=uopts, ajournal=j, aScreen=AS sst, aMode=mode} ropts scrname showbalchgkey = asDrawHelper UIState{aScreen=scr, aopts=uopts, ajournal=j, aMode=mode} ropts scrname showbalchgkey =
dlogUiTrace "asDraw 1" $ dlogUiTrace "asDrawHelper" $
case mode of case toAccountsLikeScreen scr of
Help -> [helpDialog, maincontent] Nothing -> dlogUiTrace "asDrawHelper" $ errorWrongScreenType "draw helper" -- PARTIAL:
-- Minibuffer e -> [minibuffer e, maincontent] Just (ALS _ ass) -> case mode of
_ -> [maincontent] Help -> [helpDialog, maincontent]
where _ -> [maincontent]
UIOpts{uoCliOpts=copts} = uopts
maincontent = Widget Greedy Greedy $ do
c <- getContext
let
availwidth =
-- ltrace "availwidth" $
c^.availWidthL
- 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils)
displayitems = sst ^. assList . listElementsL
acctwidths = V.map (\AccountsScreenItem{..} -> asItemIndentLevel + realLength asItemDisplayAccountName) displayitems
balwidths = V.map (maybe 0 (wbWidth . showMixedAmountB oneLine) . asItemMixedAmount) displayitems
preferredacctwidth = V.maximum acctwidths
totalacctwidthseen = V.sum acctwidths
preferredbalwidth = V.maximum balwidths
totalbalwidthseen = V.sum balwidths
totalwidthseen = totalacctwidthseen + totalbalwidthseen
shortfall = preferredacctwidth + preferredbalwidth + 2 - availwidth
acctwidthproportion = fromIntegral totalacctwidthseen / fromIntegral totalwidthseen
adjustedacctwidth = min preferredacctwidth . max 15 . round $ acctwidthproportion * fromIntegral (availwidth - 2) -- leave 2 whitespace for padding
adjustedbalwidth = availwidth - 2 - adjustedacctwidth
-- XXX how to minimise the balance column's jumping around as you change the depth limit ?
colwidths | shortfall <= 0 = (preferredacctwidth, preferredbalwidth)
| otherwise = (adjustedacctwidth, adjustedbalwidth)
render $ defaultLayout toplabel bottomlabel $ renderList (asDrawItem colwidths) True (sst ^. assList)
where where
ishistorical = balanceaccum_ ropts == Historical UIOpts{uoCliOpts=copts} = uopts
maincontent = Widget Greedy Greedy $ do
c <- getContext
let
availwidth =
-- ltrace "availwidth" $
c^.availWidthL
- 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils)
displayitems = ass ^. assList . listElementsL
acctwidths = V.map (\AccountsScreenItem{..} -> asItemIndentLevel + realLength asItemDisplayAccountName) displayitems
balwidths = V.map (maybe 0 (wbWidth . showMixedAmountB oneLine) . asItemMixedAmount) displayitems
preferredacctwidth = V.maximum acctwidths
totalacctwidthseen = V.sum acctwidths
preferredbalwidth = V.maximum balwidths
totalbalwidthseen = V.sum balwidths
totalwidthseen = totalacctwidthseen + totalbalwidthseen
shortfall = preferredacctwidth + preferredbalwidth + 2 - availwidth
acctwidthproportion = fromIntegral totalacctwidthseen / fromIntegral totalwidthseen
adjustedacctwidth = min preferredacctwidth . max 15 . round $ acctwidthproportion * fromIntegral (availwidth - 2) -- leave 2 whitespace for padding
adjustedbalwidth = availwidth - 2 - adjustedacctwidth
-- XXX how to minimise the balance column's jumping around as you change the depth limit ?
colwidths | shortfall <= 0 = (preferredacctwidth, preferredbalwidth)
| otherwise = (adjustedacctwidth, adjustedbalwidth)
render $ defaultLayout toplabel bottomlabel $ renderList (asDrawItem colwidths) True (ass ^. assList)
toplabel =
withAttr (attrName "border" <> attrName "filename") files
<+> toggles
<+> str (" " ++ scrname)
<+> borderPeriodStr (if ishistorical then "at end of" else "in") (period_ ropts)
<+> borderQueryStr (T.unpack . T.unwords . map textQuoteIfNeeded $ querystring_ ropts)
<+> borderDepthStr mdepth
<+> str (" ("++curidx++"/"++totidx++")")
<+> (if ignore_assertions_ . balancingopts_ $ inputopts_ copts
then withAttr (attrName "border" <> attrName "query") (str " ignoring balance assertions")
else str "")
where where
files = case journalFilePaths j of ishistorical = balanceaccum_ ropts == Historical
[] -> str ""
f:_ -> str $ takeFileName f toplabel =
-- [f,_:[]] -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str " (& 1 included file)" withAttr (attrName "border" <> attrName "filename") files
-- f:fs -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str (" (& " ++ show (length fs) ++ " included files)") <+> toggles
toggles = withAttr (attrName "border" <> attrName "query") $ str $ unwords $ concat [ <+> str (" " ++ scrname)
[""] <+> borderPeriodStr (if ishistorical then "at end of" else "in") (period_ ropts)
,if empty_ ropts then [] else ["nonzero"] <+> borderQueryStr (T.unpack . T.unwords . map textQuoteIfNeeded $ querystring_ ropts)
,uiShowStatus copts $ statuses_ ropts <+> borderDepthStr mdepth
,if real_ ropts then ["real"] else [] <+> str (" ("++curidx++"/"++totidx++")")
] <+> (if ignore_assertions_ . balancingopts_ $ inputopts_ copts
mdepth = depth_ ropts then withAttr (attrName "border" <> attrName "query") (str " ignoring balance assertions")
curidx = case sst ^. assList . listSelectedL of else str "")
Nothing -> "-"
Just i -> show (i + 1)
totidx = show $ V.length nonblanks
where where
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ sst ^. assList . listElementsL files = case journalFilePaths j of
[] -> str ""
f:_ -> str $ takeFileName f
-- [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)")
toggles = withAttr (attrName "border" <> attrName "query") $ str $ unwords $ concat [
[""]
,if empty_ ropts then [] else ["nonzero"]
,uiShowStatus copts $ statuses_ ropts
,if real_ ropts then ["real"] else []
]
mdepth = depth_ ropts
curidx = case ass ^. assList . listSelectedL of
Nothing -> "-"
Just i -> show (i + 1)
totidx = show $ V.length nonblanks
where
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ ass ^. assList . listElementsL
bottomlabel = case mode of bottomlabel = case mode of
Minibuffer label ed -> minibuffer label ed Minibuffer label ed -> minibuffer label ed
_ -> quickhelp _ -> quickhelp
where where
quickhelp = borderKeysStr' [ quickhelp = borderKeysStr' [
("?", str "help") ("?", str "help")
-- ,("RIGHT", str "register") -- ,("RIGHT", str "register")
,("t", renderToggle (tree_ ropts) "list" "tree") ,("t", renderToggle (tree_ ropts) "list" "tree")
-- ,("t", str "tree") -- ,("t", str "tree")
-- ,("l", str "list") -- ,("l", str "list")
,("-+", str "depth") ,("-+", str "depth")
,(if showbalchgkey then "H" else "", renderToggle (not ishistorical) "end-bals" "changes") ,(if showbalchgkey then "H" else "", renderToggle (not ishistorical) "end-bals" "changes")
,("F", renderToggle1 (isJust . forecast_ $ inputopts_ copts) "forecast") ,("F", renderToggle1 (isJust . forecast_ $ inputopts_ copts) "forecast")
--,("/", "filter") --,("/", "filter")
--,("DEL", "unfilter") --,("DEL", "unfilter")
--,("ESC", "cancel/top") --,("ESC", "cancel/top")
,("a", str "add") ,("a", str "add")
-- ,("g", "reload") -- ,("g", "reload")
,("q", str "quit") ,("q", str "quit")
] ]
asDrawHelper _ _ _ _ = dlogUiTrace "asDrawHelper" $ errorWrongScreenType "draw function" -- PARTIAL:
asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget Name asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget Name
asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} = asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
@ -175,40 +175,37 @@ asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
sel | selected = (<> attrName "selected") sel | selected = (<> attrName "selected")
| otherwise = id | otherwise = id
-- | Handle events on any accounts-like screen (all accounts, balance sheet, income statement..).
asHandle :: BrickEvent Name AppEvent -> EventM Name UIState () asHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
asHandle ev = do asHandle ev = do
ui0 <- get'
dlogUiTraceM "asHandle" dlogUiTraceM "asHandle"
case ui0 of ui0@UIState{aScreen=scr, aMode=mode} <- get'
ui1@UIState{aMode=mode, aScreen=AS sst} -> case mode of case toAccountsLikeScreen scr of
Normal -> asHandleNormalMode ui scr ev Nothing -> dlogUiTrace "asHandle" $ errorWrongScreenType "event handler" -- PARTIAL:
Minibuffer _ ed -> handleMinibufferMode ui ed ev Just als@(ALS scons ass) -> do
Help -> handleHelpMode ui ev -- save the currently selected account, in case we leave this screen and lose the selection
where put' ui0{aScreen=scons ass{_assSelectedAccount=asSelectedAccount ass}}
scr = AS case mode of
-- save the currently selected account, in case we leave this screen and lose the selection Normal -> asHandleNormalMode als ev
selacct = case listSelectedElement $ _assList sst of Minibuffer _ ed -> handleMinibufferMode ed ev
Just (_, AccountsScreenItem{..}) -> asItemAccountName Help -> handleHelpMode ev
Nothing -> sst ^. assSelectedAccount
ui = ui1{aScreen=scr sst{_assSelectedAccount=selacct}}
_ -> dlogUiTraceM "asHandle" >> errorWrongScreenType "event handler"
-- | Handle events when in normal mode on any accounts-screen-like screen. -- | Handle events when in normal mode on any accounts-like screen.
asHandleNormalMode :: UIState -> (AccountsScreenState -> Screen) -> BrickEvent Name AppEvent -> EventM Name UIState () -- The provided AccountsLikeScreen should correspond to the ui state's current screen.
asHandleNormalMode ui1@UIState{aopts=UIOpts{uoCliOpts=copts}, ajournal=j, aScreen=AS sst} scr ev = do asHandleNormalMode :: AccountsLikeScreen -> BrickEvent Name AppEvent -> EventM Name UIState ()
asHandleNormalMode (ALS scons ass) ev = do
dlogUiTraceM "asHandleNormalMode"
ui@UIState{aopts=UIOpts{uoCliOpts=copts}, ajournal=j} <- get'
d <- liftIO getCurrentDay d <- liftIO getCurrentDay
let let
l = _assList sst l = _assList ass
selacct = asSelectedAccount ass
centerSelection = scrollSelectionToMiddle l centerSelection = scrollSelectionToMiddle l
-- save the currently selected account, in case we leave this screen and lose the selection
selacct = case listSelectedElement l of
Just (_, AccountsScreenItem{..}) -> asItemAccountName
Nothing -> sst ^. assSelectedAccount
clickedAcctAt y = clickedAcctAt y =
case asItemAccountName <$> listElements l !? y of case asItemAccountName <$> listElements l !? y of
Just t | not $ T.null t -> Just t Just t | not $ T.null t -> Just t
_ -> Nothing _ -> Nothing
ui = ui1{aScreen=AS sst{_assSelectedAccount=selacct}}
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ listElements l nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ listElements l
lastnonblankidx = max 0 (length nonblanks - 1) lastnonblankidx = max 0 (length nonblanks - 1)
journalspan = journalDateSpan False j journalspan = journalDateSpan False j
@ -283,17 +280,19 @@ asHandleNormalMode ui1@UIState{aopts=UIOpts{uoCliOpts=copts}, ajournal=j, aScree
VtyEvent e | e `elem` moveRightEvents, not $ isBlankItem $ listSelectedElement l -> enterRegisterScreen d selacct ui VtyEvent e | e `elem` moveRightEvents, not $ isBlankItem $ listSelectedElement l -> enterRegisterScreen d selacct ui
MouseUp _n (Just BLeft) Location{loc=(_,y)} | Just clkacct <- clickedAcctAt y -> enterRegisterScreen d clkacct ui MouseUp _n (Just BLeft) Location{loc=(_,y)} | Just clkacct <- clickedAcctAt y -> enterRegisterScreen d clkacct ui
-- MouseDown: this is sometimes duplicated (https://github.com/jtdaugherty/brick/issues/347), -- MouseDown: this is not debounced and can repeat (https://github.com/jtdaugherty/brick/issues/347)
-- so we use it only to move the selection. -- so we only let it do something harmless: move the selection.
MouseDown _n BLeft _mods Location{loc=(_,y)} | not $ isBlankItem clickeditem -> MouseDown _n BLeft _mods Location{loc=(_,y)} | not $ isBlankItem clickeditem ->
put' ui{aScreen=scr sst} -- XXX does this do anything ? put' ui{aScreen=scons ass'}
where clickeditem = (0,) <$> listElements l !? y where
clickeditem = (0,) <$> listElements l !? y
ass' = ass{_assList=listMoveTo y l}
-- Mouse scroll wheel: scroll up or down to the maximum extent, pushing the selection when necessary. -- Mouse scroll wheel: scroll up or down to the maximum extent, pushing the selection when necessary.
MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do
let scrollamt = if btn==BScrollUp then -1 else 1 let scrollamt = if btn==BScrollUp then -1 else 1
l' <- nestEventM' l $ listScrollPushingSelection name (asListSize l) scrollamt l' <- nestEventM' l $ listScrollPushingSelection name (asListSize l) scrollamt
put' ui{aScreen=scr sst{_assList=l'}} put' ui{aScreen=scons ass{_assList=l'}}
-- PGDOWN/END keys: handle with List's default handler, but restrict the selection to stop -- PGDOWN/END keys: handle with List's default handler, but restrict the selection to stop
-- (and center) at the last non-blank item. -- (and center) at the last non-blank item.
@ -303,9 +302,9 @@ asHandleNormalMode ui1@UIState{aopts=UIOpts{uoCliOpts=copts}, ajournal=j, aScree
then do then do
let l2 = listMoveTo lastnonblankidx l1 let l2 = listMoveTo lastnonblankidx l1
scrollSelectionToMiddle l2 scrollSelectionToMiddle l2
put' ui{aScreen=scr sst{_assList=l2}} put' ui{aScreen=scons ass{_assList=l2}}
else else
put' ui{aScreen=scr sst{_assList=l1}} put' ui{aScreen=scons ass{_assList=l1}}
-- DOWN key when selection is at the last item: scroll instead of moving, until maximally scrolled -- DOWN key when selection is at the last item: scroll instead of moving, until maximally scrolled
VtyEvent e | e `elem` moveDownEvents, isBlankItem mnextelement -> vScrollBy (viewportScroll $ l^.listNameL) 1 VtyEvent e | e `elem` moveDownEvents, isBlankItem mnextelement -> vScrollBy (viewportScroll $ l^.listNameL) 1
@ -314,17 +313,16 @@ asHandleNormalMode ui1@UIState{aopts=UIOpts{uoCliOpts=copts}, ajournal=j, aScree
-- Any other vty event (UP, DOWN, PGUP etc): handle with List's default handler. -- Any other vty event (UP, DOWN, PGUP etc): handle with List's default handler.
VtyEvent e -> do VtyEvent e -> do
l' <- nestEventM' l $ handleListEvent (normaliseMovementKeys e) l' <- nestEventM' l $ handleListEvent (normaliseMovementKeys e)
put' ui{aScreen=scr $ sst & assList .~ l' & assSelectedAccount .~ selacct} put' ui{aScreen=scons $ ass & assList .~ l' & assSelectedAccount .~ selacct}
-- Any other mouse/app event: ignore -- Any other mouse/app event: ignore
MouseDown{} -> return () MouseDown{} -> return ()
MouseUp{} -> return () MouseUp{} -> return ()
AppEvent _ -> return () AppEvent _ -> return ()
asHandleNormalMode _ _ _ = dlogUiTraceM "handleNormalMode" >> errorWrongScreenType "event handler"
-- | Handle events when in minibuffer mode on any screen. -- | Handle events when in minibuffer mode on any screen.
handleMinibufferMode ui@UIState{ajournal=j} ed ev = do handleMinibufferMode ed ev = do
ui@UIState{ajournal=j} <- get'
d <- liftIO getCurrentDay d <- liftIO getCurrentDay
case ev of case ev of
VtyEvent (EvKey KEsc []) -> put' $ closeMinibuffer ui VtyEvent (EvKey KEsc []) -> put' $ closeMinibuffer ui
@ -343,7 +341,8 @@ handleMinibufferMode ui@UIState{ajournal=j} ed ev = do
MouseUp{} -> return () MouseUp{} -> return ()
-- | Handle events when in help mode on any screen. -- | Handle events when in help mode on any screen.
handleHelpMode ui ev = handleHelpMode ev = do
ui <- get'
case ev of case ev of
-- VtyEvent (EvKey (KChar 'q') []) -> halt -- VtyEvent (EvKey (KChar 'q') []) -> halt
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
@ -362,6 +361,14 @@ enterRegisterScreen d acct ui@UIState{ajournal=j, aopts=uopts} = do
ui1 = pushScreen regscr ui ui1 = pushScreen regscr ui
rsCenterSelection ui1 >>= put' rsCenterSelection ui1 >>= put'
-- | From an accounts-screen-like screen's state, get the account name from the
-- currently selected list item, or otherwise the last known selected account name.
asSelectedAccount :: AccountsScreenState -> AccountName
asSelectedAccount ass =
case listSelectedElement $ _assList ass of
Just (_, AccountsScreenItem{..}) -> asItemAccountName
Nothing -> ass ^. assSelectedAccount
-- | Set the selected account on an accounts screen. No effect on other screens. -- | Set the selected account on an accounts screen. No effect on other screens.
asSetSelectedAccount :: AccountName -> Screen -> Screen asSetSelectedAccount :: AccountName -> Screen -> Screen
asSetSelectedAccount a (AS ass@ASS{}) = AS ass{_assSelectedAccount=a} asSetSelectedAccount a (AS ass@ASS{}) = AS ass{_assSelectedAccount=a}

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

@ -1,8 +1,5 @@
-- The balance sheet screen, like the accounts screen but restricted to balance sheet accounts. -- The balance sheet screen, like the accounts screen but restricted to balance sheet accounts.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.UI.BalancesheetScreen module Hledger.UI.BalancesheetScreen
(bsNew (bsNew
,bsUpdate ,bsUpdate
@ -12,8 +9,6 @@ module Hledger.UI.BalancesheetScreen
where where
import Brick hiding (bsDraw) import Brick hiding (bsDraw)
import Brick.Widgets.List
import Lens.Micro.Platform
import Hledger import Hledger
import Hledger.Cli hiding (mode, progname, prognameandversion) import Hledger.Cli hiding (mode, progname, prognameandversion)
@ -21,7 +16,7 @@ import Hledger.UI.UIOptions
import Hledger.UI.UITypes import Hledger.UI.UITypes
import Hledger.UI.UIUtils import Hledger.UI.UIUtils
import Hledger.UI.UIScreens import Hledger.UI.UIScreens
import Hledger.UI.AccountsScreen (asDrawHelper, handleHelpMode, handleMinibufferMode, asHandleNormalMode) import Hledger.UI.AccountsScreen (asHandle, asDrawHelper)
bsDraw :: UIState -> [Widget Name] bsDraw :: UIState -> [Widget Name]
@ -32,19 +27,4 @@ bsDraw ui = dlogUiTrace "bsDraw" $ asDrawHelper ui ropts' scrname showbalchgkey
showbalchgkey = False showbalchgkey = False
bsHandle :: BrickEvent Name AppEvent -> EventM Name UIState () bsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
bsHandle ev = do bsHandle = asHandle . dlogUiTrace "bsHandle"
ui0 <- get'
dlogUiTraceM "bsHandle"
case ui0 of
ui1@UIState{aMode=mode, aScreen=BS sst} -> case mode of
Normal -> asHandleNormalMode ui scr ev
Minibuffer _ ed -> handleMinibufferMode ui ed ev
Help -> handleHelpMode ui ev
where
scr = BS
-- save the currently selected account, in case we leave this screen and lose the selection
selacct = case listSelectedElement $ _assList sst of
Just (_, AccountsScreenItem{..}) -> asItemAccountName
Nothing -> sst ^. assSelectedAccount
ui = ui1{aScreen=scr sst{_assSelectedAccount=selacct}}
_ -> dlogUiTraceM "bsHandle" >> errorWrongScreenType "event handler"

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

@ -41,7 +41,6 @@ esDraw UIState{aScreen=ES ESS{..}
} = } =
case mode of case mode of
Help -> [helpDialog, maincontent] Help -> [helpDialog, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent]
_ -> [maincontent] _ -> [maincontent]
where where
maincontent = Widget Greedy Greedy $ do maincontent = Widget Greedy Greedy $ do

30
hledger-ui/Hledger/UI/IncomestatementScreen.hs Normal file
View File

@ -0,0 +1,30 @@
-- The income statement accounts screen, like the accounts screen but restricted to income statement accounts.
module Hledger.UI.IncomestatementScreen
(isNew
,isUpdate
,isDraw
,isHandle
)
where
import Brick
import Hledger
import Hledger.Cli hiding (mode, progname, prognameandversion)
import Hledger.UI.UIOptions
import Hledger.UI.UITypes
import Hledger.UI.UIUtils
import Hledger.UI.UIScreens
import Hledger.UI.AccountsScreen (asHandle, asDrawHelper)
isDraw :: UIState -> [Widget Name]
isDraw ui = dlogUiTrace "isDraw" $ asDrawHelper ui ropts' scrname showbalchgkey
where
scrname = "income statement"
ropts' = (_rsReportOpts $ reportspec_ $ uoCliOpts $ aopts ui){balanceaccum_=PerPeriod}
showbalchgkey = False
isHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
isHandle = asHandle . dlogUiTrace "isHandle"

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

@ -37,6 +37,7 @@ import Hledger.UI.UIUtils (dlogUiTrace, dlogUiTraceM)
import Hledger.UI.MenuScreen import Hledger.UI.MenuScreen
import Hledger.UI.AccountsScreen import Hledger.UI.AccountsScreen
import Hledger.UI.BalancesheetScreen import Hledger.UI.BalancesheetScreen
import Hledger.UI.IncomestatementScreen
import Hledger.UI.RegisterScreen import Hledger.UI.RegisterScreen
import Hledger.UI.TransactionScreen import Hledger.UI.TransactionScreen
import Hledger.UI.ErrorScreen import Hledger.UI.ErrorScreen
@ -114,10 +115,11 @@ runBrickUi uopts0@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=_iopts,reportspec_=r
reportspec_=rspec{ reportspec_=rspec{
_rsQuery=filteredQuery $ _rsQuery rspec, -- query with depth/date parts removed _rsQuery=filteredQuery $ _rsQuery rspec, -- query with depth/date parts removed
_rsReportOpts=ropts{ _rsReportOpts=ropts{
depth_ =queryDepth $ _rsQuery rspec, -- query's depth part depth_ = queryDepth $ _rsQuery rspec, -- query's depth part
period_=periodfromoptsandargs, -- query's date part period_ = periodfromoptsandargs, -- query's date part
no_elide_=True, -- avoid squashing boring account names, for a more regular tree (unlike hledger) no_elide_ = True, -- avoid squashing boring account names, for a more regular tree (unlike hledger)
empty_=not $ empty_ ropts -- show zero items by default, hide them with -E (unlike hledger) empty_ = not $ empty_ ropts, -- show zero items by default, hide them with -E (unlike hledger)
declared_ = True -- always show declared accounts even if unused
} }
} }
} }
@ -246,6 +248,7 @@ uiHandle ev = do
MS _ -> msHandle ev MS _ -> msHandle ev
AS _ -> asHandle ev AS _ -> asHandle ev
BS _ -> bsHandle ev BS _ -> bsHandle ev
IS _ -> isHandle ev
RS _ -> rsHandle ev RS _ -> rsHandle ev
TS _ -> tsHandle ev TS _ -> tsHandle ev
ES _ -> esHandle ev ES _ -> esHandle ev
@ -256,6 +259,7 @@ uiDraw ui =
MS _ -> msDraw ui MS _ -> msDraw ui
AS _ -> asDraw ui AS _ -> asDraw ui
BS _ -> bsDraw ui BS _ -> bsDraw ui
IS _ -> isDraw ui
RS _ -> rsDraw ui RS _ -> rsDraw ui
TS _ -> tsDraw ui TS _ -> tsDraw ui
ES _ -> esDraw ui ES _ -> esDraw ui

13
hledger-ui/Hledger/UI/MenuScreen.hs
View File

@ -42,10 +42,9 @@ msDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=_rspec}}
,ajournal=j ,ajournal=j
,aScreen=MS sst ,aScreen=MS sst
,aMode=mode ,aMode=mode
} = dlogUiTrace "msDraw 1" $ } = dlogUiTrace "msDraw" $
case mode of case mode of
Help -> [helpDialog, maincontent] Help -> [helpDialog, maincontent]
Minibuffer lbl ed -> [minibuffer lbl ed, maincontent]
_ -> [maincontent] _ -> [maincontent]
where where
maincontent = Widget Greedy Greedy $ do maincontent = Widget Greedy Greedy $ do
@ -84,7 +83,7 @@ msDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=_rspec}}
,("q", str "quit") ,("q", str "quit")
] ]
msDraw _ = dlogUiTrace "msDraw 2" $ errorWrongScreenType "draw function" -- PARTIAL: msDraw _ = dlogUiTrace "msDraw" $ errorWrongScreenType "draw function" -- PARTIAL:
-- msDrawItem :: (Int,Int) -> Bool -> MenuScreenItem -> Widget Name -- msDrawItem :: (Int,Int) -> Bool -> MenuScreenItem -> Widget Name
-- msDrawItem (_acctwidth, _balwidth) _selected MenuScreenItem{..} = -- msDrawItem (_acctwidth, _balwidth) _selected MenuScreenItem{..} =
@ -93,6 +92,7 @@ msDrawItem _selected MenuScreenItem{..} =
Widget Greedy Fixed $ do Widget Greedy Fixed $ do
render $ txt msItemScreenName render $ txt msItemScreenName
-- XXX clean up like asHandle
msHandle :: BrickEvent Name AppEvent -> EventM Name UIState () msHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
msHandle ev = do msHandle ev = do
ui0 <- get' ui0 <- get'
@ -189,7 +189,7 @@ msHandle ev = do
-- VtyEvent (EvKey (KRight) [MShift]) -> put' $ regenerateScreens j d $ nextReportPeriod journalspan ui -- VtyEvent (EvKey (KRight) [MShift]) -> put' $ regenerateScreens j d $ nextReportPeriod journalspan ui
-- VtyEvent (EvKey (KLeft) [MShift]) -> put' $ regenerateScreens j d $ previousReportPeriod journalspan ui -- VtyEvent (EvKey (KLeft) [MShift]) -> put' $ regenerateScreens j d $ previousReportPeriod journalspan ui
VtyEvent (EvKey (KChar '/') []) -> put' $ regenerateScreens j d $ showMinibuffer "filter" Nothing ui VtyEvent (EvKey (KChar '/') []) -> put' $ regenerateScreens j d $ showMinibuffer "filter" Nothing ui
-- VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> (put' $ regenerateScreens j d $ resetFilter ui) VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> (put' $ regenerateScreens j d $ resetFilter ui)
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle (_mssList sst) >> redraw VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle (_mssList sst) >> redraw
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
@ -256,8 +256,9 @@ msEnterScreen d scrname ui@UIState{ajournal=j, aopts=uopts} = do
dlogUiTraceM "msEnterScreen" dlogUiTraceM "msEnterScreen"
let let
scr = case scrname of scr = case scrname of
Accounts -> asNew uopts d j Nothing Accounts -> asNew uopts d j Nothing
Balancesheet -> bsNew uopts d j Nothing Balancesheet -> bsNew uopts d j Nothing
Incomestatement -> isNew uopts d j Nothing
put' $ pushScreen scr ui put' $ pushScreen scr ui
isBlankElement mel = ((msItemScreenName . snd) <$> mel) == Just "" isBlankElement mel = ((msItemScreenName . snd) <$> mel) == Just ""

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

@ -48,7 +48,6 @@ rsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
} = dlogUiTrace "rsDraw 1" $ } = dlogUiTrace "rsDraw 1" $
case mode of case mode of
Help -> [helpDialog, maincontent] Help -> [helpDialog, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent]
_ -> [maincontent] _ -> [maincontent]
where where
displayitems = V.toList $ listElements $ _rssList displayitems = V.toList $ listElements $ _rssList
@ -180,6 +179,7 @@ rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected Regist
sel | selected = (<> attrName "selected") sel | selected = (<> attrName "selected")
| otherwise = id | otherwise = id
-- XXX clean up like asHandle
rsHandle :: BrickEvent Name AppEvent -> EventM Name UIState () rsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
rsHandle ev = do rsHandle ev = do
ui0 <- get' ui0 <- get'

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

@ -43,7 +43,6 @@ tsDraw UIState{aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec
} = } =
case mode of case mode of
Help -> [helpDialog, maincontent] Help -> [helpDialog, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent]
_ -> [maincontent] _ -> [maincontent]
where where
maincontent = Widget Greedy Greedy $ render $ defaultLayout toplabel bottomlabel txneditor maincontent = Widget Greedy Greedy $ render $ defaultLayout toplabel bottomlabel txneditor

77
hledger-ui/Hledger/UI/UIScreens.hs
View File

@ -24,6 +24,8 @@ module Hledger.UI.UIScreens
,asUpdate ,asUpdate
,bsNew ,bsNew
,bsUpdate ,bsUpdate
,isNew
,isUpdate
,rsNew ,rsNew
,rsUpdate ,rsUpdate
,tsNew ,tsNew
@ -50,7 +52,8 @@ screenUpdate :: UIOpts -> Day -> Journal -> Screen -> Screen
screenUpdate opts d j = \case screenUpdate opts d j = \case
MS sst -> MS $ msUpdate sst -- opts d j ass MS sst -> MS $ msUpdate sst -- opts d j ass
AS sst -> AS $ asUpdate opts d j sst AS sst -> AS $ asUpdate opts d j sst
BS sst -> BS $ asUpdate opts d j sst BS sst -> BS $ bsUpdate opts d j sst
IS sst -> IS $ isUpdate opts d j sst
RS sst -> RS $ rsUpdate opts d j sst RS sst -> RS $ rsUpdate opts d j sst
TS sst -> TS $ tsUpdate sst TS sst -> TS $ tsUpdate sst
ES sst -> ES $ esUpdate sst ES sst -> ES $ esUpdate sst
@ -78,7 +81,8 @@ msNew =
MS MSS { MS MSS {
_mssList = list MenuList (V.fromList [ _mssList = list MenuList (V.fromList [
MenuScreenItem "All accounts" Accounts MenuScreenItem "All accounts" Accounts
,MenuScreenItem "Balance sheet accounts" Balancesheet ,MenuScreenItem "Balance sheet accounts (assets, liabilities, equity)" Balancesheet
,MenuScreenItem "Income statement accounts (revenues, expenses)" Incomestatement
]) 1 ]) 1
,_mssUnused = () ,_mssUnused = ()
} }
@ -86,37 +90,43 @@ msNew =
-- | Update a menu screen. Currently a no-op since menu screen -- | Update a menu screen. Currently a no-op since menu screen
-- has unchanging content. -- has unchanging content.
msUpdate :: MenuScreenState -> MenuScreenState msUpdate :: MenuScreenState -> MenuScreenState
msUpdate = dlogUiTrace "msUpdate`" msUpdate = dlogUiTrace "msUpdate"
nullass macct = ASS { nullass macct = ASS {
_assSelectedAccount = fromMaybe "" macct _assSelectedAccount = fromMaybe "" macct
,_assList = list AccountsList (V.fromList []) 1 ,_assList = list AccountsList (V.fromList []) 1
} }
-- | Construct an accounts screen listing the appropriate set of accounts, -- | Construct an accounts screen listing the appropriate set of accounts,
-- with the appropriate one selected. -- with the appropriate one selected.
-- Screen-specific arguments: the account to select if any. -- Screen-specific arguments: the account to select if any.
asNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen asNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen
asNew uopts d j macct = dlogUiTrace "asNew" $ AS $ asUpdate uopts d j $ nullass macct asNew uopts d j macct = dlogUiTrace "asNew" $ AS $ asUpdate uopts d j $ nullass macct
-- | Update an accounts screen from these options, reporting date, and journal. -- | Update an accounts screen's state from these options, reporting date, and journal.
asUpdate :: UIOpts -> Day -> Journal -> AccountsScreenState -> AccountsScreenState asUpdate :: UIOpts -> Day -> Journal -> AccountsScreenState -> AccountsScreenState
asUpdate uopts d = dlogUiTrace "asUpdate" . asUpdateHelper rspec' asUpdate uopts d = dlogUiTrace "asUpdate" .
asUpdateHelper rspec d copts roptsmod extraquery
where where
UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} = uopts UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} = uopts
rspec' = roptsmod = id
updateReportSpec extraquery = Any
ropts{declared_=True} -- always show declared accounts even if unused
rspec{_rsDay=d} -- update to the given day, might have changed since program start
& either (error "asUpdate: adjusting the query, should not have failed") id -- PARTIAL:
& reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts) -- include/exclude future & forecast transactions
-- | Update an accounts-screen-like screen from this report spec and journal. -- | Update an accounts-like screen's state from this report spec, reporting date,
asUpdateHelper :: ReportSpec -> Journal -> AccountsScreenState -> AccountsScreenState -- cli options, report options modifier, extra query, and journal.
asUpdateHelper rspec j ass = dlogUiTrace "asUpdate" ass{_assList=l} asUpdateHelper :: ReportSpec -> Day -> CliOpts -> (ReportOpts -> ReportOpts) -> Query -> Journal -> AccountsScreenState -> AccountsScreenState
asUpdateHelper rspec0 d copts roptsModify extraquery j ass = dlogUiTrace "asUpdateHelper"
ass{_assList=l}
where where
ropts = _rsReportOpts rspec ropts = roptsModify $ _rsReportOpts rspec0
rspec =
updateReportSpec
ropts
rspec0{_rsDay=d} -- update to the current date, might have changed since program start
& either (error "asUpdateHelper: adjusting the query, should not have failed") id -- PARTIAL:
& reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts) -- include/exclude future & forecast transactions
& reportSpecAddQuery extraquery -- add any extra restrictions
-- decide which account is selected: -- decide which account is selected:
-- if selectfirst is true, the first account; -- if selectfirst is true, the first account;
-- otherwise, the previously selected account if possible; -- otherwise, the previously selected account if possible;
@ -163,20 +173,29 @@ asUpdateHelper rspec j ass = dlogUiTrace "asUpdate" ass{_assList=l}
bsNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen bsNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen
bsNew uopts d j macct = dlogUiTrace "bsNew" $ BS $ bsUpdate uopts d j $ nullass macct bsNew uopts d j macct = dlogUiTrace "bsNew" $ BS $ bsUpdate uopts d j $ nullass macct
-- | Update a balance sheet screen from these options, reporting date, and journal. -- | Update a balance sheet screen's state from these options, reporting date, and journal.
bsUpdate :: UIOpts -> Day -> Journal -> AccountsScreenState -> AccountsScreenState bsUpdate :: UIOpts -> Day -> Journal -> AccountsScreenState -> AccountsScreenState
bsUpdate uopts d = dlogUiTrace "bsUpdate" . asUpdateHelper rspec' bsUpdate uopts d = dlogUiTrace "bsUpdate" .
asUpdateHelper rspec d copts roptsmod extraquery
where where
UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} = uopts UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} = uopts
rspec' = roptsmod ropts = ropts{balanceaccum_=Historical} -- always show historical end balances
updateReportSpec extraquery = Type [Asset,Liability,Equity] -- restrict to balance sheet accounts
ropts{declared_=True -- always show declared accounts even if unused
,balanceaccum_=Historical -- always show historical end balances -- | Construct an income statement screen listing the appropriate set of accounts,
} -- with the appropriate one selected.
rspec{_rsDay=d} -- update to the given day, might have changed since program start -- Screen-specific arguments: the account to select if any.
& either (error "bsUpdate: adjusting the query, should not have failed") id -- PARTIAL: isNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen
& reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts) -- include/exclude future & forecast transactions isNew uopts d j macct = dlogUiTrace "isNew" $ IS $ isUpdate uopts d j $ nullass macct
& reportSpecAddQuery (Type [Asset,Liability,Equity]) -- restrict to balance sheet accounts
-- | Update an income statement screen's state from these options, reporting date, and journal.
isUpdate :: UIOpts -> Day -> Journal -> AccountsScreenState -> AccountsScreenState
isUpdate uopts d = dlogUiTrace "isUpdate" .
asUpdateHelper rspec d copts roptsmod extraquery
where
UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} = uopts
roptsmod ropts = ropts{balanceaccum_=PerPeriod} -- always show historical end balances
extraquery = Type [Revenue, Expense] -- restrict to income statement accounts
-- | Construct a register screen listing the appropriate set of transactions, -- | Construct a register screen listing the appropriate set of transactions,
-- with the appropriate one selected. -- with the appropriate one selected.

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

@ -102,6 +102,7 @@ data Name =
data ScreenName = data ScreenName =
Accounts Accounts
| Balancesheet | Balancesheet
| Incomestatement
deriving (Ord, Show, Eq) deriving (Ord, Show, Eq)
---------------------------------------------------------------------------------------------------- ----------------------------------------------------------------------------------------------------
@ -159,12 +160,14 @@ data ScreenName =
-- and debug. The screen types store only state, not behaviour (functions), and there is no longer -- and debug. The screen types store only state, not behaviour (functions), and there is no longer
-- a circular dependency between UIState and Screen. -- a circular dependency between UIState and Screen.
-- A new screen requires -- A new screen requires
-- 1. a new constructor in the Screen type, -- 1. a new constructor in the Screen type
-- 2. a new screen state type, -- 2. a new screen state type if needed
-- 3. new cases in the uiDraw and uiHandle functions, -- 3. a new case in toAccountsLikeScreen if needed
-- 4. new constructor and updater functions in UIScreens, and a new case in screenUpdate -- 4. new cases in the uiDraw and uiHandle functions
-- 5. a new module implementing draw and event-handling functions, -- 5. new constructor and updater functions in UIScreens, and a new case in screenUpdate
-- 6. a call from any other screen which enters it. -- 6. a new module implementing draw and event-handling functions
-- 7. a call from any other screen which enters it (eg the menu screen, a new case in msEnterScreen)
-- 8. if it appears on the main menu: a new menu item in msNew
-- cf https://github.com/jtdaugherty/brick/issues/379#issuecomment-1192000374 -- cf https://github.com/jtdaugherty/brick/issues/379#issuecomment-1192000374
-- | The various screens which a user can navigate to in hledger-ui, -- | The various screens which a user can navigate to in hledger-ui,
@ -174,11 +177,28 @@ data Screen =
MS MenuScreenState MS MenuScreenState
| AS AccountsScreenState | AS AccountsScreenState
| BS AccountsScreenState | BS AccountsScreenState
| IS AccountsScreenState
| RS RegisterScreenState | RS RegisterScreenState
| TS TransactionScreenState | TS TransactionScreenState
| ES ErrorScreenState | ES ErrorScreenState
deriving (Show) deriving (Show)
-- | A subset of the screens which reuse the account screen's state and logic.
-- Such Screens can be converted to and from this more restrictive type
-- for cleaner code.
data AccountsLikeScreen = ALS (AccountsScreenState -> Screen) AccountsScreenState
deriving (Show)
toAccountsLikeScreen :: Screen -> Maybe AccountsLikeScreen
toAccountsLikeScreen scr = case scr of
AS ass -> Just $ ALS AS ass
BS ass -> Just $ ALS BS ass
IS ass -> Just $ ALS IS ass
_ -> Nothing
fromAccountsLikeScreen :: AccountsLikeScreen -> Screen
fromAccountsLikeScreen (ALS scons ass) = scons ass
data MenuScreenState = MSS { data MenuScreenState = MSS {
-- view data: -- view data:
_mssList :: List Name MenuScreenItem -- ^ list widget showing screen names _mssList :: List Name MenuScreenItem -- ^ list widget showing screen names

1
hledger-ui/hledger-ui.cabal
View File

@ -52,6 +52,7 @@ executable hledger-ui
Hledger.UI.BalancesheetScreen Hledger.UI.BalancesheetScreen
Hledger.UI.Editor Hledger.UI.Editor
Hledger.UI.ErrorScreen Hledger.UI.ErrorScreen
Hledger.UI.IncomestatementScreen
Hledger.UI.Main Hledger.UI.Main
Hledger.UI.MenuScreen Hledger.UI.MenuScreen
Hledger.UI.RegisterScreen Hledger.UI.RegisterScreen

15
hledger-ui/hledger-ui.m4.md
View File

@ -296,12 +296,21 @@ reload).
## Balance sheet accounts screen ## Balance sheet accounts screen
This is like the accounts screen, except: This is like the accounts screen except:
- it shows only asset, liability and equity accounts (see [account types](/hledger.html#account-types)) - it shows only asset, liability and equity accounts (see [account types](/hledger.html#account-types))
- it always shows historical end balances on a certain date (not balance changes). - it always shows historical end balances on some date (not balance changes).
It corresponds to the `hledger balancesheet` CLI report. It corresponds to the `hledger balancesheet` command.
## Income statement accounts screen
Like the accounts screen except:
- it shows only revenue and expense accounts
- it always shows balance changes in some period (not end balances).
It corresponds to the `hledger incomestatement` command.
## Error screen ## Error screen