feat: ui: add balance sheet accounts screen

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

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
+
+

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

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
+            MouseUp _n (Just BLeft) Location{loc=(_x,y)} ->  -- | not $ (=="") clickedname ->
-              msEnterScreen d clickedscr ui
+              case mclickedscr of
-              where clickedscr = maybe "" msItemScreenName $ listElements (_mssList sst) !? y
+                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.

hledger-ui/Hledger/UI/UIScreens.hs

@@ -15,18 +15,20 @@
 {-# LANGUAGE NamedFieldPuns #-}
 
 module Hledger.UI.UIScreens
- (screenUpdate
+(screenUpdate
- ,msNew
+,esNew
- ,msUpdate
+,esUpdate
- ,asNew
+,msNew
- ,asUpdate
+,msUpdate
- ,rsNew
+,asNew
- ,rsUpdate
+,asUpdate
- ,tsNew
+,bsNew
- ,tsUpdate
+,bsUpdate
- ,esNew
+,rsNew
- ,esUpdate
+,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{
-                    {_rsReportOpts=ropts{declared_=True}}
+                       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`"
-

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
+   msItemScreenName :: Text                         -- ^ screen display name
-  ,msItemScreen :: Name                             -- ^ an internal name we can use to find the corresponding screen
+  ,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

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.

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

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,