fix:print:style balance assertion costs; more styling api; HasAmounts class

hledger-lib/Hledger/Data/Amount.hs

@@ -75,10 +75,11 @@ module Hledger.Data.Amount (
   amountstyle,
   canonicaliseAmount,
   styleAmount,
-  styleAmountExceptPrecision,
   amountSetStyles,
+  amountSetStylesExceptPrecision,
   amountSetMainStyle,
   amountSetCostStyle,
+  amountStyleUnsetPrecision,
   amountUnstyled,
   showAmountB,
   showAmount,
@@ -131,6 +132,7 @@ module Hledger.Data.Amount (
   canonicaliseMixedAmount,
   styleMixedAmount,
   mixedAmountSetStyles,
+  mixedAmountSetStylesExceptPrecision,
   mixedAmountUnstyled,
   showMixedAmount,
   showMixedAmountOneLine,
@@ -251,6 +253,8 @@ amountstyle = AmountStyle L False Nothing (Just '.') (Just $ Precision 0)
 -------------------------------------------------------------------------------
 -- Amount
 
+instance HasAmounts Amount where styleAmounts = amountSetStyles
+
 instance Num Amount where
     abs a@Amount{aquantity=q}    = a{aquantity=abs q}
     signum a@Amount{aquantity=q} = a{aquantity=signum q}
@@ -446,26 +450,31 @@ styleAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
 styleAmount = amountSetStyles
 {-# DEPRECATED styleAmount "please use amountSetStyles instead" #-}
 
--- | Like styleAmount, but leave the display precision 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
-
 -- v3
 
 -- | 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 may or may not be changed, as specified by the style.                                                                                                                                                    
--- the cost amount's display precision is left unchanged, ignoring what the style says.
- -- If no style is found for an amount, it is left unchanged.
+-- The main amount's display precision is set or not, 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
 
+-- | Like amountSetStyles, but leave the display precision unchanged
+-- in both main and cost amounts.
+amountSetStylesExceptPrecision :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
+amountSetStylesExceptPrecision styles a@Amount{astyle=AmountStyle{asprecision=origp}} =
+  case M.lookup (acommodity a) styles' of
+    Just s  -> a{astyle=s{asprecision=origp}}
+    Nothing -> a
+  where styles' = M.map amountStyleUnsetPrecision styles
+
+amountStyleUnsetPrecision :: AmountStyle -> AmountStyle
+amountStyleUnsetPrecision as = as{asprecision=Nothing}
+
 -- | Find and apply the appropriate display style, if any, to this amount.
--- The display precision may or may not be changed, as specified by the style.                                                                                                                                                    
+-- The display precision is set or not, according to the style.
 amountSetMainStyle :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
 amountSetMainStyle styles a@Amount{acommodity=comm, astyle=AmountStyle{asprecision=morigp}} =
   case M.lookup comm styles of
@@ -477,13 +486,13 @@ amountSetMainStyle styles a@Amount{acommodity=comm, astyle=AmountStyle{asprecisi
           _       -> s
 
 -- | Find and apply the appropriate display style, if any, to this amount's cost, if any.
--- The display precision is left unchanged, ignoring what the style says.
+-- The display precision is left unchanged, regardless of the style.
 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}
+    Just (UnitPrice  a2) -> a{aprice=Just $ UnitPrice  $ amountSetStylesExceptPrecision styles a2}
+    Just (TotalPrice a2) -> a{aprice=Just $ TotalPrice $ amountSetStylesExceptPrecision styles a2}
 
 
 -- | Reset this amount's display style to the default.
@@ -589,6 +598,8 @@ applyDigitGroupStyle (Just (DigitGroups c (g0:gs0))) l0 s0 = addseps (g0:|gs0) (
 -------------------------------------------------------------------------------
 -- MixedAmount
 
+instance HasAmounts MixedAmount where styleAmounts = mixedAmountSetStyles
+
 instance Semigroup MixedAmount where
   (<>) = maPlus
   sconcat = maSum
@@ -869,6 +880,9 @@ styleMixedAmount = mixedAmountSetStyles
 mixedAmountSetStyles :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
 mixedAmountSetStyles styles = mapMixedAmountUnsafe (amountSetStyles styles)
 
+mixedAmountSetStylesExceptPrecision :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
+mixedAmountSetStylesExceptPrecision styles = mapMixedAmountUnsafe (amountSetStylesExceptPrecision styles)
+
 -- | Reset each individual amount's display style to the default.
 mixedAmountUnstyled :: MixedAmount -> MixedAmount
 mixedAmountUnstyled = mapMixedAmountUnsafe amountUnstyled

hledger-lib/Hledger/Data/Journal.hs

@@ -802,7 +802,7 @@ journalApplyCommodityStyles = fmap fixjournal . journalInferCommodityStyles
         journalMapPostings (postingApplyCommodityStyles styles) j{jpricedirectives=map fixpricedirective pds}
       where
         styles = journalCommodityStyles j
-        fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmountExceptPrecision styles a}
+        fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=amountSetStylesExceptPrecision styles a}
 
 -- | Get the canonical amount styles for this journal, whether (in order of precedence):
 -- set globally in InputOpts,

hledger-lib/Hledger/Data/Posting.hs

@@ -39,6 +39,7 @@ module Hledger.Data.Posting (
   postingStripPrices,
   postingApplyAliases,
   postingApplyCommodityStyles,
+  postingApplyCommodityStylesExceptPrecision,
   postingAddTags,
   -- * date operations
   postingDate,
@@ -97,6 +98,14 @@ import Hledger.Data.Dates (nulldate, spanContainsDate)
 import Hledger.Data.Valuation
 
 
+instance HasAmounts BalanceAssertion where
+  styleAmounts styles ba@BalanceAssertion{baamount} = ba{baamount=styleAmounts styles baamount}
+
+instance HasAmounts Posting where
+  styleAmounts styles p@Posting{pamount, pbalanceassertion} =
+    p{ pamount=styleAmounts styles pamount
+      ,pbalanceassertion=styleAmounts styles pbalanceassertion 
+      }
 
 nullposting, posting :: Posting
 nullposting = Posting
@@ -410,13 +419,22 @@ postingApplyAliases aliases p@Posting{paccount} =
         err = "problem while applying account aliases:\n" ++ pshow aliases
           ++ "\n to account name: "++T.unpack paccount++"\n "++e
 
--- | Choose and apply a consistent display style to the posting
--- amounts in each commodity (see journalCommodityStyles).
+-- | Find and apply the appropriate display style to the posting amounts
+-- in each commodity (see journalCommodityStyles).
+-- Main amount precisions may be set or not according to the styles, but cost precisions are not set.
 postingApplyCommodityStyles :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting
 postingApplyCommodityStyles styles p = p{pamount=mixedAmountSetStyles styles $ pamount p
-                                        ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p}
+                                        ,pbalanceassertion=balanceassertionsetstyles <$> pbalanceassertion p}
   where
-    fixbalanceassertion ba = ba{baamount=styleAmountExceptPrecision styles $ baamount ba}
+    balanceassertionsetstyles ba = ba{baamount=amountSetStyles styles $ baamount ba}
+
+-- | Like postingApplyCommodityStyles, but neither
+-- main amount precisions or cost precisions are set.
+postingApplyCommodityStylesExceptPrecision :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting
+postingApplyCommodityStylesExceptPrecision styles p = p{pamount=mixedAmountSetStylesExceptPrecision styles $ pamount p
+                                        ,pbalanceassertion=balanceassertionsetstyles <$> pbalanceassertion p}
+  where
+    balanceassertionsetstyles ba = ba{baamount=amountSetStylesExceptPrecision styles $ baamount ba}
 
 -- | Add tags to a posting, discarding any for which the posting already has a value.
 postingAddTags :: Posting -> [Tag] -> Posting

hledger-lib/Hledger/Data/Transaction.hs

@@ -74,6 +74,9 @@ import Data.Decimal (normalizeDecimal, decimalPlaces)
 import Data.Functor ((<&>))
 
 
+instance HasAmounts Transaction where
+  styleAmounts styles t = t{tpostings=styleAmounts styles $ tpostings t}
+
 nulltransaction :: Transaction
 nulltransaction = Transaction {
                     tindex=0,

hledger-lib/Hledger/Data/Types.hs

@@ -301,6 +301,24 @@ data Amount = Amount {
       aprice      :: !(Maybe AmountPrice)  -- ^ the (fixed, transaction-specific) price for this amount, if any
     } deriving (Eq,Ord,Generic,Show)
 
+-- | Types with this class have one or more amounts,
+-- which can have display styles applied to them.
+class HasAmounts a where
+  styleAmounts :: M.Map CommoditySymbol AmountStyle -> a -> a
+
+instance HasAmounts a =>
+  HasAmounts [a]
+  where styleAmounts styles = map (styleAmounts styles)
+
+instance (HasAmounts a, HasAmounts b) =>
+  HasAmounts (a,b)
+  where styleAmounts styles (aa,bb) = (styleAmounts styles aa, styleAmounts styles bb)
+
+instance HasAmounts a =>
+  HasAmounts (Maybe a)
+  where styleAmounts styles = fmap (styleAmounts styles)
+
+
 newtype MixedAmount = Mixed (M.Map MixedAmountKey Amount) deriving (Generic,Show)
 
 instance Eq  MixedAmount where a == b  = maCompare a b == EQ

hledger-lib/Hledger/Reports/AccountTransactionsReport.hs

@@ -85,6 +85,10 @@ type AccountTransactionsReportItem =
   ,MixedAmount -- the register's running total or the current account(s)'s historical balance, after this transaction
   )
 
+instance HasAmounts AccountTransactionsReportItem where
+  styleAmounts styles (torig,tacct,b,c,a1,a2) =
+    (styleAmounts styles torig,styleAmounts styles tacct,b,c,styleAmounts styles a1,styleAmounts styles a2)
+
 triOrigTransaction (torig,_,_,_,_,_) = torig
 triDate (_,tacct,_,_,_,_) = tdate tacct
 triAmount (_,_,_,_,a,_) = a

hledger-lib/Hledger/Reports/BalanceReport.hs

@@ -49,6 +49,9 @@ import Hledger.Reports.ReportTypes
 type BalanceReport = ([BalanceReportItem], MixedAmount)
 type BalanceReportItem = (AccountName, AccountName, Int, MixedAmount)
 
+instance HasAmounts BalanceReportItem where
+  styleAmounts styles (a,b,c,d) = (a,b,c,styleAmounts styles d)
+
 -- | When true (the default), this makes balance --flat reports and their implementation clearer.
 -- Single/multi-col balance reports currently aren't all correct if this is false.
 flatShowsExclusiveBalance    = True

hledger-lib/Hledger/Reports/PostingsReport.hs

@@ -52,6 +52,9 @@ type PostingsReportItem = (Maybe Day     -- The posting date, if this is the fir
                                          -- the running total/average.
                           )
 
+instance HasAmounts PostingsReportItem where
+  styleAmounts styles (a,b,c,d,e) = (a,b,c,styleAmounts styles d,styleAmounts styles e)
+
 -- | A summary posting summarises the activity in one account within a report
 -- interval. It is by a regular Posting with no description, the interval's
 -- start date stored as the posting date, and the interval's Period attached

hledger-lib/Hledger/Reports/ReportTypes.hs

@@ -4,6 +4,8 @@ New common report types, used by the BudgetReport for now, perhaps all reports l
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveFunctor  #-}
 {-# LANGUAGE DeriveGeneric  #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 module Hledger.Reports.ReportTypes
 ( PeriodicReport(..)
@@ -91,6 +93,10 @@ data PeriodicReport a b =
 instance Bifunctor PeriodicReport where
   bimap f g pr = pr{prRows = map (bimap f g) $ prRows pr, prTotals = g <$> prTotals pr}
 
+instance HasAmounts b => HasAmounts (PeriodicReport a b) where
+  styleAmounts styles r@PeriodicReport{prRows,prTotals} =
+    r{prRows=styleAmounts styles prRows, prTotals=styleAmounts styles prTotals}
+
 data PeriodicReportRow a b =
   PeriodicReportRow
   { prrName    :: a    -- An account name.
@@ -106,6 +112,13 @@ instance Bifunctor PeriodicReportRow where
 instance Semigroup b => Semigroup (PeriodicReportRow a b) where
   (<>) = prrAdd
 
+instance HasAmounts b => HasAmounts (PeriodicReportRow a b) where
+  styleAmounts styles r =
+    r{prrAmounts=styleAmounts styles $ prrAmounts r
+     ,prrTotal  =styleAmounts styles $ prrTotal r
+     ,prrAverage=styleAmounts styles $ prrAverage r
+     }
+
 -- | Add two 'PeriodicReportRows', preserving the name of the first.
 prrAdd :: Semigroup b => PeriodicReportRow a b -> PeriodicReportRow a b -> PeriodicReportRow a b
 prrAdd (PeriodicReportRow n1 amts1 t1 a1) (PeriodicReportRow _ amts2 t2 a2) =
@@ -162,6 +175,16 @@ data CompoundPeriodicReport a b = CompoundPeriodicReport
   , cbrTotals     :: PeriodicReportRow () b
   } deriving (Show, Functor, Generic, ToJSON)
 
+instance HasAmounts b => HasAmounts (CompoundPeriodicReport a b) where
+  styleAmounts styles cpr@CompoundPeriodicReport{cbrSubreports, cbrTotals} =
+    cpr{
+        cbrSubreports = styleAmounts styles cbrSubreports
+      , cbrTotals     = styleAmounts styles cbrTotals
+      }
+
+instance HasAmounts b => HasAmounts (Text, PeriodicReport a b, Bool) where
+  styleAmounts styles (a,b,c) = (a,styleAmounts styles b,c)
+
 -- | Description of one subreport within a compound balance report.
 -- Part of a "CompoundBalanceCommandSpec", but also used in hledger-lib.
 data CBCSubreportSpec a = CBCSubreportSpec