lib,cli,ui: Implement all showMixed* functions in terms of DisplayAmountOpts and WideBuilder.

This commit is contained in:
Stephen Morgan 2020-12-22 23:35:20 +11:00
parent 0a686e220e
commit b9c00dce61
9 changed files with 152 additions and 143 deletions

View File

@ -68,10 +68,15 @@ module Hledger.Data.Amount (
multiplyAmountAndPrice, multiplyAmountAndPrice,
amountTotalPriceToUnitPrice, amountTotalPriceToUnitPrice,
-- ** rendering -- ** rendering
AmountDisplayOpts(..),
noColour,
noPrice,
oneLine,
amountstyle, amountstyle,
styleAmount, styleAmount,
styleAmountExceptPrecision, styleAmountExceptPrecision,
amountUnstyled, amountUnstyled,
showAmountB,
showAmount, showAmount,
cshowAmount, cshowAmount,
showAmountWithZeroCommodity, showAmountWithZeroCommodity,
@ -119,11 +124,7 @@ module Hledger.Data.Amount (
showMixedAmountOneLineWithoutPrice, showMixedAmountOneLineWithoutPrice,
showMixedAmountElided, showMixedAmountElided,
showMixedAmountWithZeroCommodity, showMixedAmountWithZeroCommodity,
showMixedAmountWithPrecision,
showMixed, showMixed,
showMixedUnnormalised,
showMixedOneLine,
showMixedOneLineUnnormalised,
setMixedAmountPrecision, setMixedAmountPrecision,
canonicaliseMixedAmount, canonicaliseMixedAmount,
-- * misc. -- * misc.
@ -135,8 +136,8 @@ import Control.Monad (foldM)
import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo) import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo)
import Data.Default (Default(..)) import Data.Default (Default(..))
import Data.Function (on) import Data.Function (on)
import Data.List (genericSplitAt, groupBy, intercalate, mapAccumL, import Data.List (groupBy, intercalate, intersperse, mapAccumL, partition,
partition, sortBy) sortBy)
import Data.List.NonEmpty (NonEmpty(..), nonEmpty) import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Map (findWithDefault) import Data.Map (findWithDefault)
@ -144,7 +145,7 @@ import Data.Maybe (fromMaybe)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as TB import qualified Data.Text.Lazy.Builder as TB
import Data.Word (Word8) import Data.Word (Word8)
import Safe (lastDef, lastMay) import Safe (headDef, lastDef, lastMay)
import Text.Printf (printf) import Text.Printf (printf)
import Hledger.Data.Types import Hledger.Data.Types
@ -154,12 +155,15 @@ import Hledger.Utils
deriving instance Show MarketPrice deriving instance Show MarketPrice
-- | Options for the display of Amount and MixedAmount.
data AmountDisplayOpts = AmountDisplayOpts data AmountDisplayOpts = AmountDisplayOpts
{ displayPrice :: Bool -- ^ Whether to display the Price of an Amount. { displayPrice :: Bool -- ^ Whether to display the Price of an Amount.
, displayZeroCommodity :: Bool -- ^ If the Amount rounds to 0, whether to display its commodity string. , displayZeroCommodity :: Bool -- ^ If the Amount rounds to 0, whether to display its commodity string.
, displayColour :: Bool -- ^ Whether to colourise negative Amounts. , displayColour :: Bool -- ^ Whether to colourise negative Amounts.
, displayNormalised :: Bool -- ^ Whether to normalise MixedAmounts before displaying. , displayNormalised :: Bool -- ^ Whether to normalise MixedAmounts before displaying.
, displayOneLine :: Bool -- ^ Whether to display on one line. , 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) } deriving (Show)
instance Default AmountDisplayOpts where instance Default AmountDisplayOpts where
@ -168,8 +172,22 @@ instance Default AmountDisplayOpts where
, displayZeroCommodity = False , displayZeroCommodity = False
, displayNormalised = True , displayNormalised = True
, displayOneLine = False , 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 -- Amount styles
@ -348,8 +366,8 @@ withDecimalPoint = flip setAmountDecimalPoint
showAmountPrice :: Maybe AmountPrice -> WideBuilder showAmountPrice :: Maybe AmountPrice -> WideBuilder
showAmountPrice Nothing = mempty showAmountPrice Nothing = mempty
showAmountPrice (Just (UnitPrice pa)) = WideBuilder (TB.fromString " @ ") 3 <> 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 def{displayColour=False} pa showAmountPrice (Just (TotalPrice pa)) = WideBuilder (TB.fromString " @@ ") 4 <> showAmountB noColour pa
showAmountPriceDebug :: Maybe AmountPrice -> String showAmountPriceDebug :: Maybe AmountPrice -> String
showAmountPriceDebug Nothing = "" showAmountPriceDebug Nothing = ""
@ -381,7 +399,7 @@ amountUnstyled a = a{astyle=amountstyle}
-- zero are converted to just \"0\". The special "missing" amount is -- zero are converted to just \"0\". The special "missing" amount is
-- displayed as the empty string. -- displayed as the empty string.
showAmount :: Amount -> String showAmount :: Amount -> String
showAmount = wbUnpack . showAmountB def{displayColour=False} showAmount = wbUnpack . showAmountB noColour
-- | Get the string representation of an amount, based on its -- | Get the string representation of an amount, based on its
-- commodity's display settings and the display options. The -- commodity's display settings and the display options. The
@ -395,7 +413,7 @@ showAmountB opts a@Amount{astyle=style} =
where where
quantity = showamountquantity a quantity = showamountquantity a
(quantity',c) | amountLooksZero a && not (displayZeroCommodity opts) = (WideBuilder (TB.singleton '0') 1,"") (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 space = if not (T.null c) && ascommodityspaced style then WideBuilder (TB.singleton ' ') 1 else mempty
c' = WideBuilder (TB.fromText c) (textWidth c) c' = WideBuilder (TB.fromText c) (textWidth c)
price = if displayPrice opts then showAmountPrice (aprice a) else mempty 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. -- | Get the string representation of an amount, without any \@ price.
showAmountWithoutPrice :: Amount -> String showAmountWithoutPrice :: Amount -> String
showAmountWithoutPrice = wbUnpack . showAmountB def{displayColour=False, displayPrice=False} showAmountWithoutPrice = wbUnpack . showAmountB noPrice{displayColour=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
-- | Like showAmount, but show a zero amount's commodity if it has one. -- | Like showAmount, but show a zero amount's commodity if it has one.
showAmountWithZeroCommodity :: Amount -> String 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, -- | Get a string representation of an amount for debugging,
-- appropriate to the current debug level. 9 shows maximum detail. -- appropriate to the current debug level. 9 shows maximum detail.
@ -434,29 +447,29 @@ showamountquantity amt@Amount{astyle=AmountStyle{asdecimalpoint=mdec, asdigitgro
where where
Decimal e n = amountRoundedQuantity amt Decimal e n = amountRoundedQuantity amt
strN = show $ abs n strN = T.pack . show $ abs n
len = length strN len = T.length strN
intLen = max 1 $ len - fromIntegral e intLen = max 1 $ len - fromIntegral e
dec = fromMaybe '.' mdec dec = fromMaybe '.' mdec
padded = replicate (fromIntegral e + 1 - len) '0' ++ strN padded = T.replicate (fromIntegral e + 1 - len) "0" <> strN
(intPart, fracPart) = splitAt intLen padded (intPart, fracPart) = T.splitAt intLen padded
intB = applyDigitGroupStyle mgrps intLen $ if e == 0 then strN else intPart intB = applyDigitGroupStyle mgrps intLen $ if e == 0 then strN else intPart
signB = if n < 0 then WideBuilder (TB.singleton '-') 1 else mempty 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, -- | Split a string representation into chunks according to DigitGroupStyle,
-- returning a Text builder and the number of separators used. -- returning a Text builder and the number of separators used.
applyDigitGroupStyle :: Maybe DigitGroupStyle -> Int -> String -> WideBuilder applyDigitGroupStyle :: Maybe DigitGroupStyle -> Int -> T.Text -> WideBuilder
applyDigitGroupStyle Nothing l s = WideBuilder (TB.fromString s) l applyDigitGroupStyle Nothing l s = WideBuilder (TB.fromText s) l
applyDigitGroupStyle (Just (DigitGroups _ [])) l s = WideBuilder (TB.fromString 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 applyDigitGroupStyle (Just (DigitGroups c (g:gs))) l s = addseps (g:|gs) (toInteger l) s
where where
addseps (g:|gs) l s addseps (g:|gs) l s
| l' > 0 = addseps gs' l' rest <> WideBuilder (TB.singleton c <> TB.fromString part) (fromIntegral g + 1) | l' > 0 = addseps gs' l' rest <> WideBuilder (TB.singleton c <> TB.fromText part) (fromIntegral g + 1)
| otherwise = WideBuilder (TB.fromString s) (fromInteger l) | otherwise = WideBuilder (TB.fromText s) (fromInteger l)
where where
(rest, part) = genericSplitAt l' s (rest, part) = T.splitAt (fromInteger l') s
gs' = fromMaybe (g:|[]) $ nonEmpty gs gs' = fromMaybe (g:|[]) $ nonEmpty gs
l' = l - toInteger g l' = l - toInteger g
@ -651,39 +664,33 @@ mixedAmountUnstyled = mapMixedAmount amountUnstyled
-- normalising it to one amount per commodity. Assumes amounts have -- normalising it to one amount per commodity. Assumes amounts have
-- no or similar prices, otherwise this can show misleading prices. -- no or similar prices, otherwise this can show misleading prices.
showMixedAmount :: MixedAmount -> String showMixedAmount :: MixedAmount -> String
showMixedAmount = fst . showMixed showAmount Nothing Nothing False showMixedAmount = wbUnpack . showMixed noColour
-- | Get the one-line string representation of a mixed amount. -- | Get the one-line string representation of a mixed amount.
showMixedAmountOneLine :: MixedAmount -> String 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 -- | Like showMixedAmount, but zero amounts are shown with their
-- commodity if they have one. -- commodity if they have one.
showMixedAmountWithZeroCommodity :: MixedAmount -> String showMixedAmountWithZeroCommodity :: MixedAmount -> String
showMixedAmountWithZeroCommodity = fst . showMixed showAmountWithZeroCommodity Nothing Nothing False showMixedAmountWithZeroCommodity = wbUnpack . showMixed noColour{displayZeroCommodity=True}
-- | 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
-- | Get the string representation of a mixed amount, without showing any transaction prices. -- | 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. -- With a True argument, adds ANSI codes to show negative amounts in red.
showMixedAmountWithoutPrice :: Bool -> MixedAmount -> String 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 -- | Get the one-line string representation of a mixed amount, but without
-- any \@ prices. -- any \@ prices.
-- With a True argument, adds ANSI codes to show negative amounts in red. -- With a True argument, adds ANSI codes to show negative amounts in red.
showMixedAmountOneLineWithoutPrice :: Bool -> MixedAmount -> String 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, -- | Like showMixedAmountOneLineWithoutPrice, but show at most the given width,
-- with an elision indicator if there are more. -- with an elision indicator if there are more.
-- With a True argument, adds ANSI codes to show negative amounts in red. -- With a True argument, adds ANSI codes to show negative amounts in red.
showMixedAmountElided :: Int -> Bool -> MixedAmount -> String 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. -- | Get an unambiguous string representation of a mixed amount for debugging.
showMixedAmountDebug :: MixedAmount -> String showMixedAmountDebug :: MixedAmount -> String
@ -691,59 +698,62 @@ showMixedAmountDebug m | m == missingmixedamt = "(missing)"
| otherwise = printf "Mixed [%s]" as | otherwise = printf "Mixed [%s]" as
where as = intercalate "\n " $ map showAmountDebug $ amounts m where as = intercalate "\n " $ map showAmountDebug $ amounts m
-- | General function to display a MixedAmount, one Amount on each line. -- | General function to generate a WideBuilder for a MixedAmount,
-- It takes a function to display each Amount, an optional minimum width -- according the supplied AmountDisplayOpts. If a maximum width is
-- to pad to, an optional maximum width to display, and a Bool to determine -- given then:
-- whether to colourise negative numbers. Amounts longer than the maximum -- - If displayed on one line, it will display as many Amounts as can
-- width (if given) will be elided. The function also returns the actual -- fit in the given width, and further Amounts will be elided.
-- width of the output string. -- - If displayed on multiple lines, any Amounts longer than the
showMixed :: (Amount -> String) -> Maybe Int -> Maybe Int -> Bool -> MixedAmount -> (String, Int) -- maximum width will be elided.
showMixed showamt mmin mmax c = showMixed :: AmountDisplayOpts -> MixedAmount -> WideBuilder
showMixedUnnormalised showamt mmin mmax c . normaliseMixedAmountSquashPricesForDisplay showMixed opts ma
| displayOneLine opts = showMixedOneLine opts ma
-- | Like showMixed, but does not normalise the MixedAmount before displaying. | otherwise = WideBuilder (wbBuilder . mconcat $ intersperse sep lines) width
showMixedUnnormalised :: (Amount -> String) -> Maybe Int -> Maybe Int -> Bool -> MixedAmount -> (String, Int)
showMixedUnnormalised showamt mmin mmax c (Mixed as) =
(intercalate "\n" $ map finalise elided, width)
where where
width = maximum $ fromMaybe 0 mmin : map adLength elided lines = showMixedLines opts ma
astrs = amtDisplayList sepwidth showamt as width = headDef 0 $ map wbWidth lines
sepwidth = 0 -- "\n" has width 0 sep = WideBuilder (TB.singleton '\n') 0
finalise = adString . pad . if c then colourise else id -- | Helper for showMixed to show a MixedAmount on multiple lines. This returns
pad amt = amt{ adString = applyN (width - adLength amt) (' ':) $ adString amt -- the list of WideBuilders: one for each Amount in the MixedAmount (possibly
, adLength = width -- 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 elided = maybe id elideTo mmax astrs
elideTo m xs = maybeAppend elisionStr short elideTo m xs = maybeAppend elisionStr short
where where
elisionStr = elisionDisplay (Just m) sepwidth (length long) $ lastDef nullAmountDisplay short elisionStr = elisionDisplay (Just m) (wbWidth sep) (length long) $ lastDef nullAmountDisplay short
(short, long) = partition ((m>=) . adLength) xs (short, long) = partition ((m>=) . wbWidth . adBuilder) xs
-- | General function to display a MixedAmount on a single line. It -- | Helper for showMixed to deal with single line displays. This does not
-- takes a function to display each Amount, an optional minimum width to -- honour displayOneLine: all amounts will be displayed as if displayOneLine
-- pad to, an optional maximum width to display, and a Bool to determine -- were True.
-- whether to colourise negative numbers. It will display as many Amounts showMixedOneLine :: AmountDisplayOpts -> MixedAmount -> WideBuilder
-- as it can in the maximum width (if given), and further Amounts will be showMixedOneLine opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma =
-- elided. The function also returns the actual width of the output string. WideBuilder (wbBuilder . pad . mconcat . intersperse sep $ map adBuilder elided) . max width $ fromMaybe 0 mmin
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)
where where
width = maybe 0 adTotal $ lastMay elided Mixed amts = if displayNormalised opts then normaliseMixedAmountSquashPricesForDisplay ma else ma
astrs = amtDisplayList sepwidth showamt as
sepwidth = 2 -- ", " has width 2
n = length as
finalise = adString . if c then colourise else id width = maybe 0 adTotal $ lastMay elided
pad = applyN (fromMaybe 0 mmin - width) (' ':) 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 elided = maybe id elideTo mmax astrs
elideTo m = addElide . takeFitting m . withElided 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) [] dropWhileRev p = foldr (\x xs -> if null xs && p x then [] else x:xs) []
-- Add the elision strings (if any) to each amount -- 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 data AmountDisplay = AmountDisplay
{ adAmount :: !Amount -- ^ Amount displayed { adBuilder :: !WideBuilder -- ^ String representation of the Amount
, adString :: !String -- ^ String representation of the Amount , adTotal :: !Int -- ^ Cumulative length of MixedAmount this Amount is part of,
, adLength :: !Int -- ^ Length of the string representation -- including separators
, adTotal :: !Int -- ^ Cumulative length of MixedAmount this Amount is part of, }
-- including separators
} deriving (Show)
nullAmountDisplay :: AmountDisplay 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) amtDisplayList sep showamt = snd . mapAccumL display (-sep)
where where
display tot amt = (tot', AmountDisplay amt str width tot') display tot amt = (tot', AmountDisplay str tot')
where where
str = showamt amt str = showamt amt
width = strWidth str tot' = tot + (wbWidth str) + sep
tot' = tot + width + sep
-- The string "m more", added to the previous running total -- The string "m more", added to the previous running total
elisionDisplay :: Maybe Int -> Int -> Int -> AmountDisplay -> Maybe AmountDisplay elisionDisplay :: Maybe Int -> Int -> Int -> AmountDisplay -> Maybe AmountDisplay
elisionDisplay mmax sep n lastAmt 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 | otherwise = Nothing
where 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 -- sep from the separator, 7 from " more..", 1 + floor (logBase 10 n) from number
fullLength = sep + 8 + floor (logBase 10 $ fromIntegral n) 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 | otherwise = fullString
len = case mmax of Nothing -> fullLength len = case mmax of Nothing -> fullLength
Just m -> max 2 $ min m fullLength Just m -> max 2 $ min m fullLength
@ -797,10 +804,6 @@ maybeAppend :: Maybe a -> [a] -> [a]
maybeAppend Nothing = id maybeAppend Nothing = id
maybeAppend (Just a) = (++[a]) 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. -- | Compact labelled trace of a mixed amount, for debugging.
ltraceamount :: String -> MixedAmount -> MixedAmount ltraceamount :: String -> MixedAmount -> MixedAmount
ltraceamount s = traceWith (((s ++ ": ") ++).showMixedAmount) ltraceamount s = traceWith (((s ++ ": ") ++).showMixedAmount)

View File

@ -170,7 +170,7 @@ showPosting p@Posting{paccount=a,pamount=amt,ptype=t} =
BalancedVirtualPosting -> (wrap "[" "]", acctnamewidth-2) BalancedVirtualPosting -> (wrap "[" "]", acctnamewidth-2)
VirtualPosting -> (wrap "(" ")", acctnamewidth-2) VirtualPosting -> (wrap "(" ")", acctnamewidth-2)
_ -> (id,acctnamewidth) _ -> (id,acctnamewidth)
showamount = fst . showMixed showAmount (Just 12) Nothing False showamount = wbUnpack . showMixed noColour{displayMinWidth=Just 12}
showComment :: Text -> String showComment :: Text -> String

View File

@ -57,12 +57,13 @@ module Hledger.Data.Transaction (
tests_Transaction tests_Transaction
) )
where where
import Data.List
import Data.List (intercalate, partition)
import Data.List.Extra (nubSort) import Data.List.Extra (nubSort)
import Data.Maybe import Data.Maybe (fromMaybe, mapMaybe)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar (Day, fromGregorian)
import qualified Data.Map as M import qualified Data.Map as M
import Hledger.Utils 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 -- currently prices are considered part of the amount string when right-aligning amounts
shownAmounts shownAmounts
| elideamount = [""] | elideamount || null (amounts $ pamount p) = [""]
| onelineamounts = [fst . showMixedOneLineUnnormalised showAmount (Just amtwidth) Nothing False $ pamount p] | otherwise = lines . wbUnpack . showMixed displayopts $ pamount p
| null (amounts $ pamount p) = [""]
| otherwise = lines . fst . showMixedUnnormalised showAmount (Just amtwidth) Nothing False $ pamount p
where 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) = (samelinecomment, newlinecomments) =
case renderCommentLines (pcomment p) of [] -> ("",[]) case renderCommentLines (pcomment p) of [] -> ("",[])

View File

@ -27,18 +27,17 @@ module Hledger.Reports.BudgetReport (
) )
where where
import Control.Arrow (first) import Data.Decimal (roundTo)
import Data.Decimal
import Data.Default (def) import Data.Default (def)
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.List import Data.List (nub, partition, transpose)
import Data.List.Extra (nubSort) import Data.List.Extra (nubSort)
import Data.Maybe import Data.Maybe (fromMaybe)
#if !(MIN_VERSION_base(4,11,0)) #if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>)) import Data.Monoid ((<>))
#endif #endif
import Safe import Safe (headDef)
--import Data.List --import Data.List
--import Data.Maybe --import Data.Maybe
import qualified Data.Map as Map import qualified Data.Map as Map
@ -245,7 +244,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $
where where
actual' = fromMaybe 0 actual actual' = fromMaybe 0 actual
budgetAndPerc b = (showamt b, showper <$> percentage actual' b) 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) showper p = let str = T.pack (show $ roundTo 0 p) in (str, T.length str)
cellWidth ((_,wa), Nothing) = (wa, 0, 0) cellWidth ((_,wa), Nothing) = (wa, 0, 0)
cellWidth ((_,wa), Just ((_,wb), Nothing)) = (wa, wb, 0) cellWidth ((_,wa), Just ((_,wb), Nothing)) = (wa, wb, 0)

View File

@ -93,10 +93,12 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportspec_=rspec
,rsItemDescription = T.unpack $ tdescription t ,rsItemDescription = T.unpack $ tdescription t
,rsItemOtherAccounts = T.unpack otheracctsstr ,rsItemOtherAccounts = T.unpack otheracctsstr
-- _ -> "<split>" -- should do this if accounts field width < 30 -- _ -> "<split>" -- should do this if accounts field width < 30
,rsItemChangeAmount = showMixedOneLine showAmountWithoutPrice Nothing (Just 32) False change ,rsItemChangeAmount = showamt change
,rsItemBalanceAmount = showMixedOneLine showAmountWithoutPrice Nothing (Just 32) False bal ,rsItemBalanceAmount = showamt bal
,rsItemTransaction = t ,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. -- 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. -- XXX Ugly. Changing to 0 helps when debugging.
blankitems = replicate 100 -- "100 ought to be enough for anyone" blankitems = replicate 100 -- "100 ought to be enough for anyone"

View File

@ -372,7 +372,7 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do
balancingamt = negate $ sum $ map pamount realps where realps = filter isReal esPostings balancingamt = negate $ sum $ map pamount realps where realps = filter isReal esPostings
balancingamtfirstcommodity = Mixed $ take 1 $ amounts balancingamt balancingamtfirstcommodity = Mixed $ take 1 $ amounts balancingamt
showamt = showamt =
showMixedAmountWithPrecision showMixedAmount . setMixedAmountPrecision
-- what should this be ? -- what should this be ?
-- 1 maxprecision (show all decimal places or none) ? -- 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) ? -- 2 maxprecisionwithpoint (show all decimal places or .0 - avoids some but not all confusion with thousands separators) ?

