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

feat: ui: add balance sheet accounts screen

Browse Source
This commit is contained in:
Simon Michael 2022-09-08 08:53:42 -10:00
parent 75a19e8609
commit 975522e759
9 changed files with 522 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -271,7 +271,7 @@ asHandle ev = do
MouseUp _ (Just BLeft) Location{loc=(_,y)} | clickedacct == "" -> put' $ popScreen ui
where clickedacct = maybe "" asItemAccountName $ listElements (_assList sst) !? y
-- enter register screen for selected account (if there is one),
-- RIGHT enters register screen for selected account (if there is one),
-- centering its selected transaction if possible
VtyEvent e | e `elem` moveRightEvents
, not $ isBlankElement $ listSelectedElement (_assList sst) -> asEnterRegisterScreen d selacct ui

353
hledger-ui/Hledger/UI/BalancesheetScreen.hs Normal file
View File

@ -0,0 +1,353 @@
-- The balance sheet screen, like the accounts screen but restricted to balance sheet accounts.
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.UI.BalancesheetScreen
(bsNew
,bsUpdate
,bsDraw
,bsHandle
,bsSetSelectedAccount
)
where
import Brick hiding (bsDraw)
import Brick.Widgets.List
import Brick.Widgets.Edit
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Data.List hiding (reverse)
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Calendar (Day)
import qualified Data.Vector as V
import Data.Vector ((!?))
import Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft, BScrollDown, BScrollUp))
import Lens.Micro.Platform
import System.Console.ANSI
import System.FilePath (takeFileName)
import Text.DocLayout (realLength)
import Hledger
import Hledger.Cli hiding (mode, progname, prognameandversion)
import Hledger.UI.UIOptions
import Hledger.UI.UITypes
import Hledger.UI.UIState
import Hledger.UI.UIUtils
import Hledger.UI.UIScreens
import Hledger.UI.Editor
import Hledger.UI.ErrorScreen (uiReloadJournal, uiCheckBalanceAssertions, uiReloadJournalIfChanged)
import Hledger.UI.RegisterScreen (rsCenterSelection)
bsDraw :: UIState -> [Widget Name]
bsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
,ajournal=j
,aScreen=BS sst
,aMode=mode
} = dlogUiTrace "bsDraw 1" $
case mode of
Help -> [helpDialog copts, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent]
_ -> [maincontent]
where
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 ^. bssList . 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 (bsDrawItem colwidths) True (sst ^. bssList)
where
ropts = (_rsReportOpts rspec){balanceaccum_=Historical}
ishistorical = balanceaccum_ ropts == Historical
toplabel =
withAttr (attrName "border" <> attrName "filename") files
<+> toggles
<+> str (" balance sheet")
<+> 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 ^. bssList . listSelectedL of
Nothing -> "-"
Just i -> show (i + 1)
totidx = show $ V.length nonblanks
where
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ sst ^. bssList . 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")
,("", 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")
]
bsDraw _ = dlogUiTrace "bsDraw 2" $ errorWrongScreenType "draw function" -- PARTIAL:
bsDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget Name
bsDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
Widget Greedy Fixed $ do
-- c <- getContext
-- let showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt
render $
txt (fitText (Just acctwidth) (Just acctwidth) True True $ T.replicate (asItemIndentLevel) " " <> asItemDisplayAccountName) <+>
txt balspace <+>
splitAmounts balBuilder
where
balBuilder = maybe mempty showamt asItemMixedAmount
showamt = showMixedAmountB oneLine{displayMinWidth=Just balwidth, displayMaxWidth=Just balwidth}
balspace = T.replicate (2 + balwidth - wbWidth balBuilder) " "
splitAmounts = foldr1 (<+>) . intersperse (str ", ") . map renderamt . T.splitOn ", " . wbToText
renderamt :: T.Text -> Widget Name
renderamt a | T.any (=='-') a = withAttr (sel $ attrName "list" <> attrName "balance" <> attrName "negative") $ txt a
| otherwise = withAttr (sel $ attrName "list" <> attrName "balance" <> attrName "positive") $ txt a
sel | selected = (<> attrName "selected")
| otherwise = id
bsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
bsHandle ev = do
ui0 <- get'
dlogUiTraceM "bsHandle 1"
case ui0 of
ui1@UIState{
aopts=UIOpts{uoCliOpts=copts}
,ajournal=j
,aMode=mode
,aScreen=BS sst
} -> do
let
-- save the currently selected account, in case we leave this screen and lose the selection
selacct = case listSelectedElement $ _bssList sst of
Just (_, AccountsScreenItem{..}) -> asItemAccountName
Nothing -> sst ^. bssSelectedAccount
ui = ui1{aScreen=BS sst{_bssSelectedAccount=selacct}}
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ listElements $ _bssList sst
lastnonblankidx = max 0 (length nonblanks - 1)
journalspan = journalDateSpan False j
d = copts^.rsDay
case mode of
Minibuffer _ ed ->
case ev of
VtyEvent (EvKey KEsc []) -> put' $ closeMinibuffer ui
VtyEvent (EvKey KEnter []) -> put' $ regenerateScreens j d $
case setFilter s $ closeMinibuffer ui of
Left bad -> showMinibuffer "Cannot compile regular expression" (Just bad) ui
Right ui' -> ui'
where s = chomp $ unlines $ map strip $ getEditContents ed
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
VtyEvent e -> do
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent e)
put' ui{aMode=Minibuffer "filter" ed'}
AppEvent _ -> return ()
MouseDown{} -> return ()
MouseUp{} -> return ()
Help ->
case ev of
-- VtyEvent (EvKey (KChar 'q') []) -> halt
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
_ -> helpHandle ev
Normal ->
case ev of
VtyEvent (EvKey (KChar 'q') []) -> halt
-- EvKey (KChar 'l') [MCtrl] -> do
VtyEvent (EvKey KEsc []) -> put' $ resetScreens d ui
VtyEvent (EvKey (KChar c) []) | c == '?' -> put' $ setMode Help ui
-- XXX AppEvents currently handled only in Normal mode
-- XXX be sure we don't leave unconsumed events piling up
AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old ->
put' $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
where
p = reportPeriod ui
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
liftIO (uiReloadJournal copts d ui) >>= put'
VtyEvent (EvKey (KChar 'I') []) -> put' $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
VtyEvent (EvKey (KChar 'a') []) -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> uiReloadJournalIfChanged copts d j ui
VtyEvent (EvKey (KChar 'A') []) -> suspendAndResume $ void (runIadd (journalFilePath j)) >> uiReloadJournalIfChanged copts d j ui
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor endPosition (journalFilePath j)) >> uiReloadJournalIfChanged copts d j ui
VtyEvent (EvKey (KChar 'B') []) -> put' $ regenerateScreens j d $ toggleConversionOp ui
VtyEvent (EvKey (KChar 'V') []) -> put' $ regenerateScreens j d $ toggleValue ui
VtyEvent (EvKey (KChar '0') []) -> put' $ regenerateScreens j d $ setDepth (Just 0) ui
VtyEvent (EvKey (KChar '1') []) -> put' $ regenerateScreens j d $ setDepth (Just 1) ui
VtyEvent (EvKey (KChar '2') []) -> put' $ regenerateScreens j d $ setDepth (Just 2) ui
VtyEvent (EvKey (KChar '3') []) -> put' $ regenerateScreens j d $ setDepth (Just 3) ui
VtyEvent (EvKey (KChar '4') []) -> put' $ regenerateScreens j d $ setDepth (Just 4) ui
VtyEvent (EvKey (KChar '5') []) -> put' $ regenerateScreens j d $ setDepth (Just 5) ui
VtyEvent (EvKey (KChar '6') []) -> put' $ regenerateScreens j d $ setDepth (Just 6) ui
VtyEvent (EvKey (KChar '7') []) -> put' $ regenerateScreens j d $ setDepth (Just 7) ui
VtyEvent (EvKey (KChar '8') []) -> put' $ regenerateScreens j d $ setDepth (Just 8) ui
VtyEvent (EvKey (KChar '9') []) -> put' $ regenerateScreens j d $ setDepth (Just 9) ui
VtyEvent (EvKey (KChar '-') []) -> put' $ regenerateScreens j d $ decDepth ui
VtyEvent (EvKey (KChar '_') []) -> put' $ regenerateScreens j d $ decDepth ui
VtyEvent (EvKey (KChar c) []) | c `elem` ['+','='] -> put' $ regenerateScreens j d $ incDepth ui
VtyEvent (EvKey (KChar 'T') []) -> put' $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
-- display mode/query toggles
-- VtyEvent (EvKey (KChar 'H') []) -> modify' (regenerateScreens j d . toggleHistorical) >> bsCenterAndContinue
VtyEvent (EvKey (KChar 't') []) -> modify' (regenerateScreens j d . toggleTree) >> bsCenterAndContinue
VtyEvent (EvKey (KChar c) []) | c `elem` ['z','Z'] -> modify' (regenerateScreens j d . toggleEmpty) >> bsCenterAndContinue
VtyEvent (EvKey (KChar 'R') []) -> modify' (regenerateScreens j d . toggleReal) >> bsCenterAndContinue
VtyEvent (EvKey (KChar 'U') []) -> modify' (regenerateScreens j d . toggleUnmarked) >> bsCenterAndContinue
VtyEvent (EvKey (KChar 'P') []) -> modify' (regenerateScreens j d . togglePending) >> bsCenterAndContinue
VtyEvent (EvKey (KChar 'C') []) -> modify' (regenerateScreens j d . toggleCleared) >> bsCenterAndContinue
VtyEvent (EvKey (KChar 'F') []) -> modify' (regenerateScreens j d . toggleForecast d)
VtyEvent (EvKey (KDown) [MShift]) -> put' $ regenerateScreens j d $ shrinkReportPeriod d ui
VtyEvent (EvKey (KUp) [MShift]) -> put' $ regenerateScreens j d $ growReportPeriod d 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 (KChar '/') []) -> put' $ regenerateScreens j d $ showMinibuffer "filter" Nothing ui
VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> (put' $ regenerateScreens j d $ resetFilter ui)
VtyEvent e | e `elem` moveLeftEvents -> put' $ popScreen ui
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle (_bssList sst) >> redraw
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
-- exit screen on LEFT
VtyEvent e | e `elem` moveLeftEvents -> put' $ popScreen ui
-- or on a click in the app's left margin. This is a VtyEvent since not in a clickable widget.
VtyEvent (EvMouseUp x _y (Just BLeft)) | x==0 -> put' $ popScreen ui
-- or on clicking a blank list item.
MouseUp _ (Just BLeft) Location{loc=(_,y)} | clickedacct == "" -> put' $ popScreen ui
where clickedacct = maybe "" asItemAccountName $ listElements (_bssList sst) !? y
-- enter register screen for selected account (if there is one),
-- centering its selected transaction if possible
-- XXX should propagate ropts{balanceaccum_=Historical}
VtyEvent e | e `elem` moveRightEvents
, not $ isBlankElement $ listSelectedElement (_bssList sst) -> bsEnterRegisterScreen d selacct ui
-- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347
-- just use it to move the selection
MouseDown _n BLeft _mods Location{loc=(_x,y)} | not $ (=="") clickedacct -> do
put' ui{aScreen=BS sst} -- XXX does this do anything ?
where clickedacct = maybe "" asItemAccountName $ listElements (_bssList sst) !? y
-- and on MouseUp, enter the subscreen
MouseUp _n (Just BLeft) Location{loc=(_x,y)} | not $ (=="") clickedacct -> do
bsEnterRegisterScreen d clickedacct ui
where clickedacct = maybe "" asItemAccountName $ listElements (_bssList sst) !? y
-- when selection is at the last item, DOWN scrolls instead of moving, until maximally scrolled
VtyEvent e | e `elem` moveDownEvents, isBlankElement mnextelement -> do
vScrollBy (viewportScroll $ (_bssList sst)^.listNameL) 1
where mnextelement = listSelectedElement $ listMoveDown (_bssList sst)
-- mouse scroll wheel scrolls the viewport up or down to its 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
list' <- nestEventM' (_bssList sst) $ listScrollPushingSelection name (bsListSize (_bssList sst)) scrollamt
put' ui{aScreen=BS sst{_bssList=list'}}
-- if page down or end leads to a blank padding item, stop at last non-blank
VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do
l <- nestEventM' (_bssList sst) $ handleListEvent e
if isBlankElement $ listSelectedElement l
then do
let l' = listMoveTo lastnonblankidx l
scrollSelectionToMiddle l'
put' ui{aScreen=BS sst{_bssList=l'}}
else
put' ui{aScreen=BS sst{_bssList=l}}
-- fall through to the list's event handler (handles up/down)
VtyEvent e -> do
list' <- nestEventM' (_bssList sst) $ handleListEvent (normaliseMovementKeys e)
put' ui{aScreen=BS $ sst & bssList .~ list' & bssSelectedAccount .~ selacct }
MouseDown{} -> return ()
MouseUp{} -> return ()
AppEvent _ -> return ()
_ -> dlogUiTraceM "bsHandle 2" >> errorWrongScreenType "event handler"
bsEnterRegisterScreen :: Day -> AccountName -> UIState -> EventM Name UIState ()
bsEnterRegisterScreen d acct ui@UIState{ajournal=j, aopts=uopts} = do
dlogUiTraceM "bsEnterRegisterScreen"
let
regscr = rsNew uopts d j acct isdepthclipped
where
isdepthclipped = case getDepth ui of
Just de -> accountNameLevel acct >= de
Nothing -> False
ui1 = pushScreen regscr ui
rsCenterSelection ui1 >>= put'
-- | Set the selected account on an accounts screen. No effect on other screens.
bsSetSelectedAccount :: AccountName -> Screen -> Screen
bsSetSelectedAccount a (BS bss@BSS{}) = BS bss{_bssSelectedAccount=a}
bsSetSelectedAccount _ s = s
isBlankElement mel = ((asItemAccountName . snd) <$> mel) == Just ""
-- | Scroll the accounts screen's selection to the center. No effect if on another screen.
bsCenterAndContinue :: EventM Name UIState ()
bsCenterAndContinue = do
ui <- get'
case aScreen ui of
BS sst -> scrollSelectionToMiddle $ _bssList sst
_ -> return ()
bsListSize = V.length . V.takeWhile ((/="").asItemAccountName) . listElements

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

