403 lines
20 KiB
Haskell
403 lines
20 KiB
Haskell
-- The accounts screen, showing accounts and balances like the CLI balance command.
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
module Hledger.UI.AccountsScreen
|
|
(accountsScreen
|
|
,asInit
|
|
,asSetSelectedAccount
|
|
)
|
|
where
|
|
|
|
import Brick
|
|
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 Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft, BScrollDown, BScrollUp))
|
|
import Lens.Micro.Platform
|
|
import Safe
|
|
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.Editor
|
|
import Hledger.UI.RegisterScreen
|
|
import Hledger.UI.ErrorScreen
|
|
import Data.Vector ((!?))
|
|
|
|
|
|
accountsScreen :: Screen
|
|
accountsScreen = AccountsScreen{
|
|
sInit = asInit
|
|
,sDraw = asDraw
|
|
,sHandle = asHandle
|
|
,_asList = list AccountsList V.empty 1
|
|
,_asSelectedAccount = ""
|
|
}
|
|
|
|
asInit :: Day -> Bool -> UIState -> UIState
|
|
asInit d reset ui@UIState{
|
|
aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}},
|
|
ajournal=j,
|
|
aScreen=s@AccountsScreen{}
|
|
} = dlogUiTrace "asInit 1" $
|
|
ui{aScreen=s & asList .~ newitems'}
|
|
where
|
|
newitems = list AccountsList (V.fromList $ displayitems ++ blankitems) 1
|
|
|
|
-- decide which account is selected:
|
|
-- if reset 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.
|
|
newitems' = listMoveTo selidx newitems
|
|
where
|
|
selidx = case (reset, listSelectedElement $ _asList s) of
|
|
(True, _) -> 0
|
|
(_, Nothing) -> 0
|
|
(_, Just (_,AccountsScreenItem{asItemAccountName=a})) ->
|
|
headDef 0 $ catMaybes [
|
|
elemIndex a as
|
|
,findIndex (a `isAccountNamePrefixOf`) as
|
|
,Just $ max 0 (length (filter (< a) as) - 1)
|
|
]
|
|
where
|
|
as = map asItemAccountName displayitems
|
|
|
|
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}}
|
|
|
|
-- run the report
|
|
(items,_total) = balanceReport rspec' j
|
|
|
|
-- pre-render the list items
|
|
displayitem (fullacct, shortacct, indent, bal) =
|
|
AccountsScreenItem{asItemIndentLevel = indent
|
|
,asItemAccountName = fullacct
|
|
,asItemDisplayAccountName = replaceHiddenAccountsNameWith "All" $ if tree_ ropts then shortacct else fullacct
|
|
,asItemMixedAmount = Just bal
|
|
}
|
|
displayitems = map displayitem items
|
|
-- 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
|
|
}
|
|
|
|
|
|
asInit _ _ _ = dlogUiTrace "asInit 2" $ errorWrongScreenType "init function" -- PARTIAL:
|
|
|
|
asDraw :: UIState -> [Widget Name]
|
|
asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
|
|
,ajournal=j
|
|
,aScreen=s@AccountsScreen{}
|
|
,aMode=mode
|
|
} = dlogUiTrace "asDraw 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 = s ^. asList . listElementsL
|
|
|
|
acctwidths = V.map (\AccountsScreenItem{..} -> asItemIndentLevel + realLength asItemDisplayAccountName) displayitems
|
|
balwidths = V.map (maybe 0 (wbWidth . showMixedAmountB oneLine) . asItemMixedAmount) displayitems
|
|
preferredacctwidth = V.maximum acctwidths
|
|
totalacctwidthseen = V.sum acctwidths
|
|
preferredbalwidth = V.maximum balwidths
|
|
totalbalwidthseen = V.sum balwidths
|
|
|
|
totalwidthseen = totalacctwidthseen + totalbalwidthseen
|
|
shortfall = preferredacctwidth + preferredbalwidth + 2 - availwidth
|
|
acctwidthproportion = fromIntegral totalacctwidthseen / fromIntegral totalwidthseen
|
|
adjustedacctwidth = min preferredacctwidth . max 15 . round $ acctwidthproportion * fromIntegral (availwidth - 2) -- leave 2 whitespace for padding
|
|
adjustedbalwidth = availwidth - 2 - adjustedacctwidth
|
|
|
|
-- XXX how to minimise the balance column's jumping around as you change the depth limit ?
|
|
|
|
colwidths | shortfall <= 0 = (preferredacctwidth, preferredbalwidth)
|
|
| otherwise = (adjustedacctwidth, adjustedbalwidth)
|
|
|
|
render $ defaultLayout toplabel bottomlabel $ renderList (asDrawItem colwidths) True (_asList s)
|
|
|
|
where
|
|
ropts = _rsReportOpts rspec
|
|
ishistorical = balanceaccum_ ropts == Historical
|
|
|
|
toplabel =
|
|
withAttr (attrName "border" <> attrName "filename") files
|
|
<+> toggles
|
|
<+> str (" account " ++ if ishistorical then "balances" else "changes")
|
|
<+> 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 _asList s ^. listSelectedL of
|
|
Nothing -> "-"
|
|
Just i -> show (i + 1)
|
|
totidx = show $ V.length nonblanks
|
|
where
|
|
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ s ^. asList . 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")
|
|
,("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")
|
|
,("q", str "quit")
|
|
]
|
|
|
|
asDraw _ = dlogUiTrace "asDraw 2" $ errorWrongScreenType "draw function" -- PARTIAL:
|
|
|
|
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 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
|
|
|
|
asHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
|
asHandle ev = do
|
|
ui0 <- get'
|
|
dlogUiTraceM "asHandle 1"
|
|
case ui0 of
|
|
ui1@UIState{
|
|
aScreen=scr@AccountsScreen{..}
|
|
,aopts=UIOpts{uoCliOpts=copts}
|
|
,ajournal=j
|
|
,aMode=mode
|
|
} -> do
|
|
|
|
let
|
|
-- save the currently selected account, in case we leave this screen and lose the selection
|
|
selacct = case listSelectedElement _asList of
|
|
Just (_, AccountsScreenItem{..}) -> asItemAccountName
|
|
Nothing -> scr ^. asSelectedAccount
|
|
ui = ui1{aScreen=scr & asSelectedAccount .~ selacct}
|
|
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ _asList^.listElementsL
|
|
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) >> asCenterAndContinue
|
|
VtyEvent (EvKey (KChar 't') []) -> modify' (regenerateScreens j d . toggleTree) >> asCenterAndContinue
|
|
VtyEvent (EvKey (KChar c) []) | c `elem` ['z','Z'] -> modify' (regenerateScreens j d . toggleEmpty) >> asCenterAndContinue
|
|
VtyEvent (EvKey (KChar 'R') []) -> modify' (regenerateScreens j d . toggleReal) >> asCenterAndContinue
|
|
VtyEvent (EvKey (KChar 'U') []) -> modify' (regenerateScreens j d . toggleUnmarked) >> asCenterAndContinue
|
|
VtyEvent (EvKey (KChar 'P') []) -> modify' (regenerateScreens j d . togglePending) >> asCenterAndContinue
|
|
VtyEvent (EvKey (KChar 'C') []) -> modify' (regenerateScreens j d . toggleCleared) >> asCenterAndContinue
|
|
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 _asList >> redraw
|
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
|
|
|
-- enter register screen for selected account (if there is one),
|
|
-- centering its selected transaction if possible
|
|
VtyEvent e | e `elem` moveRightEvents
|
|
, not $ isBlankElement $ listSelectedElement _asList -> asEnterRegister 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=scr} -- XXX does this do anything ?
|
|
where clickedacct = maybe "" asItemAccountName $ listElements _asList !? y
|
|
-- and on MouseUp, enter the subscreen
|
|
MouseUp _n (Just BLeft) Location{loc=(_x,y)} | not $ (=="") clickedacct -> do
|
|
asEnterRegister d clickedacct ui
|
|
where clickedacct = maybe "" asItemAccountName $ listElements _asList !? 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 $ _asList^.listNameL) 1
|
|
where mnextelement = listSelectedElement $ listMoveDown _asList
|
|
|
|
-- 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' _asList $ listScrollPushingSelection name (asListSize _asList) scrollamt
|
|
put' ui{aScreen=scr{_asList=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' _asList $ handleListEvent e
|
|
if isBlankElement $ listSelectedElement l
|
|
then do
|
|
let l' = listMoveTo lastnonblankidx l
|
|
scrollSelectionToMiddle l'
|
|
put' ui{aScreen=scr{_asList=l'}}
|
|
else
|
|
put' ui{aScreen=scr{_asList=l}}
|
|
|
|
-- fall through to the list's event handler (handles up/down)
|
|
VtyEvent e -> do
|
|
list' <- nestEventM' _asList $ handleListEvent (normaliseMovementKeys e)
|
|
put' ui{aScreen=scr & asList .~ list' & asSelectedAccount .~ selacct }
|
|
|
|
MouseDown{} -> return ()
|
|
MouseUp{} -> return ()
|
|
AppEvent _ -> return ()
|
|
|
|
_ -> dlogUiTraceM "asHandle 2" >> errorWrongScreenType "event handler"
|
|
|
|
asEnterRegister :: Day -> AccountName -> UIState -> EventM Name UIState ()
|
|
asEnterRegister d selacct ui = do
|
|
dlogUiTraceM "asEnterRegister"
|
|
let
|
|
regscr = rsSetAccount selacct isdepthclipped registerScreen
|
|
where
|
|
isdepthclipped = case getDepth ui of
|
|
Just de -> accountNameLevel selacct >= de
|
|
Nothing -> False
|
|
rsCenterSelection (screenEnter d regscr ui) >>= put'
|
|
|
|
asSetSelectedAccount a s@AccountsScreen{} = s & asSelectedAccount .~ a
|
|
asSetSelectedAccount _ s = s
|
|
|
|
isBlankElement mel = ((asItemAccountName . snd) <$> mel) == Just ""
|
|
|
|
asCenterAndContinue :: EventM Name UIState ()
|
|
asCenterAndContinue = do
|
|
ui <- get'
|
|
scrollSelectionToMiddle (_asList $ aScreen ui)
|
|
|
|
asListSize = V.length . V.takeWhile ((/="").asItemAccountName) . listElements
|
|
|