simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-11-07 21:15:19 +03:00
Code Issues 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 ui = dlogUiTrace "asDraw 1" $ asDrawHelper ui ropts' scrname showbalchgkey
asDraw ui = dlogUiTrace "asDraw" $ asDrawHelper ui ropts' scrname showbalchgkey
where
ropts' = _rsReportOpts $ reportspec_ $ uoCliOpts $ aopts ui
scrname = "account " ++ if ishistorical then "balances" else "changes"
where ishistorical = balanceaccum_ ropts' == Historical
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 other arguments are the screen display name and whether to show a key
-- for toggling between end balance and balance change mode.
asDrawHelper :: UIState -> ReportOpts -> String -> Bool -> [Widget Name]
asDrawHelper UIState{aopts=uopts, ajournal=j, aScreen=AS sst, aMode=mode} ropts scrname showbalchgkey =
dlogUiTrace "asDraw 1" $
case mode of
Help -> [helpDialog, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent]
_ -> [maincontent]
where
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)
asDrawHelper UIState{aScreen=scr, aopts=uopts, ajournal=j, aMode=mode} ropts scrname showbalchgkey =
dlogUiTrace "asDrawHelper" $
case toAccountsLikeScreen scr of
Nothing -> dlogUiTrace "asDrawHelper" $ errorWrongScreenType "draw helper" -- PARTIAL:
Just (ALS _ ass) -> case mode of
Help -> [helpDialog, maincontent]
_ -> [maincontent]
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
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 sst ^. assList . listSelectedL of
Nothing -> "-"
Just i -> show (i + 1)
totidx = show $ V.length nonblanks
ishistorical = balanceaccum_ ropts == Historical
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
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
Minibuffer label ed -> minibuffer label ed
_ -> quickhelp
where
quickhelp = borderKeysStr' [
("?", str "help")
-- ,("RIGHT", str "register")
,("t", renderToggle (tree_ ropts) "list" "tree")
-- ,("t", str "tree")
-- ,("l", str "list")
,("-+", str "depth")
,(if showbalchgkey then "H" else "", renderToggle (not ishistorical) "end-bals" "changes")
,("F", renderToggle1 (isJust . forecast_ $ inputopts_ copts) "forecast")
--,("/", "filter")
--,("DEL", "unfilter")
--,("ESC", "cancel/top")
,("a", str "add")
-- ,("g", "reload")
,("q", str "quit")
]
asDrawHelper _ _ _ _ = dlogUiTrace "asDrawHelper" $ errorWrongScreenType "draw function" -- PARTIAL:
bottomlabel = case mode of
Minibuffer label ed -> minibuffer label ed
_ -> quickhelp
where
quickhelp = borderKeysStr' [
("?", str "help")
-- ,("RIGHT", str "register")
,("t", renderToggle (tree_ ropts) "list" "tree")
-- ,("t", str "tree")
-- ,("l", str "list")
,("-+", str "depth")
,(if showbalchgkey then "H" else "", renderToggle (not ishistorical) "end-bals" "changes")
,("F", renderToggle1 (isJust . forecast_ $ inputopts_ copts) "forecast")
--,("/", "filter")
--,("DEL", "unfilter")
--,("ESC", "cancel/top")
,("a", str "add")
-- ,("g", "reload")
,("q", str "quit")
]
asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget Name
asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
@ -175,40 +175,37 @@ asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
sel | selected = (<> attrName "selected")
| otherwise = id
-- | Handle events on any accounts-like screen (all accounts, balance sheet, income statement..).
asHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
asHandle ev = do
ui0 <- get'
dlogUiTraceM "asHandle"
case ui0 of
ui1@UIState{aMode=mode, aScreen=AS sst} -> case mode of
Normal -> asHandleNormalMode ui scr ev
Minibuffer _ ed -> handleMinibufferMode ui ed ev
Help -> handleHelpMode ui ev
where
scr = AS
-- 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 "asHandle" >> errorWrongScreenType "event handler"
ui0@UIState{aScreen=scr, aMode=mode} <- get'
case toAccountsLikeScreen scr of
Nothing -> dlogUiTrace "asHandle" $ errorWrongScreenType "event handler" -- PARTIAL:
Just als@(ALS scons ass) -> do
-- save the currently selected account, in case we leave this screen and lose the selection
put' ui0{aScreen=scons ass{_assSelectedAccount=asSelectedAccount ass}}
case mode of
Normal -> asHandleNormalMode als ev
Minibuffer _ ed -> handleMinibufferMode ed ev
Help -> handleHelpMode ev
-- | Handle events when in normal mode on any accounts-screen-like screen.
asHandleNormalMode :: UIState -> (AccountsScreenState -> Screen) -> BrickEvent Name AppEvent -> EventM Name UIState ()
asHandleNormalMode ui1@UIState{aopts=UIOpts{uoCliOpts=copts}, ajournal=j, aScreen=AS sst} scr ev = do
-- | Handle events when in normal mode on any accounts-like screen.
-- The provided AccountsLikeScreen should correspond to the ui state's current screen.
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
let
l = _assList sst
l = _assList ass
selacct = asSelectedAccount ass
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 =
case asItemAccountName <$> listElements l !? y of
Just t | not $ T.null t -> Just t
_ -> Nothing
ui = ui1{aScreen=AS sst{_assSelectedAccount=selacct}}
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ listElements l
lastnonblankidx = max 0 (length nonblanks - 1)
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
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),
-- so we use it only to move the selection.
-- MouseDown: this is not debounced and can repeat (https://github.com/jtdaugherty/brick/issues/347)
-- so we only let it do something harmless: move the selection.
MouseDown _n BLeft _mods Location{loc=(_,y)} | not $ isBlankItem clickeditem ->
put' ui{aScreen=scr sst} -- XXX does this do anything ?
where clickeditem = (0,) <$> listElements l !? y
put' ui{aScreen=scons ass'}
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.
MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do
let scrollamt = if btn==BScrollUp then -1 else 1
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
-- (and center) at the last non-blank item.
@ -303,9 +302,9 @@ asHandleNormalMode ui1@UIState{aopts=UIOpts{uoCliOpts=copts}, ajournal=j, aScree
then do
let l2 = listMoveTo lastnonblankidx l1
scrollSelectionToMiddle l2
put' ui{aScreen=scr sst{_assList=l2}}
put' ui{aScreen=scons ass{_assList=l2}}
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
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.
VtyEvent e -> do
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
MouseDown{} -> return ()
MouseUp{} -> return ()
AppEvent _ -> return ()
asHandleNormalMode _ _ _ = dlogUiTraceM "handleNormalMode" >> errorWrongScreenType "event handler"
-- | 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
case ev of
VtyEvent (EvKey KEsc []) -> put' $ closeMinibuffer ui
@ -343,7 +341,8 @@ handleMinibufferMode ui@UIState{ajournal=j} ed ev = do
MouseUp{} -> return ()
-- | Handle events when in help mode on any screen.
handleHelpMode ui ev =
handleHelpMode ev = do
ui <- get'
case ev of
-- VtyEvent (EvKey (KChar 'q') []) -> halt
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
@ -362,6 +361,14 @@ enterRegisterScreen d acct ui@UIState{ajournal=j, aopts=uopts} = do
ui1 = pushScreen regscr ui
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.
asSetSelectedAccount :: AccountName -> Screen -> Screen
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.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.UI.BalancesheetScreen
(bsNew
,bsUpdate
@ -12,8 +9,6 @@ module Hledger.UI.BalancesheetScreen
where
import Brick hiding (bsDraw)
import Brick.Widgets.List
import Lens.Micro.Platform
import Hledger
import Hledger.Cli hiding (mode, progname, prognameandversion)
@ -21,7 +16,7 @@ import Hledger.UI.UIOptions
import Hledger.UI.UITypes
import Hledger.UI.UIUtils
import Hledger.UI.UIScreens
import Hledger.UI.AccountsScreen (asDrawHelper, handleHelpMode, handleMinibufferMode, asHandleNormalMode)
import Hledger.UI.AccountsScreen (asHandle, asDrawHelper)
bsDraw :: UIState -> [Widget Name]
@ -32,19 +27,4 @@ bsDraw ui = dlogUiTrace "bsDraw" $ asDrawHelper ui ropts' scrname showbalchgkey
showbalchgkey = False
bsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
bsHandle ev = do
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"
bsHandle = asHandle . dlogUiTrace "bsHandle"

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

@ -41,7 +41,6 @@ esDraw UIState{aScreen=ES ESS{..}
} =
case mode of
Help -> [helpDialog, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent]
_ -> [maincontent]
where
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.AccountsScreen
import Hledger.UI.BalancesheetScreen
import Hledger.UI.IncomestatementScreen
import Hledger.UI.RegisterScreen
import Hledger.UI.TransactionScreen
import Hledger.UI.ErrorScreen
@ -114,10 +115,11 @@ runBrickUi uopts0@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=_iopts,reportspec_=r
reportspec_=rspec{
_rsQuery=filteredQuery $ _rsQuery rspec, -- query with depth/date parts removed
_rsReportOpts=ropts{
depth_ =queryDepth $ _rsQuery rspec, -- query's depth part
period_=periodfromoptsandargs, -- query's date part
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)
depth_ = queryDepth $ _rsQuery rspec, -- query's depth part
period_ = periodfromoptsandargs, -- query's date part
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)
declared_ = True -- always show declared accounts even if unused
}
}
}
@ -246,6 +248,7 @@ uiHandle ev = do
MS _ -> msHandle ev
AS _ -> asHandle ev
BS _ -> bsHandle ev
IS _ -> isHandle ev
RS _ -> rsHandle ev
TS _ -> tsHandle ev
ES _ -> esHandle ev
@ -256,6 +259,7 @@ uiDraw ui =
MS _ -> msDraw ui
AS _ -> asDraw ui
BS _ -> bsDraw ui
IS _ -> isDraw ui
RS _ -> rsDraw ui
TS _ -> tsDraw 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
,aScreen=MS sst
,aMode=mode
} = dlogUiTrace "msDraw 1" $
} = dlogUiTrace "msDraw" $
case mode of
Help -> [helpDialog, maincontent]
Minibuffer lbl ed -> [minibuffer lbl ed, maincontent]
_ -> [maincontent]
where
maincontent = Widget Greedy Greedy $ do
@ -84,7 +83,7 @@ msDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=_rspec}}
,("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 (_acctwidth, _balwidth) _selected MenuScreenItem{..} =
@ -93,6 +92,7 @@ msDrawItem _selected MenuScreenItem{..} =
Widget Greedy Fixed $ do
render $ txt msItemScreenName
-- XXX clean up like asHandle
msHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
msHandle ev = do
ui0 <- get'
@ -189,7 +189,7 @@ msHandle ev = do
-- VtyEvent (EvKey (KRight) [MShift]) -> put' $ regenerateScreens j d $ nextReportPeriod 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 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 'z') [MCtrl]) -> suspend ui
@ -256,8 +256,9 @@ msEnterScreen d scrname ui@UIState{ajournal=j, aopts=uopts} = do
dlogUiTraceM "msEnterScreen"
let
scr = case scrname of
Accounts -> asNew uopts d j Nothing
Balancesheet -> bsNew uopts d j Nothing
Accounts -> asNew uopts d j Nothing
Balancesheet -> bsNew uopts d j Nothing
Incomestatement -> isNew uopts d j Nothing
put' $ pushScreen scr ui
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" $
case mode of
Help -> [helpDialog, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent]
_ -> [maincontent]
where
displayitems = V.toList $ listElements $ _rssList
@ -180,6 +179,7 @@ rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected Regist
sel | selected = (<> attrName "selected")
| otherwise = id
-- XXX clean up like asHandle
rsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
rsHandle ev = do
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
Help -> [helpDialog, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent]
_ -> [maincontent]
where
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
,bsNew
,bsUpdate
,isNew
,isUpdate
,rsNew
,rsUpdate
,tsNew
@ -50,7 +52,8 @@ screenUpdate :: UIOpts -> Day -> Journal -> Screen -> Screen
screenUpdate opts d j = \case
MS sst -> MS $ msUpdate sst -- opts d j ass
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
TS sst -> TS $ tsUpdate sst
ES sst -> ES $ esUpdate sst
@ -78,7 +81,8 @@ msNew =
MS MSS {
_mssList = list MenuList (V.fromList [
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
,_mssUnused = ()
}
@ -86,37 +90,43 @@ msNew =
-- | Update a menu screen. Currently a no-op since menu screen
-- has unchanging content.
msUpdate :: MenuScreenState -> MenuScreenState
msUpdate = dlogUiTrace "msUpdate`"
msUpdate = dlogUiTrace "msUpdate"
nullass macct = ASS {
_assSelectedAccount = fromMaybe "" macct
,_assList = list AccountsList (V.fromList []) 1
}
-- | Construct an accounts screen listing the appropriate set of accounts,
-- with the appropriate one selected.
-- Screen-specific arguments: the account to select if any.
asNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen
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 uopts d = dlogUiTrace "asUpdate" . asUpdateHelper rspec'
asUpdate uopts d = dlogUiTrace "asUpdate" .
asUpdateHelper rspec d copts roptsmod extraquery
where
UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} = uopts
rspec' =
updateReportSpec
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
UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} = uopts
roptsmod = id
extraquery = Any
-- | Update an accounts-screen-like screen from this report spec and journal.
asUpdateHelper :: ReportSpec -> Journal -> AccountsScreenState -> AccountsScreenState
asUpdateHelper rspec j ass = dlogUiTrace "asUpdate" ass{_assList=l}
-- | Update an accounts-like screen's state from this report spec, reporting date,
-- cli options, report options modifier, extra query, and journal.
asUpdateHelper :: ReportSpec -> Day -> CliOpts -> (ReportOpts -> ReportOpts) -> Query -> Journal -> AccountsScreenState -> AccountsScreenState
asUpdateHelper rspec0 d copts roptsModify extraquery j ass = dlogUiTrace "asUpdateHelper"
ass{_assList=l}
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:
-- if selectfirst is true, the first account;
-- 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 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 uopts d = dlogUiTrace "bsUpdate" . asUpdateHelper rspec'
bsUpdate uopts d = dlogUiTrace "bsUpdate" .
asUpdateHelper rspec d copts roptsmod extraquery
where
UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} = uopts
rspec' =
updateReportSpec
ropts{declared_=True -- always show declared accounts even if unused
,balanceaccum_=Historical -- always show historical end balances
}
rspec{_rsDay=d} -- update to the given day, might have changed since program start
& either (error "bsUpdate: adjusting the query, should not have failed") id -- PARTIAL:
& reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts) -- include/exclude future & forecast transactions
& reportSpecAddQuery (Type [Asset,Liability,Equity]) -- restrict to balance sheet accounts
UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} = uopts
roptsmod ropts = ropts{balanceaccum_=Historical} -- always show historical end balances
extraquery = Type [Asset,Liability,Equity] -- restrict to balance sheet accounts
-- | Construct an income statement screen listing the appropriate set of accounts,
-- with the appropriate one selected.
-- Screen-specific arguments: the account to select if any.
isNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen
isNew uopts d j macct = dlogUiTrace "isNew" $ IS $ isUpdate uopts d j $ nullass macct
-- | 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,
-- with the appropriate one selected.

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