View File

@ -144,9 +144,9 @@ accountTransactionsReportAsText copts reportq thisacctq items
title : title :
map (accountTransactionsReportItemAsText copts reportq thisacctq amtwidth balwidth) items map (accountTransactionsReportItemAsText copts reportq thisacctq amtwidth balwidth) items
where where
amtwidth = maximumStrict $ 12 : map (snd . showamt . itemamt) items amtwidth = maximumStrict $ 12 : map (wbWidth . showamt . itemamt) items
balwidth = maximumStrict $ 12 : map (snd . showamt . itembal) items balwidth = maximumStrict $ 12 : map (wbWidth . showamt . itembal) items
showamt = showMixedOneLine showAmountWithoutPrice (Just 12) mmax False -- color_ showamt = showMixed oneLine{displayMinWidth=Just 12, displayMaxWidth=mmax, displayColour=False} -- color_
where mmax = if no_elide_ . rsOpts . reportspec_ $ copts then Nothing else Just 32 where mmax = if no_elide_ . rsOpts . reportspec_ $ copts then Nothing else Just 32
itemamt (_,_,_,_,a,_) = a itemamt (_,_,_,_,a,_) = a
itembal (_,_,_,_,_,a) = a itembal (_,_,_,_,_,a) = a
@ -216,8 +216,9 @@ accountTransactionsReportItemAsText
-- gather content -- gather content
accts = -- T.unpack $ elideAccountName acctwidth $ T.pack accts = -- T.unpack $ elideAccountName acctwidth $ T.pack
otheracctsstr otheracctsstr
amt = T.pack . fst $ showMixed showAmountWithoutPrice (Just amtwidth) (Just balwidth) color_ change amt = TL.toStrict . TB.toLazyText . wbBuilder $ showamt amtwidth change
bal = T.pack . fst $ showMixed showAmountWithoutPrice (Just balwidth) (Just balwidth) color_ balance 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 -- alternate behaviour, show null amounts as 0 instead of blank
-- amt = if null amt' then "0" else amt' -- amt = if null amt' then "0" else amt'
-- bal = if null bal' then "0" else bal' -- bal = if null bal' then "0" else bal'

