From 332624f9fa3bd3e9b717b1824779cc737746f7ea Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 20 Oct 2019 07:12:14 -0700 Subject: [PATCH] ui: B and V keys toggle display of cost, value --- .../Reports/AccountTransactionsReport.hs | 30 ++++-- hledger-ui/Hledger/UI/AccountsScreen.hs | 2 + hledger-ui/Hledger/UI/RegisterScreen.hs | 2 + hledger-ui/Hledger/UI/TransactionScreen.hs | 96 ++++++++++++++----- hledger-ui/Hledger/UI/UIState.hs | 26 +++++ hledger-ui/Hledger/UI/UIUtils.hs | 2 + hledger-ui/hledger-ui.m4.md | 25 +++++ 7 files changed, 152 insertions(+), 31 deletions(-) diff --git a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs index 778b08c05..f02ff07f6 100644 --- a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs +++ b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs @@ -82,26 +82,44 @@ totallabel = "Period Total" balancelabel = "Historical Total" accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> AccountTransactionsReport -accountTransactionsReport opts j reportq thisacctq = (label, items) +accountTransactionsReport ropts j reportq thisacctq = (label, items) where -- a depth limit does not affect the account transactions report -- seems unnecessary for some reason XXX reportq' = -- filterQuery (not . queryIsDepth) reportq - -- get all transactions, with amounts converted to cost basis if -B - ts1 = jtxns $ journalSelectingAmountFromOpts opts j + + -- get all transactions + ts1 = jtxns j + -- apply any cur:SYM filters in reportq' symq = filterQuery queryIsSym reportq' ts2 = (if queryIsNull symq then id else map (filterTransactionAmounts symq)) ts1 + -- keep just the transactions affecting this account (via possibly realness or status-filtered postings) realq = filterQuery queryIsReal reportq' statusq = filterQuery queryIsStatus reportq' ts3 = filter (matchesTransaction thisacctq . filterTransactionPostings (And [realq, statusq])) ts2 + + -- maybe convert these transactions to cost or value + prices = journalPriceOracle j + styles = journalCommodityStyles j + periodlast = + fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen + reportPeriodOrJournalLastDay ropts j + mreportlast = reportPeriodLastDay ropts + today = fromMaybe (error' "journalApplyValuation: could not pick a valuation date, ReportOpts today_ is unset") $ today_ ropts + multiperiod = interval_ ropts /= NoInterval + tval = case value_ ropts of + Just v -> \t -> transactionApplyValuation prices styles periodlast mreportlast today multiperiod t v + Nothing -> id + ts4 = map tval ts3 + -- sort by the transaction's register date, for accurate starting balance - ts = sortBy (comparing (transactionRegisterDate reportq' thisacctq)) ts3 + ts = sortBy (comparing (transactionRegisterDate reportq' thisacctq)) ts4 (startbal,label) - | balancetype_ opts == HistoricalBalance = (sumPostings priorps, balancelabel) + | balancetype_ ropts == HistoricalBalance = (sumPostings priorps, balancelabel) | otherwise = (nullmixedamt, totallabel) where priorps = dbg1 "priorps" $ @@ -113,7 +131,7 @@ accountTransactionsReport opts j reportq thisacctq = (label, items) case mstartdate of Just _ -> Date (DateSpan Nothing mstartdate) Nothing -> None -- no start date specified, there are no prior postings - mstartdate = queryStartDate (date2_ opts) reportq' + mstartdate = queryStartDate (date2_ ropts) reportq' datelessreportq = filterQuery (not . queryIsDateOrDate2) reportq' items = reverse $ diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index b2989f2af..3611352fa 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -311,6 +311,8 @@ asHandle ui0@UIState{ 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 endPos (journalFilePath j)) >> uiReloadJournalIfChanged copts d j ui + VtyEvent (EvKey (KChar 'B') []) -> continue $ regenerateScreens j d $ toggleCost ui + VtyEvent (EvKey (KChar 'V') []) -> continue $ regenerateScreens j d $ toggleValue ui VtyEvent (EvKey (KChar '0') []) -> continue $ regenerateScreens j d $ setDepth (Just 0) ui VtyEvent (EvKey (KChar '1') []) -> continue $ regenerateScreens j d $ setDepth (Just 1) ui VtyEvent (EvKey (KChar '2') []) -> continue $ regenerateScreens j d $ setDepth (Just 2) ui diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index f94f6c601..33199069d 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -322,6 +322,8 @@ rsHandle ui@UIState{ rsItemTransaction=Transaction{tsourcepos=JournalSourcePos f (l,_)}}) -> (Just (l, Nothing),f) -- display mode/query toggles + VtyEvent (EvKey (KChar 'B') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleCost ui + VtyEvent (EvKey (KChar 'V') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleValue ui VtyEvent (EvKey (KChar 'H') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleHistorical ui VtyEvent (EvKey (KChar 'T') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleTree ui VtyEvent (EvKey (KChar 'Z') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleEmpty ui diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index f315d46ad..84bbf1334 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -12,6 +12,7 @@ where import Control.Monad import Control.Monad.IO.Class (liftIO) import Data.List +import Data.Maybe #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif @@ -43,12 +44,22 @@ transactionScreen = TransactionScreen{ tsInit :: Day -> Bool -> UIState -> UIState tsInit _d _reset ui@UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}} - ,ajournal=_j - ,aScreen=TransactionScreen{..}} = ui + ,ajournal=_j + ,aScreen=TransactionScreen{..} + } = + -- plog ("initialising TransactionScreen, value_ is " + -- -- ++ (pshow (Just (AtDefault Nothing)::Maybe ValuationType)) + -- ++(pshow (value_ _ropts)) -- XXX calling value_ here causes plog to fail with: debug.log: openFile: resource busy (file is locked) + -- ++ "?" + -- ++" and first commodity is") + -- (acommodity$head$amounts$pamount$head$tpostings$snd$tsTransaction) + -- `seq` + ui tsInit _ _ _ = error "init function called with wrong screen type, should not happen" tsDraw :: UIState -> [Widget Name] tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} + ,ajournal=j ,aScreen=TransactionScreen{tsTransaction=(i,t) ,tsTransactions=nts ,tsAccount=acct @@ -61,8 +72,20 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} _ -> [maincontent] where maincontent = Widget Greedy Greedy $ do + let + prices = journalPriceOracle j + styles = journalCommodityStyles j + periodlast = + fromMaybe (error' "TransactionScreen: expected a non-empty journal") $ -- XXX shouldn't happen + reportPeriodOrJournalLastDay ropts j + mreportlast = reportPeriodLastDay ropts + today = fromMaybe (error' "TransactionScreen: could not pick a valuation date, ReportOpts today_ is unset") $ today_ ropts + multiperiod = interval_ ropts /= NoInterval + render $ defaultLayout toplabel bottomlabel $ str $ showTransactionOneLineAmounts $ + (if valuationTypeIsCost ropts then transactionToCost (journalCommodityStyles j) else id) $ + (if valuationTypeIsDefaultValue ropts then (\t -> transactionApplyValuation prices styles periodlast mreportlast today multiperiod t (AtDefault Nothing)) else id) $ -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real t where @@ -142,38 +165,35 @@ tsHandle ui@UIState{aScreen=s@TransactionScreen{tsTransaction=(i,t) where p = reportPeriod ui e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> do + -- plog (if e == AppEvent FileChange then "file change" else "manual reload") "" `seq` return () d <- liftIO getCurrentDay ej <- liftIO $ journalReload copts case ej of Left err -> continue $ screenEnter d errorScreen{esError=err} ui Right j' -> do - -- got to redo the register screen's transactions report, to get the latest transactions list for this screen - -- XXX duplicates rsInit - let - ropts' = ropts {depth_=Nothing - ,balancetype_=HistoricalBalance - } - q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts' - thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs - items = reverse $ snd $ accountTransactionsReport ropts j' q thisacctq - ts = map first6 items - numberedts = zip [1..] ts - -- select the best current transaction from the new list - -- stay at the same index if possible, or if we are now past the end, select the last, otherwise select the first - (i',t') = case lookup i numberedts - of Just t'' -> (i,t'') - Nothing | null numberedts -> (0,nulltransaction) - | i > fst (last numberedts) -> last numberedts - | otherwise -> head numberedts - ui' = ui{aScreen=s{tsTransaction=(i',t') - ,tsTransactions=numberedts - ,tsAccount=acct}} - continue $ regenerateScreens j' d ui' + continue $ + regenerateScreens j' d $ + regenerateTransactions ropts d j' s acct i $ -- added (inline) 201512 (why ?) + clearCostValue $ + ui VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui) - -- if allowing toggling here, we should refresh the txn list from the parent register screen + + -- for toggles that may change the current/prev/next transactions, + -- we must regenerate the transaction list, like the g handler above ? with regenerateTransactions ? TODO WIP -- EvKey (KChar 'E') [] -> continue $ regenerateScreens j d $ stToggleEmpty ui -- EvKey (KChar 'C') [] -> continue $ regenerateScreens j d $ stToggleCleared ui -- EvKey (KChar 'R') [] -> continue $ regenerateScreens j d $ stToggleReal ui + VtyEvent (EvKey (KChar 'B') []) -> + continue $ + regenerateScreens j d $ + -- regenerateTransactions ropts d j s acct i $ + toggleCost ui + VtyEvent (EvKey (KChar 'V') []) -> + continue $ + regenerateScreens j d $ + -- regenerateTransactions ropts d j s acct i $ + toggleValue ui + VtyEvent e | e `elem` moveUpEvents -> continue $ regenerateScreens j d ui{aScreen=s{tsTransaction=(iprev,tprev)}} VtyEvent e | e `elem` moveDownEvents -> continue $ regenerateScreens j d ui{aScreen=s{tsTransaction=(inext,tnext)}} VtyEvent e | e `elem` moveLeftEvents -> continue ui'' @@ -186,6 +206,32 @@ tsHandle ui@UIState{aScreen=s@TransactionScreen{tsTransaction=(i,t) tsHandle _ _ = error "event handler called with wrong screen type, should not happen" +-- Got to redo the register screen's transactions report, to get the latest transactions list for this screen. +-- XXX Duplicates rsInit. Why do we have to do this as well as regenerateScreens ? +regenerateTransactions :: ReportOpts -> Day -> Journal -> Screen -> AccountName -> Integer -> UIState -> UIState +regenerateTransactions ropts d j s acct i ui = + let + ropts' = ropts {depth_=Nothing + ,balancetype_=HistoricalBalance + } + q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts' + thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs + items = reverse $ snd $ accountTransactionsReport ropts j q thisacctq + ts = map first6 items + numberedts = zip [1..] ts + -- select the best current transaction from the new list + -- stay at the same index if possible, or if we are now past the end, select the last, otherwise select the first + (i',t') = case lookup i numberedts + of Just t'' -> (i,t'') + Nothing | null numberedts -> (0,nulltransaction) + | i > fst (last numberedts) -> last numberedts + | otherwise -> head numberedts + in + ui{aScreen=s{tsTransaction=(i',t') + ,tsTransactions=numberedts + ,tsAccount=acct + }} + -- | Select the nth item on the register screen. rsSelect i scr@RegisterScreen{..} = scr{rsList=l'} where l' = listMoveTo (i-1) rsList diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs index 6bf9eed22..44c412c60 100644 --- a/hledger-ui/Hledger/UI/UIState.hs +++ b/hledger-ui/Hledger/UI/UIState.hs @@ -108,6 +108,32 @@ toggleEmpty ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=rop where toggleEmpty ropts = ropts{empty_=not $ empty_ ropts} +-- | Show primary amounts, not cost or value. +clearCostValue :: UIState -> UIState +clearCostValue ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = + ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{value_ = plog "clearing value mode" Nothing}}}} + +-- | Toggle between showing the primary amounts or costs. +toggleCost :: UIState -> UIState +toggleCost ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = + ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{value_ = valuationToggleCost $ value_ ropts}}}} + +-- | Toggle between showing primary amounts or default valuation. +toggleValue :: UIState -> UIState +toggleValue ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = + ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{ + value_ = plog "toggling value mode to" $ valuationToggleValue $ value_ ropts}}}} + +-- | Basic toggling of -B/cost, for hledger-ui. +valuationToggleCost :: Maybe ValuationType -> Maybe ValuationType +valuationToggleCost (Just (AtCost _)) = Nothing +valuationToggleCost _ = Just $ AtCost Nothing + +-- | Basic toggling of -V, for hledger-ui. +valuationToggleValue :: Maybe ValuationType -> Maybe ValuationType +valuationToggleValue (Just (AtDefault _)) = Nothing +valuationToggleValue _ = Just $ AtDefault Nothing + -- | Toggle between flat and tree mode. If current mode is unspecified/default, assume it's flat. toggleTree :: UIState -> UIState toggleTree ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index 24aedd08b..123a5a38b 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -134,8 +134,10 @@ helpDialog _copts = ,withAttr ("help" <> "heading") $ str "Other" ,renderKey ("a ", "add transaction (hledger add)") ,renderKey ("A ", "add transaction (hledger-iadd)") + ,renderKey ("B ", "toggle normal/cost mode") ,renderKey ("E ", "open editor") ,renderKey ("I ", "toggle balance assertions") + ,renderKey ("V ", "toggle normal/value mode") ,renderKey ("g ", "reload data") ,renderKey ("C-l ", "redraw & recenter") ,renderKey ("C-z ", "suspend") diff --git a/hledger-ui/hledger-ui.m4.md b/hledger-ui/hledger-ui.m4.md index fb7deb135..4cc51225e 100644 --- a/hledger-ui/hledger-ui.m4.md +++ b/hledger-ui/hledger-ui.m4.md @@ -161,6 +161,31 @@ when invoked from the error screen. `q` quits the application. +Experimental: + +`B` toggles cost mode, showing amounts in their transaction price's +commodity (like toggling the +[`-B/--cost`](https://hledger.org/hledger.html#b-cost) flag). + +`V` toggles value mode, showing amounts' current market value in their +default valuation commodity (like toggling the +[`-V/--market`](https://hledger.org/hledger.html#v-market-value) flag). +Note, "current market value" means the value on the report end date if specified, otherwise today. +To see the value on another date, such as the transaction's date, you can +temporarily set a date filter ending on the following day. +Eg to see the contemporaneous value of a transaction on july 30, +go to the accounts or register screen, press `/`, add ` date:-7/30`. + +At most one of cost or value mode can be active at once (in hledger-ui). + +There's not yet any visual reminder when cost or value mode is active; +for now pressing `B` `B` `V` should reliably reset to normal mode. + +With --watch active, if you save an edit to the journal file +while viewing the transaction screen in cost or value mode, +the `B`/`V` keys will stop working. +To work around, press g to force a manual reload, or exit the transaction screen. + Additional screen-specific keys are described below. # SCREENS