@ -102,6 +102,7 @@ data Name =
data ScreenName =
Accounts
| Balancesheet
| Incomestatement
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
-- a circular dependency between UIState and Screen.
-- A new screen requires
-- 1. a new constructor in the Screen type,
-- 2. a new screen state type,
-- 3. new cases in the uiDraw and uiHandle functions,
-- 4. new constructor and updater functions in UIScreens, and a new case in screenUpdate
-- 5. a new module implementing draw and event-handling functions,
-- 6. a call from any other screen which enters it.
-- 1. a new constructor in the Screen type
-- 2. a new screen state type if needed
-- 3. a new case in toAccountsLikeScreen if needed
-- 4. new cases in the uiDraw and uiHandle functions
-- 5. new constructor and updater functions in UIScreens, and a new case in screenUpdate
-- 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
-- | The various screens which a user can navigate to in hledger-ui,
@ -174,11 +177,28 @@ data Screen =
MS MenuScreenState
| AS AccountsScreenState
| BS AccountsScreenState
| IS AccountsScreenState
| RS RegisterScreenState
| TS TransactionScreenState
| ES ErrorScreenState
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 {
-- view data:
_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.Editor
Hledger.UI.ErrorScreen
Hledger.UI.IncomestatementScreen
Hledger.UI.Main
Hledger.UI.MenuScreen
Hledger.UI.RegisterScreen

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

@ -296,12 +296,21 @@ reload).
## 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 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