ui: styled amounts, smarter accounts column sizing

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
+      mdepth = depth_ $ reportopts_ $ cliopts_ uopts
-      -- ropts = reportopts_ $ cliopts_ uopts
+      cur = str (case l^.listSelectedL of
-      -- q = queryFromOpts d ropts
-      -- depth = queryDepth q
-      cur = str (case is^.listSelectedL of
                   Nothing -> "-"
                   Just i -> show (i + 1))
-      total = str $ show $ V.length $ is^.listElementsL
+      total = str $ show $ V.length $ l^.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
-             ]
 
       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 :: (Int,Int) -> Bool -> (Int, String, String, [String]) -> Widget
-drawAccountsItem fmt _sel item =
+drawAccountsItem (acctwidth, balwidth) selected (indent, _fullacct, displayacct, balamts) =
   Widget Greedy Fixed $ do
     -- c <- getContext
-    let
+      -- let showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt
-      showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt
+    render $
-    render $ str $ showitem item
+      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
+      acct = case listSelectedElement l of
-              Just (_, ((a, _, _), _)) -> a
+              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.KPageDown) [] -> continue $ st{aScreen=scr{asState=moveSel h l}}
-        -- Vty.EvKey (Vty.KPageUp) []   -> continue $ st{aScreen=scr{asState=moveSel (-h) is}}
+        -- 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
+                                     l' <- handleEvent ev l
-                                     continue $ st{aScreen=scr{asState=is'}}
+                                     continue $ st{aScreen=scr{asState=l'}}
                                  -- continue =<< handleEventLensed st someLens ev
 handleAccountsScreen _ _ = error "event handler called with wrong screen type, should not happen"
 

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

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

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)