From 11fee9fbe883b1917fde54aa17e6b9bab1bef0dc Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 29 Oct 2015 18:05:02 -0700 Subject: [PATCH] ui: txn: show multi-commodity amounts on one line In the transaction screen, show multi-commodity posting amounts on one line, consistent with the rest of hledger-ui. --- hledger-lib/Hledger/Data/Amount.hs | 21 ++-- hledger-lib/Hledger/Data/Transaction.hs | 33 +++--- hledger-ui/Hledger/UI/TransactionScreen.hs | 123 ++------------------- 3 files changed, 42 insertions(+), 135 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 57c24b61d..2bca8cba8 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -87,6 +87,7 @@ module Hledger.Data.Amount ( isReallyZeroMixedAmountCost, -- ** rendering showMixedAmount, + showMixedAmountOneLine, showMixedAmountDebug, showMixedAmountWithoutPrice, showMixedAmountOneLineWithoutPrice, @@ -519,19 +520,25 @@ isReallyZeroMixedAmountCost = isReallyZeroMixedAmount . costOfMixedAmount -- normalising it to one amount per commodity. Assumes amounts have -- no or similar prices, otherwise this can show misleading prices. showMixedAmount :: MixedAmount -> String -showMixedAmount = showMixedAmountHelper False +showMixedAmount = showMixedAmountHelper False False -- | Like showMixedAmount, but zero amounts are shown with their -- commodity if they have one. showMixedAmountWithZeroCommodity :: MixedAmount -> String -showMixedAmountWithZeroCommodity = showMixedAmountHelper True +showMixedAmountWithZeroCommodity = showMixedAmountHelper True False -showMixedAmountHelper :: Bool -> MixedAmount -> String -showMixedAmountHelper showzerocommodity m = - vConcatRightAligned $ map showw $ amounts $ normaliseMixedAmountSquashPricesForDisplay m +-- | Get the one-line string representation of a mixed amount. +showMixedAmountOneLine :: MixedAmount -> String +showMixedAmountOneLine = showMixedAmountHelper False True + +showMixedAmountHelper :: Bool -> Bool -> MixedAmount -> String +showMixedAmountHelper showzerocommodity useoneline m = + join $ map showamt $ amounts $ normaliseMixedAmountSquashPricesForDisplay m where - showw | showzerocommodity = showAmountWithZeroCommodity - | otherwise = showAmount + join | useoneline = intercalate ", " + | otherwise = vConcatRightAligned + showamt | showzerocommodity = showAmountWithZeroCommodity + | otherwise = showAmount -- | Compact labelled trace of a mixed amount, for debugging. ltraceamount :: String -> MixedAmount -> MixedAmount diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index ad5df6cf2..b3de52312 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -30,6 +30,7 @@ module Hledger.Data.Transaction ( -- * rendering showTransaction, showTransactionUnelided, + showTransactionUnelidedOneLineAmounts, -- * misc. tests_Hledger_Data_Transaction ) @@ -89,10 +90,10 @@ pcommentwidth = no limit -- 22 @ -} showTransaction :: Transaction -> String -showTransaction = showTransaction' True +showTransaction = showTransactionHelper True False showTransactionUnelided :: Transaction -> String -showTransactionUnelided = showTransaction' False +showTransactionUnelided = showTransactionHelper False False tests_showTransactionUnelided = [ "showTransactionUnelided" ~: do @@ -127,12 +128,15 @@ tests_showTransactionUnelided = [ ] ] +showTransactionUnelidedOneLineAmounts :: Transaction -> String +showTransactionUnelidedOneLineAmounts = showTransactionHelper False True + -- cf showPosting -showTransaction' :: Bool -> Transaction -> String -showTransaction' elide t = +showTransactionHelper :: Bool -> Bool -> Transaction -> String +showTransactionHelper elide onelineamounts t = unlines $ [descriptionline] ++ newlinecomments - ++ (postingsAsLines elide t (tpostings t)) + ++ (postingsAsLines elide onelineamounts t (tpostings t)) ++ [""] where descriptionline = rstrip $ concat [date, status, code, desc, samelinecomment] @@ -164,14 +168,14 @@ renderCommentLines s = case lines s of ("":ls) -> "":map commentprefix ls -- ls = lines s -- prefix = indent . (";"++) -postingsAsLines :: Bool -> Transaction -> [Posting] -> [String] -postingsAsLines elide t ps +postingsAsLines :: Bool -> Bool -> Transaction -> [Posting] -> [String] +postingsAsLines elide onelineamounts t ps | elide && length ps > 1 && isTransactionBalanced Nothing t -- imprecise balanced check - = (concatMap (postingAsLines False ps) $ init ps) ++ postingAsLines True ps (last ps) - | otherwise = concatMap (postingAsLines False ps) ps + = (concatMap (postingAsLines False onelineamounts ps) $ init ps) ++ postingAsLines True onelineamounts ps (last ps) + | otherwise = concatMap (postingAsLines False onelineamounts ps) ps -postingAsLines :: Bool -> [Posting] -> Posting -> [String] -postingAsLines elideamount ps p = +postingAsLines :: Bool -> Bool -> [Posting] -> Posting -> [String] +postingAsLines elideamount onelineamounts ps p = postinglines ++ newlinecomments where @@ -186,8 +190,9 @@ postingAsLines elideamount ps p = -- currently prices are considered part of the amount string when right-aligning amounts amount - | elideamount = "" - | otherwise = fitStringMulti (Just amtwidth) Nothing False False $ showMixedAmount $ pamount p + | elideamount = "" + | onelineamounts = fitString (Just amtwidth) Nothing False False $ showMixedAmountOneLine $ pamount p + | otherwise = fitStringMulti (Just amtwidth) Nothing False False $ showMixedAmount $ pamount p where amtwidth = maximum $ 12 : map (strWidth . showMixedAmount . pamount) ps -- min. 12 for backwards compatibility @@ -197,7 +202,7 @@ postingAsLines elideamount ps p = tests_postingAsLines = [ "postingAsLines" ~: do - let p `gives` ls = assertEqual "" ls (postingAsLines False [p] p) + let p `gives` ls = assertEqual "" ls (postingAsLines False False [p] p) posting `gives` [" 0"] posting{ pstatus=Cleared, diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 05ad4a5de..f44310ee9 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -1,10 +1,9 @@ --- The transaction screen, showing the general journal entry representing a single transaction. +-- The transaction screen, showing a single transaction's general journal entry. {-# LANGUAGE OverloadedStrings #-} -- , FlexibleContexts module Hledger.UI.TransactionScreen (screen - -- ,tsSetCurrentAccount ) where @@ -39,128 +38,24 @@ screen = TransactionScreen{ ,sHandleFn = handleTransactionScreen } --- tsSetCurrentAccount a scr@TransactionScreen{tsState=(l,_)} = scr{tsState=(l,a)} --- tsSetCurrentAccount _ scr = scr - initTransactionScreen :: Day -> AppState -> AppState -initTransactionScreen _d st@AppState{aopts=_opts, ajournal=_j, aScreen=_s@TransactionScreen{tsState=_t}} = - st - -- where - -- -- gather arguments and queries - -- ropts = (reportopts_ $ cliopts_ opts) - -- { - -- depth_=Nothing, - -- balancetype_=HistoricalBalance - -- } - -- -- XXX temp - -- thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs - -- q = filterQuery (not . queryIsDepth) $ queryFromOpts d ropts - - -- -- run a transactions report, most recent last - -- q' = - -- -- ltrace "q" - -- q - -- thisacctq' = - -- -- ltrace "thisacctq" - -- thisacctq - -- (_label,items') = accountTransactionsReport ropts j q' thisacctq' - -- items = reverse items' - - -- -- pre-render all items; these will be the List elements. This helps calculate column widths. - -- displayitem (_, t, _issplit, otheracctsstr, change, bal) = - -- (showDate $ tdate t - -- ,tdescription t - -- ,case splitOn ", " otheracctsstr of - -- [s] -> s - -- ss -> intercalate ", " ss - -- -- _ -> "" -- should do this if accounts field width < 30 - -- ,showMixedAmountOneLineWithoutPrice change - -- ,showMixedAmountOneLineWithoutPrice bal - -- ) - -- displayitems = map displayitem items - - -- -- build the List, moving the selection to the end - -- l = listMoveTo (length items) $ - -- list (Name "register") (V.fromList displayitems) 1 - - -- -- (listName someList) - +initTransactionScreen _d st@AppState{aopts=_opts, ajournal=_j, aScreen=_s@TransactionScreen{tsState=_t}} = st initTransactionScreen _ _ = error "init function called with wrong screen type, should not happen" drawTransactionScreen :: AppState -> [Widget] drawTransactionScreen AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}}, - aScreen=TransactionScreen{tsState=t}} = [ui] + aScreen=TransactionScreen{tsState=t}} = [ui] where toplabel = str "Transaction " <+> withAttr ("border" <> "bold") (str $ show (tdate t) ++ " " ++ tdescription t) - -- <+> str " of " - -- <+> str " (" - -- <+> cur - -- <+> str "/" - -- <+> total - -- <+> str ")" - -- cur = str $ case l^.listSelectedL of - -- Nothing -> "-" - -- Just i -> show (i + 1) - -- total = str $ show $ length displayitems - -- displayitems = V.toList $ l^.listElementsL - - -- query = query_ $ reportopts_ $ cliopts_ opts - + bottomlabel = borderKeysStr [ + ("left", "return to register") + ,("g", "reload") + ,("q", "quit") + ] ui = Widget Greedy Greedy $ do - - -- calculate column widths, based on current available width - -- c <- getContext - let - -- totalwidth = c^.availWidthL - -- - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils) - - -- -- the date column is fixed width - -- datewidth = 10 - - -- -- multi-commodity amounts rendered on one line can be - -- -- arbitrarily wide. Give the two amounts as much space as - -- -- they need, while reserving a minimum of space for other - -- -- columns and whitespace. If they don't get all they need, - -- -- allocate it to them proportionally to their maximum widths. - -- whitespacewidth = 10 -- inter-column whitespace, fixed width - -- minnonamtcolswidth = datewidth + 2 + 2 -- date column plus at least 2 for desc and accts - -- maxamtswidth = max 0 (totalwidth - minnonamtcolswidth - whitespacewidth) - -- maxchangewidthseen = maximum' $ map (strWidth . fourth5) displayitems - -- maxbalwidthseen = maximum' $ map (strWidth . fifth5) displayitems - -- changewidthproportion = fromIntegral maxchangewidthseen / fromIntegral (maxchangewidthseen + maxbalwidthseen) - -- maxchangewidth = round $ changewidthproportion * fromIntegral maxamtswidth - -- maxbalwidth = maxamtswidth - maxchangewidth - -- changewidth = min maxchangewidth maxchangewidthseen - -- balwidth = min maxbalwidth maxbalwidthseen - - -- -- assign the remaining space to the description and accounts columns - -- -- maxdescacctswidth = totalwidth - (whitespacewidth - 4) - changewidth - balwidth - -- maxdescacctswidth = - -- -- trace (show (totalwidth, datewidth, changewidth, balwidth, whitespacewidth)) $ - -- max 0 (totalwidth - datewidth - changewidth - balwidth - whitespacewidth) - -- -- allocating proportionally. - -- -- descwidth' = maximum' $ map (strWidth . second5) displayitems - -- -- acctswidth' = maximum' $ map (strWidth . third5) displayitems - -- -- descwidthproportion = (descwidth' + acctswidth') / descwidth' - -- -- maxdescwidth = min (maxdescacctswidth - 7) (maxdescacctswidth / descwidthproportion) - -- -- maxacctswidth = maxdescacctswidth - maxdescwidth - -- -- descwidth = min maxdescwidth descwidth' - -- -- acctswidth = min maxacctswidth acctswidth' - -- -- allocating equally. - -- descwidth = maxdescacctswidth `div` 2 - -- acctswidth = maxdescacctswidth - descwidth - -- colwidths = (datewidth,descwidth,acctswidth,changewidth,balwidth) - - bottomlabel = borderKeysStr [ - -- ("up/down/pgup/pgdown/home/end", "move") - ("left", "return to register") - ,("g", "reload") - ,("q", "quit") - ] - - render $ defaultLayout toplabel bottomlabel $ str $ showTransactionUnelided t + render $ defaultLayout toplabel bottomlabel $ str $ showTransactionUnelidedOneLineAmounts t drawTransactionScreen _ = error "draw function called with wrong screen type, should not happen"