@ -24,7 +24,7 @@ import Lens.Micro ((^.))
import System.Directory (canonicalizePath)
import System.FilePath (takeDirectory)
import System.FSNotify (Event(Modified), isPollingManager, watchDir, withManager)
import Brick
import Brick hiding (bsDraw)
import qualified Brick.BChan as BC
import Hledger
@ -36,6 +36,7 @@ import Hledger.UI.UIState (uiState, getDepth)
import Hledger.UI.UIUtils (dlogUiTrace)
import Hledger.UI.MenuScreen
import Hledger.UI.AccountsScreen
import Hledger.UI.BalancesheetScreen
import Hledger.UI.RegisterScreen
import Hledger.UI.TransactionScreen
import Hledger.UI.ErrorScreen
@ -243,6 +244,7 @@ uiHandle ev = do
case aScreen ui of
MS _ -> msHandle ev
AS _ -> asHandle ev
BS _ -> bsHandle ev
RS _ -> rsHandle ev
TS _ -> tsHandle ev
ES _ -> esHandle ev
@ -252,6 +254,7 @@ uiDraw ui =
case aScreen ui of
MS _ -> msDraw ui
AS _ -> asDraw ui
BS _ -> bsDraw ui
RS _ -> rsDraw ui
TS _ -> tsDraw ui
ES _ -> esDraw ui

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

