dev: consolidate amount styling as a new (interim) api

hledger-lib/Hledger/Data/Amount.hs

@@ -73,8 +73,12 @@ module Hledger.Data.Amount (
   oneLine,
   csvDisplay,
   amountstyle,
+  canonicaliseAmount,
   styleAmount,
   styleAmountExceptPrecision,
+  amountSetStyles,
+  amountSetMainStyle,
+  amountSetCostStyle,
   amountUnstyled,
   showAmountB,
   showAmount,
@@ -91,7 +95,6 @@ module Hledger.Data.Amount (
   setAmountDecimalPoint,
   withDecimalPoint,
   amountStripPrices,
-  canonicaliseAmount,
   -- * MixedAmount
   nullmixedamt,
   missingmixedamt,
@@ -125,7 +128,9 @@ module Hledger.Data.Amount (
   maIsNonZero,
   mixedAmountLooksZero,
   -- ** rendering
+  canonicaliseMixedAmount,
   styleMixedAmount,
+  mixedAmountSetStyles,
   mixedAmountUnstyled,
   showMixedAmount,
   showMixedAmountOneLine,
@@ -140,7 +145,6 @@ module Hledger.Data.Amount (
   wbUnpack,
   mixedAmountSetPrecision,
   mixedAmountSetFullPrecision,
-  canonicaliseMixedAmount,
   -- * misc.
   tests_Amount
 ) where
@@ -418,33 +422,67 @@ showAmountPriceDebug Nothing                = ""
 showAmountPriceDebug (Just (UnitPrice pa))  = " @ "  ++ showAmountDebug pa
 showAmountPriceDebug (Just (TotalPrice pa)) = " @@ " ++ showAmountDebug pa
 
+-- Amount styling
+-- v1
+
+-- like journalCanonicaliseAmounts
+-- | Canonicalise an amount's display style using the provided commodity style map.
+-- Its cost amount, if any, is not affected.
+canonicaliseAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
+canonicaliseAmount = amountSetMainStyle
+{-# DEPRECATED canonicaliseAmount "please use amountSetMainStyle (or amountSetStyles) instead" #-}
+
+-- v2
+
 -- | Given a map of standard commodity display styles, apply the
 -- appropriate one to this amount. If there's no standard style for
 -- this amount's commodity, return the amount unchanged.
--- Also apply the style, except for precision, to the cost.
+-- Also do the same for the cost amount if any, but leave its precision unchanged.
 styleAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
-styleAmount styles a = styledAmount{aprice = stylePrice styles (aprice styledAmount)}
+styleAmount = amountSetStyles
-  where
+{-# DEPRECATED styleAmount "please use amountSetStyles instead" #-}
-    styledAmount = case M.lookup (acommodity a) styles of
-      Just s -> a{astyle=s}
-      Nothing -> a
 
-stylePrice :: M.Map CommoditySymbol AmountStyle -> Maybe AmountPrice -> Maybe AmountPrice
+-- | Like styleAmount, but leave the display precision unchanged.
-stylePrice styles (Just (UnitPrice a)) = Just (UnitPrice $ styleAmountExceptPrecision styles a)
-stylePrice styles (Just (TotalPrice a)) = Just (TotalPrice $ styleAmountExceptPrecision styles a)
-stylePrice _ _  = Nothing
-
--- | Like styleAmount, but keep the number of decimal places unchanged.
 styleAmountExceptPrecision :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
 styleAmountExceptPrecision styles a@Amount{astyle=AmountStyle{asprecision=origp}} =
   case M.lookup (acommodity a) styles of
     Just s  -> a{astyle=s{asprecision=origp}}
     Nothing -> a
 
+-- v2.9
+
+-- | Given some commodity display styles, find and apply the appropriate
+-- display style to this amount, and do the same for its cost amount if any
+-- (and then stop; we assume costs don't have costs).
+-- The main amount's display precision is set according to its style;
+-- the cost amount's display precision is left unchanged, regardless of its style.
+-- If no style is found for an amount, it is left unchanged.
+amountSetStyles :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
+amountSetStyles styles = amountSetMainStyle styles <&> amountSetCostStyle styles
+
+-- | Find and apply the appropriate display style, if any, to this amount.
+-- The display precision is also set.
+amountSetMainStyle :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
+amountSetMainStyle styles a@Amount{acommodity=comm} =
+  case M.lookup comm styles of
+    Nothing -> a
+    Just s  -> a{astyle=s}
+
+-- | Find and apply the appropriate display style, if any, to this amount's cost, if any.
+-- The display precision is left unchanged.
+amountSetCostStyle :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
+amountSetCostStyle styles a@Amount{aprice=mcost} =
+  case mcost of
+    Nothing              -> a
+    Just (UnitPrice  a2) -> a{aprice=Just $ UnitPrice  $ styleAmountExceptPrecision styles a2}
+    Just (TotalPrice a2) -> a{aprice=Just $ TotalPrice $ styleAmountExceptPrecision styles a2}
+
+
 -- | Reset this amount's display style to the default.
 amountUnstyled :: Amount -> Amount
 amountUnstyled a = a{astyle=amountstyle}
 
+
 -- | Get the string representation of an amount, based on its
 -- commodity's display settings. String representations equivalent to
 -- zero are converted to just \"0\". The special "missing" amount is
@@ -540,12 +578,6 @@ applyDigitGroupStyle (Just (DigitGroups c (g0:gs0))) l0 s0 = addseps (g0:|gs0) (
         gs2 = fromMaybe (g1:|[]) $ nonEmpty gs1
         l2 = l1 - toInteger g1
 
--- like journalCanonicaliseAmounts
--- | Canonicalise an amount's display style using the provided commodity style map.
-canonicaliseAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
-canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'}
-  where s' = M.findWithDefault s c styles
-
 -------------------------------------------------------------------------------
 -- MixedAmount
 
@@ -807,15 +839,33 @@ mixedAmountCost (Mixed ma) =
 --     where a' = mixedAmountStripPrices a
 --           b' = mixedAmountStripPrices b
 
+-- Mixed amount styling
+-- v1
+
+-- | Canonicalise a mixed amount's display styles using the provided commodity style map.
+-- Cost amounts, if any, are not affected.
+canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
+canonicaliseMixedAmount styles = mapMixedAmountUnsafe (canonicaliseAmount styles)
+{-# DEPRECATED canonicaliseMixedAmount "please use mixedAmountSetMainStyle (or mixedAmountSetStyles) instead" #-}
+
+-- v2
+
 -- | Given a map of standard commodity display styles, find and apply
 -- the appropriate style to each individual amount.
 styleMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
-styleMixedAmount styles = mapMixedAmountUnsafe (styleAmount styles)
+styleMixedAmount = mixedAmountSetStyles
+{-# DEPRECATED styleMixedAmount "please use mixedAmountSetStyles instead" #-}
+
+-- v2.9
+
+mixedAmountSetStyles :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
+mixedAmountSetStyles styles = mapMixedAmountUnsafe (amountSetStyles styles)
 
 -- | Reset each individual amount's display style to the default.
 mixedAmountUnstyled :: MixedAmount -> MixedAmount
 mixedAmountUnstyled = mapMixedAmountUnsafe amountUnstyled
 
+
 -- | Get the string representation of a mixed amount, after
 -- normalising it to one amount per commodity. Assumes amounts have
 -- no or similar prices, otherwise this can show misleading prices.
@@ -1008,10 +1058,6 @@ mixedAmountStripPrices (Mixed ma) =
     foldl' (\m a -> maAddAmount m a{aprice=Nothing}) (Mixed noPrices) withPrices
   where (noPrices, withPrices) = M.partition (isNothing . aprice) ma
 
--- | Canonicalise a mixed amount's display styles using the provided commodity style map.
-canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
-canonicaliseMixedAmount styles = mapMixedAmountUnsafe (canonicaliseAmount styles)
-
 
 -------------------------------------------------------------------------------
 -- tests

hledger-lib/Hledger/Data/Balancing.hs

@@ -101,12 +101,12 @@ transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs
             VirtualPosting         -> (l, r)
 
     -- check for mixed signs, detecting nonzeros at display precision
-    canonicalise = maybe id canonicaliseMixedAmount commodity_styles_
+    setstyles = maybe id mixedAmountSetStyles commodity_styles_
     postingBalancingAmount p
       | "_price-matched" `elem` map fst (ptags p) = mixedAmountStripPrices $ pamount p
       | otherwise                                 = mixedAmountCost $ pamount p
     signsOk ps =
-      case filter (not.mixedAmountLooksZero) $ map (canonicalise.postingBalancingAmount) ps of
+      case filter (not.mixedAmountLooksZero) $ map (setstyles.postingBalancingAmount) ps of
         nonzeros | length nonzeros >= 2
                    -> length (nubSort $ mapMaybe isNegativeMixedAmount nonzeros) > 1
         _          -> True
@@ -114,7 +114,7 @@ transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs
 
     -- check for zero sum, at display precision
     (rsumcost, bvsumcost)       = (foldMap postingBalancingAmount rps, foldMap postingBalancingAmount bvps)
-    (rsumdisplay, bvsumdisplay) = (canonicalise rsumcost, canonicalise bvsumcost)
+    (rsumdisplay, bvsumdisplay) = (setstyles rsumcost, setstyles bvsumcost)
     (rsumok, bvsumok)           = (mixedAmountLooksZero rsumdisplay, mixedAmountLooksZero bvsumdisplay)
 
     -- generate error messages, showing amounts with their original precision
@@ -250,7 +250,7 @@ transactionInferBalancingAmount styles t@Transaction{tpostings=ps}
               -- Inferred amounts are converted to cost.
               -- Also ensure the new amount has the standard style for its commodity
               -- (since the main amount styling pass happened before this balancing pass);
-              a' = styleMixedAmount styles . mixedAmountCost $ maNegate a
+              a' = mixedAmountSetStyles styles . mixedAmountCost $ maNegate a
 
 -- | Infer costs for this transaction's posting amounts, if needed to make
 -- the postings balance, and if permitted. This is done once for the real

hledger-lib/Hledger/Data/Posting.hs

@@ -413,7 +413,7 @@ postingApplyAliases aliases p@Posting{paccount} =
 -- | Choose and apply a consistent display style to the posting
 -- amounts in each commodity (see journalCommodityStyles).
 postingApplyCommodityStyles :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting
-postingApplyCommodityStyles styles p = p{pamount=styleMixedAmount styles $ pamount p
+postingApplyCommodityStyles styles p = p{pamount=mixedAmountSetStyles styles $ pamount p
                                         ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p}
   where
     fixbalanceassertion ba = ba{baamount=styleAmountExceptPrecision styles $ baamount ba}
@@ -436,7 +436,7 @@ postingToCost _      NoConversionOp p = Just p
 postingToCost styles ToCost         p
     -- If this is a conversion posting with a matched transaction price posting, ignore it
     | "_conversion-matched" `elem` map fst (ptags p) && noCost = Nothing
-    | otherwise = Just $ postingTransformAmount (styleMixedAmount styles . mixedAmountCost) p
+    | otherwise = Just $ postingTransformAmount (mixedAmountSetStyles styles . mixedAmountCost) p
   where
     noCost = (not . any (isJust . aprice) . amountsRaw) $ pamount p
 

hledger-lib/Hledger/Data/Valuation.hs

@@ -129,7 +129,7 @@ mixedAmountApplyValuation priceoracle styles periodlast today postingdate v =
 
 -- | Convert an Amount to its cost if requested, and style it appropriately.
 amountToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> Amount -> Amount
-amountToCost styles ToCost         = styleAmount styles . amountCost
+amountToCost styles ToCost         = amountSetStyles styles . amountCost
 amountToCost _      NoConversionOp = id
 
 -- | Apply a specified valuation to this amount, using the provided
@@ -192,7 +192,7 @@ amountValueAtDate priceoracle styles mto d a =
       -- setNaturalPrecisionUpTo 8 $  -- XXX force higher precision in case amount appears to be zero ?
                                       -- Make default display style use precision 2 instead of 0 ?
                                       -- Leave as is for now; mentioned in manual.
-      styleAmount styles
+      amountSetStyles styles
       nullamt{acommodity=comm, aquantity=rate * aquantity a}
 
 -- | Calculate the gain of each component amount, that is the difference

hledger-lib/Hledger/Reports/ReportOptions.hs

@@ -623,7 +623,7 @@ mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle =
     gain mc spn = mixedAmountGainAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd spn)
     costing = case fromMaybe NoConversionOp $ conversionop_ ropts of
         NoConversionOp -> id
-        ToCost         -> styleMixedAmount styles . mixedAmountCost
+        ToCost         -> mixedAmountSetStyles styles . mixedAmountCost
     styles = journalCommodityStyles j
     err = error "mixedAmountApplyValuationAfterSumFromOptsWith: expected all spans to have an end date"