ui: misc enhancements, allow depth adjustment

- clean up options a bit, enable -V/--value (affects the accounts screen)
- more informative top/bottom borders, including key help
- number keys adjust the depth limit (accounts screen)
- remove obsolete args parameter

hledger-ui/Hledger/UI/AccountsScreen.hs

@@ -1,6 +1,7 @@
 -- The accounts screen, showing accounts and balances like the CLI balance command.
 
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Hledger.UI.AccountsScreen
  (screen)
@@ -11,6 +12,7 @@ import Control.Lens ((^.))
 import Control.Monad.IO.Class
 -- import Data.Default
 import Data.List
+import Data.Maybe
 import Data.Monoid
 import Data.Time.Calendar (Day)
 import System.FilePath (takeFileName)
@@ -32,35 +34,52 @@ import qualified Hledger.UI.RegisterScreen2 as RS2 (screen)
 
 screen = AccountsScreen{
    asState  = list "accounts" V.empty 1
-  ,sInitFn    = initAccountsScreen
+  ,sInitFn    = initAccountsScreen Nothing
   ,sDrawFn    = drawAccountsScreen
   ,sHandleFn = handleAccountsScreen
   }
 
-initAccountsScreen :: Day -> [String] -> AppState -> AppState
+initAccountsScreen :: Maybe AccountName -> Day -> AppState -> AppState
-initAccountsScreen d args st@AppState{aopts=opts, ajournal=j, aScreen=s@AccountsScreen{}} =
+initAccountsScreen mselacct d st@AppState{aopts=opts, aargs=args, ajournal=j, aScreen=s@AccountsScreen{}} =
-  st{aScreen=s{asState=is'}}
+  st{aScreen=s{asState=is''}}
    where
     is' = list (Name "accounts") (V.fromList items) 1
-    (items,_total) = balanceReport ropts q j
+    -- crazy hacks dept.
+    -- 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
+    is'' = case mselacct of
+             Nothing -> is'
+             Just a  -> -- vScrollToBeginning $ viewportScroll "accounts"
+                           maybe is' (flip listMoveTo is') mi
+               where
+                 mi = findIndex (\((acct,_,_),_) -> acct==a') items
+                 a' = maybe a (flip clipAccountName a) $ depth_ ropts
+
+    q = queryFromOpts d ropts
+         -- query_="cur:\\$"} -- XXX limit to one commodity to ensure one-line items
+         --{query_=unwords' $ locArgs l}
+    ropts = (reportopts_ cliopts)
+            {
+              query_=unwords' args,
+              balancetype_=HistoricalBalance -- XXX balanceReport doesn't respect this yet
+            }
+    cliopts = cliopts_ opts
+    convert | value_ ropts = balanceReportValue j valuedate
+            | otherwise    = id
       where
-        q = queryFromOpts d ropts
+        valuedate = fromMaybe d $ queryEndDate False q
-             -- query_="cur:\\$"} -- XXX limit to one commodity to ensure one-line items
+
-             --{query_=unwords' $ locArgs l}
+    (items,_total) = convert $ balanceReport ropts q j
-        ropts = (reportopts_ cliopts)
+
-                {
-                  query_=unwords' args,
-                  balancetype_=HistoricalBalance -- XXX balanceReport doesn't respect this yet
-                }
-        cliopts = cliopts_ opts
 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}} = [ui]
     where
-      label = files
+      toplabel = files
               <+> str " accounts"
-              <+> borderQuery querystr
+              <+> borderQueryStr querystr
+              <+> borderDepthStr depth
               <+> str " ("
               <+> cur
               <+> str " of "
@@ -72,6 +91,7 @@ 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
       cur = str (case is^.listSelectedL of
                   Nothing -> "-"
                   Just i -> show (i + 1))