@ -36,7 +36,6 @@ import Hledger.UI.UIState
import Hledger.UI.UIUtils
import Hledger.UI.UIScreens
import Hledger.UI.ErrorScreen (uiReloadJournal, uiCheckBalanceAssertions, uiReloadJournalIfChanged)
import Data.Text (Text)
import Hledger.UI.Editor (runIadd, runEditor, endPosition)
import Brick.Widgets.Edit (getEditContents, handleEditorEvent)
-- import Hledger.UI.AccountsScreen
@ -177,7 +176,7 @@ msHandle ev = do
let
-- save the currently selected account, in case we leave this screen and lose the selection
mselscr = case listSelectedElement $ _mssList sst of
Just (_, MenuScreenItem{..}) -> Just msItemScreenName
Just (_, MenuScreenItem{..}) -> Just msItemScreen
Nothing -> Nothing
-- ui = ui1{aScreen=MS sst{_assSelectedAccount=selacct}}
nonblanks = V.takeWhile (not . T.null . msItemScreenName) $ listElements $ _mssList sst
@ -266,19 +265,27 @@ msHandle ev = do
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle (_mssList sst) >> redraw
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
-- Enter enters selected screen if there is one
-- RIGHT enters selected screen if there is one
VtyEvent e | e `elem` moveRightEvents
, not $ isBlankElement $ listSelectedElement (_mssList sst) -> msEnterScreen d (fromMaybe "" mselscr) ui
, not $ isBlankElement $ listSelectedElement (_mssList sst) -> msEnterScreen d (fromMaybe Accounts mselscr) ui
-- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347
-- just use it to move the selection
MouseDown _n BLeft _mods Location{loc=(_x,y)} | not $ (=="") clickedscr -> do
MouseDown _n BLeft _mods Location{loc=(_x,y)} | not $ (=="") clickedname -> do
put' ui{aScreen=MS sst} -- XXX does this do anything ?
where clickedscr = maybe "" msItemScreenName $ listElements (_mssList sst) !? y
where
item = listElements (_mssList sst) !? y
clickedname = maybe "" msItemScreenName item
-- mclickedscr = msItemScreen <$> item
-- and on MouseUp, enter the subscreen
MouseUp _n (Just BLeft) Location{loc=(_x,y)} | not $ (=="") clickedscr -> do
msEnterScreen d clickedscr ui
where clickedscr = maybe "" msItemScreenName $ listElements (_mssList sst) !? y
MouseUp _n (Just BLeft) Location{loc=(_x,y)} -> -- | not $ (=="") clickedname ->
case mclickedscr of
Just scr -> msEnterScreen d scr ui
Nothing -> return ()
where
item = listElements (_mssList sst) !? y
-- clickedname = maybe "" msItemScreenName item
mclickedscr = msItemScreen <$> item
-- when selection is at the last item, DOWN scrolls instead of moving, until maximally scrolled
VtyEvent e | e `elem` moveDownEvents, isBlankElement mnextelement -> do
@ -314,12 +321,13 @@ msHandle ev = do
_ -> dlogUiTraceM "msHandle 2" >> errorWrongScreenType "event handler"
type ScreenName = Text
msEnterScreen :: Day -> ScreenName -> UIState -> EventM Name UIState ()
msEnterScreen d _scrname ui@UIState{ajournal=j, aopts=uopts} = do
msEnterScreen d scrname ui@UIState{ajournal=j, aopts=uopts} = do
dlogUiTraceM "msEnterScreen"
let scr = asNew uopts d j Nothing
let
scr = case scrname of
Accounts -> asNew uopts d j Nothing
Balancesheet -> bsNew uopts d j Nothing
put' $ pushScreen scr ui
-- -- | Set the selected account on an accounts screen. No effect on other screens.

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

