mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-19 18:29:36 +03:00
lib: showamountquantity shows directly, rather than parsing string output of show instance for Quantity.
This commit is contained in:
parent
f998a791cf
commit
5dedec83da
@ -130,15 +130,16 @@ module Hledger.Data.Amount (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (foldM)
|
import Control.Monad (foldM)
|
||||||
import Data.Char (isDigit)
|
import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo)
|
||||||
import Data.Decimal (decimalPlaces, normalizeDecimal, roundTo)
|
|
||||||
import Data.Function (on)
|
import Data.Function (on)
|
||||||
import Data.List (genericSplitAt, groupBy, intercalate, mapAccumL,
|
import Data.List (genericSplitAt, groupBy, intercalate, mapAccumL,
|
||||||
partition, sortBy)
|
partition, sortBy)
|
||||||
|
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)
|
||||||
import Data.Maybe (fromMaybe)
|
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 Data.Word (Word8)
|
import Data.Word (Word8)
|
||||||
import Safe (lastDef, lastMay)
|
import Safe (lastDef, lastMay)
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
@ -156,7 +157,6 @@ deriving instance Show MarketPrice
|
|||||||
-- | Default amount style
|
-- | Default amount style
|
||||||
amountstyle = AmountStyle L False (Precision 0) (Just '.') Nothing
|
amountstyle = AmountStyle L False (Precision 0) (Just '.') Nothing
|
||||||
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- Amount
|
-- Amount
|
||||||
|
|
||||||
@ -386,7 +386,7 @@ showAmountHelper showzerocommodity a@Amount{acommodity=c, aprice=mp, astyle=Amou
|
|||||||
L -> printf "%s%s%s%s" (T.unpack c') space quantity' price
|
L -> printf "%s%s%s%s" (T.unpack c') space quantity' price
|
||||||
R -> printf "%s%s%s%s" quantity' space (T.unpack c') price
|
R -> printf "%s%s%s%s" quantity' space (T.unpack c') price
|
||||||
where
|
where
|
||||||
quantity = showamountquantity a
|
quantity = wbUnpack $ showamountquantity a
|
||||||
(quantity',c') | amountLooksZero a && not showzerocommodity = ("0","")
|
(quantity',c') | amountLooksZero a && not showzerocommodity = ("0","")
|
||||||
| otherwise = (quantity, quoteCommoditySymbolIfNeeded c)
|
| otherwise = (quantity, quoteCommoditySymbolIfNeeded c)
|
||||||
space = if not (T.null c') && ascommodityspaced then " " else "" :: String
|
space = if not (T.null c') && ascommodityspaced then " " else "" :: String
|
||||||
@ -402,35 +402,40 @@ showAmountDebug :: Amount -> String
|
|||||||
showAmountDebug Amount{acommodity="AUTO"} = "(missing)"
|
showAmountDebug Amount{acommodity="AUTO"} = "(missing)"
|
||||||
showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}" (show acommodity) (show aquantity) (showAmountPriceDebug aprice) (show astyle)
|
showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}" (show acommodity) (show aquantity) (showAmountPriceDebug aprice) (show astyle)
|
||||||
|
|
||||||
-- | Get the string representation of the number part of of an amount,
|
-- | Get a Text Builder for the string representation of the number part of of an amount,
|
||||||
-- using the display settings from its commodity.
|
-- using the display settings from its commodity. Also returns the width of the
|
||||||
showamountquantity :: Amount -> String
|
-- number.
|
||||||
|
showamountquantity :: Amount -> WideBuilder
|
||||||
showamountquantity amt@Amount{astyle=AmountStyle{asdecimalpoint=mdec, asdigitgroups=mgrps}} =
|
showamountquantity amt@Amount{astyle=AmountStyle{asdecimalpoint=mdec, asdigitgroups=mgrps}} =
|
||||||
punctuatenumber (fromMaybe '.' mdec) mgrps . show $ amountRoundedQuantity amt
|
signB <> intB <> fracB
|
||||||
|
|
||||||
-- | Replace a number string's decimal mark with the specified
|
|
||||||
-- character, and add the specified digit group marks. The last digit
|
|
||||||
-- group will be repeated as needed.
|
|
||||||
punctuatenumber :: Char -> Maybe DigitGroupStyle -> String -> String
|
|
||||||
punctuatenumber dec mgrps s = sign ++ reverse (applyDigitGroupStyle mgrps (reverse int)) ++ frac''
|
|
||||||
where
|
|
||||||
(sign,num) = break isDigit s
|
|
||||||
(int,frac) = break (=='.') num
|
|
||||||
frac' = dropWhile (=='.') frac
|
|
||||||
frac'' | null frac' = ""
|
|
||||||
| otherwise = dec:frac'
|
|
||||||
|
|
||||||
applyDigitGroupStyle :: Maybe DigitGroupStyle -> String -> String
|
|
||||||
applyDigitGroupStyle Nothing s = s
|
|
||||||
applyDigitGroupStyle (Just (DigitGroups c gs)) s = addseps (repeatLast gs) s
|
|
||||||
where
|
where
|
||||||
addseps [] s = s
|
Decimal e n = amountRoundedQuantity amt
|
||||||
addseps (g:gs) s
|
|
||||||
| toInteger (length s) <= toInteger g = s
|
strN = show $ abs n
|
||||||
| otherwise = let (part,rest) = genericSplitAt g s
|
len = length strN
|
||||||
in part ++ c : addseps gs rest
|
intLen = max 1 $ len - fromIntegral e
|
||||||
repeatLast [] = []
|
dec = fromMaybe '.' mdec
|
||||||
repeatLast gs = init gs ++ repeat (last gs)
|
padded = replicate (fromIntegral e + 1 - len) '0' ++ strN
|
||||||
|
(intPart, fracPart) = 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
|
||||||
|
|
||||||
|
-- | 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 (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)
|
||||||
|
where
|
||||||
|
(rest, part) = genericSplitAt l' s
|
||||||
|
gs' = fromMaybe (g:|[]) $ nonEmpty gs
|
||||||
|
l' = l - toInteger g
|
||||||
|
|
||||||
-- like journalCanonicaliseAmounts
|
-- like journalCanonicaliseAmounts
|
||||||
-- | Canonicalise an amount's display style using the provided commodity style map.
|
-- | Canonicalise an amount's display style using the provided commodity style map.
|
||||||
|
@ -46,6 +46,8 @@ module Hledger.Utils.Text
|
|||||||
-- fitto,
|
-- fitto,
|
||||||
fitText,
|
fitText,
|
||||||
-- -- * wide-character-aware layout
|
-- -- * wide-character-aware layout
|
||||||
|
WideBuilder(..),
|
||||||
|
wbUnpack,
|
||||||
textWidth,
|
textWidth,
|
||||||
textTakeWidth,
|
textTakeWidth,
|
||||||
-- fitString,
|
-- fitString,
|
||||||
@ -66,6 +68,8 @@ import Data.Monoid
|
|||||||
#endif
|
#endif
|
||||||
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.Builder as TB
|
||||||
-- import Text.Parsec
|
-- import Text.Parsec
|
||||||
-- import Text.Printf (printf)
|
-- import Text.Printf (printf)
|
||||||
|
|
||||||
@ -74,6 +78,24 @@ import qualified Data.Text as T
|
|||||||
import Hledger.Utils.Test
|
import Hledger.Utils.Test
|
||||||
import Text.WideString (charWidth, textWidth)
|
import Text.WideString (charWidth, textWidth)
|
||||||
|
|
||||||
|
|
||||||
|
-- | Helper for constructing Builders while keeping track of text width.
|
||||||
|
data WideBuilder = WideBuilder
|
||||||
|
{ wbBuilder :: !TB.Builder
|
||||||
|
, wbWidth :: !Int
|
||||||
|
}
|
||||||
|
|
||||||
|
instance Semigroup WideBuilder where
|
||||||
|
WideBuilder x i <> WideBuilder y j = WideBuilder (x <> y) (i + j)
|
||||||
|
|
||||||
|
instance Monoid WideBuilder where
|
||||||
|
mempty = WideBuilder mempty 0
|
||||||
|
|
||||||
|
-- | Unpack a WideBuilder to a String.
|
||||||
|
wbUnpack :: WideBuilder -> String
|
||||||
|
wbUnpack = TL.unpack . TB.toLazyText . wbBuilder
|
||||||
|
|
||||||
|
|
||||||
-- lowercase, uppercase :: String -> String
|
-- lowercase, uppercase :: String -> String
|
||||||
-- lowercase = map toLower
|
-- lowercase = map toLower
|
||||||
-- uppercase = map toUpper
|
-- uppercase = map toUpper
|
||||||
|
Loading…
Reference in New Issue
Block a user