diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 19995af15..c18d780e3 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -79,7 +79,7 @@ module Hledger.Data.Amount ( amountSetStylesExceptPrecision, amountSetMainStyle, amountSetCostStyle, - amountStyleUnsetPrecision, + amountStyleSetRounding, amountUnstyled, showAmountB, showAmount, @@ -91,6 +91,7 @@ module Hledger.Data.Amount ( amountSetPrecision, withPrecision, amountSetFullPrecision, + -- amountInternalPrecision, setAmountInternalPrecision, withInternalPrecision, setAmountDecimalPoint, @@ -203,7 +204,7 @@ quoteCommoditySymbolIfNeeded s -- | Options for the display of Amount and MixedAmount. --- (See also Types.AmountStyle) +-- (ee also Types.AmountStyle. 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. @@ -248,7 +249,7 @@ csvDisplay = oneLine{displayThousandsSep=False} -- Amount styles -- | Default amount style -amountstyle = AmountStyle L False Nothing (Just '.') (Just $ Precision 0) +amountstyle = AmountStyle L False Nothing (Just '.') (Precision 0) NoRounding ------------------------------------------------------------------------------- -- Amount @@ -279,11 +280,11 @@ missingamt = nullamt{acommodity="AUTO"} -- usd/eur/gbp round their argument to a whole number of pennies/cents. -- XXX these are a bit clashy num n = nullamt{acommodity="", aquantity=n} -hrs n = nullamt{acommodity="h", aquantity=n, astyle=amountstyle{asprecision=Just $ Precision 2, ascommodityside=R}} -usd n = nullamt{acommodity="$", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Just $ Precision 2}} -eur n = nullamt{acommodity="€", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Just $ Precision 2}} -gbp n = nullamt{acommodity="£", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Just $ Precision 2}} -per n = nullamt{acommodity="%", aquantity=n, astyle=amountstyle{asprecision=Just $ Precision 1, ascommodityside=R, ascommodityspaced=True}} +hrs n = nullamt{acommodity="h", aquantity=n, astyle=amountstyle{asprecision=Precision 2, ascommodityside=R}} +usd n = nullamt{acommodity="$", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}} +eur n = nullamt{acommodity="€", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}} +gbp n = nullamt{acommodity="£", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}} +per n = nullamt{acommodity="%", aquantity=n, astyle=amountstyle{asprecision=Precision 1, ascommodityside=R, ascommodityspaced=True}} amt `at` priceamt = amt{aprice=Just $ UnitPrice priceamt} amt @@ priceamt = amt{aprice=Just $ TotalPrice priceamt} @@ -345,9 +346,8 @@ isNegativeAmount Amount{aquantity=q} = q < 0 -- If that is unset or NaturalPrecision, this does nothing. amountRoundedQuantity :: Amount -> Quantity amountRoundedQuantity Amount{aquantity=q, astyle=AmountStyle{asprecision=mp}} = case mp of - Nothing -> q - Just NaturalPrecision -> q - Just (Precision p) -> roundTo p q + NaturalPrecision -> q + Precision p -> roundTo p q -- | Apply a test to both an Amount and its total price, if it has one. testAmountAndTotalPrice :: (Amount -> Bool) -> Amount -> Bool @@ -363,9 +363,8 @@ amountLooksZero :: Amount -> Bool amountLooksZero = testAmountAndTotalPrice looksZero where looksZero Amount{aquantity=Decimal e q, astyle=AmountStyle{asprecision=p}} = case p of - Just (Precision d) -> if e > d then abs q <= 5*10^(e-d-1) else q == 0 - Just NaturalPrecision -> q == 0 - Nothing -> q == 0 + Precision d -> if e > d then abs q <= 5*10^(e-d-1) else q == 0 + NaturalPrecision -> q == 0 -- | Is this Amount (and its total price, if it has one) exactly zero, ignoring its display precision ? amountIsZero :: Amount -> Bool @@ -377,7 +376,7 @@ withPrecision = flip amountSetPrecision -- | Set an amount's display precision. amountSetPrecision :: AmountPrecision -> Amount -> Amount -amountSetPrecision p a@Amount{astyle=s} = a{astyle=s{asprecision=Just p}} +amountSetPrecision p a@Amount{astyle=s} = a{astyle=s{asprecision=p}} -- | Increase an amount's display precision, if needed, to enough decimal places -- to show it exactly (showing all significant decimal digits, without trailing zeros). @@ -386,9 +385,13 @@ amountSetFullPrecision :: Amount -> Amount amountSetFullPrecision a = amountSetPrecision p a where p = max displayprecision naturalprecision - displayprecision = fromMaybe (Precision 0) $ asprecision $ astyle a + displayprecision = asprecision $ astyle a naturalprecision = Precision . decimalPlaces . normalizeDecimal $ aquantity a +-- -- | Get an amount's internal Decimal precision (not display precision). +-- amountInternalPrecision :: Amount -> Word8 +-- amountInternalPrecision = decimalPlaces . normalizeDecimal . aquantity + -- | Set an amount's internal precision, ie rounds the Decimal representing -- the amount's quantity to some number of decimal places. -- Rounding is done with Data.Decimal's default roundTo function: @@ -397,7 +400,7 @@ amountSetFullPrecision a = amountSetPrecision p a -- Intended mainly for internal use, eg when comparing amounts in tests. setAmountInternalPrecision :: Word8 -> Amount -> Amount setAmountInternalPrecision p a@Amount{ aquantity=q, astyle=s } = a{ - astyle=s{asprecision=Just $ Precision p} + astyle=s{asprecision=Precision p} ,aquantity=roundTo p q } @@ -468,22 +471,49 @@ amountSetStylesExceptPrecision styles a@Amount{astyle=AmountStyle{asprecision=or case M.lookup (acommodity a) styles' of Just s -> a{astyle=s{asprecision=origp}} Nothing -> a - where styles' = M.map amountStyleUnsetPrecision styles + where styles' = M.map (amountStyleSetRounding NoRounding) styles -amountStyleUnsetPrecision :: AmountStyle -> AmountStyle -amountStyleUnsetPrecision as = as{asprecision=Nothing} +amountStyleSetRounding :: Rounding -> AmountStyle -> AmountStyle +amountStyleSetRounding r as = as{asrounding=r} -- | Find and apply the appropriate display style, if any, to this amount. --- The display precision is set or not, according to the style. +-- The display precision is adjusted or not, as determnined by the style's rounding strategy. amountSetMainStyle :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount -amountSetMainStyle styles a@Amount{acommodity=comm, astyle=AmountStyle{asprecision=morigp}} = +amountSetMainStyle styles a@Amount{aquantity=q, acommodity=comm, astyle=s0} = case M.lookup comm styles of - Nothing -> a - Just s@AmountStyle{asprecision=mp} -> a{astyle=s'} + Nothing -> a + Just s -> a{astyle=amountStyleApplyPrecision q s s0} + +-- | A helper for updating an Amount's display precision, more carefully than amountSetPrecision. +-- Given an Amount's decimal quantity (for inspecting its internal representation), +-- its current display style, and a new display style, +-- apply the new style's display precision to the old style, +-- using the new style's rounding strategy, as follows: +-- +-- NoRounding - the precision is left unchanged +-- +-- SoftRounding - +-- +-- if either precision is NaturalPrecision, use NaturalPrecision; +-- +-- if the new precision is greater than the old, use the new (adds decimal zeros); +-- +-- if the new precision is less than the old, use as close to the new as we can get +-- without dropping (more) non-zero digits (drops decimal zeros). +-- +amountStyleApplyPrecision :: Quantity -> AmountStyle -> AmountStyle -> AmountStyle +amountStyleApplyPrecision q AmountStyle{asprecision=newp, asrounding=r} s@AmountStyle{asprecision=oldp} = + case r of + NoRounding -> s + SoftRounding -> s{asprecision=p} where - s' = case mp of - Nothing -> s{asprecision=morigp} - _ -> s + p = case (newp, oldp) of + (Precision new, Precision old) -> + if new >= old + then Precision new + else Precision $ max (min old internal) new + where internal = decimalPlaces $ normalizeDecimal q + _ -> NaturalPrecision -- | Find and apply the appropriate display style, if any, to this amount's cost, if any. -- The display precision is left unchanged, regardless of the style. @@ -1120,8 +1150,8 @@ tests_Amount = testGroup "Amount" [ (usd (-1.23) + usd (-1.23)) @?= usd (-2.46) sum [usd 1.23,usd (-1.23),usd (-1.23),-(usd (-1.23))] @?= usd 0 -- highest precision is preserved - asprecision (astyle $ sum [usd 1 `withPrecision` Precision 1, usd 1 `withPrecision` Precision 3]) @?= Just (Precision 3) - asprecision (astyle $ sum [usd 1 `withPrecision` Precision 3, usd 1 `withPrecision` Precision 1]) @?= Just (Precision 3) + asprecision (astyle $ sum [usd 1 `withPrecision` Precision 1, usd 1 `withPrecision` Precision 3]) @?= Precision 3 + asprecision (astyle $ sum [usd 1 `withPrecision` Precision 3, usd 1 `withPrecision` Precision 1]) @?= Precision 3 -- adding different commodities assumes conversion rate 1 assertBool "" $ amountLooksZero (usd 1.23 - eur 1.23) diff --git a/hledger-lib/Hledger/Data/Balancing.hs b/hledger-lib/Hledger/Data/Balancing.hs index edce06bb5..77982e332 100644 --- a/hledger-lib/Hledger/Data/Balancing.hs +++ b/hledger-lib/Hledger/Data/Balancing.hs @@ -337,8 +337,8 @@ costInferrerFor t pt = maybe id infercost inferFromAndTo unitprice = aquantity fromamount `divideAmount` toamount unitprecision = case (asprecision $ astyle fromamount, asprecision $ astyle toamount) of - (Just (Precision a), Just (Precision b)) -> Precision . max 2 $ saturatedAdd a b - _ -> NaturalPrecision + (Precision a, Precision b) -> Precision . max 2 $ saturatedAdd a b + _ -> NaturalPrecision saturatedAdd a b = if maxBound - a < b then maxBound else a + b @@ -1009,26 +1009,26 @@ tests_Balancing = -- testCase "1091a" $ do commodityStylesFromAmounts [ - nullamt{aquantity=1000, astyle=AmountStyle L False Nothing (Just ',') (Just $ Precision 3)} - ,nullamt{aquantity=1000, astyle=AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Just $ Precision 2)} + nullamt{aquantity=1000, astyle=AmountStyle L False Nothing (Just ',') (Precision 3) NoRounding} + ,nullamt{aquantity=1000, astyle=AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Precision 2) NoRounding} ] @?= -- The commodity style should have period as decimal mark -- and comma as digit group mark. Right (M.fromList [ - ("", AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Just $ Precision 3)) + ("", AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Precision 3) NoRounding) ]) -- same journal, entries in reverse order ,testCase "1091b" $ do commodityStylesFromAmounts [ - nullamt{aquantity=1000, astyle=AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Just $ Precision 2)} - ,nullamt{aquantity=1000, astyle=AmountStyle L False Nothing (Just ',') (Just $ Precision 3)} + nullamt{aquantity=1000, astyle=AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Precision 2) NoRounding} + ,nullamt{aquantity=1000, astyle=AmountStyle L False Nothing (Just ',') (Precision 3) NoRounding} ] @?= -- The commodity style should have period as decimal mark -- and comma as digit group mark. Right (M.fromList [ - ("", AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Just $ Precision 3)) + ("", AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Precision 3) NoRounding) ]) ] diff --git a/hledger-lib/Hledger/Data/Json.hs b/hledger-lib/Hledger/Data/Json.hs index b3aeb82d2..2db1a4d2f 100644 --- a/hledger-lib/Hledger/Data/Json.hs +++ b/hledger-lib/Hledger/Data/Json.hs @@ -82,6 +82,7 @@ decimalKV d = let d' = if decimalPlaces d <= 10 then d else roundTo 10 d in ] instance ToJSON Amount +instance ToJSON Rounding instance ToJSON AmountStyle -- Use the same JSON serialisation as Maybe Word8 @@ -193,6 +194,7 @@ instance FromJSON Pos where parseJSON = fmap mkPos . parseJSON instance FromJSON Amount +instance FromJSON Rounding instance FromJSON AmountStyle -- Use the same JSON serialisation as Maybe Word8 diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 0fc417200..3559868fe 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -378,11 +378,7 @@ transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTra Nothing -> Left $ annotateWithPostings [p] "Conversion postings must have a single-commodity amount:" -- Do these amounts look the same when compared at the first's display precision ? - -- (Or if that's unset, compare as-is) - amountsMatch a b = - case asprecision $ astyle a of - Just p -> amountLooksZero $ amountSetPrecision p $ a - b - Nothing -> amountLooksZero $ a - b + amountsMatch a b = amountLooksZero $ amountSetPrecision (asprecision $ astyle a) $ a - b -- Delete a posting from the indexed list of postings based on either its -- index or its posting amount. @@ -400,9 +396,8 @@ transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTra dbgShowAmountPrecision a = case asprecision $ astyle a of - Just (Precision n) -> show n - Just NaturalPrecision -> show $ decimalPlaces $ normalizeDecimal $ aquantity a - Nothing -> "unset" + Precision n -> show n + NaturalPrecision -> show $ decimalPlaces $ normalizeDecimal $ aquantity a -- Using the provided account types map, sort the given indexed postings -- into three lists of posting numbers (stored in two pairs), like so: diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 04a57e2eb..4b70e052e 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -249,16 +249,19 @@ deriving instance Generic (DecimalRaw a) data AmountPrice = UnitPrice !Amount | TotalPrice !Amount deriving (Eq,Ord,Generic,Show) --- | The display style for an amount. --- (See also Amount.AmountDisplayOpts). +-- | Every Amount has one of these, influencing how the amount is displayed. +-- Also, each Commodity can have one, which can be applied to its amounts for consistent display. +-- See also Amount.AmountDisplayOpts. data AmountStyle = AmountStyle { ascommodityside :: !Side, -- ^ show the symbol on the left or the right ? ascommodityspaced :: !Bool, -- ^ show a space between symbol and quantity ? asdigitgroups :: !(Maybe DigitGroupStyle), -- ^ show the integer part with these digit group marks, or not asdecimalmark :: !(Maybe Char), -- ^ show this character (should be . or ,) as decimal mark, or use the default (.) - asprecision :: !(Maybe AmountPrecision) -- ^ show this number of digits after the decimal point, or show as-is (leave precision unchanged) - -- XXX Making asprecision a maybe simplifies code for styling with or without precision, - -- but complicates the semantics (Nothing is useful only when setting style). + asprecision :: !AmountPrecision, -- ^ "display precision" - show this number of digits after the decimal point + asrounding :: !Rounding -- ^ "rounding strategy" - kept here for convenience, for now: + -- when displaying an amount, it is ignored, + -- but when applying this style to another amount, it determines + -- how hard we should try to adjust the amount's display precision. } deriving (Eq,Ord,Read,Generic) instance Show AmountStyle where @@ -278,6 +281,16 @@ data AmountPrecision = | NaturalPrecision -- ^ show all significant decimal digits stored internally deriving (Eq,Ord,Read,Show,Generic) +-- | "Rounding strategy" - when applying the display precision from AmountStyle to another +-- (as when applying commodity styles to amounts), how much padding or rounding +-- of decimal digits should be done ? +data Rounding = + NoRounding -- ^ keep the amount precisions unchanged + | SoftRounding -- ^ add or remove trailing zeros to approach the desired precision + -- | HardRounding -- ^ also remove non-zero digits, in posting amounts (lossy) + -- | HardRoundingAndCost -- ^ also remove non-zero digits, in posting and cost amounts (lossy) + deriving (Eq,Ord,Read,Generic) + -- | A style for displaying digit groups in the integer part of a -- floating point number. It consists of the character used to -- separate groups (comma or period, whichever is not used as decimal diff --git a/hledger-lib/Hledger/Data/Valuation.hs b/hledger-lib/Hledger/Data/Valuation.hs index 868cbb754..7c20110fd 100644 --- a/hledger-lib/Hledger/Data/Valuation.hs +++ b/hledger-lib/Hledger/Data/Valuation.hs @@ -110,8 +110,8 @@ amountPriceDirectiveFromCost d amt@Amount{acommodity=fromcomm, aquantity=fromq} where style' = (astyle a) { asprecision = precision' } precision' = case asprecision (astyle a) of - Just (Precision p) -> Just $ Precision $ (numDigitsInt $ truncate n) + p - mp -> mp + NaturalPrecision -> NaturalPrecision + Precision p -> Precision $ (numDigitsInt $ truncate n) + p ------------------------------------------------------------------------------ -- Converting things to value diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 994743a48..fd2ef41fb 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -804,7 +804,7 @@ simpleamountp mult = offAfterNum <- getOffset let numRegion = (offBeforeNum, offAfterNum) (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent - let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=Just prec, asdecimalmark=mdec, asdigitgroups=mgrps} + let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalmark=mdec, asdigitgroups=mgrps} return nullamt{acommodity=c, aquantity=sign (sign2 q), astyle=s, aprice=Nothing} -- An amount with commodity symbol on the right or no commodity symbol. @@ -826,7 +826,7 @@ simpleamountp mult = -- XXX amounts of this commodity in periodic transaction rules and auto posting rules ? #1461 let msuggestedStyle = mdecmarkStyle <|> mcommodityStyle (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion msuggestedStyle ambiguousRawNum mExponent - let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=Just prec, asdecimalmark=mdec, asdigitgroups=mgrps} + let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalmark=mdec, asdigitgroups=mgrps} return nullamt{acommodity=c, aquantity=sign q, astyle=s, aprice=Nothing} -- no symbol amount Nothing -> do @@ -842,8 +842,8 @@ simpleamountp mult = -- (unless it's a multiplier in an automated posting) defcs <- getDefaultCommodityAndStyle let (c,s) = case (mult, defcs) of - (False, Just (defc,defs)) -> (defc, defs{asprecision=max (asprecision defs) (Just prec)}) - _ -> ("", amountstyle{asprecision=Just prec, asdecimalmark=mdec, asdigitgroups=mgrps}) + (False, Just (defc,defs)) -> (defc, defs{asprecision=max (asprecision defs) prec}) + _ -> ("", amountstyle{asprecision=prec, asdecimalmark=mdec, asdigitgroups=mgrps}) return nullamt{acommodity=c, aquantity=sign q, astyle=s, aprice=Nothing} -- For reducing code duplication. Doesn't parse anything. Has the type @@ -1070,7 +1070,7 @@ disambiguateNumber msuggestedStyle (AmbiguousNumber grp1 sep grp2) = isValidDecimalBy c = \case AmountStyle{asdecimalmark = Just d} -> d == c AmountStyle{asdigitgroups = Just (DigitGroups g _)} -> g /= c - AmountStyle{asprecision = Just (Precision 0)} -> False + AmountStyle{asprecision = Precision 0} -> False _ -> True -- | Parse and interpret the structure of a number without external hints. @@ -1574,24 +1574,24 @@ tests_Common = testGroup "Common" [ nullamt{ acommodity="$" ,aquantity=10 -- need to test internal precision with roundTo ? I think not - ,astyle=amountstyle{asprecision=Just $ Precision 0, asdecimalmark=Nothing} + ,astyle=amountstyle{asprecision=Precision 0, asdecimalmark=Nothing} ,aprice=Just $ UnitPrice $ nullamt{ acommodity="€" ,aquantity=0.5 - ,astyle=amountstyle{asprecision=Just $ Precision 1, asdecimalmark=Just '.'} + ,astyle=amountstyle{asprecision=Precision 1, asdecimalmark=Just '.'} } } ,testCase "total price" $ assertParseEq amountp "$10 @@ €5" nullamt{ acommodity="$" ,aquantity=10 - ,astyle=amountstyle{asprecision=Just $ Precision 0, asdecimalmark=Nothing} + ,astyle=amountstyle{asprecision=Precision 0, asdecimalmark=Nothing} ,aprice=Just $ TotalPrice $ nullamt{ acommodity="€" ,aquantity=5 - ,astyle=amountstyle{asprecision=Just $ Precision 0, asdecimalmark=Nothing} + ,astyle=amountstyle{asprecision=Precision 0, asdecimalmark=Nothing} } } ,testCase "unit price, parenthesised" $ assertParse amountp "$10 (@) €0.5" diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs index 8a8b189f6..d4d2ac92f 100644 --- a/hledger-lib/Hledger/Read/TimedotReader.hs +++ b/hledger-lib/Hledger/Read/TimedotReader.hs @@ -193,8 +193,8 @@ timedotentryp = do mcs <- getDefaultCommodityAndStyle let (c,s) = case mcs of - Just (defc,defs) -> (defc, defs{asprecision=max (asprecision defs) (Just $ Precision 2)}) - _ -> ("", amountstyle{asprecision=Just $ Precision 2}) + Just (defc,defs) -> (defc, defs{asprecision=max (asprecision defs) (Precision 2)}) + _ -> ("", amountstyle{asprecision=Precision 2}) -- lift $ traceparse' "timedotentryp end" return $ nullposting{paccount=a ,pamount=mixedAmount $ nullamt{acommodity=c, aquantity=hours, astyle=s} diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index a023c9887..b0bc5e508 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -618,7 +618,8 @@ tests_MultiBalanceReport = testGroup "MultiBalanceReport" [ let amt0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, - astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asdigitgroups = Nothing, asdecimalmark = Just '.', asprecision = Just $ Precision 2}} + astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asdigitgroups = Nothing, + asdecimalmark = Just '.', asprecision = Precision 2, asrounding = NoRounding}} (rspec,journal) `gives` r = do let rspec' = rspec{_rsQuery=And [queryFromFlags $ _rsReportOpts rspec, _rsQuery rspec]} (eitems, etotal) = r diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index 64177739e..49ea8d942 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -70,16 +70,15 @@ print' opts j = do printEntries :: CliOpts -> Journal -> IO () printEntries opts@CliOpts{reportspec_=rspec} j = - writeOutputLazyText opts . render $ - styleAmounts styles $ - entriesReport rspec j + writeOutputLazyText opts $ render $ entriesReport rspec j where - styles = M.map amountStyleUnsetPrecision $ journalCommodityStyles j -- keep all precisions unchanged + stylesnorounding = M.map (amountStyleSetRounding NoRounding) $ journalCommodityStyles j + stylessoftrounding = M.map (amountStyleSetRounding SoftRounding) $ journalCommodityStyles j fmt = outputFormatFromOpts opts - render | fmt=="txt" = entriesReportAsText opts - | fmt=="csv" = printCSV . entriesReportAsCsv - | fmt=="json" = toJsonText - | fmt=="sql" = entriesReportAsSql + render | fmt=="txt" = entriesReportAsText opts . styleAmounts stylesnorounding + | fmt=="csv" = printCSV . entriesReportAsCsv . styleAmounts stylessoftrounding + | fmt=="json" = toJsonText . styleAmounts stylessoftrounding + | fmt=="sql" = entriesReportAsSql . styleAmounts stylessoftrounding | otherwise = error' $ unsupportedOutputFormatError fmt -- PARTIAL: entriesReportAsText :: CliOpts -> EntriesReport -> TL.Text