@ -15,18 +15,20 @@
{-# LANGUAGE NamedFieldPuns #-}
module Hledger.UI.UIScreens
(screenUpdate
,msNew
,msUpdate
,asNew
,asUpdate
,rsNew
,rsUpdate
,tsNew
,tsUpdate
,esNew
,esUpdate
)
(screenUpdate
,esNew
,esUpdate
,msNew
,msUpdate
,asNew
,asUpdate
,bsNew
,bsUpdate
,rsNew
,rsUpdate
,tsNew
,tsUpdate
)
where
import Brick.Widgets.List (listMoveTo, listSelectedElement, list)
@ -47,10 +49,26 @@ screenUpdate :: UIOpts -> Day -> Journal -> Screen -> Screen
screenUpdate opts d j = \case
MS mss -> MS $ msUpdate mss -- opts d j ass
AS ass -> AS $ asUpdate opts d j ass
BS bss -> BS $ bsUpdate opts d j bss
RS rss -> RS $ rsUpdate opts d j rss
TS tss -> TS $ tsUpdate tss
ES ess -> ES $ esUpdate ess
-- | Construct an error screen.
-- Screen-specific arguments: the error message to show.
esNew :: String -> Screen
esNew msg =
dlogUiTrace "esNew" $
ES ESS {
_essError = msg
,_essUnused = ()
}
-- | Update an error screen. Currently a no-op since error screen
-- depends only on its screen-specific state.
esUpdate :: ErrorScreenState -> ErrorScreenState
esUpdate = dlogUiTrace "esUpdate`"
-- | Construct a menu screen.
-- Screen-specific arguments: none.
msNew :: Screen
@ -58,12 +76,13 @@ msNew =
dlogUiTrace "msNew" $
MS MSS {
_mssList = list MenuList (V.fromList [
MenuScreenItem "All accounts" AccountsViewport
MenuScreenItem "All accounts" Accounts
,MenuScreenItem "Balance sheet accounts" Balancesheet
]) 1
,_mssUnused = ()
}
-- | Recalculate a menu screen. Currently a no-op since menu screen
-- | Update a menu screen. Currently a no-op since menu screen
-- has unchanging content.
msUpdate :: MenuScreenState -> MenuScreenState
msUpdate = dlogUiTrace "msUpdate`"
@ -81,7 +100,7 @@ asNew uopts d j macct =
,_assList = list AccountsList (V.fromList []) 1
}
-- | Recalculate an accounts screen from these options, reporting date, and journal.
-- | Update an accounts screen from these options, reporting date, and journal.
asUpdate :: UIOpts -> Day -> Journal -> AccountsScreenState -> AccountsScreenState
asUpdate uopts d j ass = dlogUiTrace "asUpdate" ass{_assList=l}
where
@ -112,8 +131,79 @@ asUpdate uopts d j ass = dlogUiTrace "asUpdate" ass{_assList=l}
rspec' =
-- Further restrict the query based on the current period and future/forecast mode.
(reportSpecSetFutureAndForecast d (forecast_ $ inputopts_ copts) rspec)
-- always show declared accounts even if unused
{_rsReportOpts=ropts{declared_=True}}
{_rsReportOpts=ropts{
declared_=True -- always show declared accounts even if unused
}}
-- pre-render a list item
displayitem (fullacct, shortacct, indent, bal) =
AccountsScreenItem{asItemIndentLevel = indent
,asItemAccountName = fullacct
,asItemDisplayAccountName = replaceHiddenAccountsNameWith "All" $ if tree_ ropts then shortacct else fullacct
,asItemMixedAmount = Just bal
}
-- blanks added for scrolling control, cf RegisterScreen.
-- XXX Ugly. Changing to 0 helps when debugging.
blankitems = replicate uiNumBlankItems
AccountsScreenItem{asItemIndentLevel = 0
,asItemAccountName = ""
,asItemDisplayAccountName = ""
,asItemMixedAmount = Nothing
}
-- | Construct a balance sheet screen listing the appropriate set of accounts,
-- with the appropriate one selected.
-- Screen-specific arguments: the account to select if any.
bsNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen
bsNew uopts d j macct =
dlogUiTrace "bsNew" $
BS $
bsUpdate uopts d j $
BSS {
_bssSelectedAccount = fromMaybe "" macct
,_bssList = list AccountsList (V.fromList []) 1 -- reusing widget name..
}
-- | Update a balance sheet screen from these options, reporting date, and journal.
bsUpdate :: UIOpts -> Day -> Journal -> BalancesheetScreenState -> BalancesheetScreenState
bsUpdate uopts d j bss = dlogUiTrace "bsUpdate" bss{_bssList=l}
where
UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} = uopts
-- decide which account is selected:
-- if selectfirst is true, the first account;
-- otherwise, the previously selected account if possible;
-- otherwise, the first account with the same prefix (eg first leaf account when entering flat mode);
-- otherwise, the alphabetically preceding account.
l =
listMoveTo selidx $
list AccountsList (V.fromList $ displayitems ++ blankitems) 1
where
selidx = headDef 0 $ catMaybes [
elemIndex a as
,findIndex (a `isAccountNamePrefixOf`) as
,Just $ max 0 (length (filter (< a) as) - 1)
]
where
a = _bssSelectedAccount bss
as = map asItemAccountName displayitems
displayitems = map displayitem items
where
-- run the report
(items, _) = balanceReport rspec' j
where
rspec' =
-- XXX recalculate reportspec properly here
-- Further restrict the query based on the current period and future/forecast mode.
(reportSpecSetFutureAndForecast d (forecast_ $ inputopts_ copts) $
reportSpecAddQuery (Type [Asset,Liability,Equity])
rspec){
_rsReportOpts=ropts{
declared_=True -- always show declared accounts even if unused
,balanceaccum_=Historical -- always show historical end balances
}
}
-- pre-render a list item
displayitem (fullacct, shortacct, indent, bal) =
@ -147,7 +237,7 @@ rsNew uopts d j acct forceinclusive = -- XXX forcedefaultselection - whether to
,_rssList = list RegisterList (V.fromList []) 1
}
-- | Recalculate a register screen from these options, reporting date, and journal.
-- | Update a register screen from these options, reporting date, and journal.
rsUpdate :: UIOpts -> Day -> Journal -> RegisterScreenState -> RegisterScreenState
rsUpdate uopts d j rss@RSS{_rssAccount, _rssForceInclusive, _rssList=oldlist} =
dlogUiTrace "rsUpdate"
@ -262,23 +352,8 @@ tsNew acct nts nt =
,_tssTransaction = nt
}
-- | Recalculate a transaction screen. Currently a no-op since transaction screen
-- | Update a transaction screen. Currently a no-op since transaction screen
-- depends only on its screen-specific state.
tsUpdate :: TransactionScreenState -> TransactionScreenState
tsUpdate = dlogUiTrace "tsUpdate"
-- | Construct a error screen.
-- Screen-specific arguments: the error message to show.
esNew :: String -> Screen
esNew msg =
dlogUiTrace "esNew" $
ES ESS {
_essError = msg
,_essUnused = ()
}
-- | Recalculate an error screen. Currently a no-op since error screen
-- depends only on its screen-specific state.
esUpdate :: ErrorScreenState -> ErrorScreenState
esUpdate = dlogUiTrace "esUpdate`"

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

