From b9c00dce61a7ea595e128d13ce7fc557956e563d Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Tue, 22 Dec 2020 23:35:20 +1100 Subject: [PATCH] lib,cli,ui: Implement all showMixed* functions in terms of DisplayAmountOpts and WideBuilder. --- hledger-lib/Hledger/Data/Amount.hs | 221 ++++++++++---------- hledger-lib/Hledger/Data/Posting.hs | 2 +- hledger-lib/Hledger/Data/Transaction.hs | 16 +- hledger-lib/Hledger/Reports/BudgetReport.hs | 11 +- hledger-ui/Hledger/UI/RegisterScreen.hs | 6 +- hledger/Hledger/Cli/Commands/Add.hs | 2 +- hledger/Hledger/Cli/Commands/Aregister.hs | 11 +- hledger/Hledger/Cli/Commands/Balance.hs | 12 +- hledger/Hledger/Cli/Commands/Register.hs | 14 +- 9 files changed, 152 insertions(+), 143 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index f960dd7d3..c2411092e 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -68,10 +68,15 @@ module Hledger.Data.Amount ( multiplyAmountAndPrice, amountTotalPriceToUnitPrice, -- ** rendering + AmountDisplayOpts(..), + noColour, + noPrice, + oneLine, amountstyle, styleAmount, styleAmountExceptPrecision, amountUnstyled, + showAmountB, showAmount, cshowAmount, showAmountWithZeroCommodity, @@ -119,11 +124,7 @@ module Hledger.Data.Amount ( showMixedAmountOneLineWithoutPrice, showMixedAmountElided, showMixedAmountWithZeroCommodity, - showMixedAmountWithPrecision, showMixed, - showMixedUnnormalised, - showMixedOneLine, - showMixedOneLineUnnormalised, setMixedAmountPrecision, canonicaliseMixedAmount, -- * misc. @@ -135,8 +136,8 @@ import Control.Monad (foldM) import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo) import Data.Default (Default(..)) import Data.Function (on) -import Data.List (genericSplitAt, groupBy, intercalate, mapAccumL, - partition, sortBy) +import Data.List (groupBy, intercalate, intersperse, mapAccumL, partition, + sortBy) import Data.List.NonEmpty (NonEmpty(..), nonEmpty) import qualified Data.Map as M import Data.Map (findWithDefault) @@ -144,7 +145,7 @@ import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.Lazy.Builder as TB import Data.Word (Word8) -import Safe (lastDef, lastMay) +import Safe (headDef, lastDef, lastMay) import Text.Printf (printf) import Hledger.Data.Types @@ -154,12 +155,15 @@ import Hledger.Utils deriving instance Show MarketPrice +-- | Options for the display of Amount and MixedAmount. data AmountDisplayOpts = AmountDisplayOpts - { displayPrice :: Bool -- ^ Whether to display the Price of an Amount. - , displayZeroCommodity :: Bool -- ^ If the Amount rounds to 0, whether to display its commodity string. - , displayColour :: Bool -- ^ Whether to colourise negative Amounts. - , displayNormalised :: Bool -- ^ Whether to normalise MixedAmounts before displaying. - , displayOneLine :: Bool -- ^ Whether to display on one line. + { displayPrice :: Bool -- ^ Whether to display the Price of an Amount. + , displayZeroCommodity :: Bool -- ^ If the Amount rounds to 0, whether to display its commodity string. + , displayColour :: Bool -- ^ Whether to colourise negative Amounts. + , displayNormalised :: Bool -- ^ Whether to normalise MixedAmounts before displaying. + , displayOneLine :: Bool -- ^ Whether to display on one line. + , displayMinWidth :: Maybe Int -- ^ Minimum width to pad to + , displayMaxWidth :: Maybe Int -- ^ Maximum width to clip to } deriving (Show) instance Default AmountDisplayOpts where @@ -168,8 +172,22 @@ instance Default AmountDisplayOpts where , displayZeroCommodity = False , displayNormalised = True , displayOneLine = False + , displayMinWidth = Nothing + , displayMaxWidth = Nothing } +-- | Display Amount and MixedAmount with no colour. +noColour :: AmountDisplayOpts +noColour = def{displayColour=False} + +-- | Display Amount and MixedAmount with no prices. +noPrice :: AmountDisplayOpts +noPrice = def{displayPrice=False} + +-- | Display Amount and MixedAmount on one line with no prices. +oneLine :: AmountDisplayOpts +oneLine = def{displayOneLine=True, displayPrice=False} + ------------------------------------------------------------------------------- -- Amount styles @@ -348,8 +366,8 @@ withDecimalPoint = flip setAmountDecimalPoint showAmountPrice :: Maybe AmountPrice -> WideBuilder showAmountPrice Nothing = mempty -showAmountPrice (Just (UnitPrice pa)) = WideBuilder (TB.fromString " @ ") 3 <> showAmountB def{displayColour=False} pa -showAmountPrice (Just (TotalPrice pa)) = WideBuilder (TB.fromString " @@ ") 4 <> showAmountB def{displayColour=False} pa +showAmountPrice (Just (UnitPrice pa)) = WideBuilder (TB.fromString " @ ") 3 <> showAmountB noColour pa +showAmountPrice (Just (TotalPrice pa)) = WideBuilder (TB.fromString " @@ ") 4 <> showAmountB noColour pa showAmountPriceDebug :: Maybe AmountPrice -> String showAmountPriceDebug Nothing = "" @@ -381,7 +399,7 @@ amountUnstyled a = a{astyle=amountstyle} -- zero are converted to just \"0\". The special "missing" amount is -- displayed as the empty string. showAmount :: Amount -> String -showAmount = wbUnpack . showAmountB def{displayColour=False} +showAmount = wbUnpack . showAmountB noColour -- | Get the string representation of an amount, based on its -- commodity's display settings and the display options. The @@ -395,7 +413,7 @@ showAmountB opts a@Amount{astyle=style} = where quantity = showamountquantity a (quantity',c) | amountLooksZero a && not (displayZeroCommodity opts) = (WideBuilder (TB.singleton '0') 1,"") - | otherwise = (quantity, quoteCommoditySymbolIfNeeded $ acommodity a) + | otherwise = (quantity, quoteCommoditySymbolIfNeeded $ acommodity a) space = if not (T.null c) && ascommodityspaced style then WideBuilder (TB.singleton ' ') 1 else mempty c' = WideBuilder (TB.fromText c) (textWidth c) price = if displayPrice opts then showAmountPrice (aprice a) else mempty @@ -408,16 +426,11 @@ cshowAmount = wbUnpack . showAmountB def -- | Get the string representation of an amount, without any \@ price. showAmountWithoutPrice :: Amount -> String -showAmountWithoutPrice = wbUnpack . showAmountB def{displayColour=False, displayPrice=False} - --- | Get the string representation of an amount, based on its commodity's --- display settings except using the specified precision. -showAmountWithPrecision :: AmountPrecision -> Amount -> String -showAmountWithPrecision p = showAmount . setAmountPrecision p +showAmountWithoutPrice = wbUnpack . showAmountB noPrice{displayColour=False} -- | Like showAmount, but show a zero amount's commodity if it has one. showAmountWithZeroCommodity :: Amount -> String -showAmountWithZeroCommodity = wbUnpack . showAmountB def{displayColour=False, displayZeroCommodity=True} +showAmountWithZeroCommodity = wbUnpack . showAmountB noColour{displayZeroCommodity=True} -- | Get a string representation of an amount for debugging, -- appropriate to the current debug level. 9 shows maximum detail. @@ -434,29 +447,29 @@ showamountquantity amt@Amount{astyle=AmountStyle{asdecimalpoint=mdec, asdigitgro where Decimal e n = amountRoundedQuantity amt - strN = show $ abs n - len = length strN + strN = T.pack . show $ abs n + len = T.length strN intLen = max 1 $ len - fromIntegral e dec = fromMaybe '.' mdec - padded = replicate (fromIntegral e + 1 - len) '0' ++ strN - (intPart, fracPart) = splitAt intLen padded + padded = T.replicate (fromIntegral e + 1 - len) "0" <> strN + (intPart, fracPart) = T.splitAt intLen padded intB = applyDigitGroupStyle mgrps intLen $ if e == 0 then strN else intPart signB = if n < 0 then WideBuilder (TB.singleton '-') 1 else mempty - fracB = if e > 0 then WideBuilder (TB.singleton dec <> TB.fromString fracPart) (fromIntegral e + 1) else mempty + fracB = if e > 0 then WideBuilder (TB.singleton dec <> TB.fromText fracPart) (fromIntegral e + 1) else mempty -- | Split a string representation into chunks according to DigitGroupStyle, -- returning a Text builder and the number of separators used. -applyDigitGroupStyle :: Maybe DigitGroupStyle -> Int -> String -> WideBuilder -applyDigitGroupStyle Nothing l s = WideBuilder (TB.fromString s) l -applyDigitGroupStyle (Just (DigitGroups _ [])) l s = WideBuilder (TB.fromString s) l +applyDigitGroupStyle :: Maybe DigitGroupStyle -> Int -> T.Text -> WideBuilder +applyDigitGroupStyle Nothing l s = WideBuilder (TB.fromText s) l +applyDigitGroupStyle (Just (DigitGroups _ [])) l s = WideBuilder (TB.fromText s) l applyDigitGroupStyle (Just (DigitGroups c (g:gs))) l s = addseps (g:|gs) (toInteger l) s where addseps (g:|gs) l s - | l' > 0 = addseps gs' l' rest <> WideBuilder (TB.singleton c <> TB.fromString part) (fromIntegral g + 1) - | otherwise = WideBuilder (TB.fromString s) (fromInteger l) + | l' > 0 = addseps gs' l' rest <> WideBuilder (TB.singleton c <> TB.fromText part) (fromIntegral g + 1) + | otherwise = WideBuilder (TB.fromText s) (fromInteger l) where - (rest, part) = genericSplitAt l' s + (rest, part) = T.splitAt (fromInteger l') s gs' = fromMaybe (g:|[]) $ nonEmpty gs l' = l - toInteger g @@ -651,39 +664,33 @@ mixedAmountUnstyled = mapMixedAmount amountUnstyled -- normalising it to one amount per commodity. Assumes amounts have -- no or similar prices, otherwise this can show misleading prices. showMixedAmount :: MixedAmount -> String -showMixedAmount = fst . showMixed showAmount Nothing Nothing False +showMixedAmount = wbUnpack . showMixed noColour -- | Get the one-line string representation of a mixed amount. showMixedAmountOneLine :: MixedAmount -> String -showMixedAmountOneLine = fst . showMixedOneLine showAmountWithoutPrice Nothing Nothing False +showMixedAmountOneLine = wbUnpack . showMixed oneLine{displayColour=False} -- | Like showMixedAmount, but zero amounts are shown with their -- commodity if they have one. showMixedAmountWithZeroCommodity :: MixedAmount -> String -showMixedAmountWithZeroCommodity = fst . showMixed showAmountWithZeroCommodity Nothing Nothing False - --- | Get the string representation of a mixed amount, showing each of its --- component amounts with the specified precision, ignoring their --- commoditys' display precision settings. -showMixedAmountWithPrecision :: AmountPrecision -> MixedAmount -> String -showMixedAmountWithPrecision p = fst . showMixed (showAmountWithPrecision p) Nothing Nothing False +showMixedAmountWithZeroCommodity = wbUnpack . showMixed noColour{displayZeroCommodity=True} -- | Get the string representation of a mixed amount, without showing any transaction prices. -- With a True argument, adds ANSI codes to show negative amounts in red. showMixedAmountWithoutPrice :: Bool -> MixedAmount -> String -showMixedAmountWithoutPrice c = fst . showMixed showAmountWithoutPrice Nothing Nothing c +showMixedAmountWithoutPrice c = wbUnpack . showMixed noPrice{displayColour=c} -- | Get the one-line string representation of a mixed amount, but without -- any \@ prices. -- With a True argument, adds ANSI codes to show negative amounts in red. showMixedAmountOneLineWithoutPrice :: Bool -> MixedAmount -> String -showMixedAmountOneLineWithoutPrice c = fst . showMixedOneLine showAmountWithoutPrice Nothing Nothing c +showMixedAmountOneLineWithoutPrice c = wbUnpack . showMixed oneLine{displayColour=c} -- | Like showMixedAmountOneLineWithoutPrice, but show at most the given width, -- with an elision indicator if there are more. -- With a True argument, adds ANSI codes to show negative amounts in red. showMixedAmountElided :: Int -> Bool -> MixedAmount -> String -showMixedAmountElided w c = fst . showMixedOneLine showAmountWithoutPrice Nothing (Just w) c +showMixedAmountElided w c = wbUnpack . showMixed oneLine{displayColour=c, displayMaxWidth=Just w} -- | Get an unambiguous string representation of a mixed amount for debugging. showMixedAmountDebug :: MixedAmount -> String @@ -691,59 +698,62 @@ showMixedAmountDebug m | m == missingmixedamt = "(missing)" | otherwise = printf "Mixed [%s]" as where as = intercalate "\n " $ map showAmountDebug $ amounts m --- | General function to display a MixedAmount, one Amount on each line. --- It takes a function to display each Amount, an optional minimum width --- to pad to, an optional maximum width to display, and a Bool to determine --- whether to colourise negative numbers. Amounts longer than the maximum --- width (if given) will be elided. The function also returns the actual --- width of the output string. -showMixed :: (Amount -> String) -> Maybe Int -> Maybe Int -> Bool -> MixedAmount -> (String, Int) -showMixed showamt mmin mmax c = - showMixedUnnormalised showamt mmin mmax c . normaliseMixedAmountSquashPricesForDisplay - --- | Like showMixed, but does not normalise the MixedAmount before displaying. -showMixedUnnormalised :: (Amount -> String) -> Maybe Int -> Maybe Int -> Bool -> MixedAmount -> (String, Int) -showMixedUnnormalised showamt mmin mmax c (Mixed as) = - (intercalate "\n" $ map finalise elided, width) +-- | General function to generate a WideBuilder for a MixedAmount, +-- according the supplied AmountDisplayOpts. If a maximum width is +-- given then: +-- - If displayed on one line, it will display as many Amounts as can +-- fit in the given width, and further Amounts will be elided. +-- - If displayed on multiple lines, any Amounts longer than the +-- maximum width will be elided. +showMixed :: AmountDisplayOpts -> MixedAmount -> WideBuilder +showMixed opts ma + | displayOneLine opts = showMixedOneLine opts ma + | otherwise = WideBuilder (wbBuilder . mconcat $ intersperse sep lines) width where - width = maximum $ fromMaybe 0 mmin : map adLength elided - astrs = amtDisplayList sepwidth showamt as - sepwidth = 0 -- "\n" has width 0 + lines = showMixedLines opts ma + width = headDef 0 $ map wbWidth lines + sep = WideBuilder (TB.singleton '\n') 0 - finalise = adString . pad . if c then colourise else id - pad amt = amt{ adString = applyN (width - adLength amt) (' ':) $ adString amt - , adLength = width - } +-- | Helper for showMixed to show a MixedAmount on multiple lines. This returns +-- the list of WideBuilders: one for each Amount in the MixedAmount (possibly +-- normalised), and padded/elided to the appropriate width. This does not +-- honour displayOneLine: all amounts will be displayed as if displayOneLine +-- were False. +showMixedLines :: AmountDisplayOpts -> MixedAmount -> [WideBuilder] +showMixedLines opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma = + map (adBuilder . pad) elided + where + Mixed amts = if displayNormalised opts then normaliseMixedAmountSquashPricesForDisplay ma else ma + + astrs = amtDisplayList (wbWidth sep) (showAmountB opts) amts + sep = WideBuilder (TB.singleton '\n') 0 + width = maximum $ fromMaybe 0 mmin : map (wbWidth . adBuilder) elided + + pad amt = amt{ adBuilder = WideBuilder (TB.fromText $ T.replicate w " ") w <> adBuilder amt } + where w = width - wbWidth (adBuilder amt) elided = maybe id elideTo mmax astrs elideTo m xs = maybeAppend elisionStr short where - elisionStr = elisionDisplay (Just m) sepwidth (length long) $ lastDef nullAmountDisplay short - (short, long) = partition ((m>=) . adLength) xs + elisionStr = elisionDisplay (Just m) (wbWidth sep) (length long) $ lastDef nullAmountDisplay short + (short, long) = partition ((m>=) . wbWidth . adBuilder) xs --- | General function to display a MixedAmount on a single line. It --- takes a function to display each Amount, an optional minimum width to --- pad to, an optional maximum width to display, and a Bool to determine --- whether to colourise negative numbers. It will display as many Amounts --- as it can in the maximum width (if given), and further Amounts will be --- elided. The function also returns the actual width of the output string. -showMixedOneLine :: (Amount -> String) -> Maybe Int -> Maybe Int -> Bool -> MixedAmount -> (String, Int) -showMixedOneLine showamt mmin mmax c = - showMixedOneLineUnnormalised showamt mmin mmax c . normaliseMixedAmountSquashPricesForDisplay - --- | Like showMixedOneLine, but does not normalise the MixedAmount before --- displaying. -showMixedOneLineUnnormalised :: (Amount -> String) -> Maybe Int -> Maybe Int -> Bool -> MixedAmount -> (String, Int) -showMixedOneLineUnnormalised showamt mmin mmax c (Mixed as) = - (pad . intercalate ", " $ map finalise elided, max width $ fromMaybe 0 mmin) +-- | Helper for showMixed to deal with single line displays. This does not +-- honour displayOneLine: all amounts will be displayed as if displayOneLine +-- were True. +showMixedOneLine :: AmountDisplayOpts -> MixedAmount -> WideBuilder +showMixedOneLine opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma = + WideBuilder (wbBuilder . pad . mconcat . intersperse sep $ map adBuilder elided) . max width $ fromMaybe 0 mmin where - width = maybe 0 adTotal $ lastMay elided - astrs = amtDisplayList sepwidth showamt as - sepwidth = 2 -- ", " has width 2 - n = length as + Mixed amts = if displayNormalised opts then normaliseMixedAmountSquashPricesForDisplay ma else ma - finalise = adString . if c then colourise else id - pad = applyN (fromMaybe 0 mmin - width) (' ':) + width = maybe 0 adTotal $ lastMay elided + astrs = amtDisplayList (wbWidth sep) (showAmountB opts) amts + sep = WideBuilder (TB.fromString ", ") 2 + n = length amts + + pad = (WideBuilder (TB.fromText $ T.replicate w " ") w <>) + where w = fromMaybe 0 mmin - width elided = maybe id elideTo mmax astrs elideTo m = addElide . takeFitting m . withElided @@ -756,39 +766,36 @@ showMixedOneLineUnnormalised showamt mmin mmax c (Mixed as) = dropWhileRev p = foldr (\x xs -> if null xs && p x then [] else x:xs) [] -- Add the elision strings (if any) to each amount - withElided = zipWith (\num amt -> (amt, elisionDisplay Nothing sepwidth num amt)) [n-1,n-2..0] + withElided = zipWith (\num amt -> (amt, elisionDisplay Nothing (wbWidth sep) num amt)) [n-1,n-2..0] data AmountDisplay = AmountDisplay - { adAmount :: !Amount -- ^ Amount displayed - , adString :: !String -- ^ String representation of the Amount - , adLength :: !Int -- ^ Length of the string representation - , adTotal :: !Int -- ^ Cumulative length of MixedAmount this Amount is part of, - -- including separators - } deriving (Show) + { adBuilder :: !WideBuilder -- ^ String representation of the Amount + , adTotal :: !Int -- ^ Cumulative length of MixedAmount this Amount is part of, + -- including separators + } nullAmountDisplay :: AmountDisplay -nullAmountDisplay = AmountDisplay nullamt "" 0 0 +nullAmountDisplay = AmountDisplay mempty 0 -amtDisplayList :: Int -> (Amount -> String) -> [Amount] -> [AmountDisplay] +amtDisplayList :: Int -> (Amount -> WideBuilder) -> [Amount] -> [AmountDisplay] amtDisplayList sep showamt = snd . mapAccumL display (-sep) where - display tot amt = (tot', AmountDisplay amt str width tot') + display tot amt = (tot', AmountDisplay str tot') where str = showamt amt - width = strWidth str - tot' = tot + width + sep + tot' = tot + (wbWidth str) + sep -- The string "m more", added to the previous running total elisionDisplay :: Maybe Int -> Int -> Int -> AmountDisplay -> Maybe AmountDisplay elisionDisplay mmax sep n lastAmt - | n > 0 = Just $ AmountDisplay 0 str len (adTotal lastAmt + len) + | n > 0 = Just $ AmountDisplay (WideBuilder (TB.fromText str) len) (adTotal lastAmt + len) | otherwise = Nothing where - fullString = show n ++ " more.." + fullString = T.pack $ show n ++ " more.." -- sep from the separator, 7 from " more..", 1 + floor (logBase 10 n) from number fullLength = sep + 8 + floor (logBase 10 $ fromIntegral n) - str | Just m <- mmax, fullLength > m = take (m - 2) fullString ++ ".." + str | Just m <- mmax, fullLength > m = T.take (m - 2) fullString <> ".." | otherwise = fullString len = case mmax of Nothing -> fullLength Just m -> max 2 $ min m fullLength @@ -797,10 +804,6 @@ maybeAppend :: Maybe a -> [a] -> [a] maybeAppend Nothing = id maybeAppend (Just a) = (++[a]) -colourise :: AmountDisplay -> AmountDisplay -colourise amt = amt{adString=markColour $ adString amt} - where markColour = if isNegativeAmount (adAmount amt) then color Dull Red else id - -- | Compact labelled trace of a mixed amount, for debugging. ltraceamount :: String -> MixedAmount -> MixedAmount ltraceamount s = traceWith (((s ++ ": ") ++).showMixedAmount) diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 61fe8a244..d027c50e3 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -170,7 +170,7 @@ showPosting p@Posting{paccount=a,pamount=amt,ptype=t} = BalancedVirtualPosting -> (wrap "[" "]", acctnamewidth-2) VirtualPosting -> (wrap "(" ")", acctnamewidth-2) _ -> (id,acctnamewidth) - showamount = fst . showMixed showAmount (Just 12) Nothing False + showamount = wbUnpack . showMixed noColour{displayMinWidth=Just 12} showComment :: Text -> String diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index c6ea54f58..4042ee49e 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -57,12 +57,13 @@ module Hledger.Data.Transaction ( tests_Transaction ) where -import Data.List + +import Data.List (intercalate, partition) import Data.List.Extra (nubSort) -import Data.Maybe +import Data.Maybe (fromMaybe, mapMaybe) import Data.Text (Text) import qualified Data.Text as T -import Data.Time.Calendar +import Data.Time.Calendar (Day, fromGregorian) import qualified Data.Map as M import Hledger.Utils @@ -258,12 +259,11 @@ postingAsLines elideamount onelineamounts pstoalignwith p = concat [ -- currently prices are considered part of the amount string when right-aligning amounts shownAmounts - | elideamount = [""] - | onelineamounts = [fst . showMixedOneLineUnnormalised showAmount (Just amtwidth) Nothing False $ pamount p] - | null (amounts $ pamount p) = [""] - | otherwise = lines . fst . showMixedUnnormalised showAmount (Just amtwidth) Nothing False $ pamount p + | elideamount || null (amounts $ pamount p) = [""] + | otherwise = lines . wbUnpack . showMixed displayopts $ pamount p where - amtwidth = maximum $ 12 : map (snd . showMixedUnnormalised showAmount Nothing Nothing False . pamount) pstoalignwith -- min. 12 for backwards compatibility + displayopts = noColour{displayOneLine=onelineamounts, displayMinWidth = Just amtwidth, displayNormalised=False} + amtwidth = maximum $ 12 : map (wbWidth . showMixed displayopts{displayMinWidth=Nothing} . pamount) pstoalignwith -- min. 12 for backwards compatibility (samelinecomment, newlinecomments) = case renderCommentLines (pcomment p) of [] -> ("",[]) diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index cd5bcb6d0..a44b6010c 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -27,18 +27,17 @@ module Hledger.Reports.BudgetReport ( ) where -import Control.Arrow (first) -import Data.Decimal +import Data.Decimal (roundTo) import Data.Default (def) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM -import Data.List +import Data.List (nub, partition, transpose) import Data.List.Extra (nubSort) -import Data.Maybe +import Data.Maybe (fromMaybe) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif -import Safe +import Safe (headDef) --import Data.List --import Data.Maybe import qualified Data.Map as Map @@ -245,7 +244,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $ where actual' = fromMaybe 0 actual budgetAndPerc b = (showamt b, showper <$> percentage actual' b) - showamt = first T.pack . showMixedOneLine showAmountWithoutPrice Nothing (Just 32) color_ + showamt = (\(WideBuilder b w) -> (TL.toStrict $ TB.toLazyText b, w)) . showMixed oneLine{displayColour=color_, displayMaxWidth=Just 32} showper p = let str = T.pack (show $ roundTo 0 p) in (str, T.length str) cellWidth ((_,wa), Nothing) = (wa, 0, 0) cellWidth ((_,wa), Just ((_,wb), Nothing)) = (wa, wb, 0) diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 294375f39..04a6e0d36 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -93,10 +93,12 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportspec_=rspec ,rsItemDescription = T.unpack $ tdescription t ,rsItemOtherAccounts = T.unpack otheracctsstr -- _ -> "" -- should do this if accounts field width < 30 - ,rsItemChangeAmount = showMixedOneLine showAmountWithoutPrice Nothing (Just 32) False change - ,rsItemBalanceAmount = showMixedOneLine showAmountWithoutPrice Nothing (Just 32) False bal + ,rsItemChangeAmount = showamt change + ,rsItemBalanceAmount = showamt bal ,rsItemTransaction = t } + where showamt = \((WideBuilder b w) -> (TL.toStrict $ TB.toLazyText b, w)) + . showMixed oneLine{displayMaxWidth=Just 32} -- blank items are added to allow more control of scroll position; we won't allow movement over these. -- XXX Ugly. Changing to 0 helps when debugging. blankitems = replicate 100 -- "100 ought to be enough for anyone" diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index afda925b5..52ab691a3 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -372,7 +372,7 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do balancingamt = negate $ sum $ map pamount realps where realps = filter isReal esPostings balancingamtfirstcommodity = Mixed $ take 1 $ amounts balancingamt showamt = - showMixedAmountWithPrecision + showMixedAmount . setMixedAmountPrecision -- what should this be ? -- 1 maxprecision (show all decimal places or none) ? -- 2 maxprecisionwithpoint (show all decimal places or .0 - avoids some but not all confusion with thousands separators) ? diff --git a/hledger/Hledger/Cli/Commands/Aregister.hs b/hledger/Hledger/Cli/Commands/Aregister.hs index 267a9d316..173a1cbf5 100644 --- a/hledger/Hledger/Cli/Commands/Aregister.hs +++ b/hledger/Hledger/Cli/Commands/Aregister.hs @@ -144,9 +144,9 @@ accountTransactionsReportAsText copts reportq thisacctq items title : map (accountTransactionsReportItemAsText copts reportq thisacctq amtwidth balwidth) items where - amtwidth = maximumStrict $ 12 : map (snd . showamt . itemamt) items - balwidth = maximumStrict $ 12 : map (snd . showamt . itembal) items - showamt = showMixedOneLine showAmountWithoutPrice (Just 12) mmax False -- color_ + amtwidth = maximumStrict $ 12 : map (wbWidth . showamt . itemamt) items + balwidth = maximumStrict $ 12 : map (wbWidth . showamt . itembal) items + showamt = showMixed oneLine{displayMinWidth=Just 12, displayMaxWidth=mmax, displayColour=False} -- color_ where mmax = if no_elide_ . rsOpts . reportspec_ $ copts then Nothing else Just 32 itemamt (_,_,_,_,a,_) = a itembal (_,_,_,_,_,a) = a @@ -216,8 +216,9 @@ accountTransactionsReportItemAsText -- gather content accts = -- T.unpack $ elideAccountName acctwidth $ T.pack otheracctsstr - amt = T.pack . fst $ showMixed showAmountWithoutPrice (Just amtwidth) (Just balwidth) color_ change - bal = T.pack . fst $ showMixed showAmountWithoutPrice (Just balwidth) (Just balwidth) color_ balance + amt = TL.toStrict . TB.toLazyText . wbBuilder $ showamt amtwidth change + bal = TL.toStrict . TB.toLazyText . wbBuilder $ showamt balwidth balance + showamt w = showMixed noPrice{displayColour=color_, displayMinWidth=Just w, displayMaxWidth=Just w} -- alternate behaviour, show null amounts as 0 instead of blank -- amt = if null amt' then "0" else amt' -- bal = if null bal' then "0" else bal' diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index cb82d9e7b..d58006fb1 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -254,7 +254,6 @@ module Hledger.Cli.Commands.Balance ( ,tests_Balance ) where -import Control.Arrow (first) import Data.Default (def) import Data.List (intersperse, transpose) import Data.Maybe (fromMaybe, maybeToList) @@ -435,10 +434,13 @@ renderComponent topaligned opts (acctname, depth, total) (FormatField ljust mmin DepthSpacerField -> Cell align [(T.replicate d " ", d)] where d = maybe id min mmax $ depth * fromMaybe 1 mmin AccountField -> Cell align [(t, textWidth t)] where t = formatText ljust mmin mmax acctname - TotalField -> Cell align . pure . first T.pack $ showMixed showAmountWithoutPrice mmin mmax (color_ opts) total + TotalField -> Cell align . pure $ showamt total _ -> Cell align [("", 0)] - where align = if topaligned then (if ljust then TopLeft else TopRight) - else (if ljust then BottomLeft else BottomRight) + where + align = if topaligned then (if ljust then TopLeft else TopRight) + else (if ljust then BottomLeft else BottomRight) + showamt = (\(WideBuilder b w) -> (TL.toStrict $ TB.toLazyText b, w)) + . showMixed noPrice{displayColour=color_ opts, displayMinWidth=mmin, displayMaxWidth=mmax} -- rendering multi-column balance reports @@ -627,7 +629,7 @@ balanceReportTableAsText ReportOpts{..} = Tab.renderTableB def{tableBorders=False, prettyTable=pretty_tables_} (Tab.alignCell TopLeft) (Tab.alignCell TopRight) showamt where - showamt = Cell TopRight . (\(a,w) -> [(T.pack a,w)]) . showMixedOneLine showAmountWithoutPrice Nothing mmax color_ + showamt = Cell TopRight . (\(WideBuilder b w) -> [(TL.toStrict $ TB.toLazyText b, w)]) . showMixed oneLine{displayColour=color_, displayMaxWidth=mmax} mmax = if no_elide_ then Nothing else Just 32 diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index 74151e0fa..f560f7bc3 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -18,8 +18,8 @@ module Hledger.Cli.Commands.Register ( ,tests_Register ) where -import Data.List -import Data.Maybe +import Data.List (intersperse) +import Data.Maybe (fromMaybe, isJust) -- import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL @@ -96,12 +96,13 @@ postingsReportAsText opts items = TB.toLazyText . unlinesB $ map (postingsReportItemAsText opts amtwidth balwidth) items where - amtwidth = maximumStrict $ map (snd . showMixed showAmount (Just 12) Nothing False . itemamt) items - balwidth = maximumStrict $ map (snd . showMixed showAmount (Just 12) Nothing False . itembal) items + amtwidth = maximumStrict $ map (wbWidth . showAmt . itemamt) items + balwidth = maximumStrict $ map (wbWidth . showAmt . itembal) items itemamt (_,_,_,Posting{pamount=a},_) = a itembal (_,_,_,_,a) = a unlinesB [] = mempty unlinesB xs = mconcat (intersperse (TB.fromText "\n") xs) <> TB.fromText "\n" + showAmt = showMixed noColour{displayMinWidth=Just 12,displayColour=False} -- | Render one register report line item as plain text. Layout is like so: -- @ @@ -179,8 +180,9 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda VirtualPosting -> (\s -> wrap "(" ")" s, acctwidth-2) _ -> (id,acctwidth) wrap a b x = a <> x <> b - amt = T.pack . fst $ showMixed showAmountWithoutPrice (Just amtwidth) (Just amtwidth) (color_ . rsOpts $ reportspec_ opts) $ pamount p - bal = T.pack . fst $ showMixed showAmountWithoutPrice (Just balwidth) (Just balwidth) (color_ . rsOpts $ reportspec_ opts) b + amt = TL.toStrict . TB.toLazyText . wbBuilder . showamt amtwidth $ pamount p + bal = TL.toStrict . TB.toLazyText . wbBuilder $ showamt balwidth b + showamt w = showMixed noPrice{displayColour=color_ . rsOpts $ reportspec_ opts, displayMinWidth=Just w, displayMaxWidth=Just w} -- alternate behaviour, show null amounts as 0 instead of blank -- amt = if null amt' then "0" else amt' -- bal = if null bal' then "0" else bal'