@@ -91,7 +111,14 @@ drawAccountsScreen st@AppState{aopts=uopts, ajournal=j, aScreen=AccountsScreen{a
              , FormatField False (Just 40) Nothing TotalField
              ]
 
-      ui = defaultLayout label $ renderList is (drawAccountsItem fmt)
+      bottomlabel = borderKeysStr [
+         -- "up/down/pgup/pgdown/home/end: move"
+         "1-0: adjust depth limit"
+        ,"right: show transactions"
+        ,"q: quit"
+        ]
+
+      ui = defaultLayout toplabel bottomlabel $ renderList is (drawAccountsItem fmt)
 
 drawAccountsScreen _ = error "draw function called with wrong screen type, should not happen"
 
@@ -109,18 +136,28 @@ handleAccountsScreen st@AppState{aargs=args, aScreen=scr@AccountsScreen{asState=
     -- c <- getContext
     -- let h = c^.availHeightL
     --     moveSel n l = listMoveBy n l
+    let
+      acct = case listSelectedElement is of
+              Just (_, ((a, _, _), _)) -> a
+              Nothing -> ""
     case e of
         Vty.EvKey Vty.KEsc []        -> halt st
         Vty.EvKey (Vty.KChar 'q') [] -> halt st
+        Vty.EvKey (Vty.KChar '0') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 0 st
+        Vty.EvKey (Vty.KChar '1') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 1 st
+        Vty.EvKey (Vty.KChar '2') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 2 st
+        Vty.EvKey (Vty.KChar '3') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 3 st
+        Vty.EvKey (Vty.KChar '4') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 4 st
+        Vty.EvKey (Vty.KChar '5') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 5 st
+        Vty.EvKey (Vty.KChar '6') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 6 st
+        Vty.EvKey (Vty.KChar '7') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 7 st
+        Vty.EvKey (Vty.KChar '8') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 8 st
+        Vty.EvKey (Vty.KChar '9') [] -> continue $ initAccountsScreen (Just acct) d $ setDepth 9 st
         Vty.EvKey (Vty.KLeft) []     -> continue $ popScreen st
         Vty.EvKey (Vty.KRight) []    -> do
           let st' = screenEnter d args RS2.screen{rs2Acct=acct} st
           vScrollToBeginning $ viewportScroll "register"
           continue st'
-          where
-            acct = case listSelectedElement is of
-                    Just (_, ((a, _, _), _)) -> a
-                    Nothing -> ""
 
         -- Vty.EvKey (Vty.KPageDown) [] -> continue $ st{aScreen=scr{asState=moveSel h is}}
         -- Vty.EvKey (Vty.KPageUp) []   -> continue $ st{aScreen=scr{asState=moveSel (-h) is}}
@@ -131,3 +168,10 @@ handleAccountsScreen st@AppState{aargs=args, aScreen=scr@AccountsScreen{asState=
                                      continue $ st{aScreen=scr{asState=is'}}
                                  -- continue =<< handleEventLensed st someLens ev
 handleAccountsScreen _ _ = error "event handler called with wrong screen type, should not happen"
+
+setDepth :: Int -> AppState -> AppState
+setDepth depth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{..}}} =
+  st{aopts=uopts{cliopts_=copts{reportopts_=reportopts_{depth_=md}}}}
+  where
+    md | depth==0  = Nothing
+       | otherwise = Just depth

hledger-ui/Hledger/UI/Main.hs

@@ -65,7 +65,7 @@ runBrickUi opts j = do
             maybestringopt "theme" $ rawopts_ $ cliopts_ opts
     args = words' $ query_ $ reportopts_ $ cliopts_ opts
     scr = AS.screen
-    st = (sInitFn scr) d args
+    st = (sInitFn scr) d
          AppState{
             aopts=opts
            ,aargs=args

hledger-ui/Hledger/UI/Options.hs

@@ -23,13 +23,13 @@ prognameandversion :: String
 prognameandversion = progname ++ " " ++ version :: String
 
 uiflags = [
-  flagNone ["debug-ui"]  (\opts -> setboolopt "rules-file" opts) "run with no terminal output, showing console"
+  -- flagNone ["debug-ui"]  (\opts -> setboolopt "rules-file" opts) "run with no terminal output, showing console"
+   flagReq  ["theme"] (\s opts -> Right $ setopt "theme" s opts) "THEME" ("use this custom display theme ("++intercalate ", " themeNames++")")
   ,flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show full account names, unindented"
-  ,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components"
+  -- ,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components"
-  ,flagReq  ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format"
+  -- ,flagReq  ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format"
-  ,flagReq  ["theme"] (\s opts -> Right $ setopt "theme" s opts) "THEME" ("use this custom display theme ("++intercalate ", " themeNames++")")
+  ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "don't compress empty parent accounts on one line"
-  ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "no eliding at all, stronger than --empty"
+  ,flagNone ["value","V"] (setboolopt "value") "show amounts as their market value in their default valuation commodity (accounts screen)"
-  -- ,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total"
  ]
 
 --uimode :: Mode [([Char], [Char])]

hledger-ui/Hledger/UI/RegisterScreen2.hs

@@ -37,8 +37,8 @@ screen = RegisterScreen2{
   ,sHandleFn = handleRegisterScreen2
   }
 
-initRegisterScreen2 :: Day -> [String] -> AppState -> AppState
+initRegisterScreen2 :: Day -> AppState -> AppState
-initRegisterScreen2 d args st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen2{rs2Acct=acct}} =
+initRegisterScreen2 d st@AppState{aargs=args, aopts=opts, ajournal=j, aScreen=s@RegisterScreen2{rs2Acct=acct}} =
   st{aScreen=s{rs2State=l}}
   where
     -- gather arguments and queries
@@ -71,7 +71,7 @@ initRegisterScreen2 d args st@AppState{aopts=opts, ajournal=j, aScreen=s@Registe
       ,case splitOn ", " otheracctsstr of
         [s] -> s
         ss  -> intercalate ", " ss
-        -- _   -> "<split>"
+        -- _   -> "<split>"  -- should do this if accounts field width < 30
       ,showMixedAmountOneLineWithoutPrice change
       ,showMixedAmountOneLineWithoutPrice bal
       )
@@ -83,15 +83,15 @@ initRegisterScreen2 d args st@AppState{aopts=opts, ajournal=j, aScreen=s@Registe
 
         -- (listName someList)
 
-initRegisterScreen2 _ _ _ = error "init function called with wrong screen type, should not happen"
+initRegisterScreen2 _ _ = error "init function called with wrong screen type, should not happen"
 
 drawRegisterScreen2 :: AppState -> [Widget]
-drawRegisterScreen2 AppState{aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}},
+drawRegisterScreen2 AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}},
-                             aargs=_args, aScreen=RegisterScreen2{rs2State=l,rs2Acct=acct}} = [ui]
+                             aScreen=RegisterScreen2{rs2State=l,rs2Acct=acct}} = [ui]
   where
-    label = withAttr ("border" <> "bold") (str acct)
+    toplabel = withAttr ("border" <> "bold") (str acct)
             <+> str " transactions"
-            <+> borderQuery querystr
+            -- <+> borderQueryStr querystr -- no, account transactions report shows all transactions in the acct ?
             -- <+> str " and subs"
             <+> str " ("
             <+> cur
@@ -149,10 +149,14 @@ drawRegisterScreen2 AppState{aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reporto
         -- allocating equally.
         descwidth = maxdescacctswidth `div` 2
         acctswidth = maxdescacctswidth - descwidth
-
         colwidths = (datewidth,descwidth,acctswidth,changewidth,balwidth)
 
-      render $ defaultLayout label $ renderList l (drawRegisterItem colwidths)
+        bottomlabel = borderKeysStr [
+           -- "up/down/pgup/pgdown/home/end: move"
+           "left: return to accounts"
+          ]
+
+      render $ defaultLayout toplabel bottomlabel $ renderList l (drawRegisterItem colwidths)
 
 drawRegisterScreen2 _ = error "draw function called with wrong screen type, should not happen"
 

hledger-ui/Hledger/UI/Theme.hs

@@ -69,6 +69,7 @@ themesList = [
               (borderAttr       , white `on` black & dim),
               (borderAttr <> "bold", white `on` black & bold),
               (borderAttr <> "query", yellow `on` black & bold),
+              (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

hledger-ui/Hledger/UI/UITypes.hs

@@ -26,20 +26,20 @@ data AppState = AppState {
 data Screen =
     AccountsScreen {
      asState :: List BalanceReportItem                            -- ^ the screen's state (data being displayed and widget state)
-    ,sInitFn :: Day -> [String] -> AppState -> AppState                         -- ^ function to initialise the screen's state on entry
+    ,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 PostingsReportItem
-    ,sInitFn :: Day -> [String] -> AppState -> AppState
+    ,sInitFn :: Day -> AppState -> AppState
     ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
     ,sDrawFn :: AppState -> [Widget]
     }
   | RegisterScreen2 {
      rs2State :: List (String,String,String,String,String)
     ,rs2Acct :: AccountName              -- ^ the account we are showing a register for
-    ,sInitFn :: Day -> [String] -> AppState -> AppState
+    ,sInitFn :: Day -> AppState -> AppState
     ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
     ,sDrawFn :: AppState -> [Widget]
     }

hledger-ui/Hledger/UI/UIUtils.hs

@@ -8,14 +8,18 @@ module Hledger.UI.UIUtils (
  -- ,margin
  ,withBorderAttr
  ,topBottomBorderWithLabel
+ ,topBottomBorderWithLabels
  ,defaultLayout
- ,borderQuery
+ ,borderQueryStr
+ ,borderDepthStr
+ ,borderKeysStr
  ) where
 
 import Control.Lens ((^.))
 -- import Control.Monad
 -- import Control.Monad.IO.Class
 -- import Data.Default
+import Data.List
 import Data.Monoid
 import Data.Time.Calendar (Day)
 import Brick
@@ -44,9 +48,9 @@ popScreen st = st
 -- Extra args can be passed to the new screen's init function,
 -- these can be eg query arguments.
 screenEnter :: Day -> [String] -> Screen -> AppState -> AppState
-screenEnter d args scr st = (sInitFn scr) d args $
+screenEnter d args scr st = (sInitFn scr) d $
                             pushScreen scr
-                            st
+                            st{aargs=args}
 
 -- | In the EventM monad, get the named current viewport's width and height,
 -- or (0,0) if the named viewport is not found.
@@ -59,8 +63,8 @@ getViewportSize name = do
   -- liftIO $ putStrLn $ show (w,h)
   return (w,h)
 
-defaultLayout label =
+defaultLayout toplabel bottomlabel =
-  topBottomBorderWithLabel label .
+  topBottomBorderWithLabels (str " "<+>toplabel<+>str " ") (str " "<+>bottomlabel<+>str " ") .
   margin 1 0 Nothing
   -- topBottomBorderWithLabel2 label .
   -- padLeftRight 1 -- XXX should reduce inner widget's width by 2, but doesn't
@@ -82,6 +86,22 @@ topBottomBorderWithLabel label = \wrapped ->
       <=>
       hBorder
 
+topBottomBorderWithLabels toplabel bottomlabel = \wrapped ->
+  Widget Greedy Greedy $ do
+    c <- getContext
+    let (_w,h) = (c^.availWidthL, c^.availHeightL)
+        h' = h - 2
+        wrapped' = vLimit (h') wrapped
+        debugmsg =
+          ""
+          -- "  debug: "++show (_w,h')
+    render $
+      hBorderWithLabel (toplabel <+> str debugmsg)
+      <=>
+      wrapped'
+      <=>
+      hBorderWithLabel bottomlabel
+
 -- XXX should be equivalent to the above, but isn't (page down goes offscreen)
 _topBottomBorderWithLabel2 label = \wrapped ->
  let debugmsg = ""
@@ -123,6 +143,16 @@ withBorderAttr attr = updateAttrMap (applyAttrMappings [(borderAttr, attr)])
 --                       , hCenter $ str "Press Esc to exit."
 --                       ]
 
-borderQuery :: String -> Widget
+borderQueryStr :: String -> Widget
-borderQuery ""  = str ""
+borderQueryStr ""  = str ""
-borderQuery qry = str " matching " <+> withAttr (borderAttr <> "query") (str qry)
+borderQueryStr qry = str " matching " <+> withAttr (borderAttr <> "query") (str qry)
+
+borderDepthStr :: Maybe Int -> Widget
+borderDepthStr Nothing  = str ""
+borderDepthStr (Just d) = str " to " <+> withAttr (borderAttr <> "depth") (str $ "depth "++show d)
+
+borderKeysStr :: [String] -> Widget
+borderKeysStr keydescs = str $ intercalate sep keydescs
+  where
+    sep = " | "
+    -- sep = "  "