hledger-lib 1.30 → 1.31

raw patch · 21 files changed

+655/−358 lines, 21 filesdep ~aesonPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• CHANGES.md +28/−1
• Hledger/Data/Amount.hs +221/−94
• Hledger/Data/Balancing.hs +16/−13
• Hledger/Data/Dates.hs +1/−1
• Hledger/Data/Journal.hs +32/−25
• Hledger/Data/JournalChecks.hs +57/−89
• Hledger/Data/Json.hs +22/−3
• Hledger/Data/Posting.hs +32/−12
• Hledger/Data/Transaction.hs +143/−72
• Hledger/Data/Types.hs +35/−14
• Hledger/Data/Valuation.hs +4/−4
• Hledger/Read/Common.hs +14/−14
• Hledger/Read/JournalReader.hs +3/−3
• Hledger/Read/TimedotReader.hs +2/−2
• Hledger/Reports/AccountTransactionsReport.hs +5/−1
• Hledger/Reports/BalanceReport.hs +3/−0
• Hledger/Reports/MultiBalanceReport.hs +2/−1
• Hledger/Reports/PostingsReport.hs +3/−0
• Hledger/Reports/ReportOptions.hs +1/−1
• Hledger/Reports/ReportTypes.hs +23/−0
• hledger-lib.cabal +8/−8

@@ -8,10 +8,37 @@ Breaking changes  Misc. changes-nn+ --> Internal/api/developer-ish changes in the hledger-lib (and hledger) packages. For user-visible changes, see the hledger package changelog.++# 1.31 2023-09-03++Breaking changes++- There is a new consolidated API for styling amounts, and a+  convenient HasAmounts typeclass.  AmountStyle's fields have been+  renamed/reordered more mnemonically, and setting the precision is+  now optional.  (This simplifies the amount-stylingn code, but+  complicates the semantics a little. When reading, an unset precision+  generally behaves like NaturalPrecision.)++- (Possible breaking change):+  showMixedAmountLinesB, showAmountB, showAmountPrice now preserve+  commodityful zeroes when rendering. This is intended to affect print output,+  but it seems possible it might also affect balance and register reports,+  though our tests show no change in those.++- Renamed: journalAddInferredEquityPostings -> journalInferEquityFromCosts++Misc. changes++- Reports now do a final amount styling pass before rendering.++- groupByDateSpan code cleanup (Jay Neubrand)++- Allow aeson 2.2, megaparsec 9.5  # 1.30 2023-06-01 

