From 975522e7595a8be98b3c178f430a5bfcff828a4d Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 8 Sep 2022 08:53:42 -1000 Subject: [PATCH] feat: ui: add balance sheet accounts screen --- hledger-ui/Hledger/UI/AccountsScreen.hs | 2 +- hledger-ui/Hledger/UI/BalancesheetScreen.hs | 353 ++++++++++++++++++++ hledger-ui/Hledger/UI/Main.hs | 5 +- hledger-ui/Hledger/UI/MenuScreen.hs | 34 +- hledger-ui/Hledger/UI/UIScreens.hs | 143 ++++++-- hledger-ui/Hledger/UI/UITypes.hs | 21 +- hledger-ui/Hledger/UI/UIUtils.hs | 6 + hledger-ui/hledger-ui.cabal | 1 + hledger-ui/hledger-ui.m4.md | 9 + 9 files changed, 522 insertions(+), 52 deletions(-) create mode 100644 hledger-ui/Hledger/UI/BalancesheetScreen.hs diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index 9344b27a0..8ce49669b 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -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 diff --git a/hledger-ui/Hledger/UI/BalancesheetScreen.hs b/hledger-ui/Hledger/UI/BalancesheetScreen.hs new file mode 100644 index 000000000..328472522 --- /dev/null +++ b/hledger-ui/Hledger/UI/BalancesheetScreen.hs @@ -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 + + diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index 8e9794300..deaa7d7ca 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -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 diff --git a/hledger-ui/Hledger/UI/MenuScreen.hs b/hledger-ui/Hledger/UI/MenuScreen.hs index 1021c273b..4967239ed 100644 --- a/hledger-ui/Hledger/UI/MenuScreen.hs +++ b/hledger-ui/Hledger/UI/MenuScreen.hs @@ -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. diff --git a/hledger-ui/Hledger/UI/UIScreens.hs b/hledger-ui/Hledger/UI/UIScreens.hs index 22cdf6cbf..721928767 100644 --- a/hledger-ui/Hledger/UI/UIScreens.hs +++ b/hledger-ui/Hledger/UI/UIScreens.hs @@ -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`" - diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index 404d5a625..0fa48aa56 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/hledger-ui/Hledger/UI/UITypes.hs @@ -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 diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index b9e5032f7..2b52803fc 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -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. diff --git a/hledger-ui/hledger-ui.cabal b/hledger-ui/hledger-ui.cabal index aa1c73868..48b4715bc 100644 --- a/hledger-ui/hledger-ui.cabal +++ b/hledger-ui/hledger-ui.cabal @@ -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 diff --git a/hledger-ui/hledger-ui.m4.md b/hledger-ui/hledger-ui.m4.md index 075ee1322..1789a24b0 100644 --- a/hledger-ui/hledger-ui.m4.md +++ b/hledger-ui/hledger-ui.m4.md @@ -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,