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.
This commit is contained in:
Simon Michael
parent
68cd35c965
commit
11fee9fbe8
@ -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
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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
|
||||
-- -- _ -> "<split>" -- 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"
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user