@ -86,7 +86,7 @@ data Mode =
-- Ignore the editor when comparing Modes.
instance Eq (Editor l n) where _ == _ = True
-- Unique names required for widgets, viewports, cursor locations etc.
-- Unique names required for brick widgets, viewports, cursor locations etc.
data Name =
HelpDialog
| MinibufferEditor
@ -98,6 +98,12 @@ data Name =
| TransactionEditor
deriving (Ord, Show, Eq)
-- Unique names for screens the user can navigate to from the menu.
data ScreenName =
Accounts
| Balancesheet
deriving (Ord, Show, Eq)
----------------------------------------------------------------------------------------------------
-- | hledger-ui screen types, v1, "one screen = one module"
-- These types aimed for maximum decoupling of modules and ease of adding more screens.
@ -167,6 +173,7 @@ data Name =
data Screen =
MS MenuScreenState
| AS AccountsScreenState
| BS BalancesheetScreenState
| RS RegisterScreenState
| TS TransactionScreenState
| ES ErrorScreenState
@ -185,6 +192,13 @@ data AccountsScreenState = ASS {
,_assList :: List Name AccountsScreenItem -- ^ list widget showing account names & balances
} deriving (Show)
data BalancesheetScreenState = BSS {
-- screen parameters:
_bssSelectedAccount :: AccountName -- ^ a copy of the account name from the list's selected item (or "")
-- view data derived from options, reporting date, journal, and screen parameters:
,_bssList :: List Name AccountsScreenItem -- ^ list widget showing account names & balances
} deriving (Show)
data RegisterScreenState = RSS {
-- screen parameters:
_rssAccount :: AccountName -- ^ the account this register is for
@ -210,8 +224,8 @@ data ErrorScreenState = ESS {
-- | An item in the menu screen's list of screens.
data MenuScreenItem = MenuScreenItem {
msItemScreenName :: Text -- ^ screen name
,msItemScreen :: Name -- ^ an internal name we can use to find the corresponding screen
msItemScreenName :: Text -- ^ screen display name
,msItemScreen :: ScreenName -- ^ an internal name we can use to find the corresponding screen
} deriving (Show)
-- | An item in the accounts screen's list of accounts and balances.
@ -241,6 +255,7 @@ type NumberedTransaction = (Integer, Transaction)
-- XXX foo fields producing fooL lenses would be preferable
makeLenses ''MenuScreenState
makeLenses ''AccountsScreenState
makeLenses ''BalancesheetScreenState
makeLenses ''RegisterScreenState
makeLenses ''TransactionScreenState
makeLenses ''ErrorScreenState

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

@ -28,6 +28,7 @@ module Hledger.UI.UIUtils (
,modify'
,suspend
,redraw
,reportSpecAddQuery
,reportSpecSetFutureAndForecast
,listScrollPushingSelection
,dlogUiTrace
@ -371,6 +372,11 @@ normaliseMovementKeys ev
| ev `elem` moveRightEvents = EvKey KRight []
| otherwise = ev
-- | Restrict the ReportSpec's query by adding the given additional query.
reportSpecAddQuery :: Query -> ReportSpec -> ReportSpec
reportSpecAddQuery q rspec =
rspec{_rsQuery=simplifyQuery $ And [_rsQuery rspec, q]}
-- | Update the ReportSpec's query to exclude future transactions (later than the given day)
-- and forecast transactions (generated by --forecast), if the given forecast DateSpan is Nothing,
-- and include them otherwise.

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

@ -49,6 +49,7 @@ executable hledger-ui
other-modules:
Hledger.UI
Hledger.UI.AccountsScreen
Hledger.UI.BalancesheetScreen
Hledger.UI.Editor
Hledger.UI.ErrorScreen
Hledger.UI.Main

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

@ -294,6 +294,15 @@ preceding them is the transaction's position within the complete
unfiltered journal, which is a more stable id (at least until the next
reload).
## Balance sheet accounts screen
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 corresponds to the `hledger balancesheet` CLI report.
## Error screen
This screen will appear if there is a problem, such as a parse error,