View File

@ -254,7 +254,6 @@ module Hledger.Cli.Commands.Balance (
,tests_Balance ,tests_Balance
) where ) where
import Control.Arrow (first)
import Data.Default (def) import Data.Default (def)
import Data.List (intersperse, transpose) import Data.List (intersperse, transpose)
import Data.Maybe (fromMaybe, maybeToList) 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)] DepthSpacerField -> Cell align [(T.replicate d " ", d)]
where d = maybe id min mmax $ depth * fromMaybe 1 mmin where d = maybe id min mmax $ depth * fromMaybe 1 mmin
AccountField -> Cell align [(t, textWidth t)] where t = formatText ljust mmin mmax acctname 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)] _ -> Cell align [("", 0)]
where align = if topaligned then (if ljust then TopLeft else TopRight) where
else (if ljust then BottomLeft else BottomRight) 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 -- rendering multi-column balance reports
@ -627,7 +629,7 @@ balanceReportTableAsText ReportOpts{..} =
Tab.renderTableB def{tableBorders=False, prettyTable=pretty_tables_} Tab.renderTableB def{tableBorders=False, prettyTable=pretty_tables_}
(Tab.alignCell TopLeft) (Tab.alignCell TopRight) showamt (Tab.alignCell TopLeft) (Tab.alignCell TopRight) showamt
where 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 mmax = if no_elide_ then Nothing else Just 32

