diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index 6d0a7521d..9ef1ec944 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/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 d args st@AppState{aopts=opts, ajournal=j, aScreen=s@AccountsScreen{}} = - st{aScreen=s{asState=is'}} +initAccountsScreen :: Maybe AccountName -> Day -> AppState -> AppState +initAccountsScreen mselacct d st@AppState{aopts=opts, aargs=args, ajournal=j, aScreen=s@AccountsScreen{}} = + 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 - -- 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 + valuedate = fromMaybe d $ queryEndDate False q + + (items,_total) = convert $ balanceReport ropts q j + 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 diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index c59a42934..5709f69ec 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/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 diff --git a/hledger-ui/Hledger/UI/Options.hs b/hledger-ui/Hledger/UI/Options.hs index 3d96c6824..f8a6a4095 100644 --- a/hledger-ui/Hledger/UI/Options.hs +++ b/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 ["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) "no eliding at all, stronger than --empty" - -- ,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total" + -- ,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" + ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "don't compress empty parent accounts on one line" + ,flagNone ["value","V"] (setboolopt "value") "show amounts as their market value in their default valuation commodity (accounts screen)" ] --uimode :: Mode [([Char], [Char])] diff --git a/hledger-ui/Hledger/UI/RegisterScreen2.hs b/hledger-ui/Hledger/UI/RegisterScreen2.hs index 370268ea2..695c350df 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen2.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen2.hs @@ -37,8 +37,8 @@ screen = RegisterScreen2{ ,sHandleFn = handleRegisterScreen2 } -initRegisterScreen2 :: Day -> [String] -> AppState -> AppState -initRegisterScreen2 d args st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen2{rs2Acct=acct}} = +initRegisterScreen2 :: Day -> AppState -> AppState +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 - -- _ -> "" + -- _ -> "" -- 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}}}, - aargs=_args, aScreen=RegisterScreen2{rs2State=l,rs2Acct=acct}} = [ui] +drawRegisterScreen2 AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}}, + 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" diff --git a/hledger-ui/Hledger/UI/Theme.hs b/hledger-ui/Hledger/UI/Theme.hs index 7b44ffc78..ee28af5fd 100644 --- a/hledger-ui/Hledger/UI/Theme.hs +++ b/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 diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index adfd25cea..0d1436afc 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/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] } diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index 3fa3c9227..6ce799372 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/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 = - topBottomBorderWithLabel label . +defaultLayout toplabel bottomlabel = + 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 -borderQuery "" = str "" -borderQuery qry = str " matching " <+> withAttr (borderAttr <> "query") (str qry) +borderQueryStr :: String -> Widget +borderQueryStr "" = str "" +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 = " "