hledger-ui-1.41: Hledger/UI/AccountsScreen.hs
-- The accounts screen, showing accounts and balances like the CLI balance command.
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module Hledger.UI.AccountsScreen
(asNew
,asUpdate
,asDraw
,asDrawHelper
,asHandle
,handleHelpMode
,handleMinibufferMode
,asHandleNormalMode
,enterRegisterScreen
,asSetSelectedAccount
)
where
import Brick
import Brick.Widgets.List
import Brick.Widgets.Edit
import Control.Monad
import Control.Monad.IO.Class (liftIO)
#if MIN_VERSION_base(4,19,0)
import Data.List hiding (reverse, (!?))
#else
import Data.List hiding (reverse)
#endif
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, 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)
import Data.Either (fromRight)
import Control.Arrow ((>>>))
import Safe (headDef)
asDraw :: UIState -> [Widget Name]
asDraw ui = dbgui "asDraw" $ asDrawHelper ui ropts' scrname
where
ropts' = _rsReportOpts $ reportspec_ $ uoCliOpts $ aopts ui
scrname = "account " ++ if ishistorical then "balances" else "changes"
where ishistorical = balanceaccum_ ropts' == Historical
-- | Help draw any accounts-like screen (all accounts, balance sheet, income statement..).
-- The provided ReportOpts are used instead of the ones in the UIState.
-- The other argument is the screen display name.
asDrawHelper :: UIState -> ReportOpts -> String -> [Widget Name]
asDrawHelper UIState{aScreen=scr, aopts=uopts, ajournal=j, aMode=mode} ropts scrname =
dbgui "asDrawHelper" $
case toAccountsLikeScreen scr of
Nothing -> dbgui "asDrawHelper" $ errorWrongScreenType "draw helper" -- PARTIAL:
Just (ALS _ ass) -> case mode of
Help -> [helpDialog, maincontent]
_ -> [maincontent]
where
UIOpts{uoCliOpts=copts} = uopts
maincontent = Widget Greedy Greedy $ do
c <- getContext
let
availwidth =
-- ltrace "availwidth" $
c^.availWidthL
- 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils)
displayitems = ass ^. assList . listElementsL
acctwidths = V.map (\AccountsScreenItem{..} -> asItemIndentLevel + realLength asItemDisplayAccountName) displayitems
balwidths = V.map (maybe 0 (wbWidth . showMixedAmountB oneLineNoCostFmt) . asItemMixedAmount) displayitems
preferredacctwidth = V.maximum acctwidths
totalacctwidthseen = V.sum acctwidths
preferredbalwidth = V.maximum balwidths
totalbalwidthseen = V.sum balwidths
totalwidthseen = totalacctwidthseen + totalbalwidthseen
shortfall = preferredacctwidth + preferredbalwidth + 2 - availwidth
acctwidthproportion = fromIntegral totalacctwidthseen / fromIntegral totalwidthseen
adjustedacctwidth = min preferredacctwidth . max 15 . round $ acctwidthproportion * fromIntegral (availwidth - 2) -- leave 2 whitespace for padding
adjustedbalwidth = availwidth - 2 - adjustedacctwidth
-- XXX how to minimise the balance column's jumping around as you change the depth limit ?
colwidths | shortfall <= 0 = (preferredacctwidth, preferredbalwidth)
| otherwise = (adjustedacctwidth, adjustedbalwidth)
render $ defaultLayout toplabel bottomlabel $ renderList (asDrawItem colwidths) True (ass ^. assList)
where
ishistorical = balanceaccum_ ropts == Historical
toplabel =
withAttr (attrName "border" <> attrName "filename") files
<+> toggles
<+> str (" " ++ scrname)
<+> borderPeriodStr (if ishistorical then "at end of" else "in") (period_ ropts)
<+> borderQueryStr (T.unpack . T.unwords . map textQuoteIfNeeded $ querystring_ ropts)
<+> borderDepthStr mdepth
<+> str (" ("++curidx++"/"++totidx++")")
<+> (if ignore_assertions_ . balancingopts_ $ inputopts_ copts
then withAttr (attrName "border" <> attrName "query") (str " ignoring balance assertions")
else str "")
where
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 = dsFlatDepth $ depth_ ropts
curidx = case ass ^. assList . listSelectedL of
Nothing -> "-"
Just i -> show (i + 1)
totidx = show $ V.length nonblanks
where
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ ass ^. assList . listElementsL
bottomlabel = case mode of
Minibuffer label ed -> minibuffer label ed
_ -> quickhelp
where
quickhelp = borderKeysStr' [
("LEFT", str "back")
-- ,("RIGHT", str "register")
,("t", renderToggle (tree_ ropts) "list" "tree")
-- ,("t", str "tree")
-- ,("l", str "list")
,("-+", str "depth")
,case scr of
BS _ -> ("", str "")
IS _ -> ("", str "")
_ -> ("H", renderToggle (not ishistorical) "end-bals" "changes")
,("F", renderToggle1 (isJust . forecast_ $ inputopts_ copts) "forecast")
--,("/", "filter")
--,("DEL", "unfilter")
--,("ESC", "cancel/top")
-- ,("a", str "add")
-- ,("g", "reload")
,("?", str "help")
-- ,("q", str "quit")
]
asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget Name
asDrawItem (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 oneLineNoCostFmt{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
-- | Handle events on any accounts-like screen (all accounts, balance sheet, income statement..).
asHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
asHandle ev = do
dbguiEv "asHandle"
ui0@UIState{aScreen=scr, aMode=mode} <- get'
case toAccountsLikeScreen scr of
Nothing -> dbgui "asHandle" $ errorWrongScreenType "event handler" -- PARTIAL:
Just als@(ALS scons ass) -> do
-- save the currently selected account, in case we leave this screen and lose the selection
put' ui0{aScreen=scons ass{_assSelectedAccount=asSelectedAccount ass}}
case mode of
Normal -> asHandleNormalMode als ev
Minibuffer _ ed -> handleMinibufferMode ed ev
Help -> handleHelpMode ev
-- | Handle events when in normal mode on any accounts-like screen.
-- The provided AccountsLikeScreen should correspond to the ui state's current screen.
asHandleNormalMode :: AccountsLikeScreen -> BrickEvent Name AppEvent -> EventM Name UIState ()
asHandleNormalMode (ALS scons ass) ev = do
dbguiEv "asHandleNormalMode"
ui@UIState{aopts=UIOpts{uoCliOpts=copts}, ajournal=j} <- get'
d <- liftIO getCurrentDay
let
l = _assList ass
selacct = asSelectedAccount ass
centerSelection = scrollSelectionToMiddle l
clickedAcctAt y =
case asItemAccountName <$> listElements l !? y of
Just t | not $ T.null t -> Just t
_ -> Nothing
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ listElements l
lastnonblankidx = max 0 (length nonblanks - 1)
journalspan = journalDateSpan False j
case ev of
VtyEvent (EvKey (KChar 'q') []) -> halt -- q: quit
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui -- C-z: suspend
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> centerSelection >> redraw -- C-l: redraw
VtyEvent (EvKey KEsc []) -> modify' (resetScreens d) -- ESC: reset
VtyEvent (EvKey (KChar c) []) | c == '?' -> modify' (setMode Help) -- ?: enter help mode
-- AppEvents come from the system, in --watch mode.
-- XXX currently they are handled only in Normal mode
-- XXX be sure we don't leave unconsumed app events piling up
-- A data file has changed (or the user has pressed g): reload.
e | e `elem` [AppEvent FileChange, VtyEvent (EvKey (KChar 'g') [])] ->
liftIO (uiReloadJournal copts d ui) >>= put'
-- The date has changed (and we are viewing a standard period which contained the old date):
-- adjust the viewed period and regenerate, just in case needed.
-- (Eg: when watching data for "today" and the time has just passed midnight.)
AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old ->
modify' (setReportPeriod (DayPeriod d) >>> regenerateScreens j d)
where p = reportPeriod ui
-- set or reset a filter:
VtyEvent (EvKey (KChar '/') []) -> modify' (showMinibuffer "filter" Nothing >>> regenerateScreens j d)
VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> modify' (resetFilter >>> regenerateScreens j d)
-- run external programs:
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
-- adjust the period displayed:
VtyEvent (EvKey (KChar 'T') []) -> modify' (setReportPeriod (DayPeriod d) >>> regenerateScreens j d)
VtyEvent (EvKey (KDown) [MShift]) -> modify' (shrinkReportPeriod d >>> regenerateScreens j d)
VtyEvent (EvKey (KUp) [MShift]) -> modify' (growReportPeriod d >>> regenerateScreens j d)
VtyEvent (EvKey (KRight) [MShift]) -> modify' (nextReportPeriod journalspan >>> regenerateScreens j d)
VtyEvent (EvKey (KLeft) [MShift]) -> modify' (previousReportPeriod journalspan >>> regenerateScreens j d)
-- various toggles and settings:
VtyEvent (EvKey (KChar 'I') []) -> modify' (toggleIgnoreBalanceAssertions >>> uiCheckBalanceAssertions d)
VtyEvent (EvKey (KChar 'F') []) -> modify' (toggleForecast d >>> regenerateScreens j d)
VtyEvent (EvKey (KChar 'B') []) -> modify' (toggleConversionOp >>> regenerateScreens j d)
VtyEvent (EvKey (KChar 'V') []) -> modify' (toggleValue >>> regenerateScreens j d)
VtyEvent (EvKey (KChar '0') []) -> modify' (setDepth (Just 0) >>> regenerateScreens j d)
VtyEvent (EvKey (KChar '1') []) -> modify' (setDepth (Just 1) >>> regenerateScreens j d)
VtyEvent (EvKey (KChar '2') []) -> modify' (setDepth (Just 2) >>> regenerateScreens j d)
VtyEvent (EvKey (KChar '3') []) -> modify' (setDepth (Just 3) >>> regenerateScreens j d)
VtyEvent (EvKey (KChar '4') []) -> modify' (setDepth (Just 4) >>> regenerateScreens j d)
VtyEvent (EvKey (KChar '5') []) -> modify' (setDepth (Just 5) >>> regenerateScreens j d)
VtyEvent (EvKey (KChar '6') []) -> modify' (setDepth (Just 6) >>> regenerateScreens j d)
VtyEvent (EvKey (KChar '7') []) -> modify' (setDepth (Just 7) >>> regenerateScreens j d)
VtyEvent (EvKey (KChar '8') []) -> modify' (setDepth (Just 8) >>> regenerateScreens j d)
VtyEvent (EvKey (KChar '9') []) -> modify' (setDepth (Just 9) >>> regenerateScreens j d)
VtyEvent (EvKey (KChar c) []) | c `elem` ['-','_'] -> modify' (decDepth >>> regenerateScreens j d)
VtyEvent (EvKey (KChar c) []) | c `elem` ['+','='] -> modify' (incDepth >>> regenerateScreens j d)
-- toggles after which the selection should be recentered:
VtyEvent (EvKey (KChar 'H') []) -> modify' (toggleHistorical >>> regenerateScreens j d) >> centerSelection -- harmless on BS/IS screens
VtyEvent (EvKey (KChar 't') []) -> modify' (toggleTree >>> regenerateScreens j d) >> centerSelection
VtyEvent (EvKey (KChar 'R') []) -> modify' (toggleReal >>> regenerateScreens j d) >> centerSelection
VtyEvent (EvKey (KChar 'U') []) -> modify' (toggleUnmarked >>> regenerateScreens j d) >> centerSelection
VtyEvent (EvKey (KChar 'P') []) -> modify' (togglePending >>> regenerateScreens j d) >> centerSelection
VtyEvent (EvKey (KChar 'C') []) -> modify' (toggleCleared >>> regenerateScreens j d) >> centerSelection
VtyEvent (EvKey (KChar c) []) | c `elem` ['z','Z'] -> modify' (toggleEmpty >>> regenerateScreens j d) >> centerSelection -- back compat: accept Z as well as z
-- LEFT key or a click in the app's left margin: exit to the parent screen.
VtyEvent e | e `elem` moveLeftEvents -> modify' popScreen
VtyEvent (EvMouseUp 0 _ (Just BLeft)) -> modify' popScreen -- this mouse click is a VtyEvent since not in a clickable widget
-- RIGHT key or MouseUp on an account: enter the register screen for the selected account
VtyEvent e | e `elem` moveRightEvents, not $ isBlankItem $ listSelectedElement l -> enterRegisterScreen d selacct ui
MouseUp _n (Just BLeft) Location{loc=(_,y)} | Just clkacct <- clickedAcctAt y -> enterRegisterScreen d clkacct ui
-- MouseDown: this is not debounced and can repeat (https://github.com/jtdaugherty/brick/issues/347)
-- so we only let it do something harmless: move the selection.
MouseDown _n BLeft _mods Location{loc=(_,y)} | not $ isBlankItem clickeditem ->
put' ui{aScreen=scons ass'}
where
clickeditem = (0,) <$> listElements l !? y
ass' = ass{_assList=listMoveTo y l}
-- Mouse scroll wheel: scroll up or down to the maximum extent, pushing the selection when necessary.
MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do
let scrollamt = if btn==BScrollUp then -1 else 1
l' <- nestEventM' l $ listScrollPushingSelection name (asListSize l) scrollamt
put' ui{aScreen=scons ass{_assList=l'}}
-- PGDOWN/END keys: handle with List's default handler, but restrict the selection to stop
-- (and center) at the last non-blank item.
VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do
l1 <- nestEventM' l $ handleListEvent e
if isBlankItem $ listSelectedElement l1
then do
let l2 = listMoveTo lastnonblankidx l1
scrollSelectionToMiddle l2
put' ui{aScreen=scons ass{_assList=l2}}
else
put' ui{aScreen=scons ass{_assList=l1}}
-- DOWN key when selection is at the last item: scroll instead of moving, until maximally scrolled
VtyEvent e | e `elem` moveDownEvents, isBlankItem mnextelement -> vScrollBy (viewportScroll $ l^.listNameL) 1
where mnextelement = listSelectedElement $ listMoveDown l
-- Any other vty event (UP, DOWN, PGUP etc): handle with List's default handler.
VtyEvent e -> do
l' <- nestEventM' l $ handleListEvent (normaliseMovementKeys e)
put' ui{aScreen=scons $ ass & assList .~ l' & assSelectedAccount .~ selacct}
-- Any other mouse/app event: ignore
MouseDown{} -> return ()
MouseUp{} -> return ()
AppEvent _ -> return ()
-- | Handle events when in minibuffer mode on any screen.
handleMinibufferMode ed ev = do
ui@UIState{ajournal=j} <- get'
d <- liftIO getCurrentDay
case ev of
VtyEvent (EvKey KEsc []) -> put' $ closeMinibuffer ui
VtyEvent (EvKey KEnter []) -> put' $ regenerateScreens j d ui'
where
ui' = setFilter s (closeMinibuffer ui)
& fromRight (showMinibuffer "Cannot compile regular expression" (Just s) 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 ()
-- | Handle events when in help mode on any screen.
handleHelpMode ev = do
ui <- get'
case ev of
-- VtyEvent (EvKey (KChar 'q') []) -> halt
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
_ -> helpHandle ev
enterRegisterScreen :: Day -> AccountName -> UIState -> EventM Name UIState ()
enterRegisterScreen d acct ui@UIState{ajournal=j, aopts=uopts} = do
dbguiEv "enterRegisterScreen"
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'
-- | From any accounts screen's state, get the account name from the
-- currently selected list item, or otherwise the last known selected account name.
asSelectedAccount :: AccountsScreenState -> AccountName
asSelectedAccount ass =
case listSelectedElement $ _assList ass of
Just (_, AccountsScreenItem{..}) -> asItemAccountName
Nothing -> ass ^. assSelectedAccount
-- | Set the selected account on any of the accounts screens. Has no effect on other screens.
-- Sets the high-level property _assSelectedAccount and also selects the corresponding or
-- best alternative item in the list widget (_assList).
asSetSelectedAccount :: AccountName -> Screen -> Screen
asSetSelectedAccount acct scr =
case scr of
(AS ass) -> AS $ assSetSelectedAccount acct ass
(BS ass) -> BS $ assSetSelectedAccount acct ass
(IS ass) -> IS $ assSetSelectedAccount acct ass
_ -> scr
where
assSetSelectedAccount a ass@ASS{_assList=l} =
ass{_assSelectedAccount=a, _assList=listMoveTo selidx l}
where
-- which list item should be selected ?
selidx = headDef 0 $ catMaybes [
elemIndex a as -- the specified account, if it can be found
,findIndex (a `isAccountNamePrefixOf`) as -- or the first account found with the same prefix
,Just $ max 0 (length (filter (< a) as) - 1) -- otherwise, the alphabetically preceding account.
]
where
as = map asItemAccountName $ V.toList $ listElements l
isBlankItem mitem = ((asItemAccountName . snd) <$> mitem) == Just ""
asListSize = V.length . V.takeWhile ((/="").asItemAccountName) . listElements