@@ -73,8 +73,13 @@   oneLine,   csvDisplay,   amountstyle,+  canonicaliseAmount,   styleAmount,-  styleAmountExceptPrecision,+  amountSetStyles,+  amountSetStylesExceptPrecision,+  amountSetMainStyle,+  amountSetCostStyle,+  amountStyleUnsetPrecision,   amountUnstyled,   showAmountB,   showAmount,@@ -91,7 +96,6 @@   setAmountDecimalPoint,   withDecimalPoint,   amountStripPrices,-  canonicaliseAmount,   -- * MixedAmount   nullmixedamt,   missingmixedamt,@@ -102,6 +106,7 @@   maAddAmounts,   amounts,   amountsRaw,+  amountsPreservingZeros,   maCommodities,   filterMixedAmount,   filterMixedAmountByCommodity,@@ -124,7 +129,10 @@   maIsNonZero,   mixedAmountLooksZero,   -- ** rendering+  canonicaliseMixedAmount,   styleMixedAmount,+  mixedAmountSetStyles,+  mixedAmountSetStylesExceptPrecision,   mixedAmountUnstyled,   showMixedAmount,   showMixedAmountOneLine,@@ -139,7 +147,6 @@   wbUnpack,   mixedAmountSetPrecision,   mixedAmountSetFullPrecision,-  canonicaliseMixedAmount,   -- * misc.   tests_Amount ) where@@ -170,6 +177,7 @@ import Hledger.Utils (colorB, numDigitsInt) import Hledger.Utils.Text (textQuoteIfNeeded) import Text.WideString (WideBuilder(..), wbFromText, wbToText, wbUnpack)+import Data.Functor ((<&>))   -- A 'Commodity' is a symbol representing a currency or some other kind of@@ -195,6 +203,7 @@   -- | Options for the display of Amount and MixedAmount.+-- (See 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.@@ -208,10 +217,10 @@   , displayOrder         :: Maybe [CommoditySymbol]   } deriving (Show) --- | Display Amount and MixedAmount with no colour.+-- | By default, display Amount and MixedAmount using @noColour@ amount display options. instance Default AmountDisplayOpts where def = noColour --- | Display Amount and MixedAmount with no colour.+-- | Display amounts without colour, and with various other defaults. noColour :: AmountDisplayOpts noColour = AmountDisplayOpts { displayPrice         = True                              , displayColour        = False@@ -239,11 +248,13 @@ -- Amount styles  -- | Default amount style-amountstyle = AmountStyle L False (Precision 0) (Just '.') Nothing+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}@@ -253,11 +264,14 @@     (-)                          = similarAmountsOp (-)     (*)                          = similarAmountsOp (*) --- | The empty simple amount.+-- | The empty simple amount - a zero with no commodity symbol or cost+-- and the default amount display style. nullamt :: Amount nullamt = Amount{acommodity="", aquantity=0, aprice=Nothing, astyle=amountstyle} --- | A temporary value for parsed transactions which had no amount specified.+-- | A special amount used as a marker, meaning+-- "no explicit amount provided here, infer it when needed".+-- It is nullamt with commodity symbol "AUTO". missingamt :: Amount missingamt = nullamt{acommodity="AUTO"} @@ -265,11 +279,11 @@ -- 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=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}}+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}} amt `at` priceamt = amt{aprice=Just $ UnitPrice priceamt} amt @@ priceamt = amt{aprice=Just $ TotalPrice priceamt} @@ -327,12 +341,13 @@ isNegativeAmount :: Amount -> Bool isNegativeAmount Amount{aquantity=q} = q < 0 --- | Round an Amount's Quantity to its specified display precision. If that is--- NaturalPrecision, this does nothing.+-- | Round an Amount's Quantity (internally) to match its display precision. +-- If that is unset or NaturalPrecision, this does nothing. amountRoundedQuantity :: Amount -> Quantity-amountRoundedQuantity Amount{aquantity=q, astyle=AmountStyle{asprecision=p}} = case p of-    NaturalPrecision -> q-    Precision p'     -> roundTo p' q+amountRoundedQuantity Amount{aquantity=q, astyle=AmountStyle{asprecision=mp}} = case mp of+    Nothing               -> q+    Just NaturalPrecision -> q+    Just (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@@ -340,14 +355,17 @@     Just (TotalPrice price) -> f amt && f price     _                       -> f amt --- | Do this Amount and (and its total price, if it has one) appear to be zero when rendered with its--- display precision ?+-- | Do this Amount and (and its total price, if it has one) appear to be zero+-- when rendered with its display precision ?+-- The display precision should usually have a specific value here;+-- if unset, it will be treated like NaturalPrecision. amountLooksZero :: Amount -> Bool amountLooksZero = testAmountAndTotalPrice looksZero   where     looksZero Amount{aquantity=Decimal e q, astyle=AmountStyle{asprecision=p}} = case p of-        Precision d      -> if e > d then abs q <= 5*10^(e-d-1) else q == 0-        NaturalPrecision -> q == 0+        Just (Precision d)    -> if e > d then abs q <= 5*10^(e-d-1) else q == 0+        Just NaturalPrecision -> q == 0+        Nothing               -> q == 0  -- | Is this Amount (and its total price, if it has one) exactly zero, ignoring its display precision ? amountIsZero :: Amount -> Bool@@ -359,16 +377,16 @@  -- | Set an amount's display precision. amountSetPrecision :: AmountPrecision -> Amount -> Amount-amountSetPrecision p a@Amount{astyle=s} = a{astyle=s{asprecision=p}}+amountSetPrecision p a@Amount{astyle=s} = a{astyle=s{asprecision=Just p}}  -- | Increase an amount's display precision, if needed, to enough decimal places--- to show it exactly (showing all significant decimal digits, excluding trailing--- zeros).+-- to show it exactly (showing all significant decimal digits, without trailing zeros).+-- If the amount's display precision is unset, it is will be treated as precision 0. amountSetFullPrecision :: Amount -> Amount amountSetFullPrecision a = amountSetPrecision p a   where     p                = max displayprecision naturalprecision-    displayprecision = asprecision $ astyle a+    displayprecision = fromMaybe (Precision 0) $ asprecision $ astyle a     naturalprecision = Precision . decimalPlaces . normalizeDecimal $ aquantity a  -- | Set an amount's internal precision, ie rounds the Decimal representing@@ -379,7 +397,7 @@ -- 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=Precision p}+   astyle=s{asprecision=Just $ Precision p}   ,aquantity=roundTo p q   } @@ -390,7 +408,7 @@  -- | Set (or clear) an amount's display decimal point. setAmountDecimalPoint :: Maybe Char -> Amount -> Amount-setAmountDecimalPoint mc a@Amount{ astyle=s } = a{ astyle=s{asdecimalpoint=mc} }+setAmountDecimalPoint mc a@Amount{ astyle=s } = a{ astyle=s{asdecimalmark=mc} }  -- | Set (or clear) an amount's display decimal point, flipped. withDecimalPoint :: Amount -> Maybe Char -> Amount@@ -403,8 +421,8 @@ showAmountPrice :: Amount -> WideBuilder showAmountPrice amt = case aprice amt of     Nothing              -> mempty-    Just (UnitPrice  pa) -> WideBuilder (TB.fromString " @ ")  3 <> showAmountB noColour pa-    Just (TotalPrice pa) -> WideBuilder (TB.fromString " @@ ") 4 <> showAmountB noColour (sign pa)+    Just (UnitPrice  pa) -> WideBuilder (TB.fromString " @ ")  3 <> showAmountB noColour{displayZeroCommodity=True} pa+    Just (TotalPrice pa) -> WideBuilder (TB.fromString " @@ ") 4 <> showAmountB noColour{displayZeroCommodity=True} (sign pa)   where sign = if aquantity amt < 0 then negate else id  showAmountPriceDebug :: Maybe AmountPrice -> String@@ -412,33 +430,76 @@ 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 to the price (except for precision)+-- 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)}-  where-    styledAmount = case M.lookup (acommodity a) styles of-      Just s -> a{astyle=s}-      Nothing -> a+styleAmount = amountSetStyles+{-# DEPRECATED styleAmount "please use amountSetStyles instead" #-} -stylePrice :: M.Map CommoditySymbol AmountStyle -> Maybe AmountPrice -> Maybe AmountPrice-stylePrice styles (Just (UnitPrice a)) = Just (UnitPrice $ styleAmountExceptPrecision styles a)-stylePrice styles (Just (TotalPrice a)) = Just (TotalPrice $ styleAmountExceptPrecision styles a)-stylePrice _ _  = Nothing+-- v3 --- | 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+-- | 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 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 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+    Nothing                            -> a+    Just s@AmountStyle{asprecision=mp} -> a{astyle=s'}+      where+        s' = case mp of+          Nothing -> s{asprecision=morigp}+          _       -> s++-- | 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.+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  $ amountSetStylesExceptPrecision styles a2}+    Just (TotalPrice a2) -> a{aprice=Just $ TotalPrice $ amountSetStylesExceptPrecision 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@@ -449,24 +510,35 @@ showAmount = wbUnpack . showAmountB noColour  -- | General function to generate a WideBuilder for an Amount, according the--- supplied AmountDisplayOpts. The special "missing" amount is displayed as--- the empty string. This is the main function to use for showing+-- supplied AmountDisplayOpts. This is the main function to use for showing -- Amounts, constructing a builder; it can then be converted to a Text with -- wbToText, or to a String with wbUnpack.+-- Some special cases:+--+-- * The special "missing" amount is displayed as the empty string. +--+-- * If an amount is showing digit group separators but no decimal places,+--   we force showing a decimal mark (with nothing after it) to make+--   it easier to parse correctly.+-- showAmountB :: AmountDisplayOpts -> Amount -> WideBuilder showAmountB _ Amount{acommodity="AUTO"} = mempty showAmountB opts a@Amount{astyle=style} =     color $ case ascommodityside style of-      L -> showC (wbFromText c) space <> quantity' <> price-      R -> quantity' <> showC space (wbFromText c) <> price+      L -> showC (wbFromText comm) space <> quantity' <> price+      R -> quantity' <> showC space (wbFromText comm) <> price   where-    quantity = showamountquantity $ if displayThousandsSep opts then a else a{astyle=(astyle a){asdigitgroups=Nothing}}-    (quantity',c) | amountLooksZero a && not (displayZeroCommodity opts) = (WideBuilder (TB.singleton '0') 1,"")-                  | otherwise = (quantity, quoteCommoditySymbolIfNeeded $ acommodity a)-    space = if not (T.null c) && ascommodityspaced style then WideBuilder (TB.singleton ' ') 1 else mempty+    color = if displayColour opts && isNegativeAmount a then colorB Dull Red else id+    quantity = showamountquantity $+      if displayThousandsSep opts then a else a{astyle=(astyle a){asdigitgroups=Nothing}}+    (quantity', comm)+      | amountLooksZero a && not (displayZeroCommodity opts) = (WideBuilder (TB.singleton '0') 1, "")+      | otherwise = (quantity, quoteCommoditySymbolIfNeeded $ acommodity a)+    space = if not (T.null comm) && ascommodityspaced style then WideBuilder (TB.singleton ' ') 1 else mempty+    -- concatenate these texts,+    -- or return the empty text if there's a commodity display order. XXX why ?     showC l r = if isJust (displayOrder opts) then mempty else l <> r     price = if displayPrice opts then showAmountPrice a else mempty-    color = if displayColour opts && isNegativeAmount a then colorB Dull Red else id  -- | Colour version. For a negative amount, adds ANSI codes to change the colour, -- currently to hard-coded red.@@ -496,27 +568,33 @@    ++ ", aprice=" ++ showAmountPriceDebug aprice ++ ", astyle=" ++ show astyle ++ "}"  -- | Get a Text Builder for the string representation of the number part of of an amount,--- using the display settings from its commodity. Also returns the width of the--- number.+-- using the display settings from its commodity. Also returns the width of the number.+-- A special case: if it is showing digit group separators but no decimal places,+-- show a decimal mark (with nothing after it) to make it easier to parse correctly. showamountquantity :: Amount -> WideBuilder-showamountquantity amt@Amount{astyle=AmountStyle{asdecimalpoint=mdec, asdigitgroups=mgrps}} =+showamountquantity amt@Amount{astyle=AmountStyle{asdecimalmark=mdec, asdigitgroups=mgrps}} =     signB <> intB <> fracB   where-    Decimal e n = amountRoundedQuantity amt--    strN = T.pack . show $ abs n-    len = T.length strN-    intLen = max 1 $ len - fromIntegral e+    Decimal decplaces mantissa = amountRoundedQuantity amt+    numtxt = T.pack . show $ abs mantissa+    numlen = T.length numtxt+    intLen = max 1 $ numlen - fromIntegral decplaces     dec = fromMaybe '.' mdec-    padded = T.replicate (fromIntegral e + 1 - len) "0" <> strN-    (intPart, fracPart) = T.splitAt intLen padded+    numtxtwithzero = T.replicate (fromIntegral decplaces + 1 - numlen) "0" <> numtxt+    (intPart, fracPart) = T.splitAt intLen numtxtwithzero+    intB = applyDigitGroupStyle mgrps intLen $ if decplaces == 0 then numtxt else intPart+    signB = if mantissa < 0 then WideBuilder (TB.singleton '-') 1 else mempty+    fracB = if decplaces > 0 || isshowingdigitgroupseparator+      then WideBuilder (TB.singleton dec <> TB.fromText fracPart) (1 + fromIntegral decplaces)+      else mempty -    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.fromText fracPart) (fromIntegral e + 1) else mempty+    isshowingdigitgroupseparator = case mgrps of+      Just (DigitGroups _ (rightmostgrplen:_)) -> intLen > fromIntegral rightmostgrplen+      _ -> False --- | Split a string representation into chunks according to DigitGroupStyle,--- returning a Text builder and the number of separators used.+-- | Given an integer as text, and its length, apply the given DigitGroupStyle,+-- inserting digit group separators between digit groups where appropriate.+-- Returns a Text builder and the number of digit group separators used. applyDigitGroupStyle :: Maybe DigitGroupStyle -> Int -> T.Text -> WideBuilder applyDigitGroupStyle Nothing                       l s = WideBuilder (TB.fromText s) l applyDigitGroupStyle (Just (DigitGroups _ []))     l s = WideBuilder (TB.fromText s) l@@ -530,15 +608,11 @@         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 +instance HasAmounts MixedAmount where styleAmounts = mixedAmountSetStyles+ instance Semigroup MixedAmount where   (<>) = maPlus   sconcat = maSum@@ -567,11 +641,15 @@ nullmixedamt :: MixedAmount nullmixedamt = Mixed mempty --- | A temporary value for parsed transactions which had no amount specified.+-- | A special mixed amount used as a marker, meaning+-- "no explicit amount provided here, infer it when needed". missingmixedamt :: MixedAmount missingmixedamt = mixedAmount missingamt --- | Whether a MixedAmount has a missing amount+-- | Does this MixedAmount include the "missing amount" marker ?+-- Note: currently does not test for equality with missingmixedamt,+-- instead it looks for missingamt among the Amounts.+-- missingamt should always be alone, but detect it even if not. isMissingMixedAmount :: MixedAmount -> Bool isMissingMixedAmount (Mixed ma) = amountKey missingamt `M.member` ma @@ -663,7 +741,8 @@ maIsNonZero :: MixedAmount -> Bool maIsNonZero = not . mixedAmountIsZero --- | Get a mixed amount's component amounts.+-- | Get a mixed amount's component amounts, with some cleanups.+-- The following descriptions are old and possibly wrong: -- -- * amounts in the same commodity are combined unless they have different prices or total prices --@@ -677,13 +756,37 @@ -- amounts :: MixedAmount -> [Amount] amounts (Mixed ma)-  | isMissingMixedAmount (Mixed ma) = [missingamt]  -- missingamt should always be alone, but detect it even if not+  | isMissingMixedAmount (Mixed ma) = [missingamt]   | M.null nonzeros                 = [newzero]   | otherwise                       = toList nonzeros   where     newzero = fromMaybe nullamt $ find (not . T.null . acommodity) zeros     (zeros, nonzeros) = M.partition amountIsZero ma +-- | Get a mixed amount's component amounts, with some cleanups.+-- This is a new version of @amounts@, with updated descriptions+-- and optimised for @print@ to show commodityful zeros.+--+-- * If it contains the "missing amount" marker, only that is returned+--   (discarding any additional amounts).+--+-- * Or if it contains any non-zero amounts, only those are returned+--   (discarding any zeroes).+--+-- * Or if it contains any zero amounts (possibly more than one,+--   possibly in different commodities), all of those are returned.+--+-- * Otherwise the null amount is returned.+--+amountsPreservingZeros :: MixedAmount -> [Amount]+amountsPreservingZeros (Mixed ma)+  | isMissingMixedAmount (Mixed ma) = [missingamt]+  | not $ M.null nonzeros           = toList nonzeros+  | not $ M.null zeros              = toList zeros+  | otherwise                       = [nullamt]+  where+    (zeros, nonzeros) = M.partition amountIsZero ma+ -- | Get a mixed amount's component amounts without normalising zero and missing -- amounts. This is used for JSON serialisation, so the order is important. In -- particular, we want the Amounts given in the order of the MixedAmountKeys,@@ -768,15 +871,36 @@ --     where a' = mixedAmountStripPrices a --           b' = mixedAmountStripPrices b --- | Given a map of standard commodity display styles, apply the--- appropriate one to each individual amount.+-- 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" #-} +-- v3++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 + -- | 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.@@ -848,10 +972,9 @@     width = headDef 0 $ map wbWidth ls     sep = WideBuilder (TB.singleton '\n') 0 --- | Helper for showMixedAmountB to show a list of Amounts on multiple lines. This returns--- the list of WideBuilders: one for each Amount, and padded/elided to the appropriate--- width. This does not honour displayOneLine: all amounts will be displayed as if--- displayOneLine were False.+-- | Helper for showMixedAmountB (and postingAsLines, ...) to show a list of Amounts on multiple lines.+-- This returns the list of WideBuilders: one for each Amount, and padded/elided to the appropriate width.+-- This does not honour displayOneLine; all amounts will be displayed as if displayOneLine were False. showMixedAmountLinesB :: AmountDisplayOpts -> MixedAmount -> [WideBuilder] showMixedAmountLinesB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma =     map (adBuilder . pad) elided@@ -905,11 +1028,19 @@     -- Add the elision strings (if any) to each amount     withElided = zipWith (\n2 amt -> (amt, elisionDisplay Nothing (wbWidth sep) n2 amt)) [n-1,n-2..0] +-- Get a mixed amount's component amounts with a bit of cleanup,+-- optionally preserving multiple zeros in different commodities,+-- optionally sorting them according to a commodity display order. orderedAmounts :: AmountDisplayOpts -> MixedAmount -> [Amount]-orderedAmounts dopts = maybe id (mapM pad) (displayOrder dopts) . amounts+orderedAmounts AmountDisplayOpts{displayZeroCommodity=preservezeros, displayOrder=mcommodityorder} =+  if preservezeros then amountsPreservingZeros else amounts+  <&> maybe id (mapM findfirst) mcommodityorder  -- maybe sort them (somehow..)   where-    pad c = fromMaybe (amountWithCommodity c nullamt) . find ((c==) . acommodity)-+    -- Find the first amount with the given commodity, otherwise a null amount in that commodity.+    findfirst :: CommoditySymbol -> [Amount] -> Amount+    findfirst c = fromMaybe nullamtc . find ((c==) . acommodity)+      where+        nullamtc = amountWithCommodity c nullamt  data AmountDisplay = AmountDisplay   { adBuilder :: !WideBuilder  -- ^ String representation of the Amount@@ -962,11 +1093,7 @@     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 @@ -993,8 +1120,8 @@        (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]) @?= Precision 3-       asprecision (astyle $ sum [usd 1 `withPrecision` Precision 3, usd 1 `withPrecision` Precision 1]) @?= Precision 3+       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)        -- adding different commodities assumes conversion rate 1        assertBool "" $ amountLooksZero (usd 1.23 - eur 1.23) 

@@ -101,12 +101,12 @@             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 @@      -- 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 @@               -- 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@@ -337,8 +337,8 @@          unitprice     = aquantity fromamount `divideAmount` toamount         unitprecision = case (asprecision $ astyle fromamount, asprecision $ astyle toamount) of-            (Precision a, Precision b) -> Precision . max 2 $ saturatedAdd a b-            _                          -> NaturalPrecision+            (Just (Precision a), Just (Precision b)) -> Precision . max 2 $ saturatedAdd a b+            _                                        -> NaturalPrecision         saturatedAdd a b = if maxBound - a < b then maxBound else a + b  @@ -454,6 +454,9 @@     -- display precisions used in balanced checking     styles = Just $ journalCommodityStyles j     bopts = bopts'{commodity_styles_=styles}+      -- XXX ^ The commodity directive styles and default style and inferred styles+      -- are merged into the command line styles in commodity_styles_ - why ?+      -- Mainly for the precisions, used during amount and cost inference and balanced checking ?     -- balance assignments are not allowed on accounts affected by auto postings     autopostingaccts = S.fromList . map (paccount . tmprPosting) . concatMap tmpostingrules $ jtxnmodifiers j   in@@ -628,7 +631,7 @@         "but the calculated balance is: %s", -- (at display precision: %s)",         "a difference of:               %s",         "",-        "Consider viewing this account's calculated balances to troubleshoot. Eg:",+        "To troubleshoot, you can view this account's running balance. Eg:",         "",         "hledger reg '%s'%s -I  # -f FILE"       ])@@ -1005,26 +1008,26 @@       --       testCase "1091a" $ do         commodityStylesFromAmounts [-           nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing}-          ,nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 2) (Just '.') (Just (DigitGroups ',' [3]))}+           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)}           ]          @?=           -- The commodity style should have period as decimal mark           -- and comma as digit group mark.           Right (M.fromList [-            ("", AmountStyle L False (Precision 3) (Just '.') (Just (DigitGroups ',' [3])))+            ("", AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Just $ Precision 3))           ])         -- same journal, entries in reverse order       ,testCase "1091b" $ do         commodityStylesFromAmounts [-           nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 2) (Just '.') (Just (DigitGroups ',' [3]))}-          ,nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing}+           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)}           ]          @?=           -- The commodity style should have period as decimal mark           -- and comma as digit group mark.           Right (M.fromList [-            ("", AmountStyle L False (Precision 3) (Just '.') (Just (DigitGroups ',' [3])))+            ("", AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Just $ Precision 3))           ])       ]

@@ -317,7 +317,7 @@     groupByCols (c:cs) ps = (c, map snd matches) : groupByCols cs later       where (matches, later) = span ((spanEnd c >) . Just . fst) ps -    beforeStart = maybe (const True) (>) $ spanStart =<< headMay colspans+    beforeStart = maybe (const False) (>) $ spanStart =<< headMay colspans  -- | Calculate the intersection of a number of datespans. spansIntersect [] = nulldatespan

@@ -26,7 +26,7 @@   commodityStylesFromAmounts,   journalCommodityStyles,   journalToCost,-  journalAddInferredEquityPostings,+  journalInferEquityFromCosts,   journalInferCostsFromEquity,   journalMarkRedundantCosts,   journalReverse,@@ -793,16 +793,17 @@     Left err -> Left err  -- | Choose and apply a consistent display style to the posting--- amounts in each commodity (see journalCommodityStyles).+-- amounts in each commodity (see journalCommodityStyles),+-- keeping all display precisions unchanged. -- Can return an error message eg if inconsistent number formats are found. journalApplyCommodityStyles :: Journal -> Either String Journal journalApplyCommodityStyles = fmap fixjournal . journalInferCommodityStyles   where     fixjournal j@Journal{jpricedirectives=pds} =-        journalMapPostings (postingApplyCommodityStyles styles) j{jpricedirectives=map fixpricedirective pds}+        journalMapPostings (postingApplyCommodityStylesExceptPrecision 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,@@ -858,7 +859,7 @@ -- with the first digit group style seen, -- with the maximum precision of all. canonicalStyle :: AmountStyle -> AmountStyle -> AmountStyle-canonicalStyle a b = a{asprecision=prec, asdecimalpoint=decmark, asdigitgroups=mgrps}+canonicalStyle a b = a{asprecision=prec, asdecimalmark=decmark, asdigitgroups=mgrps}   where     -- precision is maximum of all precisions     prec = max (asprecision a) (asprecision b)@@ -874,7 +875,7 @@     -- urgh.. refactor..     decmark = case mgrps of         Just _  -> Just defdecmark-        Nothing -> asdecimalpoint a <|> asdecimalpoint b <|> Just defdecmark+        Nothing -> asdecimalmark a <|> asdecimalmark b <|> Just defdecmark  -- -- | Apply this journal's historical price records to unpriced amounts where possible. -- journalApplyPriceDirectives :: Journal -> Journal@@ -908,21 +909,19 @@        journalPostings j    } --- | Convert all this journal's amounts to cost using the transaction prices, if any.--- The journal's commodity styles are applied to the resulting amounts.+-- | Convert all this journal's amounts to cost using their attached prices, if any. journalToCost :: ConversionOp -> Journal -> Journal-journalToCost cost j@Journal{jtxns=ts} = j{jtxns=map (transactionToCost styles cost) ts}-  where-    styles = journalCommodityStyles j+journalToCost cost j@Journal{jtxns=ts} = j{jtxns=map (transactionToCost cost) ts} --- | Add inferred equity postings to a 'Journal' using transaction prices.-journalAddInferredEquityPostings :: Bool -> Journal -> Journal-journalAddInferredEquityPostings verbosetags j = journalMapTransactions (transactionAddInferredEquityPostings verbosetags equityAcct) j+-- | Add equity postings inferred from costs, where needed and possible.+-- See hledger manual > Cost reporting.+journalInferEquityFromCosts :: Bool -> Journal -> Journal+journalInferEquityFromCosts verbosetags j = journalMapTransactions (transactionAddInferredEquityPostings verbosetags equityAcct) j   where     equityAcct = journalConversionAccount j  -- | Add costs inferred from equity conversion postings, where needed and possible.--- See hledger manual > Inferring cost from equity postings.+-- See hledger manual > Cost reporting. journalInferCostsFromEquity :: Journal -> Either String Journal journalInferCostsFromEquity j = do     ts <- mapM (transactionInferCostsFromEquity False $ jaccounttypes j) $ jtxns j@@ -1083,16 +1082,24 @@ -- | Replace this posting's account name with the value -- of the given field or tag, if any, otherwise the empty string. postingPivot :: Text -> Posting -> Posting-postingPivot fieldortagname p = p{paccount = pivotedacct, poriginal = Just $ originalPosting p}-  where-    pivotedacct-      | Just t <- ptransaction p, fieldortagname == "code"        = tcode t-      | Just t <- ptransaction p, fieldortagname == "description" = tdescription t-      | Just t <- ptransaction p, fieldortagname == "payee"       = transactionPayee t-      | Just t <- ptransaction p, fieldortagname == "note"        = transactionNote t-      | Just t <- ptransaction p, fieldortagname == "status"      = T.pack . show . tstatus $ t-      | Just (_, value) <- postingFindTag fieldortagname p        = value-      | otherwise                                                 = ""+postingPivot fieldortagname p =+  p{paccount = pivotAccount fieldortagname p, poriginal = Just $ originalPosting p}++pivotAccount :: Text -> Posting -> Text+pivotAccount fieldortagname p =+  T.intercalate ":" [pivotComponent x p | x <- T.splitOn ":" fieldortagname]++pivotComponent :: Text -> Posting -> Text+pivotComponent fieldortagname p+  |                           fieldortagname == "acct"        = paccount p+  | Just t <- ptransaction p, fieldortagname == "code"        = tcode t+  | Just t <- ptransaction p, fieldortagname == "desc"        = tdescription t+  | Just t <- ptransaction p, fieldortagname == "description" = tdescription t  -- backward compatible with 1.30 and older+  | Just t <- ptransaction p, fieldortagname == "payee"       = transactionPayee t+  | Just t <- ptransaction p, fieldortagname == "note"        = transactionNote t+  | Just t <- ptransaction p, fieldortagname == "status"      = T.pack . show . tstatus $ t+  | Just (_, value) <- postingFindTag fieldortagname p        = value+  | otherwise                                                 = ""  postingFindTag :: TagName -> Posting -> Maybe (TagName, TagValue) postingFindTag tagname p = find ((tagname==) . fst) $ postingAllTags p

@@ -6,7 +6,6 @@  {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE RecordWildCards #-}  module Hledger.Data.JournalChecks (   journalCheckAccounts,@@ -25,19 +24,21 @@ import Data.Maybe import qualified Data.Map.Strict as M import qualified Data.Text as T-import Safe (atMay, lastMay)+import Safe (atMay, lastMay, headMay) import Text.Printf (printf)  import Hledger.Data.Errors import Hledger.Data.Journal import Hledger.Data.JournalChecks.Ordereddates import Hledger.Data.JournalChecks.Uniqueleafnames-import Hledger.Data.Posting (isVirtual, postingDate, postingStatus, transactionAllTags)+import Hledger.Data.Posting (isVirtual, postingDate, transactionAllTags) import Hledger.Data.Types-import Hledger.Data.Amount (amountIsZero, amountsRaw, missingamt)+import Hledger.Data.Amount (amountIsZero, amountsRaw, missingamt, amounts) import Hledger.Data.Transaction (transactionPayee, showTransactionLineFirstPart, partitionAndCheckConversionPostings) import Data.Time (Day, diffDays) import Hledger.Utils+import Data.Ord+import Hledger.Data.Dates (showDate)  -- | Check that all the journal's postings are to accounts  with -- account directives, returning an error message otherwise.@@ -209,97 +210,64 @@  ---------- --- | Information useful for checking the age and lag of an account's latest balance assertion.-data BalanceAssertionInfo = BAI {-    baiAccount                :: AccountName -- ^ the account-  , baiLatestAssertionPosting :: Posting     -- ^ the account's latest posting with a balance assertion-  , baiLatestAssertionDate    :: Day         -- ^ the posting date-  , baiLatestAssertionStatus  :: Status      -- ^ the posting status-  , baiLatestPostingDate      :: Day         -- ^ the date of this account's latest posting with or without a balance assertion-}---- | Given a list of postings to the same account,--- if any of them contain a balance assertion,--- calculate the last asserted and posted dates.-balanceAssertionInfo :: [Posting] -> Maybe BalanceAssertionInfo-balanceAssertionInfo ps =-  case (mlatestp, mlatestassertp) of-    (Just latestp, Just latestassertp) -> Just $-      BAI{baiAccount                 = paccount latestassertp-          ,baiLatestAssertionDate    = postingDate latestassertp-          ,baiLatestAssertionPosting = latestassertp-          ,baiLatestAssertionStatus  = postingStatus latestassertp-          ,baiLatestPostingDate      = postingDate latestp-          }-    _ -> Nothing-  where-    ps' = sortOn postingDate ps-    mlatestp = lastMay ps'-    mlatestassertp = lastMay [p | p@Posting{pbalanceassertion=Just _} <- ps']- -- | The number of days allowed between an account's latest balance assertion --- and latest posting.+-- and latest posting (7). maxlag = 7 --- | The number of days between this balance assertion and the latest posting in its account.-baiLag BAI{..} = diffDays baiLatestPostingDate baiLatestAssertionDate---- -- | The earliest balance assertion date which would satisfy the recentassertions check.--- baiLagOkDate :: BalanceAssertionInfo -> Day--- baiLagOkDate BAI{..} = addDays (-7) baiLatestPostingDate---- | Check that this latest assertion is close enough to the account's latest posting.-checkRecentAssertion :: BalanceAssertionInfo -> Either (BalanceAssertionInfo, String) ()-checkRecentAssertion bai@BAI{..}-  | lag > maxlag =-    Left (bai, printf (chomp $ unlines [-       "the last balance assertion (%s) was %d days before"-      ,"the latest posting (%s)."-      ])-      (show baiLatestAssertionDate) lag (show baiLatestPostingDate)-      )-  | otherwise = Right ()-  where -    lag = baiLag bai---- | Check that all the journal's accounts with balance assertions have--- an assertion no more than 7 days before their latest posting.+-- | Check that accounts with balance assertions have no posting more+-- than maxlag days after their latest balance assertion. -- Today's date is provided for error messages. journalCheckRecentAssertions :: Day -> Journal -> Either String () journalCheckRecentAssertions today j =-  let-    acctps = groupOn paccount $ sortOn paccount $ journalPostings j-    acctassertioninfos = mapMaybe balanceAssertionInfo acctps-  in-    case mapM_ checkRecentAssertion acctassertioninfos of-      Right () -> Right ()-      Left (BAI{..}, msg) -> Left errmsg-        where-          errmsg = chomp $ printf -            (unlines [-              "%s:",-              "%s\n",-              "The recentassertions check is enabled, so accounts with balance assertions must",-              "have a balance assertion no more than %d days before their latest posting date.",-              "In account %s,",-              "%s",-              "",-              "%s"-              ])-            (maybe "(no position)"  -- shouldn't happen-              (sourcePosPretty . baposition) $ pbalanceassertion baiLatestAssertionPosting)-            (textChomp excerpt)-            maxlag-            baiAccount-            msg-            recommendation-            where-              (_,_,_,excerpt) = makeBalanceAssertionErrorExcerpt baiLatestAssertionPosting-              recommendation = unlines [-                "Consider adding a more recent balance assertion for this account. Eg:",-                "",-                printf "%s *\n    %s    $0 = $0  ; <- adjust" (show today) baiAccount-                ]+  let acctps = groupOn paccount $ sortOn paccount $ journalPostings j+  in case mapMaybe (findRecentAssertionError today) acctps of+    []         -> Right ()+    firsterr:_ -> Left firsterr++-- | Do the recentassertions check for one account: given a list of postings to the account,+-- if any of them contain a balance assertion, identify the latest balance assertion,+-- and if any postings are >maxlag days later than the assertion,+-- return an error message identifying the first of them.+-- Postings on the same date will be handled in parse order (hopefully).+findRecentAssertionError :: Day -> [Posting] -> Maybe String+findRecentAssertionError today ps = do+  let rps = sortOn (Data.Ord.Down . postingDate) ps+  let (afterlatestassertrps, untillatestassertrps) = span (isNothing.pbalanceassertion) rps+  latestassertdate <- postingDate <$> headMay untillatestassertrps+  let withinlimit date = diffDays date latestassertdate <= maxlag+  firsterrorp <- lastMay $ dropWhileEnd (withinlimit.postingDate) afterlatestassertrps+  let lag = diffDays (postingDate firsterrorp) latestassertdate+  let acct = paccount firsterrorp+  let (f,l,_mcols,ex) = makePostingAccountErrorExcerpt firsterrorp+  let comm =+        case map acommodity $ amounts $ pamount firsterrorp of+          [] -> ""+          (t:_) | T.length t == 1 -> t+          (t:_) -> t <> " "+  Just $ chomp $ printf+    (unlines [+      "%s:%d:",+      "%s\n",+      "The recentassertions check is enabled, so accounts with balance assertions must",+      "have a balance assertion within %d days of their latest posting.",+      "In account \"%s\", this posting is %d days later",+      "than the last balance assertion, which was on %s.",+      "",+      "Consider adding a more recent balance assertion for this account. Eg:",+      "",+      "%s\n    %s    %s0 = %s0  ; (adjust asserted amount)"+      ])+    f+    l+    (textChomp ex)+    maxlag+    acct+    lag+    (showDate latestassertdate)+    (show today)+    acct+    comm+    comm  -- -- | Print the last balance assertion date & status of all accounts with balance assertions. -- printAccountLastAssertions :: Day -> [BalanceAssertionInfo] -> IO ()

@@ -2,6 +2,7 @@ JSON instances. Should they be in Types.hs ? -} +{-# LANGUAGE CPP               #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase        #-} {-# LANGUAGE OverloadedStrings #-}@@ -67,7 +68,13 @@   toJSON = object . decimalKV   toEncoding = pairs . mconcat . decimalKV -decimalKV :: (KeyValue kv, Integral a, ToJSON a) => DecimalRaw a -> [kv]+decimalKV :: (+#if MIN_VERSION_aeson(2,2,0)+  KeyValue e kv,+#else+  KeyValue kv,+#endif+  Integral a, ToJSON a) => DecimalRaw a -> [kv] decimalKV d = let d' = if decimalPlaces d <= 10 then d else roundTo 10 d in     [ "decimalPlaces"   .= decimalPlaces d'     , "decimalMantissa" .= decimalMantissa d'@@ -102,7 +109,13 @@   toJSON = object . postingKV   toEncoding = pairs . mconcat . postingKV -postingKV :: KeyValue kv => Posting -> [kv]+postingKV ::+#if MIN_VERSION_aeson(2,2,0)+  KeyValue e kv+#else+  KeyValue kv+#endif+  => Posting -> [kv] postingKV Posting{..} =     [ "pdate"             .= pdate     , "pdate2"            .= pdate2@@ -144,7 +157,13 @@   toJSON = object . accountKV   toEncoding = pairs . mconcat . accountKV -accountKV :: KeyValue kv => Account -> [kv]+accountKV ::+#if MIN_VERSION_aeson(2,2,0)+  KeyValue e kv+#else+  KeyValue kv+#endif+  => Account -> [kv] accountKV a =     [ "aname"        .= aname a     , "aebalance"    .= aebalance a

@@ -39,6 +39,7 @@   postingStripPrices,   postingApplyAliases,   postingApplyCommodityStyles,+  postingApplyCommodityStylesExceptPrecision,   postingAddTags,   -- * date operations   postingDate,@@ -97,7 +98,15 @@ 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                 {pdate=Nothing@@ -220,6 +229,9 @@ -- Or if onelineamounts is true, such amounts are shown on one line, comma-separated -- (and the output will not be valid journal syntax). --+-- If an amount is zero, any commodity symbol attached to it is shown+-- (and the corresponding commodity display style is used).+-- -- By default, 4 spaces (2 if there's a status flag) are shown between -- account name and start of amount area, which is typically 12 chars wide -- and contains a right-aligned amount (so 10-12 visible spaces between@@ -262,7 +274,7 @@     -- amtwidth at all.     shownAmounts       | elideamount = [mempty]-      | otherwise   = showMixedAmountLinesB noColour{displayOneLine=onelineamounts} $ pamount p+      | otherwise   = showMixedAmountLinesB noColour{displayZeroCommodity=True, displayOneLine=onelineamounts} $ pamount p     thisamtwidth = maximumBound 0 $ map wbWidth shownAmounts      -- when there is a balance assertion, show it only on the last posting line@@ -407,14 +419,23 @@         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=styleMixedAmount styles $ pamount p-                                        ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p}+postingApplyCommodityStyles styles p = p{pamount=mixedAmountSetStyles styles $ pamount 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 postingAddTags p@Posting{ptags} tags = p{ptags=ptags `union` tags}@@ -426,14 +447,13 @@ postingApplyValuation priceoracle styles periodlast today v p =     postingTransformAmount (mixedAmountApplyValuation priceoracle styles periodlast today (postingDate p) v) p --- | Maybe convert this 'Posting's amount to cost, and apply apply appropriate--- amount styles.-postingToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> Posting -> Maybe Posting-postingToCost _      NoConversionOp p = Just p-postingToCost styles ToCost         p+-- | Maybe convert this 'Posting's amount to cost.+postingToCost :: ConversionOp -> Posting -> Maybe Posting+postingToCost NoConversionOp p = Just p+postingToCost 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 mixedAmountCost p   where     noCost = (not . any (isJust . aprice) . amountsRaw) $ pamount p 

@@ -53,8 +53,8 @@ ) where  import Control.Monad.Trans.State (StateT(..), evalStateT)-import Data.Bifunctor (first)-import Data.Foldable (foldrM)+import Data.Bifunctor (first, second)+import Data.Foldable (foldlM) import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Semigroup (Endo(..)) import Data.Text (Text)@@ -70,8 +70,13 @@ import Hledger.Data.Posting import Hledger.Data.Amount import Hledger.Data.Valuation+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,@@ -216,10 +221,9 @@ transactionApplyValuation priceoracle styles periodlast today v =   transactionTransformPostings (postingApplyValuation priceoracle styles periodlast today v) --- | Maybe convert this 'Transaction's amounts to cost and apply the--- appropriate amount styles.-transactionToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> Transaction -> Transaction-transactionToCost styles cost t = t{tpostings = mapMaybe (postingToCost styles cost) $ tpostings t}+-- | Maybe convert this 'Transaction's amounts to cost.+transactionToCost :: ConversionOp -> Transaction -> Transaction+transactionToCost cost t = t{tpostings = mapMaybe (postingToCost cost) $ tpostings t}  -- | Add inferred equity postings to a 'Transaction' using transaction prices. transactionAddInferredEquityPostings :: Bool -> AccountName -> Transaction -> Transaction@@ -228,8 +232,12 @@  type IdxPosting = (Int, Posting) --- WARNING: twisty code ahead+-- XXX Warning: The following code - for analysing equity conversion postings,+-- inferring missing costs and ignoring redundant costs -+-- is twisty and hard to follow. +label s = ((s <> ": ")++)+ -- | Add costs inferred from equity postings in this transaction. -- For every adjacent pair of conversion postings, it will first search the postings -- with costs to see if any match. If so, it will tag these as matched.@@ -240,71 +248,117 @@ -- the costful and conversion postings, but don't add costs. transactionInferCostsFromEquity :: Bool -> M.Map AccountName AccountType -> Transaction -> Either String Transaction transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTransaction t . T.unpack) $ do-    (conversionPairs, stateps) <- partitionAndCheckConversionPostings False acctTypes npostings-    f <- transformIndexedPostingsF (addCostsToPostings dryrun) conversionPairs stateps-    return t{tpostings = map (snd . f) npostings}+  -- number the postings+  let npostings = zip [0..] $ tpostings t++  -- Identify all pairs of conversion postings and all other postings (with and without costs) in the transaction.+  (conversionPairs, otherps) <- partitionAndCheckConversionPostings False acctTypes npostings++  -- Generate a pure function that can be applied to each of this transaction's postings,+  -- possibly modifying it, to produce the following end result:+  -- 1. each pair of conversion postings, and the corresponding postings which balance them, are tagged for easy identification+  -- 2. each pair of balancing postings which did't have an explicit cost, have had a cost calculated and added to one of them+  -- 3. if any ambiguous situation was detected, an informative error is raised+  processposting <- transformIndexedPostingsF (addCostsToPostings dryrun) conversionPairs otherps++  -- And if there was no error, use it to modify the transaction's postings.+  return t{tpostings = map (snd . processposting) npostings}+   where-    -- Include indices for postings-    npostings = zip [0..] $ tpostings t-    transformIndexedPostingsF f = evalStateT . fmap (appEndo . foldMap Endo) . traverse f -    -- Given a pair of indexed conversion postings, and a state consisting of lists of-    -- costful and costless non-conversion postings, create a function which adds a conversion cost-    -- to the posting which matches the conversion postings if necessary,-    -- and tags the conversion and matched postings. Then update the state by removing the-    -- matched postings. If there are no matching postings or too much ambiguity,-    -- return an error string annotated with the conversion postings.-    -- If the first argument is true, do a dry run instead: identify and tag-    -- the costful and conversion postings, but don't add costs.-    addCostsToPostings :: Bool -> (IdxPosting, IdxPosting)-                        -> StateT ([IdxPosting], [IdxPosting]) (Either Text) (IdxPosting -> IdxPosting)+    -- Generate the tricksy processposting function,+    -- which when applied to each posting in turn, rather magically has the effect of+    -- applying addCostsToPostings to each pair of conversion postings in the transaction,+    -- matching them with the other postings, tagging them and perhaps adding cost information to the other postings.+    -- General type:+    -- transformIndexedPostingsF :: (Monad m, Foldable t, Traversable t) =>+    --   (a -> StateT s m (a1 -> a1)) ->+    --   t a ->+    --   s ->+    --   m (a1 -> a1)+    -- Concrete type:+    transformIndexedPostingsF ::+      ((IdxPosting, IdxPosting) -> StateT ([IdxPosting],[IdxPosting]) (Either Text) (IdxPosting -> IdxPosting)) ->  -- state update function (addCostsToPostings with the bool applied)+      [(IdxPosting, IdxPosting)] ->   -- initial state: the pairs of adjacent conversion postings in the transaction+      ([IdxPosting],[IdxPosting]) ->  -- initial state: the other postings in the transaction, separated into costful and costless+      (Either Text (IdxPosting -> IdxPosting))  -- returns an error message or a posting transform function+    transformIndexedPostingsF updatefn = evalStateT . fmap (appEndo . foldMap Endo) . traverse (updatefn)++    -- A tricksy state update helper for processposting/transformIndexedPostingsF.+    -- Approximately: given a pair of conversion postings to match,+    -- and lists of the remaining unmatched costful and costless other postings,+    -- 1. find (and consume) two other postings which match the two conversion postings+    -- 2. add identifying tags to the four postings+    -- 3. add an explicit cost, if missing, to one of the matched other postings+    -- 4. or if there is a problem, raise an informative error or do nothing as appropriate.+    -- Or, if the first argument is true:+    -- do a dry run instead: find and consume, add tags, but don't add costs+    -- (and if there are no costful postings at all, do nothing).+    addCostsToPostings :: Bool -> (IdxPosting, IdxPosting) -> StateT ([IdxPosting], [IdxPosting]) (Either Text) (IdxPosting -> IdxPosting)     addCostsToPostings dryrun' ((n1, cp1), (n2, cp2)) = StateT $ \(costps, otherps) -> do-        -- Get the two conversion posting amounts, if possible-        ca1 <- conversionPostingAmountNoCost cp1-        ca2 <- conversionPostingAmountNoCost cp2-        let -- The function to add costs and tag postings in the indexed list of postings-            transformPostingF np costp (n,p) =-              (n, if | n == np            -> costp `postingAddTags` [("_price-matched","")]-                     | n == n1 || n == n2 -> p     `postingAddTags` [("_conversion-matched","")]-                     | otherwise          -> p)-            -- All costful postings which match the conversion posting pair-            matchingCostPs = mapMaybe (mapM $ costfulPostingIfMatchesBothAmounts ca1 ca2) costps-            -- All other postings which match at least one of the conversion posting pair.-            -- Add a corresponding cost to these postings, unless in dry run mode.-            matchingOtherPs-              | dryrun'   = [(n,(p, a)) | (n,p) <- otherps, let Just a = postingSingleAmount p]-              | otherwise = mapMaybe (mapM $ addCostIfMatchesOneAmount ca1 ca2) otherps+      -- Get the two conversion posting amounts, if possible+      ca1 <- conversionPostingAmountNoCost cp1+      ca2 <- conversionPostingAmountNoCost cp2+      let +        -- All costful postings which match the conversion posting pair+        matchingCostPs =+          dbg7With (label "matched costful postings".show.length) $ +          mapMaybe (mapM $ costfulPostingIfMatchesBothAmounts ca1 ca2) costps -        -- Annotate any errors with the conversion posting pair-        first (annotateWithPostings [cp1, cp2]) $-            if -- If a single costful posting matches the conversion postings,-               -- delete it from the list of costful postings in the state, delete the-               -- first matching costless posting from the list of costless postings-               -- in the state, and return the transformation function with the new state.-               | [(np, (costp, _))] <- matchingCostPs-               , Just newcostps <- deleteIdx np costps-                   -> Right (transformPostingF np costp, (if dryrun' then costps else newcostps, otherps))-               -- If no costful postings match the conversion postings, but some-               -- of the costless postings match, check that the first such posting has a-               -- different amount from all the others, and if so add a cost to it,-               -- then delete it from the list of costless postings in the state,-               -- and return the transformation function with the new state.-               | [] <- matchingCostPs-               , (np, (costp, amt)):nps <- matchingOtherPs-               , not $ any (amountMatches amt . snd . snd) nps-               , Just newotherps <- deleteIdx np otherps-                   -> Right (transformPostingF np costp, (costps, if dryrun' then otherps else newotherps))-               -- Otherwise it's too ambiguous to make a guess, so return an error.-               | otherwise -> Left "There is not a unique posting which matches the conversion posting pair:"+        -- All other single-commodity postings whose amount matches at least one of the conversion postings,+        -- with an explicit cost added. Or in dry run mode, all other single-commodity postings.+        matchingOtherPs =+          dbg7With (label "matched costless postings".show.length) $+          if dryrun'+          then [(n,(p, a)) | (n,p) <- otherps, let Just a = postingSingleAmount p]+          else mapMaybe (mapM $ addCostIfMatchesOneAmount ca1 ca2) otherps +        -- A function that adds a cost and/or tag to a numbered posting if appropriate.+        postingAddCostAndOrTag np costp (n,p) =+          (n, if | n == np            -> costp `postingAddTags` [("_price-matched","")]+                 | n == n1 || n == n2 -> p     `postingAddTags` [("_conversion-matched","")]+                 | otherwise          -> p)++      -- Annotate any errors with the conversion posting pair+      first (annotateWithPostings [cp1, cp2]) $+        if+          -- If a single costful posting matches the conversion postings,+          -- delete it from the list of costful postings in the state, delete the+          -- first matching costless posting from the list of costless postings+          -- in the state, and return the transformation function with the new state.+          | [(np, costp)] <- matchingCostPs+          , Just newcostps <- deleteIdx np costps+              -> Right (postingAddCostAndOrTag np costp, (if dryrun' then costps else newcostps, otherps))++          -- If no costful postings match the conversion postings, but some+          -- of the costless postings match, check that the first such posting has a+          -- different amount from all the others, and if so add a cost to it,+          -- then delete it from the list of costless postings in the state,+          -- and return the transformation function with the new state.+          | [] <- matchingCostPs+          , (np, (costp, amt)):nps <- matchingOtherPs+          , not $ any (amountsMatch amt . snd . snd) nps+          , Just newotherps <- deleteIdx np otherps+              -> Right (postingAddCostAndOrTag np costp, (costps, if dryrun' then otherps else newotherps))++          -- Otherwise, do nothing, leaving the transaction unchanged.+          -- We don't want to be over-zealous reporting problems here+          -- since this is always called at least in dry run mode by+          -- journalFinalise > journalMarkRedundantCosts. (#2045)+          | otherwise -> Right (id, (costps, otherps))+     -- If a posting with cost matches both the conversion amounts, return it along     -- with the matching amount which must be present in another non-conversion posting.-    costfulPostingIfMatchesBothAmounts :: Amount -> Amount -> Posting -> Maybe (Posting, Amount)-    costfulPostingIfMatchesBothAmounts a1 a2 p = do-        a@Amount{aprice=Just _} <- postingSingleAmount p-        if | amountMatches (-a1) a && amountMatches a2 (amountCost a) -> Just (p, -a2)-           | amountMatches (-a2) a && amountMatches a1 (amountCost a) -> Just (p, -a1)+    costfulPostingIfMatchesBothAmounts :: Amount -> Amount -> Posting -> Maybe Posting+    costfulPostingIfMatchesBothAmounts a1 a2 costfulp = do+        a@Amount{aprice=Just _} <- postingSingleAmount costfulp+        if+           | dbgamtmatch 1 a1 a (amountsMatch (-a1) a)  &&  dbgcostmatch 2 a2 a (amountsMatch a2 (amountCost a)) -> Just costfulp+           | dbgamtmatch 2 a2 a (amountsMatch (-a2) a)  &&  dbgcostmatch 1 a1 a (amountsMatch a1 (amountCost a)) -> Just costfulp            | otherwise -> Nothing+           where+            dbgamtmatch  n a b = dbg7 ("conversion posting "     <>show n<>" "<>showAmount a<>" balances amount "<>showAmountWithoutPrice b <>" of costful posting "<>showAmount b<>" at precision "<>dbgShowAmountPrecision a<>" ?")+            dbgcostmatch n a b = dbg7 ("and\nconversion posting "<>show n<>" "<>showAmount a<>" matches cost "   <>showAmount (amountCost b)<>" of costful posting "<>showAmount b<>" at precision "<>dbgShowAmountPrecision a<>" ?")       -- Add a cost to a posting if it matches (negative) one of the     -- supplied conversion amounts, adding the other amount as the cost.@@ -312,9 +366,10 @@     addCostIfMatchesOneAmount a1 a2 p = do         a <- postingSingleAmount p         let newp cost = p{pamount = mixedAmount a{aprice = Just $ TotalPrice cost}}-        if | amountMatches (-a1) a -> Just (newp a2, a2)-           | amountMatches (-a2) a -> Just (newp a1, a1)-           | otherwise             -> Nothing+        if+           | amountsMatch (-a1) a -> Just (newp a2, a2)+           | amountsMatch (-a2) a -> Just (newp a1, a1)+           | otherwise            -> Nothing      -- Get the single-commodity costless amount from a conversion posting, or raise an error.     conversionPostingAmountNoCost p = case postingSingleAmount p of@@ -322,7 +377,12 @@         Just Amount{aprice=Just _} -> Left $ annotateWithPostings [p] "Conversion postings must not have a cost:"         Nothing                    -> Left $ annotateWithPostings [p] "Conversion postings must have a single-commodity amount:" -    amountMatches a b = acommodity a == acommodity b && aquantity a == aquantity b+    -- 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      -- Delete a posting from the indexed list of postings based on either its     -- index or its posting amount.@@ -338,19 +398,30 @@     deleteUniqueMatch _ []                 = Nothing     annotateWithPostings xs str = T.unlines $ str : postingsAsLines False xs +dbgShowAmountPrecision a =+  case asprecision $ astyle a of+    Just (Precision n)    -> show n+    Just NaturalPrecision -> show $ decimalPlaces $ normalizeDecimal $ aquantity a+    Nothing               -> "unset"+ -- Using the provided account types map, sort the given indexed postings -- into three lists of posting numbers (stored in two pairs), like so:--- (conversion postings, (costful postings, other postings)).+-- (conversion postings, (costful other postings, costless other postings)). -- A true first argument activates its secondary function: check that all -- conversion postings occur in adjacent pairs, otherwise return an error. partitionAndCheckConversionPostings :: Bool -> M.Map AccountName AccountType -> [IdxPosting] -> Either Text ( [(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]) )-partitionAndCheckConversionPostings check acctTypes = fmap fst . foldrM select (([], ([], [])), Nothing)+partitionAndCheckConversionPostings check acctTypes =+  -- Left fold processes postings in parse order, so that eg inferred costs+  -- will be added to the first (top-most) posting, not the last one.+  foldlM select (([], ([], [])), Nothing)+    -- The costless other postings are somehow reversed still; "second (second reverse" fixes that.+    <&> fmap (second (second reverse) . fst)   where-    select np@(_, p) ((cs, others@(ps, os)), Nothing)+    select ((cs, others@(ps, os)), Nothing) np@(_, p)       | isConversion p = Right ((cs, others),      Just np)       | hasCost p      = Right ((cs, (np:ps, os)), Nothing)       | otherwise      = Right ((cs, (ps, np:os)), Nothing)-    select np@(_, p) ((cs, others@(ps,os)), Just lst)+    select ((cs, others@(ps,os)), Just lst) np@(_, p)       | isConversion p = Right (((lst, np):cs, others), Nothing)       | check          = Left "Conversion postings must occur in adjacent pairs"       | otherwise      = Right ((cs, (ps, np:os)), Nothing)

@@ -249,31 +249,34 @@ data AmountPrice = UnitPrice !Amount | TotalPrice !Amount   deriving (Eq,Ord,Generic,Show) --- | Display style for an amount.+-- | The display style for an amount.+-- (See also Amount.AmountDisplayOpts). data AmountStyle = AmountStyle {-      ascommodityside   :: !Side,                   -- ^ does the symbol appear on the left or the right ?-      ascommodityspaced :: !Bool,                   -- ^ space between symbol and quantity ?-      asprecision       :: !AmountPrecision,        -- ^ number of digits displayed after the decimal point-      asdecimalpoint    :: !(Maybe Char),           -- ^ character used as decimal point: period or comma. Nothing means "unspecified, use default"-      asdigitgroups     :: !(Maybe DigitGroupStyle) -- ^ style for displaying digit groups, if any+  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). } deriving (Eq,Ord,Read,Generic)  instance Show AmountStyle where-  show AmountStyle{..} = concat-    [ "AmountStylePP \""+  show AmountStyle{..} = unwords+    [ "AmountStylePP"     , show ascommodityside     , show ascommodityspaced-    , show asprecision-    , show asdecimalpoint     , show asdigitgroups-    , "..\""+    , show asdecimalmark+    , show asprecision     ]  -- | The "display precision" for a hledger amount, by which we mean -- the number of decimal digits to display to the right of the decimal mark.--- This can be from 0 to 255 digits (the maximum supported by the Decimal library),--- or NaturalPrecision meaning "show all significant decimal digits".-data AmountPrecision = Precision !Word8 | NaturalPrecision deriving (Eq,Ord,Read,Show,Generic)+data AmountPrecision =+    Precision !Word8    -- ^ show this many decimal digits (0..255)+  | NaturalPrecision    -- ^ show all significant decimal digits stored internally+  deriving (Eq,Ord,Read,Show,Generic)  -- | A style for displaying digit groups in the integer part of a -- floating point number. It consists of the character used to@@ -297,6 +300,24 @@       astyle      :: !AmountStyle,       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) 

@@ -110,8 +110,8 @@       where         style' = (astyle a) { asprecision = precision' }         precision' = case asprecision (astyle a) of-                          NaturalPrecision -> NaturalPrecision-                          Precision p      -> Precision $ (numDigitsInt $ truncate n) + p+                          Just (Precision p) -> Just $ Precision $ (numDigitsInt $ truncate n) + p+                          mp -> mp  ------------------------------------------------------------------------------ -- Converting things to value@@ -129,7 +129,7 @@  -- | 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 @@       -- 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

@@ -193,7 +193,7 @@ rawOptsToInputOpts :: Day -> RawOpts -> InputOpts rawOptsToInputOpts day rawopts = -    let noinferbalancingcosts = boolopt "strict" rawopts || stringopt "args" rawopts == "balancednoautoconversion"+    let noinferbalancingcosts = boolopt "strict" rawopts || stringopt "args" rawopts == "balanced"          -- Do we really need to do all this work just to get the requested end date? This is duplicating         -- much of reportOptsToSpec.@@ -334,7 +334,7 @@       >>= journalMarkRedundantCosts                      -- Mark redundant costs, to help journalBalanceTransactions ignore them       >>= journalBalanceTransactions balancingopts_                         -- Balance all transactions and maybe check balance assertions.       >>= (if infer_costs_  then journalInferCostsFromEquity else pure)     -- Maybe infer costs from equity postings where possible-      <&> (if infer_equity_ then journalAddInferredEquityPostings verbose_tags_ else id)  -- Maybe infer equity postings from costs where possible+      <&> (if infer_equity_ then journalInferEquityFromCosts verbose_tags_ else id)  -- Maybe infer equity postings from costs where possible       <&> journalInferMarketPricesFromTransactions       -- infer market prices from commodity-exchanging transactions       <&> traceOrLogAt 6 ("journalFinalise: " <> takeFileName f)  -- debug logging       <&> dbgJournalAcctDeclOrder ("journalFinalise: " <> takeFileName f <> "   acct decls           : ")@@ -386,7 +386,7 @@ getDecimalMarkStyle :: JournalParser m (Maybe AmountStyle) getDecimalMarkStyle = do   Journal{jparsedecimalmark} <- get-  let mdecmarkStyle = (\c -> Just $ amountstyle{asdecimalpoint=Just c}) =<< jparsedecimalmark+  let mdecmarkStyle = (\c -> Just $ amountstyle{asdecimalmark=Just c}) =<< jparsedecimalmark   return mdecmarkStyle  setDefaultCommodityAndStyle :: (CommoditySymbol,AmountStyle) -> JournalParser m ()@@ -802,7 +802,7 @@     offAfterNum <- getOffset     let numRegion = (offBeforeNum, offAfterNum)     (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent-    let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}+    let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=Just 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.@@ -824,7 +824,7 @@         -- 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=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}+        let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=Just prec, asdecimalmark=mdec, asdigitgroups=mgrps}         return nullamt{acommodity=c, aquantity=sign q, astyle=s, aprice=Nothing}       -- no symbol amount       Nothing -> do@@ -840,8 +840,8 @@         -- (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) prec})-              _ -> ("", amountstyle{asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps})+              (False, Just (defc,defs)) -> (defc, defs{asprecision=max (asprecision defs) (Just prec)})+              _ -> ("", amountstyle{asprecision=Just 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@@ -1066,9 +1066,9 @@   where     isValidDecimalBy :: Char -> AmountStyle -> Bool     isValidDecimalBy c = \case-      AmountStyle{asdecimalpoint = Just d} -> d == c+      AmountStyle{asdecimalmark = Just d} -> d == c       AmountStyle{asdigitgroups = Just (DigitGroups g _)} -> g /= c-      AmountStyle{asprecision = Precision 0} -> False+      AmountStyle{asprecision = Just (Precision 0)} -> False       _ -> True  -- | Parse and interpret the structure of a number without external hints.@@ -1568,28 +1568,28 @@    ,testCase "ends with decimal mark" $ assertParseEq amountp "$1."        (usd 1  `withPrecision` Precision 0)    ,testCase "unit price"             $ assertParseEq amountp "$10 @ €0.5"       -- not precise enough:-      -- (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- `withStyle` asdecimalpoint=Just '.'+      -- (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- `withStyle` asdecimalmark=Just '.'       nullamt{          acommodity="$"         ,aquantity=10 -- need to test internal precision with roundTo ? I think not-        ,astyle=amountstyle{asprecision=Precision 0, asdecimalpoint=Nothing}+        ,astyle=amountstyle{asprecision=Just $ Precision 0, asdecimalmark=Nothing}         ,aprice=Just $ UnitPrice $           nullamt{              acommodity="€"             ,aquantity=0.5-            ,astyle=amountstyle{asprecision=Precision 1, asdecimalpoint=Just '.'}+            ,astyle=amountstyle{asprecision=Just $ Precision 1, asdecimalmark=Just '.'}             }         }    ,testCase "total price"            $ assertParseEq amountp "$10 @@ €5"       nullamt{          acommodity="$"         ,aquantity=10-        ,astyle=amountstyle{asprecision=Precision 0, asdecimalpoint=Nothing}+        ,astyle=amountstyle{asprecision=Just $ Precision 0, asdecimalmark=Nothing}         ,aprice=Just $ TotalPrice $           nullamt{              acommodity="€"             ,aquantity=5-            ,astyle=amountstyle{asprecision=Precision 0, asdecimalpoint=Nothing}+            ,astyle=amountstyle{asprecision=Just $ Precision 0, asdecimalmark=Nothing}             }         }    ,testCase "unit price, parenthesised" $ assertParse amountp "$10 (@) €0.5"

@@ -490,7 +490,7 @@   lift skipNonNewlineSpaces   _ <- lift followingcommentp   let comm = Commodity{csymbol=acommodity, cformat=Just $ dbg6 "style from commodity directive" astyle}-  if isNothing $ asdecimalpoint astyle+  if isNothing $ asdecimalmark astyle   then customFailure $ parseErrorAt off pleaseincludedecimalpoint   else modify' (\j -> j{jcommodities=M.insert acommodity comm $ jcommodities j}) @@ -533,7 +533,7 @@   _ <- lift followingcommentp   if acommodity==expectedsym     then-      if isNothing $ asdecimalpoint astyle+      if isNothing $ asdecimalmark astyle       then customFailure $ parseErrorAt off pleaseincludedecimalpoint       else return $ dbg6 "style from format subdirective" astyle     else customFailure $ parseErrorAt off $@@ -648,7 +648,7 @@   off <- getOffset   Amount{acommodity,astyle} <- amountp   lift restofline-  if isNothing $ asdecimalpoint astyle+  if isNothing $ asdecimalmark astyle   then customFailure $ parseErrorAt off pleaseincludedecimalpoint   else setDefaultCommodityAndStyle (acommodity, astyle) 

@@ -192,8 +192,8 @@   mcs <- getDefaultCommodityAndStyle   let      (c,s) = case mcs of-      Just (defc,defs) -> (defc, defs{asprecision=max (asprecision defs) (Precision 2)})-      _ -> ("", amountstyle{asprecision=Precision 2})+      Just (defc,defs) -> (defc, defs{asprecision=max (asprecision defs) (Just $ Precision 2)})+      _ -> ("", amountstyle{asprecision=Just $ Precision 2})   -- lift $ traceparse' "timedotentryp end"   return $ nullposting{paccount=a                       ,pamount=mixedAmount $ nullamt{acommodity=c, aquantity=hours, astyle=s}

@@ -85,6 +85,10 @@   ,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@@ -125,7 +129,7 @@         -- maybe convert these transactions to cost or value         . journalApplyValuationFromOpts rspec         . traceOrLogAtWith 5 (("ts2:\n"++).pshowTransactions.jtxns)-        -- apply any cur:SYM filters in reportq+        -- apply any cur: or amt: filters in reportq         . (if queryIsNull amtq then id else filterJournalAmounts amtq)         -- only consider transactions which match thisacctq (possibly excluding postings         -- which are not real or have the wrong status)

@@ -49,6 +49,9 @@ 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

@@ -617,7 +617,8 @@ tests_MultiBalanceReport = testGroup "MultiBalanceReport" [    let-    amt0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = Precision 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}}+    amt0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, +      astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asdigitgroups = Nothing, asdecimalmark = Just '.', asprecision = Just $ Precision 2}}     (rspec,journal) `gives` r = do       let rspec' = rspec{_rsQuery=And [queryFromFlags $ _rsReportOpts rspec, _rsQuery rspec]}           (eitems, etotal) = r

@@ -52,6 +52,9 @@                                          -- 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

@@ -623,7 +623,7 @@     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" 

@@ -4,6 +4,8 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveFunctor  #-} {-# LANGUAGE DeriveGeneric  #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NamedFieldPuns #-}  module Hledger.Reports.ReportTypes ( PeriodicReport(..)@@ -91,6 +93,10 @@ 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 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) =@@ -161,6 +174,16 @@   , cbrSubreports :: [(Text, PeriodicReport a b, Bool)]   , 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.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           hledger-lib-version:        1.30+version:        1.31 synopsis:       A reusable library providing the core functionality of hledger description:    A reusable library containing hledger's core functionality.                 This is used by most hledger* packages so that they support the same@@ -27,7 +27,7 @@ license-file:   LICENSE build-type:     Simple tested-with:-    GHC==8.10.7, GHC==9.0.2, GHC==9.2.7, GHC==9.4.4+    GHC==8.10.7, GHC==9.0.2, GHC==9.2.8, GHC==9.4.5, GHC==9.6.2 extra-source-files:     CHANGES.md     README.md@@ -102,7 +102,7 @@   build-depends:       Decimal >=0.5.1     , Glob >=0.9-    , aeson >=1+    , aeson >=1 && <2.3     , aeson-pretty     , ansi-terminal >=0.9     , array@@ -124,7 +124,7 @@     , file-embed >=0.0.10     , filepath     , hashtables >=1.2.3.1-    , megaparsec >=7.0.0 && <9.4+    , megaparsec >=7.0.0 && <9.6     , microlens >=0.4     , microlens-th >=0.4     , mtl >=2.2.1@@ -160,7 +160,7 @@   build-depends:       Decimal >=0.5.1     , Glob >=0.7-    , aeson >=1+    , aeson >=1 && <2.3     , aeson-pretty     , ansi-terminal >=0.9     , array@@ -183,7 +183,7 @@     , file-embed >=0.0.10     , filepath     , hashtables >=1.2.3.1-    , megaparsec >=7.0.0 && <9.4+    , megaparsec >=7.0.0 && <9.6     , microlens >=0.4     , microlens-th >=0.4     , mtl >=2.2.1@@ -221,7 +221,7 @@   build-depends:       Decimal >=0.5.1     , Glob >=0.9-    , aeson >=1+    , aeson >=1 && <2.3     , aeson-pretty     , ansi-terminal >=0.9     , array@@ -244,7 +244,7 @@     , filepath     , hashtables >=1.2.3.1     , hledger-lib-    , megaparsec >=7.0.0 && <9.4+    , megaparsec >=7.0.0 && <9.6     , microlens >=0.4     , microlens-th >=0.4     , mtl >=2.2.1