diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index a3792b3a4..59c5aae3a 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -47,7 +47,7 @@ initAccountsScreen mselacct d st@AppState{ } = st{aopts=opts', aScreen=s{asState=l'}} where - l = list (Name "accounts") (V.fromList items) 1 + l = list (Name "accounts") (V.fromList displayitems) 1 -- hacky: when we're adjusting depth, mselacct is the account that was selected previously, -- in which case try and keep the selection near where it was @@ -91,16 +91,29 @@ initAccountsScreen mselacct d st@AppState{ -- run the report (items,_total) = convert $ balanceReport ropts' q j + -- pre-render the list items + displayitem ((fullacct, shortacct, indent), bal) = + (indent + ,fullacct + ,if tree_ ropts' then shortacct else fullacct + ,map showAmountWithoutPrice amts -- like showMixedAmountOneLineWithoutPrice + ) + where + Mixed amts = normaliseMixedAmountSquashPricesForDisplay $ stripPrices bal + stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice} + displayitems = map displayitem items + + initAccountsScreen _ _ _ = error "init function called with wrong screen type, should not happen" drawAccountsScreen :: AppState -> [Widget] -drawAccountsScreen st@AppState{aopts=uopts, ajournal=j, aScreen=AccountsScreen{asState=is}} = +drawAccountsScreen _st@AppState{aopts=uopts, ajournal=j, aScreen=AccountsScreen{asState=l}} = [ui] where toplabel = files <+> str " accounts" <+> borderQueryStr querystr - <+> borderDepthStr depth + <+> borderDepthStr mdepth <+> str " (" <+> cur <+> str " of " @@ -112,28 +125,11 @@ drawAccountsScreen st@AppState{aopts=uopts, ajournal=j, aScreen=AccountsScreen{a [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)") querystr = query_ $ reportopts_ $ cliopts_ uopts - depth = depth_ $ reportopts_ $ cliopts_ uopts - -- ropts = reportopts_ $ cliopts_ uopts - -- q = queryFromOpts d ropts - -- depth = queryDepth q - cur = str (case is^.listSelectedL of + mdepth = depth_ $ reportopts_ $ cliopts_ uopts + cur = str (case l^.listSelectedL of Nothing -> "-" Just i -> show (i + 1)) - total = str $ show $ V.length $ is^.listElementsL - - items = listElements is - flat = flat_ $ reportopts_ $ cliopts_ $ aopts st - acctcolwidth = V.maximum $ - V.map - (\((full,short,indent),_) -> - if flat then length full else length short + indent*2) - items - fmt = OneLine [ -- use a one-line format, List elements must have equal height - FormatField True (Just 2) Nothing DepthSpacerField - , FormatField True (Just acctcolwidth) Nothing AccountField - , FormatLiteral " " - , FormatField False (Just 40) Nothing TotalField - ] + total = str $ show $ V.length $ l^.listElementsL bottomlabel = borderKeysStr [ -- "up/down/pgup/pgdown/home/end: move" @@ -142,27 +138,81 @@ drawAccountsScreen st@AppState{aopts=uopts, ajournal=j, aScreen=AccountsScreen{a ,"q: quit" ] - ui = defaultLayout toplabel bottomlabel $ renderList is (drawAccountsItem fmt) + ui = Widget Greedy Greedy $ do + c <- getContext + let + availwidth = + -- ltrace "availwidth" $ + c^.availWidthL + - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils) + displayitems = listElements l + maxacctwidthseen = + -- ltrace "maxacctwidthseen" $ + V.maximum $ + V.map (\(indent,_,displayacct,_) -> indent*2 + length displayacct) $ + -- V.filter (\(indent,_,_,_) -> (indent-1) <= fromMaybe 99999 mdepth) $ + displayitems + maxbalwidthseen = + -- ltrace "maxbalwidthseen" $ + V.maximum $ V.map (\(_,_,_,amts) -> sum (map length amts) + 2 * (length amts-1)) displayitems + maxbalwidth = + -- ltrace "maxbalwidth" $ + max 0 (availwidth - 2 - 4) -- leave 2 whitespace plus least 4 for accts + balwidth = + -- ltrace "balwidth" $ + min maxbalwidth maxbalwidthseen + maxacctwidth = + -- ltrace "maxacctwidth" $ + availwidth - 2 - balwidth + acctwidth = + -- ltrace "acctwidth" $ + min maxacctwidth maxacctwidthseen + + -- XXX how to minimise the balance column's jumping around + -- as you change the depth limit ? + + colwidths = (acctwidth, balwidth) + + render $ defaultLayout toplabel bottomlabel $ renderList l (drawAccountsItem colwidths) drawAccountsScreen _ = error "draw function called with wrong screen type, should not happen" -drawAccountsItem :: StringFormat -> Bool -> BalanceReportItem -> Widget -drawAccountsItem fmt _sel item = +drawAccountsItem :: (Int,Int) -> Bool -> (Int, String, String, [String]) -> Widget +drawAccountsItem (acctwidth, balwidth) selected (indent, _fullacct, displayacct, balamts) = Widget Greedy Fixed $ do -- c <- getContext - let - showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt - render $ str $ showitem item + -- let showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt + render $ + addamts balamts $ + str (padright acctwidth $ elideRight acctwidth $ replicate (2*indent) ' ' ++ displayacct) <+> + str " " <+> + str (balspace balamts) + where + balspace as = replicate n ' ' + where n = max 0 (balwidth - (sum (map length as) + 2 * (length as - 1))) + addamts :: [String] -> Widget -> Widget + addamts [] w = w + addamts [a] w = (<+> renderamt a) w + -- foldl' :: (b -> a -> b) -> b -> t a -> b + -- foldl' (Widget -> String -> Widget) -> Widget -> [String] -> Widget + addamts (a:as) w = foldl' addamt (addamts [a] w) as + addamt :: Widget -> String -> Widget + addamt w a = ((<+> renderamt a) . (<+> str ", ")) w + renderamt :: String -> Widget + renderamt a | '-' `elem` a = withAttr (sel $ "list" <> "balance" <> "negative") $ str a + | otherwise = withAttr (sel $ "list" <> "balance" <> "positive") $ str a + sel | selected = (<> "selected") + | otherwise = id handleAccountsScreen :: AppState -> Vty.Event -> EventM (Next AppState) -handleAccountsScreen st@AppState{aScreen=scr@AccountsScreen{asState=is}} e = do +handleAccountsScreen st@AppState{aScreen=scr@AccountsScreen{asState=l}} e = do d <- liftIO getCurrentDay -- c <- getContext -- let h = c^.availHeightL -- moveSel n l = listMoveBy n l let - acct = case listSelectedElement is of - Just (_, ((a, _, _), _)) -> a + acct = case listSelectedElement l of + Just (_, (_, fullacct, _, _)) -> fullacct Nothing -> "" reload = continue . initAccountsScreen (Just acct) d @@ -187,13 +237,13 @@ handleAccountsScreen st@AppState{aScreen=scr@AccountsScreen{asState=is}} e = do vScrollToBeginning $ viewportScroll "register" continue st' - -- Vty.EvKey (Vty.KPageDown) [] -> continue $ st{aScreen=scr{asState=moveSel h is}} - -- Vty.EvKey (Vty.KPageUp) [] -> continue $ st{aScreen=scr{asState=moveSel (-h) is}} + -- Vty.EvKey (Vty.KPageDown) [] -> continue $ st{aScreen=scr{asState=moveSel h l}} + -- Vty.EvKey (Vty.KPageUp) [] -> continue $ st{aScreen=scr{asState=moveSel (-h) l}} -- fall through to the list's event handler (handles up/down) ev -> do - is' <- handleEvent ev is - continue $ st{aScreen=scr{asState=is'}} + l' <- handleEvent ev l + continue $ st{aScreen=scr{asState=l'}} -- continue =<< handleEventLensed st someLens ev handleAccountsScreen _ _ = error "event handler called with wrong screen type, should not happen" diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 1eab57e8a..47e43da42 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -160,7 +160,7 @@ drawRegisterScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{repo drawRegisterScreen _ = error "draw function called with wrong screen type, should not happen" drawRegisterItem :: (Int,Int,Int,Int,Int) -> Bool -> (String,String,String,String,String) -> Widget -drawRegisterItem (datewidth,descwidth,acctswidth,changewidth,balwidth) _sel (date,desc,accts,change,bal) = +drawRegisterItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected (date,desc,accts,change,bal) = Widget Greedy Fixed $ do render $ str (padright datewidth $ elideRight datewidth date) <+> @@ -169,9 +169,16 @@ drawRegisterItem (datewidth,descwidth,acctswidth,changewidth,balwidth) _sel (dat str " " <+> str (padright acctswidth $ elideLeft acctswidth $ accts) <+> str " " <+> - str (padleft changewidth $ elideLeft changewidth change) <+> + withAttr changeattr (str (padleft changewidth $ elideLeft changewidth change)) <+> str " " <+> - str (padleft balwidth $ elideLeft balwidth bal) + withAttr balattr (str (padleft balwidth $ elideLeft balwidth bal)) + where + changeattr | '-' `elem` change = sel $ "list" <> "amount" <> "decrease" + | otherwise = sel $ "list" <> "amount" <> "increase" + balattr | '-' `elem` bal = sel $ "list" <> "balance" <> "negative" + | otherwise = sel $ "list" <> "balance" <> "positive" + sel | selected = (<> "selected") + | otherwise = id handleRegisterScreen :: AppState -> Vty.Event -> EventM (Next AppState) handleRegisterScreen st@AppState{aopts=_opts,aScreen=s@RegisterScreen{rsState=is}} e = do diff --git a/hledger-ui/Hledger/UI/Theme.hs b/hledger-ui/Hledger/UI/Theme.hs index ee28af5fd..49b0be9b3 100644 --- a/hledger-ui/Hledger/UI/Theme.hs +++ b/hledger-ui/Hledger/UI/Theme.hs @@ -72,10 +72,17 @@ themesList = [ (borderAttr <> "depth", cyan `on` black & bold), -- ("normal" , black `on` white), ("list" , black `on` white), -- regular list items - ("list" <> "selected" , white `on` blue & bold) -- selected list items + ("list" <> "selected" , white `on` blue & bold), -- selected list items -- ("list" <> "selected" , black `on` brightYellow), -- ("list" <> "accounts" , white `on` brightGreen), - -- ("list" <> "amount" , black `on` white & bold) + ("list" <> "amount" <> "increase", currentAttr `withForeColor` green), + ("list" <> "amount" <> "decrease", currentAttr `withForeColor` red), + ("list" <> "balance" <> "positive", currentAttr `withForeColor` black), + ("list" <> "balance" <> "negative", currentAttr `withForeColor` red), + ("list" <> "amount" <> "increase" <> "selected", brightGreen `on` blue & bold), + ("list" <> "amount" <> "decrease" <> "selected", brightRed `on` blue & bold), + ("list" <> "balance" <> "positive" <> "selected", white `on` blue & bold), + ("list" <> "balance" <> "negative" <> "selected", brightRed `on` blue & bold) ]), ("terminal", attrMap diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index 5c195b2f1..f2383414f 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/hledger-ui/Hledger/UI/UITypes.hs @@ -25,13 +25,13 @@ data AppState = AppState { -- of their state (which must have unique accessor names). data Screen = AccountsScreen { - asState :: List BalanceReportItem -- ^ the screen's state (data being displayed and widget state) + asState :: List (Int,String,String,[String]) -- ^ indent level, full account name, full or short account name to display, rendered amounts ,sInitFn :: Day -> AppState -> AppState -- ^ function to initialise the screen's state on entry ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) -- ^ brick event handler to use for this screen ,sDrawFn :: AppState -> [Widget] -- ^ brick renderer to use for this screen } | RegisterScreen { - rsState :: List (String,String,String,String,String) + rsState :: List (String,String,String,String,String) -- ^ date, description, other accts, change amt, balance amt ,rsAcct :: AccountName -- ^ the account we are showing a register for ,sInitFn :: Day -> AppState -> AppState ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)