View File

@ -18,8 +18,8 @@ module Hledger.Cli.Commands.Register (
,tests_Register ,tests_Register
) where ) where
import Data.List import Data.List (intersperse)
import Data.Maybe import Data.Maybe (fromMaybe, isJust)
-- import Data.Text (Text) -- import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
@ -96,12 +96,13 @@ postingsReportAsText opts items =
TB.toLazyText . unlinesB $ TB.toLazyText . unlinesB $
map (postingsReportItemAsText opts amtwidth balwidth) items map (postingsReportItemAsText opts amtwidth balwidth) items
where where
amtwidth = maximumStrict $ map (snd . showMixed showAmount (Just 12) Nothing False . itemamt) items amtwidth = maximumStrict $ map (wbWidth . showAmt . itemamt) items
balwidth = maximumStrict $ map (snd . showMixed showAmount (Just 12) Nothing False . itembal) items balwidth = maximumStrict $ map (wbWidth . showAmt . itembal) items
itemamt (_,_,_,Posting{pamount=a},_) = a itemamt (_,_,_,Posting{pamount=a},_) = a
itembal (_,_,_,_,a) = a itembal (_,_,_,_,a) = a
unlinesB [] = mempty unlinesB [] = mempty
unlinesB xs = mconcat (intersperse (TB.fromText "\n") xs) <> TB.fromText "\n" 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: -- | 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) VirtualPosting -> (\s -> wrap "(" ")" s, acctwidth-2)
_ -> (id,acctwidth) _ -> (id,acctwidth)
wrap a b x = a <> x <> b wrap a b x = a <> x <> b
amt = T.pack . fst $ showMixed showAmountWithoutPrice (Just amtwidth) (Just amtwidth) (color_ . rsOpts $ reportspec_ opts) $ pamount p amt = TL.toStrict . TB.toLazyText . wbBuilder . showamt amtwidth $ pamount p
bal = T.pack . fst $ showMixed showAmountWithoutPrice (Just balwidth) (Just balwidth) (color_ . rsOpts $ reportspec_ opts) b 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 -- alternate behaviour, show null amounts as 0 instead of blank
-- amt = if null amt' then "0" else amt' -- amt = if null amt' then "0" else amt'
-- bal = if null bal' then "0" else bal' -- bal = if null bal' then "0" else bal'