hledger-lib 1.31 → 1.32

raw patch · 29 files changed

+1515/−433 lines, 29 filesdep ~textPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: text

API changes (from Hackage documentation)

Files

• CHANGES.md +15/−0
• Hledger.hs +353/−1
• Hledger/Data/AccountName.hs +47/−0
• Hledger/Data/Amount.hs +292/−155
• Hledger/Data/Balancing.hs +66/−31
• Hledger/Data/Errors.hs +4/−1
• Hledger/Data/Journal.hs +30/−11
• Hledger/Data/Json.hs +11/−8
• Hledger/Data/Posting.hs +116/−19
• Hledger/Data/Transaction.hs +42/−8
• Hledger/Data/TransactionModifier.hs +2/−2
• Hledger/Data/Types.hs +19/−5
• Hledger/Data/Valuation.hs +51/−20
• Hledger/Read.hs +143/−22
• Hledger/Read/Common.hs +34/−27
• Hledger/Read/CsvUtils.hs +8/−1
• Hledger/Read/RulesReader.hs +96/−50
• Hledger/Read/TimedotReader.hs +58/−36
• Hledger/Reports/BudgetReport.hs +1/−1
• Hledger/Reports/MultiBalanceReport.hs +2/−1
• Hledger/Reports/ReportOptions.hs +21/−8
• Hledger/Utils.hs +7/−0
• Hledger/Utils/Debug.hs +48/−5
• Hledger/Utils/Parse.hs +1/−0
• Hledger/Utils/Regex.hs +11/−1
• Hledger/Utils/String.hs +5/−0
• Hledger/Utils/Text.hs +7/−5
• Text/Tabular/AsciiWide.hs +7/−4
• hledger-lib.cabal +18/−11

@@ -13,6 +13,21 @@ Internal/api/developer-ish changes in the hledger-lib (and hledger) packages. For user-visible changes, see the hledger package changelog. +# 1.32 2023-12-01++Misc. changes++- styleAmounts is used in more places++- journalApplyCommodityStyles renamed to journalStyleAmounts++- "hard" and "all" rounding strategies have been added++- debug output improvements, eg for precision handling++- Table is now Showable, for debugging++ # 1.31 2023-09-03  Breaking changes

@@ -1,6 +1,11 @@-{-# LANGUAGE OverloadedStrings #-}+{-|+This is the root of the @hledger-lib@ package and the @Hledger.*@ module hierarchy.+hledger-lib is the core engine used by various hledger UIs and tools,+providing the main data types, file format parsers, reporting logic, and utilities.+-}  module Hledger (+  -- $DOCS   module X  ,tests_Hledger )@@ -19,3 +24,350 @@   ,tests_Reports   ,tests_Utils   ]+++{- $DOCS++This is also the starting point for hledger's code docs,+aimed at hledger developers and PTA implementors (and curious users).+These are embedded in hledger's source code as Haddock comments and can be viewed+in your code editor,+or in a web browser (eg with @make haddock@),+or (for released versions) on Hackage, eg [hledger-lib:Hledger](https://hackage.haskell.org/package/hledger-lib/docs/Hledger.html).+See also:++- hledger:Hledger.Cli+- hledger-ui:Hledger.UI+- hledger-web:Hledger.Web+- [The README files](https://github.com/search?q=repo%3Asimonmichael%2Fhledger+path%3A**%2FREADME*&type=code&ref=advsearch)+- [The high-level developer docs](https://hledger.org/dev.html)++The rest of this page discusses some general topics.+Together with the hledger manual it describes and provides a functional specification+for hledger and hledger-like apps.+The current code and tests generally conform to this, hopefully.++== Jargon++In addition to the terminology defined in the hledger manual,+eg at [Journal](https://hledger.org/dev/hledger.html#journal):++Here are some words with particular meanings in the context of hledger:++- __/Decimal/__ is a decimal number representation provided by+  the Decimal package, used by hledger for storing numeric quantities.++- __/Normalised decimal/__ A Decimal which has no trailing decimal zeros.+  This can be ensured by the @normaliseDecimal@ function.++- __/Amount/__ ('Amount') is hledger's representation of numeric amounts+  which have a decimal quantity,+  a commodity symbol ('CommoditySymbol'),+  and a display style ('AmountStyle') and display precision ('Precision').+  and optionally a cost in another commodity.++- __/Style/__, __/Amount style/__ An amount's display style, such its decimal mark and symbol placement.+  Represented by "CommodityStyle". (That also stores display precision,+  though it is sometimes convenient to speak of style and precision separately.)++- __/Commodity style/__ The standard display style inferred or specified for a particular commodity.+  Normally all amounts in that commodity are displayed with that style.++- __/Precision/__ In hledger docs, "precision" means the number of decimal digits,+  ie digits to the right of the decimal mark.++- __/Journal precision/__ The number of decimal digits written for an amount+  in the journal file (or in other input data).++- __/Decimal precision/__ The number of decimal digits stored in an Amount's internal Decimal number.+  After parsing, this will be the same as the journal precision; it can increase during amount calculations.++- __/Display precision/__ The preferred number of decimal digits to show in output+  (except by @print@-like reports, which show journal precision by default).++- __/MixedAmount/__ ('MixedAmount') is hledger's representation of a+  multi-commodity amount; it is a set of zero or more Amounts in+  different commodities and costs (stored as a map for efficiency).++- __/amount/__ means either a single-commodity Amount or a multi-commodity MixedAmount,+  depending on context. There are various sources and kinds of amount:++- __/Posting amount/__ An amount being posted (moved from or to) an account.++- __/Cost amount/__ The (cost in a different commodity) associated with a posting amount.+  Eg the purchase cost when buying, or the sale price when selling.+  Cost is recorded in the journal immediately following the posting amount, expressed as a unit or total cost.++- __/Unit cost/__ The cost per unit of the posting amount. Written as @\@ UNITCOST@.++- __/Total cost/__ The total cost the posting amount. Written as @\@\@ TOTALCOST@.++- __/Amount cost/__ A posting amount converted to its cost's commodity. Shown by @hledger print -B@.++    > 2023-01-01+    >    (a)   2 A @ 2 B   ; <- the amount cost is 4 B++    > 2023-01-01+    >    (a)   2 A @@ 2 B   ; <- the amount cost is 2 B++- __/Cost/__ can mean any of the four above depending on context.++- __/Balance assertion \/ assignment amount/__+  An amount written after the posting amount and cost,+  following @=@ or @==@ or @=*@ or @==*@,+  representing a balance assertion+  (or when the posting amount is omitted, a balance assignment).++- __/Balance assertion \/ assignment cost/__+  The unit or total cost of the balance assertion\/assignment amount, if any.+  Written after it in the usual way.++- __/Price/__, __/Market price/__+  A conversion rate\/exchange rate from a particular commodity to another as of a particular date.+  These usually fluctuate over time, and are recorded by @P@ price directives.+  Shown by @hledger prices@.++- __/Price amount/__ The amount written in a @P@ price directive,+  which specifies the destination commodity and the per-unit conversion rate.++- __/Cost vs price/__+  Both of these words are quite slippery in english.+  To simplify, we always say+  "cost" for a conversion rate used in a particular transaction (posting), and+  "price" for conversion rates prevailing in the environment.++- __/Value/__+  Any amount converted to some other commodity using a market price on a certain date.+  Shown by any hledger report when the @-V@, @-X@ or @--value@ option is used.++- __/Real postings/__ Normal account postings, required to balance to zero.++- __/Virtual postings/__ Account postings which are exempt from the normal balance-to-zero requirement.+  Written with parentheses around the account name.+  Can be excluded from reports with the @--real@ flag.++- __/Balanced virtual postings/__ Account postings which are required to balance to zero,+  but separately from the real postings.+  Written with square brackets around the account name.+  Can be excluded from reports with the @--real@ flag.++- __/Transaction balancing/__ The process of inferring amounts and/or costs to balance a transaction,+  both in its real and its balanced virtual postings.++- __/Balancing amount/__ An amount that is inferred to balance a transaction with a missing amount. Shown by @hledger print -x@.++    > 2023-01-01+    >    a   1+    >    b        ; <- a balancing amount of -1 is inferred++- __/Balancing cost/__ A cost that is inferred to balance a transaction involving two commodities. Shown by @hledger print -x@.++    > 2023-01-01+    >    a   1 A  ; <- a balancing cost of @@ 2 B is inferred+    >    b  -2 B++== Precision++As mentioned in Jargon:+"precision" in hledger means the number of digits to the right of the decimal mark.+And, amounts have several precisions we can talk about:++__/Journal precision/__ is the number of decimal digits recorded in the+journal file \/ input data. We accept up to 255 decimal digits there.++__/Decimal precision/__ is the number of decimal digits stored internally in each Decimal value. Decimal supports up to 255 decimal digits.+In amounts just parsed from the journal, this will be the same as their journal precision.+During calculations, amounts' decimal precision may increase, and will not decrease.++__/Display precision/__ is the preferred number of decimal digits to show in report output.+It is represented by 'AmountPrecision', which is currently part of the 'AmountStyle' stored within each Amount.+In amounts just parsed from the journal, this will be the same as the journal and decimal precisions;+later it gets standardised for each commodity's amounts.+When display precision is less than the decimal precision, fewer, rounded decimal digits are displayed ("rounding").+When display precision is greater than the decimal precision, additional decimal zeros are displayed ("padding").++Basically, hledger amounts have two main precisions we care about at runtime:+their internal decimal precision, used for calculation, and their display precision, used for rendering.++== Rounding++__/Internal rounding/__ means rounding (or padding) internal Decimal numbers,+using @amountSetInternalPrecision@ (which uses @Data.Decimal.roundTo@).+Internal rounding loses information so we don't do this much.++__/Display rounding/__ means applying a target display precision to an existing amount.+This can be done more or less forcefully, determined by a "display rounding strategy" ('Rounding').+Currently this too is stored within each Amount's AmountStyle, for convenience,+(though semantically speaking it is not part of the amount).++The rounding strategies are:++- none - leave the amount's display precision unchanged+- soft - add or remove trailing decimal zeros to approximate the target precision, but don't remove significant digits+- hard - use the exact target precision, possibly rounding and hiding significant digits+- all  - do hard rounding of both the main amount and its cost amount (costs are normally not display-rounded).++Broadly, here is when display rounding happens:++1. After reading a journal, when standard commodity styles are applied,+  display precisions are kept unchanged; no rounding is done at this stage (since 1.31).++2. While balancing each transaction,+  its amounts are temporarily hard-rounded to the standard commodity display precisions,+  to provide some configurable tolerance in the balancing calculations.+  (We plan to change this to use transaction-local standard precisions,+  inferred from the transaction's journal precisions only, like Ledger.)++3. Just before output, reports do display rounding according to their needs (since 1.31).+  Most reports do hard display rounding.+  @print@ and other print-like commands do no rounding by default,+  or optionally one of the other rounding strategies.++=== Precision and style handling++hledger supports user-specified precisions from 0 to 255 for each+commodity, and tries to propagate these consistently and intuitively+through all the various processing steps.++This gets rather complicated, so we keep a summary of the current+precision and style behaviours here.+This doc should always be kept synced with code.++In Decimal number calculations:++- the result is normalised, meaning any trailing decimal zeros are trimmed.+  So the result 's precision can be larger+  (1 / 2, both with precision 0, is 0.5, with precision 1)+  or smaller+  (2.0 / 1.0, both with precision 1, is normalised to 2, with precision 0).++In amount calculations:++- When amounts are summed (or subtracted), the result has the maximum+  of their decimal precisions, the maximum of their display precisions,+  and the display style of the second amount.++- When an amount is multiplied (or divided) by a pure number,+  the result's decimal precision is that of the decimal result, normalised.+  The display precision and style is kept unchanged.++- When an amount is converted to cost, the new amount's decimal precision+  is that of the cost amount (if it's a total cost),+  or of the cost amount multiplied by the quantity and normalised (if it's a unit cost).+  Its display precision is kept unchanged.+  Its display style is that of the cost amount.++- When an amount is converted to value, the new amount's decimal precision+  is that of the price amount multiplied by the quantity and normalised.+  Its display precision is set to match the decimal precision,+  or to a fallback precision (8) if the decimal appears to be infinite.+  Its display style is its commodity's standard display style.+  If no standard style is known for the commodity (eg because it does not appear in the journal),+  it is given the fallback display style (symbol on the left unspaced, period as decimal mark,+  precision limited to a maximum of 8 digits).++In a run of hledger:++__1. Input__++__1.1. Parsing__++- Each parsed amount initially has decimal precision, display precision,+  and display style set according to how it was written in the journal.++__1.2. Standard styling__++- After all amounts are parsed,+  standard display styles and display precisions are inferred for each commodity+  from its amounts, directives like @commodity@ and @D@, and -c\/--commodity options+  (in 'journalInferCommodityStyles'),+  and these are applied to all amounts and their costs for consistent display+  (in 'journalStyleAmounts').+  No amount display precisions are changed at this stage.++__1.3. Transaction balancing__++- When amounts are summed, the result has the maximum of their+  decimal precisions and the maximum of their display precisions.++- A balancing amount without a cost will have the same precisions as+  the amount (or sum) it is balancing.++- A balancing amount which has a cost will be converted to cost; see+  "When an amount is converted to cost" above.++- When inferring a balancing cost:++    - The "from amount" is the sum of postings in the first-appearing commodity.++    - The "to amount" is the sum of postings in the second-appearing commodity. See "When amounts are summed" above.++    - If the from amount comes from a single posting, it is given a total cost.+      The cost's decimal precision will be that of the to amount divided by the from quantity, normalised. +      Its display precision and style will be that of the to amount.++    - If the from amount comes from multiple postings, they all are given a unit cost.+      The cost's decimal precision will be that of the to amount divided by the from quantity, normalised. +      Its display precision will be the sum of the from and to amounts' display precisions, or 2, whichever is greater.+      Its display style will be that of the to amount.++- An amount inferred from a balance assignment will have the same precisions as the balance assignment amount.++__1.4. Determining market prices__++If needed, for a value report:++- Any @P@ price directives form the __/declared prices/__.+  Like posting amounts, their price amounts have been standard-styled+  but their precisions have not yet been changed.++- If the @--infer-market-prices@ flag is used, additional price+  directives are generated from any journal postings with costs+  (in 'amountPriceDirectiveFromCost').+  When the cost was a unit cost, the price amount will have the same precisions.+  When the cost was a total cost,++    - The total cost is divided by the amount quantity to get a unit cost.+    - Its decimal precision becomes that of the decimal result, normalised.+    - Its display precision is set to match the new decimal precision;+      unless the decimal appears to be infinite (because it uses all the 255 digits allowed),+      in which case it is given a smaller fallback display precision (8 decimal digits).++    These plus the declared prices are the __/forward prices/__.++- Additional market prices are generated (as 'MarketPrice' this time, not 'PriceDirective')+  by reversing the forward prices (in 'marketPriceReverse').+  Any new prices generated in this way are the __/reverse prices/__.+  Their decimal precision will be that of (1 \/ the decimal quantity), normalised.+  (They don't have a display precision.)+  These plus the forward prices are the __/direct prices/__+  (giving direct conversion rates from one commodity to another).++And later, if needed:++- For each requested value conversion from commodity A to commodity B,+  if an appropriate price is not found in the direct prices, we try to calculate a __/chained price/__,+  combining two or more direct prices that form a path from A to B.+  The resulting price's decimal precision will be the product of the chained prices, normalised,+  then padded back up to the maximum of their decimal precisions+  (undoing the normalising, because later we will choose the value amount's display precision+   based on the value's decimal precision).++__2. Calculating reports__++- Amounts may be converted to cost (-B), summed, averaged, converted+  to velue (-V\/-X\/--value), etc.  Precisions and styles are affected+  as described in "In amount calculations" above.++__3. Output__++- print-like reports: amounts are displayed with their current display precisions.+  Or with --round, they can be soft- or hard-rounded/padded to the standard commodity precisions.+ +- All other reports: amounts are displayed hard rounded/padded to the standard commodity precisions.++- In the roi report: if there is no standard display precision for the valuation commodity,+  it is limited to a maximum of 8 digits.++== Exports of this module:+-}

@@ -52,6 +52,8 @@   ,concatAccountNames   ,accountNameApplyAliases   ,accountNameApplyAliasesMemo+  ,accountNameToBeancount+  ,beancountTopLevelAccounts   ,tests_AccountName ) where@@ -71,6 +73,7 @@  import Hledger.Data.Types import Hledger.Utils+import Data.Char (isDigit, isLetter)  -- $setup -- >>> :set -XOverloadedStrings@@ -345,6 +348,50 @@ -- -- | Does this string look like an exact account-matching regular expression ? --isAccountRegex  :: String -> Bool --isAccountRegex s = take 1 s == "^" && take 5 (reverse s) == ")$|:("++type BeancountAccountName = AccountName+type BeancountAccountNameComponent = AccountName++-- Convert a hledger account name to a valid Beancount account name.+-- It replaces non-supported characters with @-@ (warning: in extreme cases+-- separate accounts could end up with the same name), and it capitalises +-- each account name part. It also checks that the first part is one of +-- Assets, Liabilities, Equity, Income, or Expenses, and if not it raises an error.+-- Account aliases (eg --alias) should be used to set these required+-- top-level account names if needed.+accountNameToBeancount :: AccountName -> BeancountAccountName+accountNameToBeancount a =+  -- https://beancount.github.io/docs/beancount_language_syntax.html#accounts+  accountNameFromComponents $+  case map (accountNameComponentToBeancount a) $ accountNameComponents a of+    c:_ | c `notElem` beancountTopLevelAccounts -> error' e+      where+        e = T.unpack $ T.unlines [+          beancountAccountErrorMessage a,+          "For Beancount output, all top-level accounts must be (or be aliased to) one of",+          T.intercalate ", " beancountTopLevelAccounts <> "."+          ]+    cs -> cs++accountNameComponentToBeancount :: AccountName -> AccountName -> BeancountAccountNameComponent+accountNameComponentToBeancount acct part =+  case T.uncons part of+    Just (c,_) | not $ isLetter c -> error' e+      where+        e = unlines [+          T.unpack $ beancountAccountErrorMessage acct,+          "For Beancount output, each account name part must begin with a letter."+          ]+    _ -> textCapitalise part'+      where part' = T.map (\c -> if isBeancountAccountChar c then c else '-') part++beancountAccountErrorMessage :: AccountName -> Text+beancountAccountErrorMessage a = "Could not convert \"" <> a <> "\" to a Beancount account name."++isBeancountAccountChar :: Char -> Bool+isBeancountAccountChar c = c `elem` ("-:"::[Char]) || isLetter c || isDigit c++beancountTopLevelAccounts = ["Assets", "Liabilities", "Equity", "Income", "Expenses"]  tests_AccountName = testGroup "AccountName" [    testCase "accountNameTreeFrom" $ do

@@ -42,13 +42,16 @@  {-# LANGUAGE OverloadedStrings  #-} {-# LANGUAGE RecordWildCards    #-}+{-# LANGUAGE NamedFieldPuns #-}  module Hledger.Data.Amount (   -- * Commodity   showCommoditySymbol,   isNonsimpleCommodityChar,   quoteCommoditySymbolIfNeeded,+   -- * Amount+  -- ** arithmetic   nullamt,   missingamt,   num,@@ -60,27 +63,26 @@   at,   (@@),   amountWithCommodity,-  -- ** arithmetic   amountCost,   amountIsZero,   amountLooksZero,   divideAmount,   multiplyAmount,+  invertAmount,+  -- ** styles+  amountstyle,+  canonicaliseAmount,+  styleAmount,+  amountSetStyles,+  amountStyleSetRounding,+  amountStylesSetRounding,+  amountUnstyled,   -- ** rendering   AmountDisplayOpts(..),   noColour,   noPrice,   oneLine,   csvDisplay,-  amountstyle,-  canonicaliseAmount,-  styleAmount,-  amountSetStyles,-  amountSetStylesExceptPrecision,-  amountSetMainStyle,-  amountSetCostStyle,-  amountStyleUnsetPrecision,-  amountUnstyled,   showAmountB,   showAmount,   showAmountPrice,@@ -89,13 +91,20 @@   showAmountDebug,   showAmountWithoutPrice,   amountSetPrecision,+  amountSetPrecisionMin,+  amountSetPrecisionMax,   withPrecision,   amountSetFullPrecision,+  amountSetFullPrecisionOr,+  amountInternalPrecision,+  amountDisplayPrecision,+  defaultMaxPrecision,   setAmountInternalPrecision,   withInternalPrecision,   setAmountDecimalPoint,   withDecimalPoint,   amountStripPrices,+   -- * MixedAmount   nullmixedamt,   missingmixedamt,@@ -128,12 +137,12 @@   maIsZero,   maIsNonZero,   mixedAmountLooksZero,-  -- ** rendering+  -- ** styles   canonicaliseMixedAmount,   styleMixedAmount,   mixedAmountSetStyles,-  mixedAmountSetStylesExceptPrecision,   mixedAmountUnstyled,+  -- ** rendering   showMixedAmount,   showMixedAmountOneLine,   showMixedAmountDebug,@@ -147,6 +156,9 @@   wbUnpack,   mixedAmountSetPrecision,   mixedAmountSetFullPrecision,+  mixedAmountSetPrecisionMin,+  mixedAmountSetPrecisionMax,+   -- * misc.   tests_Amount ) where@@ -174,10 +186,12 @@ import Test.Tasty.HUnit ((@?=), assertBool, testCase)  import Hledger.Data.Types-import Hledger.Utils (colorB, numDigitsInt)+import Hledger.Utils (colorB, numDigitsInt, numDigitsInteger) import Hledger.Utils.Text (textQuoteIfNeeded) import Text.WideString (WideBuilder(..), wbFromText, wbToText, wbUnpack) import Data.Functor ((<&>))+-- import Data.Function ((&))+-- import Hledger.Utils.Debug (dbg0)   -- A 'Commodity' is a symbol representing a currency or some other kind of@@ -203,11 +217,13 @@   -- | Options for the display of Amount and MixedAmount.--- (See also Types.AmountStyle)+-- (ee also Types.AmountStyle. data AmountDisplayOpts = AmountDisplayOpts   { displayPrice         :: Bool       -- ^ Whether to display the Price of an Amount.   , displayZeroCommodity :: Bool       -- ^ If the Amount rounds to 0, whether to display its commodity string.-  , displayThousandsSep  :: Bool       -- ^ Whether to display thousands separators.+  , displayThousandsSep  :: Bool       -- ^ Whether to display digit group marks (eg thousands separators)+  , displayAddDecimalMark  :: Bool     -- ^ Whether to add a trailing decimal mark when there are no decimal digits +                                       --   and there are digit group marks, to disambiguate   , displayColour        :: Bool       -- ^ Whether to colourise negative Amounts.   , displayOneLine       :: Bool       -- ^ Whether to display on one line.   , displayMinWidth      :: Maybe Int  -- ^ Minimum width to pad to@@ -226,6 +242,7 @@                              , displayColour        = False                              , displayZeroCommodity = False                              , displayThousandsSep  = True+                             , displayAddDecimalMark = False                              , displayOneLine       = False                              , displayMinWidth      = Just 0                              , displayMaxWidth      = Nothing@@ -245,15 +262,7 @@ csvDisplay = oneLine{displayThousandsSep=False}  ---------------------------------------------------------------------------------- Amount styles---- | Default amount style-amountstyle = AmountStyle L False Nothing (Just '.') (Just $ Precision 0)------------------------------------------------------------------------------------ Amount--instance HasAmounts Amount where styleAmounts = amountSetStyles+-- Amount arithmetic  instance Num Amount where     abs a@Amount{aquantity=q}    = a{aquantity=abs q}@@ -279,11 +288,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=Just $ Precision 2, ascommodityside=R}}-usd n = nullamt{acommodity="$", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Just $ Precision 2}}-eur n = nullamt{acommodity="€", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Just $ Precision 2}}-gbp n = nullamt{acommodity="£", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Just $ Precision 2}}-per n = nullamt{acommodity="%", aquantity=n,           astyle=amountstyle{asprecision=Just $ Precision 1, ascommodityside=R, ascommodityspaced=True}}+hrs n = nullamt{acommodity="h", aquantity=n,           astyle=amountstyle{asprecision=Precision 2, ascommodityside=R}}+usd n = nullamt{acommodity="$", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}}+eur n = nullamt{acommodity="€", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}}+gbp n = nullamt{acommodity="£", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=Precision 2}}+per n = nullamt{acommodity="%", aquantity=n,           astyle=amountstyle{asprecision=Precision 1, ascommodityside=R, ascommodityspaced=True}} amt `at` priceamt = amt{aprice=Just $ UnitPrice priceamt} amt @@ priceamt = amt{aprice=Just $ TotalPrice priceamt} @@ -329,7 +338,7 @@     f' (TotalPrice a1@Amount{aquantity=pq}) = TotalPrice a1{aquantity = f pq}     f' p' = p' --- | Divide an amount's quantity (and its total price, if it has one) by a constant.+-- | Divide an amount's quantity (and total cost, if any) by some number. divideAmount :: Quantity -> Amount -> Amount divideAmount n = transformAmount (/n) @@ -337,6 +346,11 @@ multiplyAmount :: Quantity -> Amount -> Amount multiplyAmount n = transformAmount (*n) +-- | Invert an amount (replace its quantity q with 1/q).+-- (Its cost if any is not changed, currently.)+invertAmount :: Amount -> Amount+invertAmount a@Amount{aquantity=q} = a{aquantity=1/q}+ -- | Is this amount negative ? The price is ignored. isNegativeAmount :: Amount -> Bool isNegativeAmount Amount{aquantity=q} = q < 0@@ -345,9 +359,8 @@ -- If that is unset or NaturalPrecision, this does nothing. amountRoundedQuantity :: Amount -> Quantity amountRoundedQuantity Amount{aquantity=q, astyle=AmountStyle{asprecision=mp}} = case mp of-    Nothing               -> q-    Just NaturalPrecision -> q-    Just (Precision p)    -> roundTo p q+    NaturalPrecision -> q+    Precision p      -> roundTo p q  -- | Apply a test to both an Amount and its total price, if it has one. testAmountAndTotalPrice :: (Amount -> Bool) -> Amount -> Bool@@ -363,49 +376,229 @@ amountLooksZero = testAmountAndTotalPrice looksZero   where     looksZero Amount{aquantity=Decimal e q, astyle=AmountStyle{asprecision=p}} = case p of-        Just (Precision d)    -> if e > d then abs q <= 5*10^(e-d-1) else q == 0-        Just NaturalPrecision -> q == 0-        Nothing               -> q == 0+        Precision d      -> if e > d then abs q <= 5*10^(e-d-1) else q == 0+        NaturalPrecision -> q == 0  -- | Is this Amount (and its total price, if it has one) exactly zero, ignoring its display precision ? amountIsZero :: Amount -> Bool amountIsZero = testAmountAndTotalPrice (\Amount{aquantity=Decimal _ q} -> q == 0) +-- | Does this amount's internal Decimal representation have the+-- maximum number of digits, suggesting that it probably is+-- representing an infinite decimal ?+amountHasMaxDigits :: Amount -> Bool+amountHasMaxDigits = (>= 255) . numDigitsInteger . decimalMantissa . aquantity+-- XXX this seems not always right. Eg:+-- ghci> let n = 100 / (3.0 :: Decimal)+-- decimalPlaces n+-- 255+-- numDigitsInteger $ decimalMantissa n+-- 257++ -- | Set an amount's display precision, flipped. withPrecision :: Amount -> AmountPrecision -> Amount withPrecision = flip amountSetPrecision  -- | Set an amount's display precision. amountSetPrecision :: AmountPrecision -> Amount -> Amount-amountSetPrecision p a@Amount{astyle=s} = a{astyle=s{asprecision=Just p}}+amountSetPrecision p a@Amount{astyle=s} = a{astyle=s{asprecision=p}} +-- | Ensure an amount's display precision is at least the given minimum precision.+-- Always sets an explicit Precision.+amountSetPrecisionMin :: Word8 -> Amount -> Amount+amountSetPrecisionMin minp a = amountSetPrecision p a+  where p = Precision $ max minp (amountDisplayPrecision a)++-- | Ensure an amount's display precision is at most the given maximum precision.+-- Always sets an explicit Precision.+amountSetPrecisionMax :: Word8 -> Amount -> Amount+amountSetPrecisionMax maxp a = amountSetPrecision p a+  where p = Precision $ min maxp (amountDisplayPrecision a)+ -- | Increase an amount's display precision, if needed, to enough decimal places -- 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.+-- If the amount's display precision is unset, it will be treated as precision 0. amountSetFullPrecision :: Amount -> Amount amountSetFullPrecision a = amountSetPrecision p a   where     p                = max displayprecision naturalprecision-    displayprecision = fromMaybe (Precision 0) $ asprecision $ astyle a-    naturalprecision = Precision . decimalPlaces . normalizeDecimal $ aquantity a+    displayprecision = asprecision $ astyle a+    naturalprecision = Precision $ amountInternalPrecision a+-- XXX Is that last sentence correct ?+-- max (Precision n) NaturalPrecision is NaturalPrecision.+-- Would this work instead ?+-- amountSetFullPrecision a = amountSetPrecision (Precision p) a+--   where p = max (amountDisplayPrecision a) (amountInternalPrecision a) --- | Set an amount's internal precision, ie rounds the Decimal representing--- the amount's quantity to some number of decimal places.++-- | We often want to display "infinite decimal" amounts rounded to some readable+-- number of digits, while still displaying amounts with a large "non infinite" number+-- of decimal digits (eg, 100 or 200 digits) in full.+-- This helper is like amountSetFullPrecision, but with some refinements:+-- 1. If the internal precision is the maximum (255), indicating an infinite decimal, +-- the display precision is set to a smaller hard-coded default (8).+-- 2. A maximum display precision can be specified, setting a hard upper limit.+-- This function always sets an explicit display precision (ie, Precision n).+amountSetFullPrecisionOr :: Maybe Word8 -> Amount -> Amount+amountSetFullPrecisionOr mmaxp a = amountSetPrecision (Precision p2) a+  where+    p1 = if -- dbg0 "maxdigits" $+            amountHasMaxDigits a then defaultMaxPrecision else max disp intp+      -- & dbg0 "p1"+      where+        intp = amountInternalPrecision a+        disp = amountDisplayPrecision a+    p2 = maybe p1 (min p1) mmaxp+      -- & dbg0 "p2"++-- | The fallback display precision used when showing amounts+-- representing an infinite decimal.+defaultMaxPrecision :: Word8+defaultMaxPrecision = 8++-- | How many internal decimal digits are stored for this amount ?+amountInternalPrecision :: Amount -> Word8+amountInternalPrecision = decimalPlaces . normalizeDecimal . aquantity++-- | How many decimal digits will be displayed for this amount ?+amountDisplayPrecision :: Amount -> Word8+amountDisplayPrecision a =+  case asprecision $ astyle a of+    Precision n      -> n+    NaturalPrecision -> amountInternalPrecision a++-- | Set an amount's internal decimal precision as well as its display precision.+-- This rounds or pads its Decimal quantity to the specified number of decimal places. -- Rounding is done with Data.Decimal's default roundTo function: -- "If the value ends in 5 then it is rounded to the nearest even value (Banker's Rounding)".--- Does not change the amount's display precision.--- Intended mainly for internal use, eg when comparing amounts in tests. setAmountInternalPrecision :: Word8 -> Amount -> Amount setAmountInternalPrecision p a@Amount{ aquantity=q, astyle=s } = a{-   astyle=s{asprecision=Just $ Precision p}-  ,aquantity=roundTo p q+   aquantity=roundTo p q+  ,astyle=s{asprecision=Precision p}   } --- | Set an amount's internal precision, flipped.--- Intended mainly for internal use, eg when comparing amounts in tests.+-- | setAmountInternalPrecision with arguments flipped. withInternalPrecision :: Amount -> Word8 -> Amount withInternalPrecision = flip setAmountInternalPrecision +-- Amount display styles++-- v1+{-# DEPRECATED canonicaliseAmount "please use styleAmounts instead" #-}+canonicaliseAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount+canonicaliseAmount = styleAmounts++-- v2+{-# DEPRECATED styleAmount "please use styleAmounts instead" #-}+styleAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount+styleAmount = styleAmounts++-- v3+{-# DEPRECATED amountSetStyles "please use styleAmounts instead" #-}+amountSetStyles :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount+amountSetStyles = styleAmounts++-- v4+instance HasAmounts Amount where+  -- | Given some commodity display styles, find and apply the appropriate one to this amount,+  -- and its cost amount if any (and stop; we assume costs don't have costs).+  -- Display precision will be applied (or not) as specified by the style's rounding strategy,+  -- except that costs' precision is never changed (costs are often recorded inexactly,+  -- so we don't want to imply greater precision than they were recorded with).+  -- If no style is found for an amount, it is left unchanged.+  styleAmounts styles a@Amount{aquantity=qty, acommodity=comm, astyle=oldstyle, aprice=mcost0} =+    a{astyle=newstyle, aprice=mcost1}+    where+      newstyle = mknewstyle False qty oldstyle comm ++      mcost1 = case mcost0 of+        Nothing -> Nothing+        Just (UnitPrice  ca@Amount{aquantity=cq, astyle=cs, acommodity=ccomm}) -> Just $ UnitPrice  ca{astyle=mknewstyle True cq cs ccomm}+        Just (TotalPrice ca@Amount{aquantity=cq, astyle=cs, acommodity=ccomm}) -> Just $ TotalPrice ca{astyle=mknewstyle True cq cs ccomm}++      mknewstyle :: Bool -> Quantity -> AmountStyle -> CommoditySymbol -> AmountStyle+      mknewstyle iscost oldq olds com =+        case M.lookup com styles of+          Just s  -> +            -- dbg0 "new      style" $ +            amountStyleApplyWithRounding iscost oldq +              (+                -- dbg0 "applying style"+                s)+              (+                -- dbg0 "old      style"+                olds)+          Nothing -> olds++-- AmountStyle helpers++-- | Replace one AmountStyle with another, but don't just replace the display precision;+-- update that in one of several ways as selected by the new style's "rounding strategy":+--+-- NoRounding - keep the precision unchanged+--+-- SoftRounding -+--+--  if either precision is NaturalPrecision, use NaturalPrecision;+--+--  if the new precision is greater than the old, use the new (adds decimal zeros);+--+--  if the new precision is less than the old, use as close to the new as we can get+--    without dropping (more) non-zero digits (drops decimal zeros).+--+--  for a cost amount, keep the precision unchanged+--+-- HardRounding -+--+--  for a posting amount, use the new precision (may truncate significant digits);+--+--  for a cost amount, keep the precision unchanged+--+-- AllRounding -+--+--  for both posting and cost amounts, do hard rounding.+--+-- Arguments:+--+--  whether this style is for a posting amount or a cost amount,+--+--  the amount's decimal quantity (for inspecting its internal representation), +--+--  the new style, +--+--  the old style.+--+amountStyleApplyWithRounding :: Bool -> Quantity -> AmountStyle -> AmountStyle -> AmountStyle+amountStyleApplyWithRounding iscost q news@AmountStyle{asprecision=newp, asrounding=newr} AmountStyle{asprecision=oldp} =+  case newr of+    NoRounding   -> news{asprecision=oldp}+    SoftRounding -> news{asprecision=if iscost then oldp else newp'}+      where+        newp' = case (newp, oldp) of+          (Precision new, Precision old) ->+            if new >= old+            then Precision new+            else Precision $ max (min old internal) new+              where internal = decimalPlaces $ normalizeDecimal q+          _ -> NaturalPrecision+    HardRounding -> news{asprecision=if iscost then oldp else newp}+    AllRounding  -> news++-- | Set this amount style's rounding strategy when being applied to amounts.+amountStyleSetRounding :: Rounding -> AmountStyle -> AmountStyle+amountStyleSetRounding r as = as{asrounding=r}++amountStylesSetRounding :: Rounding -> M.Map CommoditySymbol AmountStyle -> M.Map CommoditySymbol AmountStyle+amountStylesSetRounding r = M.map (amountStyleSetRounding r) ++-- | Default amount style+amountstyle = AmountStyle L False Nothing (Just '.') (Precision 0) NoRounding++-- | Reset this amount's display style to the default.+amountUnstyled :: Amount -> Amount+amountUnstyled a = a{astyle=amountstyle}+ -- | Set (or clear) an amount's display decimal point. setAmountDecimalPoint :: Maybe Char -> Amount -> Amount setAmountDecimalPoint mc a@Amount{ astyle=s } = a{ astyle=s{asdecimalmark=mc} }@@ -414,6 +607,8 @@ withDecimalPoint :: Amount -> Maybe Char -> Amount withDecimalPoint = flip setAmountDecimalPoint +-- Amount rendering+ -- | Strip all prices from an Amount amountStripPrices :: Amount -> Amount amountStripPrices a = a{aprice=Nothing}@@ -430,76 +625,6 @@ 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 do the same for the cost amount if any, but leave its precision unchanged.-styleAmount :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount-styleAmount = amountSetStyles-{-# DEPRECATED styleAmount "please use amountSetStyles instead" #-}---- v3---- | Given some commodity display styles, find and apply the appropriate--- display style to this amount, and do the same for its cost amount if any--- (and then stop; we assume costs don't have costs).--- The main amount's display precision 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@@ -523,22 +648,25 @@ -- showAmountB :: AmountDisplayOpts -> Amount -> WideBuilder showAmountB _ Amount{acommodity="AUTO"} = mempty-showAmountB opts a@Amount{astyle=style} =+showAmountB+  AmountDisplayOpts{displayPrice, displayColour, displayZeroCommodity, +    displayThousandsSep, displayAddDecimalMark, displayOrder}+  a@Amount{astyle=style} =     color $ case ascommodityside style of       L -> showC (wbFromText comm) space <> quantity' <> price       R -> quantity' <> showC space (wbFromText comm) <> price   where-    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}}+    color = if displayColour && isNegativeAmount a then colorB Dull Red else id+    quantity = showAmountQuantity displayAddDecimalMark $+      if displayThousandsSep then a else a{astyle=(astyle a){asdigitgroups=Nothing}}     (quantity', comm)-      | amountLooksZero a && not (displayZeroCommodity opts) = (WideBuilder (TB.singleton '0') 1, "")+      | amountLooksZero a && not displayZeroCommodity = (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+    showC l r = if isJust displayOrder then mempty else l <> r+    price = if displayPrice then showAmountPrice a else mempty  -- | Colour version. For a negative amount, adds ANSI codes to change the colour, -- currently to hard-coded red.@@ -569,10 +697,10 @@  -- | 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.--- 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{asdecimalmark=mdec, asdigitgroups=mgrps}} =+-- With a true first argument, if there are no decimal digits but there are digit group separators,+-- it shows the amount with a trailing decimal mark to help disambiguate it for parsing.+showAmountQuantity :: Bool -> Amount -> WideBuilder+showAmountQuantity disambiguate amt@Amount{astyle=AmountStyle{asdecimalmark=mdec, asdigitgroups=mgrps}} =     signB <> intB <> fracB   where     Decimal decplaces mantissa = amountRoundedQuantity amt@@ -584,13 +712,13 @@     (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+    fracB = if decplaces > 0 || (isshowingdigitgroupseparator && disambiguate)       then WideBuilder (TB.singleton dec <> TB.fromText fracPart) (1 + fromIntegral decplaces)       else mempty--    isshowingdigitgroupseparator = case mgrps of-      Just (DigitGroups _ (rightmostgrplen:_)) -> intLen > fromIntegral rightmostgrplen-      _ -> False+      where+        isshowingdigitgroupseparator = case mgrps of+          Just (DigitGroups _ (rightmostgrplen:_)) -> intLen > fromIntegral rightmostgrplen+          _ -> False  -- | Given an integer as text, and its length, apply the given DigitGroupStyle, -- inserting digit group separators between digit groups where appropriate.@@ -611,8 +739,6 @@ ------------------------------------------------------------------------------- -- MixedAmount -instance HasAmounts MixedAmount where styleAmounts = mixedAmountSetStyles- instance Semigroup MixedAmount where   (<>) = maPlus   sconcat = maSum@@ -718,14 +844,12 @@     _ -> Nothing  -- multiple amounts with different signs  -- | Does this mixed amount appear to be zero when rendered with its display precision?--- i.e. does it have zero quantity with no price, zero quantity with a total price (which is also zero),--- and zero quantity for each unit price?+-- See amountLooksZero. mixedAmountLooksZero :: MixedAmount -> Bool mixedAmountLooksZero (Mixed ma) = all amountLooksZero ma  -- | Is this mixed amount exactly zero, ignoring its display precision?--- i.e. does it have zero quantity with no price, zero quantity with a total price (which is also zero),--- and zero quantity for each unit price?+-- See amountIsZero. mixedAmountIsZero :: MixedAmount -> Bool mixedAmountIsZero (Mixed ma) = all amountIsZero ma @@ -871,35 +995,38 @@ --     where a' = mixedAmountStripPrices a --           b' = mixedAmountStripPrices b --- Mixed amount styling--- v1+-- Mixed amount styles --- | Canonicalise a mixed amount's display styles using the provided commodity style map.--- Cost amounts, if any, are not affected.+-- v1+{-# DEPRECATED canonicaliseMixedAmount "please use mixedAmountSetStyle False (or styleAmounts) instead" #-} canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount-canonicaliseMixedAmount styles = mapMixedAmountUnsafe (canonicaliseAmount styles)-{-# DEPRECATED canonicaliseMixedAmount "please use mixedAmountSetMainStyle (or mixedAmountSetStyles) instead" #-}+canonicaliseMixedAmount = styleAmounts  -- v2-+{-# DEPRECATED styleMixedAmount "please use styleAmounts instead" #-} -- | 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 = mixedAmountSetStyles-{-# DEPRECATED styleMixedAmount "please use mixedAmountSetStyles instead" #-}+styleMixedAmount = styleAmounts  -- v3-+{-# DEPRECATED mixedAmountSetStyles "please use styleAmounts instead" #-} mixedAmountSetStyles :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount-mixedAmountSetStyles styles = mapMixedAmountUnsafe (amountSetStyles styles)+mixedAmountSetStyles = styleAmounts -mixedAmountSetStylesExceptPrecision :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount-mixedAmountSetStylesExceptPrecision styles = mapMixedAmountUnsafe (amountSetStylesExceptPrecision styles)+-- v4+instance HasAmounts MixedAmount where+  styleAmounts styles = mapMixedAmountUnsafe (styleAmounts styles) +instance HasAmounts Account where+  styleAmounts styles acct@Account{aebalance,aibalance} =+    acct{aebalance=styleAmounts styles aebalance, aibalance=styleAmounts styles aibalance}+ -- | Reset each individual amount's display style to the default. mixedAmountUnstyled :: MixedAmount -> MixedAmount mixedAmountUnstyled = mapMixedAmountUnsafe amountUnstyled +-- Mixed amount rendering  -- | Get the string representation of a mixed amount, after -- normalising it to one amount per commodity. Assumes amounts have@@ -1087,6 +1214,16 @@ mixedAmountSetFullPrecision :: MixedAmount -> MixedAmount mixedAmountSetFullPrecision = mapMixedAmountUnsafe amountSetFullPrecision +-- | In each component amount, ensure the display precision is at least the given value.+-- Makes all amounts have an explicit Precision.+mixedAmountSetPrecisionMin :: Word8 -> MixedAmount -> MixedAmount+mixedAmountSetPrecisionMin p = mapMixedAmountUnsafe (amountSetPrecisionMin p)++-- | In each component amount, ensure the display precision is at most the given value.+-- Makes all amounts have an explicit Precision.+mixedAmountSetPrecisionMax :: Word8 -> MixedAmount -> MixedAmount+mixedAmountSetPrecisionMax p = mapMixedAmountUnsafe (amountSetPrecisionMax p)+ -- | Remove all prices from a MixedAmount. mixedAmountStripPrices :: MixedAmount -> MixedAmount mixedAmountStripPrices (Mixed ma) =@@ -1120,8 +1257,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]) @?= Just (Precision 3)-       asprecision (astyle $ sum [usd 1 `withPrecision` Precision 3, usd 1 `withPrecision` Precision 1]) @?= Just (Precision 3)+       asprecision (astyle $ sum [usd 1 `withPrecision` Precision 1, usd 1 `withPrecision` Precision 3]) @?= Precision 3+       asprecision (astyle $ sum [usd 1 `withPrecision` Precision 3, usd 1 `withPrecision` Precision 1]) @?= Precision 3        -- adding different commodities assumes conversion rate 1        assertBool "" $ amountLooksZero (usd 1.23 - eur 1.23) 

@@ -57,6 +57,7 @@ import Hledger.Data.Posting import Hledger.Data.Transaction import Hledger.Data.Errors+import Data.Bifunctor (second)   data BalancingOpts = BalancingOpts@@ -93,6 +94,7 @@ transactionCheckBalanced :: BalancingOpts -> Transaction -> [String] transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs   where+    -- get real and balanced virtual postings, to be checked separately     (rps, bvps) = foldr partitionPosting ([], []) $ tpostings t       where         partitionPosting p ~(l, r) = case ptype p of@@ -100,24 +102,30 @@             BalancedVirtualPosting -> (l, p:r)             VirtualPosting         -> (l, r) -    -- check for mixed signs, detecting nonzeros at display precision-    setstyles = maybe id mixedAmountSetStyles commodity_styles_+    -- convert this posting's amount to cost,+    -- without getting confused by redundant costs/equity postings     postingBalancingAmount p       | "_price-matched" `elem` map fst (ptags p) = mixedAmountStripPrices $ pamount p       | otherwise                                 = mixedAmountCost $ pamount p-    signsOk ps =-      case filter (not.mixedAmountLooksZero) $ map (setstyles.postingBalancingAmount) ps of-        nonzeros | length nonzeros >= 2-                   -> length (nubSort $ mapMaybe isNegativeMixedAmount nonzeros) > 1-        _          -> True-    (rsignsok, bvsignsok)       = (signsOk rps, signsOk bvps) -    -- check for zero sum, at display precision-    (rsumcost, bvsumcost)       = (foldMap postingBalancingAmount rps, foldMap postingBalancingAmount bvps)-    (rsumdisplay, bvsumdisplay) = (setstyles rsumcost, setstyles bvsumcost)-    (rsumok, bvsumok)           = (mixedAmountLooksZero rsumdisplay, mixedAmountLooksZero bvsumdisplay)+    -- transaction balancedness is checked at each commodity's display precision+    lookszero = mixedAmountLooksZero . atdisplayprecision+      where+        atdisplayprecision = maybe id styleAmounts $ commodity_styles_ -    -- generate error messages, showing amounts with their original precision+    -- when there's multiple non-zeros, check they do not all have the same sign+    (rsignsok, bvsignsok) = (signsOk rps, signsOk bvps)+      where+        signsOk ps = length nonzeros < 2 || length nonzerosigns > 1+          where+            nonzeros = filter (not.lookszero) $ map postingBalancingAmount ps+            nonzerosigns = nubSort $ mapMaybe isNegativeMixedAmount nonzeros++    -- check that the sum looks like zero+    (rsumcost, bvsumcost) = (foldMap postingBalancingAmount rps, foldMap postingBalancingAmount bvps)+    (rsumok, bvsumok) = (lookszero rsumcost, lookszero bvsumcost)++    -- Generate error messages if any. Show amounts with their original precisions.     errs = filter (not.null) [rmsg, bvmsg]       where         rmsg@@ -160,10 +168,12 @@   -> Transaction   -> Either String (Transaction, [(AccountName, MixedAmount)]) balanceTransactionHelper bopts t = do-  (t', inferredamtsandaccts) <--    transactionInferBalancingAmount (fromMaybe M.empty $ commodity_styles_ bopts) $-    (if infer_balancing_costs_ bopts then transactionInferBalancingCosts else id)-    t+  let lbl = lbl_ "balanceTransactionHelper"+  (t', inferredamtsandaccts) <- t+    & (if infer_balancing_costs_ bopts then transactionInferBalancingCosts else id)+    & dbg9With (lbl "amounts after balancing-cost-inferring".show.map showMixedAmountOneLine.transactionAmounts)+    & transactionInferBalancingAmount (fromMaybe M.empty $ commodity_styles_ bopts)+    <&> dbg9With (lbl "balancing amounts inferred".show.map (second showMixedAmountOneLine).snd)   case transactionCheckBalanced bopts t' of     []   -> Right (txnTieKnot t', inferredamtsandaccts)     errs -> Left $ transactionBalanceError t' errs'@@ -227,10 +237,16 @@   | otherwise       = let psandinferredamts = map inferamount ps             inferredacctsandamts = [(paccount p, amt) | (p, Just amt) <- psandinferredamts]-        in Right (t{tpostings=map fst psandinferredamts}, inferredacctsandamts)+        in Right (+           t{tpostings=map fst psandinferredamts}+          ,inferredacctsandamts+           -- & dbg9With (lbl "inferred".show.map (showMixedAmountOneLine.snd))+          )   where+    lbl = lbl_ "transactionInferBalancingAmount"     (amountfulrealps, amountlessrealps) = partition hasAmount (realPostings t)     realsum = sumPostings amountfulrealps+      -- & dbg9With (lbl "real balancing amount".showMixedAmountOneLine)     (amountfulbvps, amountlessbvps) = partition hasAmount (balancedVirtualPostings t)     bvsum = sumPostings amountfulbvps @@ -250,7 +266,17 @@               -- 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' = mixedAmountSetStyles styles . mixedAmountCost $ maNegate a+              a' = maNegate a+                -- & dbg9With (lbl "balancing amount".showMixedAmountOneLine)+                & mixedAmountCost+                -- & dbg9With (lbl "balancing amount converted to cost".showMixedAmountOneLine)+                & styleAmounts (styles+                                -- Needed until we switch to locally-inferred balancing precisions:+                                -- these had hard rounding set to help with balanced-checking;+                                -- set no rounding now to avoid excessive display precision in output+                                & amountStylesSetRounding NoRounding+                                & dbg9With (lbl "balancing amount styles".show))+                & dbg9With (lbl "balancing amount styled".showMixedAmountOneLine)  -- | 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@@ -302,6 +328,7 @@ costInferrerFor :: Transaction -> PostingType -> (Posting -> Posting) costInferrerFor t pt = maybe id infercost inferFromAndTo   where+    lbl = lbl_ "costInferrerFor"     postings     = filter ((==pt).ptype) $ tpostings t     pcommodities = map acommodity $ concatMap (amounts . pamount) postings     sumamounts   = amounts $ sumPostings postings  -- amounts normalises to one amount per commodity & price@@ -326,7 +353,8 @@     infercost (fromamount, toamount) p         | [a] <- amounts (pamount p), ptype p == pt, acommodity a == acommodity fromamount             = p{ pamount   = mixedAmount a{aprice=Just conversionprice}-                     , poriginal = Just $ originalPosting p }+                  & dbg9With (lbl "inferred cost".showMixedAmountOneLine)+               , poriginal = Just $ originalPosting p }         | otherwise = p       where         -- If only one Amount in the posting list matches fromamount we can use TotalPrice.@@ -337,8 +365,8 @@          unitprice     = aquantity fromamount `divideAmount` toamount         unitprecision = case (asprecision $ astyle fromamount, asprecision $ astyle toamount) of-            (Just (Precision a), Just (Precision b)) -> Precision . max 2 $ saturatedAdd a b-            _                                        -> NaturalPrecision+            (Precision a, Precision b) -> Precision . max 2 $ saturatedAdd a b+            _                          -> NaturalPrecision         saturatedAdd a b = if maxBound - a < b then maxBound else a + b  @@ -441,18 +469,24 @@ -- and (optional) check that all balance assertions pass. -- Or, return an error message (just the first error encountered). ----- Assumes journalInferCommodityStyles has been called, since those+-- Assumes journalStyleAmounts has been called, since amount styles -- affect transaction balancing. -- -- This does multiple things at once because amount inferring, balance -- assignments, balance assertions and posting dates are interdependent.+-- journalBalanceTransactions :: BalancingOpts -> Journal -> Either String Journal journalBalanceTransactions bopts' j' =   let     -- ensure transactions are numbered, so we can store them by number     j@Journal{jtxns=ts} = journalNumberTransactions j'     -- display precisions used in balanced checking-    styles = Just $ journalCommodityStyles j+    styles = Just $+      -- Use all the specified commodity display precisions, with hard rounding, when checking txn balancedness.+      -- XXX Problem, those precisions will also be used when inferring balancing amounts;+      -- it would be better to give those the precision of the amount they are balancing.+      journalCommodityStylesWith HardRounding+      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 ?@@ -504,7 +538,8 @@ -- This stores the balanced transactions in case 2 but not in case 1. balanceTransactionAndCheckAssertionsB :: Either Posting Transaction -> Balancing s () balanceTransactionAndCheckAssertionsB (Left p@Posting{}) =-  -- update the account's running balance and check the balance assertion if any+  -- Update the account's running balance and check the balance assertion if any.+  -- Note, cost is ignored when checking balance assertions, currently.   void . addAmountAndCheckAssertionB $ postingStripPrices p balanceTransactionAndCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do   -- make sure we can handle the balance assignments@@ -1008,26 +1043,26 @@       --       testCase "1091a" $ do         commodityStylesFromAmounts [-           nullamt{aquantity=1000, astyle=AmountStyle L False Nothing (Just ',') (Just $ Precision 3)}-          ,nullamt{aquantity=1000, astyle=AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Just $ Precision 2)}+           nullamt{aquantity=1000, astyle=AmountStyle L False Nothing (Just ',') (Precision 3) NoRounding}+          ,nullamt{aquantity=1000, astyle=AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Precision 2) NoRounding}           ]          @?=           -- The commodity style should have period as decimal mark           -- and comma as digit group mark.           Right (M.fromList [-            ("", AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Just $ Precision 3))+            ("", AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Precision 3) NoRounding)           ])         -- same journal, entries in reverse order       ,testCase "1091b" $ do         commodityStylesFromAmounts [-           nullamt{aquantity=1000, astyle=AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Just $ Precision 2)}-          ,nullamt{aquantity=1000, astyle=AmountStyle L False Nothing (Just ',') (Just $ Precision 3)}+           nullamt{aquantity=1000, astyle=AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Precision 2) NoRounding}+          ,nullamt{aquantity=1000, astyle=AmountStyle L False Nothing (Just ',') (Precision 3) NoRounding}           ]          @?=           -- The commodity style should have period as decimal mark           -- and comma as digit group mark.           Right (M.fromList [-            ("", AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Just $ Precision 3))+            ("", AmountStyle L False (Just (DigitGroups ',' [3])) (Just '.') (Precision 3) NoRounding)           ])       ]

@@ -21,6 +21,7 @@ import qualified Data.Text as T  import Hledger.Data.Transaction (showTransaction)+import Hledger.Data.Posting (postingStripPrices) import Hledger.Data.Types import Hledger.Utils import Data.Maybe@@ -118,7 +119,9 @@     Just t  -> (f, errabsline, merrcols, ex)       where         (SourcePos f tl _) = fst $ tsourcepos t-        mpindex = transactionFindPostingIndex (==p) t+        -- p had cost removed in balanceTransactionAndCheckAssertionsB,+        -- must remove them from t's postings too (#2083)+        mpindex = transactionFindPostingIndex ((==p).postingStripPrices) t         errrelline = case mpindex of           Nothing -> 0           Just pindex ->

@@ -22,9 +22,11 @@   addPeriodicTransaction,   addTransaction,   journalInferMarketPricesFromTransactions,-  journalApplyCommodityStyles,+  journalInferCommodityStyles,+  journalStyleAmounts,   commodityStylesFromAmounts,   journalCommodityStyles,+  journalCommodityStylesWith,   journalToCost,   journalInferEquityFromCosts,   journalInferCostsFromEquity,@@ -84,6 +86,8 @@   journalNextTransaction,   journalPrevTransaction,   journalPostings,+  journalPostingAmounts,+  showJournalAmountsDebug,   journalTransactionsSimilarTo,   -- * Account types   journalAccountType,@@ -144,6 +148,7 @@ import Data.Ord (comparing) import Hledger.Data.Dates (nulldate) import Data.List (sort)+-- import Data.Function ((&))   -- | A parser of text that runs in some monad, keeping a Journal as state.@@ -340,6 +345,14 @@ journalPostings :: Journal -> [Posting] journalPostings = concatMap tpostings . jtxns +-- | All posting amounts from this journal, in order.+journalPostingAmounts :: Journal -> [MixedAmount]+journalPostingAmounts = map pamount . journalPostings++-- | Show the journal amounts rendered, suitable for debug logging.+showJournalAmountsDebug :: Journal -> String+showJournalAmountsDebug = show.map showMixedAmountOneLine.journalPostingAmounts+ -- | Sorted unique commodity symbols declared by commodity directives in this journal. journalCommoditiesDeclared :: Journal -> [CommoditySymbol] journalCommoditiesDeclared = M.keys . jcommodities@@ -792,18 +805,19 @@     Right ts -> Right j{jtxns=ts}     Left err -> Left err --- | Choose and apply a consistent display style to the posting--- 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+-- | Apply this journal's commodity display styles to all of its amounts.+-- This does no display rounding, keeping decimal digits as they were;+-- it is suitable for an early cleanup pass before calculations.+-- Reports may want to do additional rounding/styling at render time.+-- This can return an error message eg if inconsistent number formats are found.+journalStyleAmounts :: Journal -> Either String Journal+journalStyleAmounts = fmap journalapplystyles . journalInferCommodityStyles   where-    fixjournal j@Journal{jpricedirectives=pds} =-        journalMapPostings (postingApplyCommodityStylesExceptPrecision styles) j{jpricedirectives=map fixpricedirective pds}+    journalapplystyles j@Journal{jpricedirectives=pds} =+      journalMapPostings (styleAmounts styles) j{jpricedirectives=map fixpricedirective pds}       where-        styles = journalCommodityStyles j-        fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=amountSetStylesExceptPrecision styles a}+        styles = journalCommodityStylesWith NoRounding j  -- defer rounding, in case of print --round=none+        fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmounts styles a}  -- | Get the canonical amount styles for this journal, whether (in order of precedence): -- set globally in InputOpts,@@ -821,6 +835,11 @@     declaredstyles        = M.mapMaybe cformat $ jcommodities j     defaultcommoditystyle = M.fromList $ catMaybes [jparsedefaultcommodity j]     inferredstyles        = jinferredcommodities j++-- | Like journalCommodityStyles, but attach a particular rounding strategy to the styles,+-- affecting how they will affect display precisions when applied.+journalCommodityStylesWith :: Rounding -> Journal -> M.Map CommoditySymbol AmountStyle+journalCommodityStylesWith r = amountStylesSetRounding r . journalCommodityStyles  -- | Collect and save inferred amount styles for each commodity based on -- the posting amounts in that commodity (excluding price amounts), ie:

@@ -82,6 +82,7 @@     ]  instance ToJSON Amount+instance ToJSON Rounding instance ToJSON AmountStyle  -- Use the same JSON serialisation as Maybe Word8@@ -165,20 +166,21 @@ #endif   => Account -> [kv] accountKV a =-    [ "aname"        .= aname a-    , "aebalance"    .= aebalance a-    , "aibalance"    .= aibalance a-    , "anumpostings" .= anumpostings a-    , "aboring"      .= aboring a+    [ "aname"            .= aname a+    , "adeclarationinfo" .= adeclarationinfo a+    , "aebalance"        .= aebalance a+    , "aibalance"        .= aibalance a+    , "anumpostings"     .= anumpostings a+    , "aboring"          .= aboring a     -- To avoid a cycle, show just the parent account's name     -- in a dummy field. When re-parsed, there will be no parent.-    , "aparent_"     .= maybe "" aname (aparent a)+    , "aparent_"         .= maybe "" aname (aparent a)     -- Just the names of subaccounts, as a dummy field, ignored when parsed.-    , "asubs_"       .= map aname (asubs a)+    , "asubs_"           .= map aname (asubs a)     -- The actual subaccounts (and their subs..), making a (probably highly redundant) tree     -- ,"asubs"        .= asubs a     -- Omit the actual subaccounts-    , "asubs"        .= ([]::[Account])+    , "asubs"            .= ([]::[Account])     ]  instance ToJSON Ledger@@ -192,6 +194,7 @@   parseJSON = fmap mkPos . parseJSON  instance FromJSON Amount+instance FromJSON Rounding instance FromJSON AmountStyle  -- Use the same JSON serialisation as Maybe Word8

@@ -39,7 +39,7 @@   postingStripPrices,   postingApplyAliases,   postingApplyCommodityStyles,-  postingApplyCommodityStylesExceptPrecision,+  postingStyleAmounts,   postingAddTags,   -- * date operations   postingDate,@@ -52,6 +52,7 @@   -- * comment/tag operations   commentJoin,   commentAddTag,+  commentAddTagUnspaced,   commentAddTagNextLine,   -- * arithmetic   sumPostings,@@ -60,7 +61,10 @@   showPostingLines,   postingAsLines,   postingsAsLines,+  postingsAsLinesBeancount,+  postingAsLinesBeancount,   showAccountName,+  showAccountNameBeancount,   renderCommentLines,   showBalanceAssertion,   -- * misc.@@ -107,6 +111,19 @@       ,pbalanceassertion=styleAmounts styles pbalanceassertion        } +{-# DEPRECATED postingApplyCommodityStyles "please use styleAmounts instead" #-}+-- | 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 = styleAmounts++{-# DEPRECATED postingStyleAmounts "please use styleAmounts instead" #-}+-- | Like postingApplyCommodityStyles, but neither+-- main amount precisions or cost precisions are set.+postingStyleAmounts :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting+postingStyleAmounts = styleAmounts+ nullposting, posting :: Posting nullposting = Posting                 {pdate=Nothing@@ -274,7 +291,10 @@     -- amtwidth at all.     shownAmounts       | elideamount = [mempty]-      | otherwise   = showMixedAmountLinesB noColour{displayZeroCommodity=True, displayOneLine=onelineamounts} $ pamount p+      | otherwise   = showMixedAmountLinesB displayopts $ pamount p+        where displayopts = noColour{+          displayZeroCommodity=True, displayAddDecimalMark=True, displayOneLine=onelineamounts+          }     thisamtwidth = maximumBound 0 $ map wbWidth shownAmounts      -- when there is a balance assertion, show it only on the last posting line@@ -301,6 +321,91 @@     fmt VirtualPosting         = wrap "(" ")" . maybe id (T.takeEnd . subtract 2) w     fmt BalancedVirtualPosting = wrap "[" "]" . maybe id (T.takeEnd . subtract 2) w +-- | Like postingsAsLines but generates Beancount journal format.+postingsAsLinesBeancount :: [Posting] -> [Text]+postingsAsLinesBeancount ps = concatMap first3 linesWithWidths+  where+    linesWithWidths = map (postingAsLinesBeancount False maxacctwidth maxamtwidth) ps+    maxacctwidth = maximumBound 0 $ map second3 linesWithWidths+    maxamtwidth  = maximumBound 0 $ map third3  linesWithWidths++-- | Like postingAsLines but generates Beancount journal format.+postingAsLinesBeancount  :: Bool -> Int -> Int -> Posting -> ([Text], Int, Int)+postingAsLinesBeancount elideamount acctwidth amtwidth p =+    (concatMap (++ newlinecomments) postingblocks, thisacctwidth, thisamtwidth)+  where+    -- This needs to be converted to strict Text in order to strip trailing+    -- spaces. This adds a small amount of inefficiency, and the only difference+    -- is whether there are trailing spaces in print (and related) reports. This+    -- could be removed and we could just keep everything as a Text Builder, but+    -- would require adding trailing spaces to 42 failing tests.+    postingblocks = [map T.stripEnd . T.lines . TL.toStrict $+                       render [ textCell BottomLeft statusandaccount+                              , textCell BottomLeft "  "+                              , Cell BottomLeft [pad amt]+                              , textCell BottomLeft samelinecomment+                              ]+                    | (amt,_assertion) <- shownAmountsAssertions]+    render = renderRow def{tableBorders=False, borderSpaces=False} . Group NoLine . map Header+    pad amt = WideBuilder (TB.fromText $ T.replicate w " ") w <> amt+      where w = max 12 amtwidth - wbWidth amt  -- min. 12 for backwards compatibility++    pacct = showAccountNameBeancount Nothing $ paccount p+    pstatusandacct p' = if pstatus p' == Pending then "! " else "" <> pacct++    -- currently prices are considered part of the amount string when right-aligning amounts+    -- Since we will usually be calling this function with the knot tied between+    -- amtwidth and thisamtwidth, make sure thisamtwidth does not depend on+    -- amtwidth at all.+    shownAmounts+      | elideamount = [mempty]+      | otherwise   = showMixedAmountLinesB displayopts a'+        where+          displayopts = noColour{ displayZeroCommodity=True, displayAddDecimalMark=True }+          a' = mapMixedAmount amountToBeancount $ pamount p+    thisamtwidth = maximumBound 0 $ map wbWidth shownAmounts++    -- when there is a balance assertion, show it only on the last posting line+    shownAmountsAssertions = zip shownAmounts shownAssertions+      where+        shownAssertions = replicate (length shownAmounts - 1) mempty ++ [assertion]+          where+            assertion = maybe mempty ((WideBuilder (TB.singleton ' ') 1 <>).showBalanceAssertion) $ pbalanceassertion p++    -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned+    statusandaccount = lineIndent . fitText (Just $ 2 + acctwidth) Nothing False True $ pstatusandacct p+    thisacctwidth = realLength pacct++    (samelinecomment, newlinecomments) =+      case renderCommentLines (pcomment p) of []   -> ("",[])+                                              c:cs -> (c,cs)++type BeancountAmount = Amount++-- | Do some best effort adjustments to make an amount that renders+-- in a way that Beancount can read: forces the commodity symbol to the right,+-- converts a few currency symbols to names, capitalises all letters.+amountToBeancount :: Amount -> BeancountAmount+amountToBeancount a@Amount{acommodity=c,astyle=s,aprice=mp} = a{acommodity=c', astyle=s', aprice=mp'}+  -- https://beancount.github.io/docs/beancount_language_syntax.html#commodities-currencies+  where+    c' = T.toUpper $+      T.replace "$" "USD" $+      T.replace "€" "EUR" $+      T.replace "¥" "JPY" $+      T.replace "£" "GBP" $+      c+    s' = s{ascommodityside=R, ascommodityspaced=True}+    mp' = costToBeancount <$> mp+      where+        costToBeancount (TotalPrice amt) = TotalPrice $ amountToBeancount amt+        costToBeancount (UnitPrice  amt) = UnitPrice  $ amountToBeancount amt++-- | Like showAccountName for Beancount journal format.+-- Calls accountNameToBeancount first.+showAccountNameBeancount :: Maybe Int -> AccountName -> Text+showAccountNameBeancount w = maybe id T.take w . accountNameToBeancount+ -- | Render a transaction or posting's comment as indented, semicolon-prefixed comment lines. -- The first line (unless empty) will have leading space, subsequent lines will have a larger indent. renderCommentLines :: Text -> [Text]@@ -419,23 +524,6 @@         err = "problem while applying account aliases:\n" ++ pshow aliases           ++ "\n to account name: "++T.unpack paccount++"\n "++e --- | Find and apply the appropriate display style to the posting amounts--- in each commodity (see journalCommodityStyles).--- Main amount precisions may be set or not according to the styles, but cost precisions are not set.-postingApplyCommodityStyles :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting-postingApplyCommodityStyles styles p = p{pamount=mixedAmountSetStyles styles $ pamount p-                                        ,pbalanceassertion=balanceassertionsetstyles <$> pbalanceassertion p}-  where-    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}@@ -523,6 +611,15 @@   where     c'  = T.stripEnd c     tag = t <> ": " <> v++-- | Like commentAddTag, but omits the space after the colon.+commentAddTagUnspaced :: Text -> Tag -> Text+commentAddTagUnspaced c (t,v)+  | T.null c' = tag+  | otherwise = c' `commentJoin` tag+  where+    c'  = T.stripEnd c+    tag = t <> ":" <> v  -- | Add a tag on its own line to a comment, preserving any prior content. -- A space is inserted following the colon, before the value.

@@ -32,6 +32,7 @@ , transactionApplyAliases , transactionMapPostings , transactionMapPostingAmounts+, transactionAmounts , partitionAndCheckConversionPostings   -- nonzerobalanceerror   -- * date operations@@ -45,6 +46,7 @@ , showTransaction , showTransactionOneLineAmounts , showTransactionLineFirstPart+, showTransactionBeancount , transactionFile   -- * transaction errors , annotateErrorWithTransaction@@ -113,6 +115,12 @@   where     (p, n) = T.span (/= '|') t +-- | Like payeeAndNoteFromDescription, but if there's no | then payee is empty.+payeeAndNoteFromDescription' :: Text -> (Text,Text)+payeeAndNoteFromDescription' t =+  if isJust $ T.find (=='|') t then payeeAndNoteFromDescription t else ("",t)++ {-| Render a journal transaction as text similar to the style of Ledger's print command. @@ -168,6 +176,33 @@            | otherwise            = ""     code = if T.null (tcode t) then "" else wrap " (" ")" $ tcode t +-- | Like showTransaction, but generates Beancount journal format.+showTransactionBeancount :: Transaction -> Text+showTransactionBeancount t =+  -- https://beancount.github.io/docs/beancount_language_syntax.html+  -- similar to showTransactionHelper, but I haven't bothered with Builder+     firstline <> nl+  <> foldMap ((<> nl)) newlinecomments+  <> foldMap ((<> nl)) (postingsAsLinesBeancount $ tpostings t)+  <> nl+  where+    nl = "\n"+    firstline = T.concat [date, status, payee, note, tags, samelinecomment]+    date = showDate $ tdate t+    status = if tstatus t == Pending then " !" else " *"+    (payee,note) =+      case payeeAndNoteFromDescription' $ tdescription t of+        ("","") -> ("",      ""      )+        ("",n ) -> (""     , wrapq n )+        (p ,"") -> (wrapq p, wrapq "")+        (p ,n ) -> (wrapq p, wrapq n )+      where+        wrapq = wrap " \"" "\"" . escapeDoubleQuotes . escapeBackslash+    tags = T.concat $ map ((" #"<>).fst) $ ttags t+    (samelinecomment, newlinecomments) =+      case renderCommentLines (tcomment t) of []   -> ("",[])+                                              c:cs -> (c,cs)+ hasRealPostings :: Transaction -> Bool hasRealPostings = not . null . realPostings @@ -378,11 +413,7 @@         Nothing                    -> Left $ annotateWithPostings [p] "Conversion postings must have a single-commodity amount:"      -- Do these amounts look the same when compared at the first's display precision ?-    -- (Or if that's unset, compare as-is)-    amountsMatch a b =-      case asprecision $ astyle a of-        Just p  -> amountLooksZero $ amountSetPrecision p $ a - b-        Nothing -> amountLooksZero $ a - b+    amountsMatch a b = amountLooksZero $ amountSetPrecision (asprecision $ astyle a) $ a - b      -- Delete a posting from the indexed list of postings based on either its     -- index or its posting amount.@@ -400,9 +431,8 @@  dbgShowAmountPrecision a =   case asprecision $ astyle a of-    Just (Precision n)    -> show n-    Just NaturalPrecision -> show $ decimalPlaces $ normalizeDecimal $ aquantity a-    Nothing               -> "unset"+    Precision n      -> show n+    NaturalPrecision -> show $ decimalPlaces $ normalizeDecimal $ aquantity a  -- Using the provided account types map, sort the given indexed postings -- into three lists of posting numbers (stored in two pairs), like so:@@ -449,6 +479,10 @@ -- | Apply a transformation to a transaction's posting amounts. transactionMapPostingAmounts :: (MixedAmount -> MixedAmount) -> Transaction -> Transaction transactionMapPostingAmounts f  = transactionMapPostings (postingTransformAmount f)++-- | All posting amounts from this transactin, in order.+transactionAmounts :: Transaction -> [MixedAmount]+transactionAmounts = map pamount . tpostings  -- | The file path from which this transaction was parsed. transactionFile :: Transaction -> FilePath

@@ -25,7 +25,7 @@ import Hledger.Data.Transaction (txnTieKnot) import Hledger.Query (Query, filterQuery, matchesAmount, matchesPostingExtra,                       parseQuery, queryIsAmt, queryIsSym, simplifyQuery)-import Hledger.Data.Posting (commentJoin, commentAddTag, postingAddTags, postingApplyCommodityStyles)+import Hledger.Data.Posting (commentJoin, commentAddTag, postingAddTags) import Hledger.Utils (dbg6, wrap)  -- $setup@@ -109,7 +109,7 @@ -- The provided TransactionModifier's query text is saved as the tags' value. tmPostingRuleToFunction :: Bool -> M.Map CommoditySymbol AmountStyle -> Query -> T.Text -> TMPostingRule -> (Posting -> Posting) tmPostingRuleToFunction verbosetags styles query querytxt tmpr =-  \p -> postingApplyCommodityStyles styles . renderPostingCommentDates $ pr+  \p -> styleAmounts styles . renderPostingCommentDates $ pr       { pdate    = pdate  pr <|> pdate  p       , pdate2   = pdate2 pr <|> pdate2 p       , pamount  = amount' p

@@ -249,16 +249,19 @@ data AmountPrice = UnitPrice !Amount | TotalPrice !Amount   deriving (Eq,Ord,Generic,Show) --- | The display style for an amount.--- (See also Amount.AmountDisplayOpts).+-- | Every Amount has one of these, influencing how the amount is displayed.+-- Also, each Commodity can have one, which can be applied to its amounts for consistent display.+-- See also Amount.AmountDisplayOpts. data AmountStyle = AmountStyle {   ascommodityside   :: !Side,                     -- ^ show the symbol on the left or the right ?   ascommodityspaced :: !Bool,                     -- ^ show a space between symbol and quantity ?   asdigitgroups     :: !(Maybe DigitGroupStyle),  -- ^ show the integer part with these digit group marks, or not   asdecimalmark     :: !(Maybe Char),             -- ^ show this character (should be . or ,) as decimal mark, or use the default (.)-  asprecision       :: !(Maybe AmountPrecision)   -- ^ show this number of digits after the decimal point, or show as-is (leave precision unchanged)-    -- XXX Making asprecision a maybe simplifies code for styling with or without precision,-    -- but complicates the semantics (Nothing is useful only when setting style).+  asprecision       :: !AmountPrecision,          -- ^ "display precision" - show this number of digits after the decimal point+  asrounding        :: !Rounding                  -- ^ "rounding strategy" - kept here for convenience, for now:+                                                  --   when displaying an amount, it is ignored,+                                                  --   but when applying this style to another amount, it determines +                                                  --   how hard we should try to adjust the amount's display precision. } deriving (Eq,Ord,Read,Generic)  instance Show AmountStyle where@@ -269,6 +272,7 @@     , show asdigitgroups     , show asdecimalmark     , show asprecision+    , show asrounding     ]  -- | The "display precision" for a hledger amount, by which we mean@@ -276,6 +280,16 @@ 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)++-- | "Rounding strategy" - how to apply an AmountStyle's display precision+-- to a posting amount (and its cost, if any). +-- Mainly used to customise print's output, with --round=none|soft|hard|all.+data Rounding =+    NoRounding    -- ^ keep display precisions unchanged in amt and cost+  | SoftRounding  -- ^ do soft rounding of amt and cost amounts (show more or fewer decimal zeros to approximate the target precision, but don't hide significant digits)+  | HardRounding  -- ^ do hard rounding of amt (use the exact target precision, possibly hiding significant digits), and soft rounding of cost+  | AllRounding   -- ^ do hard rounding of amt and cost   deriving (Eq,Ord,Read,Show,Generic)  -- | A style for displaying digit groups in the integer part of a

@@ -25,6 +25,7 @@   ,marketPriceReverse   ,priceDirectiveToMarketPrice   ,amountPriceDirectiveFromCost+  ,valuationTypeValuationCommodity   -- ,priceLookup   ,tests_Valuation )@@ -47,6 +48,7 @@ import Hledger.Data.Amount import Hledger.Data.Dates (nulldate) import Text.Printf (printf)+import Data.Decimal (decimalPlaces, roundTo)   ------------------------------------------------------------------------------@@ -67,6 +69,14 @@   | AtDate Day (Maybe CommoditySymbol)  -- ^ convert to default or given valuation commodity, using market prices on some date   deriving (Show,Eq) +valuationTypeValuationCommodity :: ValuationType -> Maybe CommoditySymbol+valuationTypeValuationCommodity = \case+    AtThen   (Just c) -> Just c+    AtEnd    (Just c) -> Just c+    AtNow    (Just c) -> Just c+    AtDate _ (Just c) -> Just c+    _                 -> Nothing+ -- | A price oracle is a magic memoising function that efficiently -- looks up market prices (exchange rates) from one commodity to -- another (or if unspecified, to a default valuation commodity) on a@@ -97,22 +107,19 @@              , mprate = aquantity pdamount              } --- | Make one or more `MarketPrice` from an 'Amount' and its price directives.+-- | Infer a market price from the given amount and its cost (if any),+-- and make a corresponding price directive on the given date.+-- The price's display precision will be set to show all significant+-- decimal digits; or if they seem to be infinite, defaultPrecisionLimit. amountPriceDirectiveFromCost :: Day -> Amount -> Maybe PriceDirective-amountPriceDirectiveFromCost d amt@Amount{acommodity=fromcomm, aquantity=fromq} = case aprice amt of-    Just (UnitPrice pa)               -> Just $ pd{pdamount=pa}-    Just (TotalPrice pa) | fromq /= 0 -> Just $ pd{pdamount=fromq `divideAmountExtraPrecision` pa}-    _                                 -> Nothing+amountPriceDirectiveFromCost d amt@Amount{acommodity=fromcomm, aquantity=n} = case aprice amt of+    Just (UnitPrice u)           -> Just $ pd{pdamount=u}+    Just (TotalPrice t) | n /= 0 -> Just $ pd{pdamount=u}+      where u = amountSetFullPrecisionOr Nothing $ divideAmount n t+    _                            -> Nothing   where     pd = PriceDirective{pddate = d, pdcommodity = fromcomm, pdamount = nullamt} -    divideAmountExtraPrecision n a = (n `divideAmount` a) { astyle = style' }-      where-        style' = (astyle a) { asprecision = precision' }-        precision' = case asprecision (astyle a) of-                          Just (Precision p) -> Just $ Precision $ (numDigitsInt $ truncate n) + p-                          mp -> mp- ------------------------------------------------------------------------------ -- Converting things to value @@ -129,7 +136,7 @@  -- | Convert an Amount to its cost if requested, and style it appropriately. amountToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> Amount -> Amount-amountToCost styles ToCost         = amountSetStyles styles . amountCost+amountToCost styles ToCost         = styleAmounts styles . amountCost amountToCost _      NoConversionOp = id  -- | Apply a specified valuation to this amount, using the provided@@ -179,22 +186,32 @@ -- valuation date.) -- -- The returned amount will have its commodity's canonical style applied,--- but with the precision adjusted to show all significant decimal digits--- up to a maximum of 8. (experimental)+-- (with soft display rounding). -- -- If the market prices available on that date are not sufficient to -- calculate this value, the amount is left unchanged.+-- amountValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> Amount -> Amount amountValueAtDate priceoracle styles mto d a =+  let lbl = lbl_ "amountValueAtDate" in   case priceoracle (d, acommodity a, mto) of     Nothing           -> a     Just (comm, rate) ->-      -- 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.-      amountSetStyles styles       nullamt{acommodity=comm, aquantity=rate * aquantity a} +      -- Manage style and precision of the new amount. Initially:+      --  rate is a Decimal with the internal precision of the original market price declaration.+      --  aquantity is a Decimal with a's internal precision.+      --  The calculated value's internal precision may be different from these.+      --  Its display precision will be that of nullamt (0).+      -- Now apply the standard display style for comm (if there is one)+      & styleAmounts styles+      -- set the display precision to match the internal precision (showing all digits),+      -- unnormalised (don't strip trailing zeros);+      -- but if it looks like an infinite decimal, limit the precision to 8.+      & amountSetFullPrecisionOr Nothing+      & dbg9With (lbl "calculated value".showAmount)+ -- | Calculate the gain of each component amount, that is the difference -- between the valued amount and the value of the cost basis (see -- mixedAmountApplyValuation).@@ -266,7 +283,19 @@         of           Nothing -> Nothing           Just [] -> Nothing-          Just ps -> Just (mpto $ last ps, product $ map mprate ps)+          Just ps -> Just (mpto $ last ps, rate)+            where+              rates = map mprate ps+              rate =+                -- aggregate all the prices into one+                product rates+                -- product (Decimal's Num instance) normalises, stripping trailing zeros.+                -- Here we undo that (by restoring the old max precision with roundTo), +                -- so that amountValueAtDate can see the original internal precision,+                -- to use as the display precision of calculated value amounts.+                -- (This can add more than the original number of trailing zeros to some prices,+                -- making them seem more precise than they were, but it seems harmless here.)+                & roundTo (maximum $ map decimalPlaces rates)  tests_priceLookup =   let@@ -435,6 +464,8 @@     ,pgDefaultValuationCommodities=defaultdests     }   where+    -- XXX logic duplicated in Hledger.Cli.Commands.Prices.prices, keep synced+     -- prices in effect on date d, either declared or inferred     visibledeclaredprices = dbg9 "visibledeclaredprices" $ filter ((<=d).mpdate) alldeclaredprices     visibleinferredprices = dbg9 "visibleinferredprices" $ filter ((<=d).mpdate) allinferredprices

@@ -8,12 +8,80 @@ journal data or read journal files. Generally it should not be necessary to import modules below this one. +== Journal reading++Reading an input file (in journal, csv, timedot, or timeclock format..)+involves these steps:++- select an appropriate file format "reader"+  based on filename extension/file path prefix/function parameter.+  A reader contains a parser and a finaliser (usually @journalFinalise@).++- run the parser to get a ParsedJournal+  (this may run additional sub-parsers to parse included files)++- run the finaliser to get a complete Journal, which passes standard checks++- if reading multiple files: merge the per-file Journals into one+  overall Journal++- if using -s/--strict: run additional strict checks++- if running print --new: save .latest files for each input file.+  (import also does this, as its final step.)++== Journal merging++Journal implements the Semigroup class, so two Journals can be merged+into one Journal with @j1 <> j2@. This is implemented by the+@journalConcat@ function, whose documentation explains what merging+Journals means exactly.++== Journal finalising++This is post-processing done after parsing an input file, such as+inferring missing information, normalising amount styles,+checking for errors and so on - a delicate and influential stage+of data processing. +In hledger it is done by @journalFinalise@, which converts a+preliminary ParsedJournal to a validated, ready-to-use Journal.+This is called immediately after the parsing of each input file.+It is not called when Journals are merged.++== Journal reading API++There are three main Journal-reading functions:++- readJournal to read from a Text value.+  Selects a reader and calls its parser and finaliser,+  then does strict checking if needed.++- readJournalFile to read one file, or stdin if the file path is @-@.+  Uses the file path/file name to help select the reader,+  calls readJournal,+  then writes .latest files if needed.++- readJournalFiles to read multiple files.+  Calls readJournalFile for each file (without strict checking or .latest file writing)+  then merges the Journals into one,+  then does strict checking and .latest file writing at the end if needed.++Each of these also has an easier variant with ' suffix,+which uses default options and has a simpler type signature.++One more variant, @readJournalFilesAndLatestDates@, is like+readJournalFiles but exposing the latest transaction date+(and how many on the same day) seen for each file.+This is used by the import command.+ -}  --- ** language {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE PackageImports      #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}  --- ** exports module Hledger.Read (@@ -26,10 +94,11 @@   ensureJournalFileExists,    -- * Journal parsing+  runExceptT,   readJournal,   readJournalFile,   readJournalFiles,-  runExceptT,+  readJournalFilesAndLatestDates,    -- * Easy journal parsing   readJournal',@@ -37,6 +106,10 @@   readJournalFiles',   orDieTrying, +  -- * Misc+  journalStrictChecks,+  saveLatestDates,+   -- * Re-exported   JournalReader.tmpostingrulep,   findReader,@@ -53,7 +126,7 @@ --- ** imports import qualified Control.Exception as C import Control.Monad (unless, when)-import "mtl" Control.Monad.Except (ExceptT(..), runExceptT)+import "mtl" Control.Monad.Except (ExceptT(..), runExceptT, liftEither) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Default (def) import Data.Foldable (asum)@@ -85,6 +158,7 @@ -- import Hledger.Read.TimeclockReader (tests_TimeclockReader) import Hledger.Utils import Prelude hiding (getContents, writeFile)+import Hledger.Data.JournalChecks (journalCheckAccounts, journalCheckCommodities)  --- ** doctest setup -- $setup@@ -126,7 +200,8 @@  -- | @readJournal iopts mfile txt@ ----- Read a Journal from some text, or return an error message.+-- Read a Journal from some text, with strict checks if enabled,+-- or return an error message. -- -- The reader (data format) is chosen based on, in this order: --@@ -137,16 +212,19 @@ -- - a file extension in @mfile@ -- -- If none of these is available, or if the reader name is unrecognised,--- we use the journal reader. (We used to try all readers in this case;--- since hledger 1.17, we prefer predictability.)+-- we use the journal reader (for predictability).+-- readJournal :: InputOpts -> Maybe FilePath -> Text -> ExceptT String IO Journal-readJournal iopts mpath txt = do+readJournal iopts@InputOpts{strict_} mpath txt = do   let r :: Reader IO = fromMaybe JournalReader.reader $ findReader (mformat_ iopts) mpath   dbg6IO "readJournal: trying reader" (rFormat r)-  rReadFn r iopts (fromMaybe "(string)" mpath) txt+  j <- rReadFn r iopts (fromMaybe "(string)" mpath) txt+  when strict_ $ liftEither $ journalStrictChecks j+  return j  -- | Read a Journal from this file, or from stdin if the file path is -,--- or return an error message. The file path can have a READER: prefix.+-- with strict checks if enabled, or return an error message.+-- The file path can have a READER: prefix. -- -- The reader (data format) to use is determined from (in priority order): -- the @mformat_@ specified in the input options, if any;@@ -156,8 +234,25 @@ -- -- The input options can also configure balance assertion checking, automated posting -- generation, a rules file for converting CSV data, etc.+--+-- If using --new, and if latest-file writing is enabled in input options,+-- and after passing strict checks if enabled, a .latest.FILE file will be created/updated+-- (for the main file only, not for included files),+-- to remember the latest transaction date (and how many transactions on this date)+-- successfully read.+-- readJournalFile :: InputOpts -> PrefixedFilePath -> ExceptT String IO Journal-readJournalFile iopts prefixedfile = do+readJournalFile iopts@InputOpts{new_, new_save_} prefixedfile = do+  (j,latestdates) <- readJournalFileAndLatestDates iopts prefixedfile+  when (new_ && new_save_) $ liftIO $+    saveLatestDates latestdates (snd $ splitReaderPrefix prefixedfile)+  return j++-- The implementation of readJournalFile, but with --new, +-- also returns the latest transaction date(s) read.+-- Used by readJournalFiles, to save those at the end.+readJournalFileAndLatestDates :: InputOpts -> PrefixedFilePath -> ExceptT String IO (Journal,LatestDates)+readJournalFileAndLatestDates iopts prefixedfile = do   let     (mfmt, f) = splitReaderPrefix prefixedfile     iopts' = iopts{mformat_=asum [mfmt, mformat_ iopts]}@@ -168,25 +263,50 @@     -- <- T.readFile f  -- or without line ending translation, for testing   j <- readJournal iopts' (Just f) t   if new_ iopts-     then do-       ds <- liftIO $ previousLatestDates f-       let (newj, newds) = journalFilterSinceLatestDates ds j-       when (new_save_ iopts && not (null newds)) . liftIO $ saveLatestDates newds f-       return newj-     else return j+    then do+      ds <- liftIO $ previousLatestDates f+      let (newj, newds) = journalFilterSinceLatestDates ds j+      return (newj, newds)+    else+      return (j, []) --- | Read a Journal from each specified file path and combine them into one.--- Or, return the first error message.+-- | Read a Journal from each specified file path (using @readJournalFile@) +-- and combine them into one; or return the first error message.+-- Strict checks, if enabled, are deferred till the end.+-- Writing .latest files, if enabled, is also deferred till the end,+-- and happens only if strict checks pass. -- -- Combining Journals means concatenating them, basically. -- The parse state resets at the start of each file, which means that -- directives & aliases do not affect subsequent sibling or parent files. -- They do affect included child files though. -- Also the final parse state saved in the Journal does span all files.+-- readJournalFiles :: InputOpts -> [PrefixedFilePath] -> ExceptT String IO Journal-readJournalFiles iopts =-  fmap (maybe def sconcat . nonEmpty) . mapM (readJournalFile iopts)+readJournalFiles iopts@InputOpts{strict_,new_,new_save_} prefixedfiles = do+  let iopts' = iopts{strict_=False, new_save_=False}+  (j,latestdates) <-+    traceOrLogAt 6 ("readJournalFiles: "++show prefixedfiles) $+    readJournalFilesAndLatestDates iopts' prefixedfiles+  when strict_ $ liftEither $ journalStrictChecks j+  when (new_ && new_save_) $ liftIO $+    mapM_ (saveLatestDates latestdates . snd . splitReaderPrefix) prefixedfiles+  return j +-- The implementation of readJournalFiles, but with --new, +-- also returns the latest transaction date(s) read in each file.+-- Used by the import command, to save those at the end.+readJournalFilesAndLatestDates :: InputOpts -> [PrefixedFilePath] -> ExceptT String IO (Journal,LatestDates)+readJournalFilesAndLatestDates iopts =+  fmap (maybe def sconcat . nonEmpty) . mapM (readJournalFileAndLatestDates iopts)++-- | Run the extra -s/--strict checks on a journal,+-- returning the first error message if any of them fail.+journalStrictChecks :: Journal -> Either String ()+journalStrictChecks j = do+  journalCheckAccounts j+  journalCheckCommodities j+ -- | An easy version of 'readJournal' which assumes default options, and fails -- in the IO monad. readJournal' :: Text -> IO Journal@@ -255,10 +375,11 @@ -- Ie, if the latest date appears once, return it in a one-element list, -- if it appears three times (anywhere), return three of it. latestDates :: [Day] -> LatestDates-latestDates = headDef [] . take 1 . group . reverse . sort+latestDates = {-# HLINT ignore "Avoid reverse" #-}+  headDef [] . take 1 . group . reverse . sort --- | Remember that these transaction dates were the latest seen when--- reading this journal file.+-- | Save the given latest date(s) seen in the given data FILE,+-- in a hidden file named .latest.FILE, creating it if needed. saveLatestDates :: LatestDates -> FilePath -> IO () saveLatestDates dates f = T.writeFile (latestDatesFileFor f) $ T.unlines $ map showDate dates 

@@ -24,6 +24,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections       #-} {-# LANGUAGE TypeFamilies        #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Functor law" #-}  --- ** exports module Hledger.Read.Common (@@ -96,6 +98,7 @@   emptyorcommentlinep,   followingcommentp,   transactioncommentp,+  commenttagsp,   postingcommentp,    -- ** bracketed dates@@ -316,37 +319,39 @@ journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal journalFinalise iopts@InputOpts{..} f txt pj = do   t <- liftIO getPOSIXTime-  liftEither $ do-    j <- pj{jglobalcommoditystyles=fromMaybe mempty $ commodity_styles_ balancingopts_}+  let+    fname = "journalFinalise " <> takeFileName f+    lbl = lbl_ fname+  liftEither $+    pj{jglobalcommoditystyles=fromMaybe mempty $ commodity_styles_ balancingopts_}       &   journalSetLastReadTime t                       -- save the last read time       &   journalAddFile (f, txt)                        -- save the main file's info       &   journalReverse                                 -- convert all lists to the order they were parsed       &   journalAddAccountTypes                         -- build a map of all known account types-      &   journalApplyCommodityStyles                    -- Infer and apply commodity styles - should be done early+      &   journalStyleAmounts                            -- Infer and apply commodity styles (but don't round) - should be done early       <&> journalAddForecast (verbose_tags_) (forecastPeriod iopts pj)   -- Add forecast transactions if enabled       <&> journalPostingsAddAccountTags                  -- Add account tags to postings, so they can be matched by auto postings.+      >>= journalMarkRedundantCosts                      -- Mark redundant costs, to help journalBalanceTransactions ignore them       >>= (if auto_ && not (null $ jtxnmodifiers pj)-            then journalAddAutoPostings verbose_tags_ _ioDay balancingopts_  -- Add auto postings if enabled, and account tags if needed+            then journalAddAutoPostings verbose_tags_ _ioDay balancingopts_  -- Add auto postings if enabled, and account tags if needed. Does preliminary transaction balancing.             else pure)       -- XXX how to force debug output here ?        -- >>= Right . dbg0With (concatMap (T.unpack.showTransaction).jtxns)        -- >>= \j -> deepseq (concatMap (T.unpack.showTransaction).jtxns $ j) (return j)-      >>= journalMarkRedundantCosts                      -- Mark redundant costs, to help journalBalanceTransactions ignore them-      >>= journalBalanceTransactions balancingopts_                         -- Balance all transactions and maybe check balance assertions.+      <&> dbg9With (lbl "amounts after styling, forecasting, auto-posting".showJournalAmountsDebug)+      >>= journalBalanceTransactions balancingopts_      -- infer balance assignments and missing amounts and maybe check balance assertions.+      <&> dbg9With (lbl "amounts after transaction-balancing".showJournalAmountsDebug)+      -- <&> dbg9With (("journalFinalise amounts after styling, forecasting, auto postings, transaction balancing"<>).showJournalAmountsDebug)+      >>= journalInferCommodityStyles                    -- infer commodity styles once more now that all posting amounts are present+      -- >>= Right . dbg0With (pshow.journalCommodityStyles)       >>= (if infer_costs_  then journalInferCostsFromEquity else pure)     -- Maybe infer costs from equity postings where possible       <&> (if infer_equity_ then journalInferEquityFromCosts verbose_tags_ else id)  -- Maybe infer equity postings from costs where possible+      <&> dbg9With (lbl "amounts after equity-inferring".showJournalAmountsDebug)       <&> journalInferMarketPricesFromTransactions       -- infer market prices from commodity-exchanging transactions-      <&> traceOrLogAt 6 ("journalFinalise: " <> takeFileName f)  -- debug logging-      <&> dbgJournalAcctDeclOrder ("journalFinalise: " <> takeFileName f <> "   acct decls           : ")+      -- <&> traceOrLogAt 6 fname  -- debug logging+      <&> dbgJournalAcctDeclOrder (fname <> ": acct decls           : ")       <&> journalRenumberAccountDeclarations-      <&> dbgJournalAcctDeclOrder ("journalFinalise: " <> takeFileName f <> "   acct decls renumbered: ")-    when strict_ $ do-      journalCheckAccounts j                     -- If in strict mode, check all postings are to declared accounts-      journalCheckCommodities j                  -- and using declared commodities-      -- journalCheckPairedConversionPostings j     -- check conversion postings are in adjacent pairs-                                                    -- disabled for now, single conversion postings are sometimes needed eg with paypal--    return j+      <&> dbgJournalAcctDeclOrder (fname <> ": acct decls renumbered: ")  -- | Apply any auto posting rules to generate extra postings on this journal's transactions. -- With a true first argument, adds visible tags to generated postings and modified transactions.@@ -368,8 +373,9 @@ journalAddForecast _ Nothing j = j journalAddForecast verbosetags (Just forecastspan) j = j{jtxns = jtxns j ++ forecasttxns}   where+    {-# HLINT ignore "Move concatMap out" #-}     forecasttxns =-        map (txnTieKnot . transactionTransformPostings (postingApplyCommodityStyles $ journalCommodityStyles j))+        map (txnTieKnot . transactionTransformPostings (styleAmounts $ journalCommodityStyles j))       . filter (spanContainsDate forecastspan . tdate)       . concatMap (\pt -> runPeriodicTransaction verbosetags pt forecastspan)       $ jperiodictxns j@@ -802,7 +808,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=Just prec, asdecimalmark=mdec, asdigitgroups=mgrps}+    let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalmark=mdec, asdigitgroups=mgrps}     return nullamt{acommodity=c, aquantity=sign (sign2 q), astyle=s, aprice=Nothing}    -- An amount with commodity symbol on the right or no commodity symbol.@@ -824,7 +830,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=Just prec, asdecimalmark=mdec, asdigitgroups=mgrps}+        let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalmark=mdec, asdigitgroups=mgrps}         return nullamt{acommodity=c, aquantity=sign q, astyle=s, aprice=Nothing}       -- no symbol amount       Nothing -> do@@ -840,8 +846,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) (Just prec)})-              _ -> ("", amountstyle{asprecision=Just prec, asdecimalmark=mdec, asdigitgroups=mgrps})+              (False, Just (defc,defs)) -> (defc, defs{asprecision=max (asprecision defs) prec})+              _ -> ("", amountstyle{asprecision=prec, asdecimalmark=mdec, asdigitgroups=mgrps})         return nullamt{acommodity=c, aquantity=sign q, astyle=s, aprice=Nothing}    -- For reducing code duplication. Doesn't parse anything. Has the type@@ -953,8 +959,9 @@   label "ledger-style lot cost" $ do   char '{'   doublebrace <- option False $ char '{' >> pure True-  _fixed <- fmap isJust $ optional $ lift skipNonNewlineSpaces >> char '='   lift skipNonNewlineSpaces+  _fixed <- fmap isJust $ optional $ char '='+  lift skipNonNewlineSpaces   _a <- simpleamountp False   lift skipNonNewlineSpaces   char '}'@@ -1068,7 +1075,7 @@     isValidDecimalBy c = \case       AmountStyle{asdecimalmark = Just d} -> d == c       AmountStyle{asdigitgroups = Just (DigitGroups g _)} -> g /= c-      AmountStyle{asprecision = Just (Precision 0)} -> False+      AmountStyle{asprecision = Precision 0} -> False       _ -> True  -- | Parse and interpret the structure of a number without external hints.@@ -1572,24 +1579,24 @@       nullamt{          acommodity="$"         ,aquantity=10 -- need to test internal precision with roundTo ? I think not-        ,astyle=amountstyle{asprecision=Just $ Precision 0, asdecimalmark=Nothing}+        ,astyle=amountstyle{asprecision=Precision 0, asdecimalmark=Nothing}         ,aprice=Just $ UnitPrice $           nullamt{              acommodity="€"             ,aquantity=0.5-            ,astyle=amountstyle{asprecision=Just $ Precision 1, asdecimalmark=Just '.'}+            ,astyle=amountstyle{asprecision=Precision 1, asdecimalmark=Just '.'}             }         }    ,testCase "total price"            $ assertParseEq amountp "$10 @@ €5"       nullamt{          acommodity="$"         ,aquantity=10-        ,astyle=amountstyle{asprecision=Just $ Precision 0, asdecimalmark=Nothing}+        ,astyle=amountstyle{asprecision=Precision 0, asdecimalmark=Nothing}         ,aprice=Just $ TotalPrice $           nullamt{              acommodity="€"             ,aquantity=5-            ,astyle=amountstyle{asprecision=Just $ Precision 0, asdecimalmark=Nothing}+            ,astyle=amountstyle{asprecision=Precision 0, asdecimalmark=Nothing}             }         }    ,testCase "unit price, parenthesised" $ assertParse amountp "$10 (@) €0.5"

@@ -13,6 +13,7 @@ module Hledger.Read.CsvUtils (   CSV, CsvRecord, CsvValue,   printCSV,+  printTSV,   -- * Tests   tests_CsvUtils, )@@ -41,9 +42,15 @@     where printRecord = foldMap TB.fromText . intersperse "," . map printField           printField = wrap "\"" "\"" . T.replace "\"" "\"\"" +printTSV :: [CsvRecord] -> TL.Text+printTSV = TB.toLazyText . unlinesB . map printRecord+    where printRecord = foldMap TB.fromText . intersperse "\t" . map printField+          printField = T.map replaceWhitespace+          replaceWhitespace c | c `elem` ['\t', '\n', '\r'] = ' '+          replaceWhitespace c = c+ --- ** tests  tests_CsvUtils :: TestTree tests_CsvUtils = testGroup "CsvUtils" [   ]-

@@ -75,9 +75,10 @@  import Hledger.Data import Hledger.Utils-import Hledger.Read.Common (aliasesFromOpts, Reader(..), InputOpts(..), amountp, statusp, journalFinalise, accountnamep )+import Hledger.Read.Common (aliasesFromOpts, Reader(..), InputOpts(..), amountp, statusp, journalFinalise, accountnamep, commenttagsp ) import Hledger.Read.CsvUtils import System.Directory (doesFileExist, getHomeDirectory)+import Data.Either (fromRight)  --- ** doctest setup -- $setup@@ -258,7 +259,7 @@ type CsvRulesParsed = CsvRules' ()  -- | Type used after parsing is done. Directives, assignments and conditional blocks--- are in the same order as they were in the unput file and rblocksassigning is functional.+-- are in the same order as they were in the input file and rblocksassigning is functional. -- Ready to be used for CSV record processing type CsvRules = CsvRules' (Text -> [ConditionalBlock])  -- XXX simplify @@ -300,7 +301,7 @@ type DateFormat       = Text  -- | A prefix for a matcher test, either & or none (implicit or).-data MatcherPrefix = And | None+data MatcherPrefix = And | Not | None   deriving (Show, Eq)  -- | A single test for matching a CSV record, in one way or another.@@ -372,10 +373,12 @@  ASSIGNMENT-SEPARATOR: SPACE | ( : SPACE? ) -FIELD-VALUE: VALUE (possibly containing CSV-FIELD-REFERENCEs)+FIELD-VALUE: VALUE (possibly containing CSV-FIELD-REFERENCEs and REGEX-MATCHGROUP-REFERENCEs)  CSV-FIELD-REFERENCE: % CSV-FIELD +REGEX-MATCHGROUP-REFERENCE: \ DIGIT++ CSV-FIELD: ( FIELD-NAME | FIELD-NUMBER ) (corresponding to a CSV field)  FIELD-NUMBER: DIGIT+@@ -660,7 +663,7 @@ matcherprefixp :: CsvRulesParser MatcherPrefix matcherprefixp = do   lift $ dbgparse 8 "trying matcherprefixp"-  (char '&' >> lift skipNonNewlineSpaces >> return And) <|> return None+  (char '&' >> lift skipNonNewlineSpaces >> return And) <|> (char '!' >> lift skipNonNewlineSpaces >> return Not) <|> return None  csvfieldreferencep :: CsvRulesParser CsvFieldReference csvfieldreferencep = do@@ -707,8 +710,12 @@ -- | Look up the final value assigned to a hledger field, with csv field -- references interpolated. hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe Text-hledgerFieldValue rules record = fmap (renderTemplate rules record) . hledgerField rules record+hledgerFieldValue rules record f = (fmap (renderTemplate rules record f) . hledgerField rules record) f +maybeNegate :: MatcherPrefix -> Bool -> Bool+maybeNegate Not origbool = not origbool+maybeNegate _ origbool = origbool+ -- | Given the conversion rules, a CSV record and a hledger field name, find -- the value template ultimately assigned to this field, if any, by a field -- assignment at top level or in a conditional block matching this record.@@ -721,60 +728,89 @@   where     -- all active assignments to field f, in order     assignments = dbg9 "csv assignments" $ filter ((==f).fst) $ toplevelassignments ++ conditionalassignments+    -- all top level field assignments+    toplevelassignments    = rassignments rules +    -- all field assignments in conditional blocks assigning to field f and active for the current csv record+    conditionalassignments = concatMap cbAssignments $ filter (isBlockActive rules record) $ (rblocksassigning rules) f++-- does this conditional block match the current csv record ?+isBlockActive :: CsvRules -> CsvRecord -> ConditionalBlock -> Bool+isBlockActive rules record CB{..} = any (all matcherMatches) $ groupedMatchers cbMatchers+  where+    -- does this individual matcher match the current csv record ?+    matcherMatches :: Matcher -> Bool+    matcherMatches (RecordMatcher prefix pat) = maybeNegate prefix origbool       where-        -- all top level field assignments-        toplevelassignments    = rassignments rules-        -- all field assignments in conditional blocks assigning to field f and active for the current csv record-        conditionalassignments = concatMap cbAssignments $ filter isBlockActive $ (rblocksassigning rules) f-          where-            -- does this conditional block match the current csv record ?-            isBlockActive :: ConditionalBlock -> Bool-            isBlockActive CB{..} = any (all matcherMatches) $ groupedMatchers cbMatchers-              where-                -- does this individual matcher match the current csv record ?-                matcherMatches :: Matcher -> Bool-                matcherMatches (RecordMatcher _ pat) = regexMatchText pat' wholecsvline-                  where-                    pat' = dbg7 "regex" pat-                    -- A synthetic whole CSV record to match against. Note, this can be-                    -- different from the original CSV data:-                    -- - any whitespace surrounding field values is preserved-                    -- - any quotes enclosing field values are removed-                    -- - and the field separator is always comma-                    -- which means that a field containing a comma will look like two fields.-                    wholecsvline = dbg7 "wholecsvline" $ T.intercalate "," record-                matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatchText pat csvfieldvalue-                  where-                    -- the value of the referenced CSV field to match against.-                    csvfieldvalue = dbg7 "csvfieldvalue" $ replaceCsvFieldReference rules record csvfieldref+        pat' = dbg7 "regex" pat+        -- A synthetic whole CSV record to match against. Note, this can be+        -- different from the original CSV data:+        -- - any whitespace surrounding field values is preserved+        -- - any quotes enclosing field values are removed+        -- - and the field separator is always comma+        -- which means that a field containing a comma will look like two fields.+        wholecsvline = dbg7 "wholecsvline" $ T.intercalate "," record+        origbool = regexMatchText pat' wholecsvline+    matcherMatches (FieldMatcher prefix csvfieldref pat) = maybeNegate prefix origbool+      where+        -- the value of the referenced CSV field to match against.+        csvfieldvalue = dbg7 "csvfieldvalue" $ replaceCsvFieldReference rules record csvfieldref+        origbool = regexMatchText pat csvfieldvalue -                -- | Group matchers into associative pairs based on prefix, e.g.:-                --   A-                --   & B-                --   C-                --   D-                --   & E-                --   => [[A, B], [C], [D, E]]-                groupedMatchers :: [Matcher] -> [[Matcher]]-                groupedMatchers [] = []-                groupedMatchers (x:xs) = (x:ys) : groupedMatchers zs-                  where-                    (ys, zs) = span (\y -> matcherPrefix y == And) xs-                    matcherPrefix :: Matcher -> MatcherPrefix-                    matcherPrefix (RecordMatcher prefix _) = prefix-                    matcherPrefix (FieldMatcher prefix _ _) = prefix+    -- | Group matchers into associative pairs based on prefix, e.g.:+    --   A+    --   & B+    --   C+    --   D+    --   & E+    --   => [[A, B], [C], [D, E]]+    groupedMatchers :: [Matcher] -> [[Matcher]]+    groupedMatchers [] = []+    groupedMatchers (x:xs) = (x:ys) : groupedMatchers zs+      where+        (ys, zs) = span (\y -> matcherPrefix y == And) xs+        matcherPrefix :: Matcher -> MatcherPrefix+        matcherPrefix (RecordMatcher prefix _) = prefix+        matcherPrefix (FieldMatcher prefix _ _) = prefix  -- | Render a field assignment's template, possibly interpolating referenced -- CSV field values. Outer whitespace is removed from interpolated values.-renderTemplate ::  CsvRules -> CsvRecord -> FieldTemplate -> Text-renderTemplate rules record t = maybe t mconcat $ parseMaybe-    (many $ takeWhile1P Nothing (/='%')+renderTemplate ::  CsvRules -> CsvRecord -> HledgerFieldName -> FieldTemplate -> Text+renderTemplate rules record f t = maybe t mconcat $ parseMaybe+    (many $ takeWhile1P Nothing isNotEscapeChar+        <|> replaceRegexGroupReference rules record f <$> matchp         <|> replaceCsvFieldReference rules record <$> referencep)     t   where+    -- XXX: can we return a parsed Int here?+    matchp = liftA2 T.cons (char '\\') (takeWhile1P (Just "matchref") isDigit) :: Parsec HledgerParseErrorData Text Text     referencep = liftA2 T.cons (char '%') (takeWhile1P (Just "reference") isFieldNameChar) :: Parsec HledgerParseErrorData Text Text     isFieldNameChar c = isAlphaNum c || c == '_' || c == '-'+    isNotEscapeChar c = c /='%' && c /= '\\' +-- | Replace something that looks like a Regex match group reference with the+-- resulting match group value after applying the Regex.+replaceRegexGroupReference :: CsvRules -> CsvRecord -> HledgerFieldName -> FieldTemplate -> Text+replaceRegexGroupReference rules record f s = case T.uncons s of+    Just ('\\', group) -> fromMaybe "" $ regexMatchValue rules record f group+    _                  -> s++regexMatchValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Text -> Maybe Text+regexMatchValue rules record f sgroup = let+  matchgroups  = concatMap (getMatchGroups rules record)+               $ concatMap cbMatchers+               $ filter (isBlockActive rules record)+               $ rblocksassigning rules f+  group = (read (T.unpack sgroup) :: Int) - 1 -- adjust to 0-indexing+  in atMay matchgroups group++getMatchGroups :: CsvRules -> CsvRecord -> Matcher -> [Text]+getMatchGroups _ record (RecordMatcher _ regex)  = let+  txt = T.intercalate "," record -- see caveats of wholecsvline, in `isBlockActive`+  in regexMatchTextGroups regex txt+getMatchGroups rules record (FieldMatcher _ fieldref regex) = let+  txt = replaceCsvFieldReference rules record fieldref+  in regexMatchTextGroups regex txt+ -- | Replace something that looks like a reference to a csv field ("%date" or "%1) -- with that field's value. If it doesn't look like a field reference, or if we -- can't find such a field, replace it with the empty string.@@ -1032,6 +1068,7 @@     code        = maybe "" singleline' $ fieldval "code"     description = maybe "" singleline' $ fieldval "description"     comment     = maybe "" unescapeNewlines $ fieldval "comment"+    ttags       = fromRight [] $ rtp commenttagsp comment     precomment  = maybe "" unescapeNewlines $ fieldval "precomment"      singleline' = T.unwords . filter (not . T.null) . map T.strip . T.lines@@ -1044,6 +1081,7 @@     p1IsVirtual = (accountNamePostingType <$> fieldval "account1") == Just VirtualPosting     ps = [p | n <- [1..maxpostings]          ,let cmt  = maybe "" unescapeNewlines $ fieldval ("comment"<> T.pack (show n))+         ,let ptags = fromRight [] $ rtp commenttagsp cmt          ,let currency = fromMaybe "" (fieldval ("currency"<> T.pack (show n)) <|> fieldval "currency")          ,let mamount  = getAmount rules record currency p1IsVirtual n          ,let mbalance = getBalance rules record currency n@@ -1056,6 +1094,7 @@                              ,ptransaction      = Just t                              ,pbalanceassertion = mkBalanceAssertion rules record <$> mbalance                              ,pcomment          = cmt+                             ,ptags             = ptags                              ,ptype             = accountNamePostingType acct                              }          ]@@ -1071,6 +1110,7 @@           ,tcode             = code           ,tdescription      = description           ,tcomment          = comment+          ,ttags             = ttags           ,tprecedingcomment = precomment           ,tpostings         = ps           }@@ -1153,7 +1193,7 @@      -- assignments to any of these field names with non-empty values     assignments = [(f,a') | f <- fieldnames-                          , Just v <- [T.strip . renderTemplate rules record <$> hledgerField rules record f]+                          , Just v <- [T.strip . renderTemplate rules record f <$> hledgerField rules record f]                           , not $ T.null v                           -- XXX maybe ignore rule-generated values like "", "-", "$", "-$", "$-" ? cf CSV FORMAT -> "amount", "Setting amounts",                           , let a = parseAmount rules record currency v@@ -2976,6 +3016,12 @@     ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a"] [("date","%csvdate")]]}     in testCase "conditional" $ getEffectiveAssignment rules ["a","b"] "date" @?= (Just "%csvdate")++   ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1)], rconditionalblocks=[CB [FieldMatcher Not "%csvdate" $ toRegex' "a"] [("date","%csvdate")]]}+    in testCase "negated-conditional-false" $ getEffectiveAssignment rules ["a","b"] "date" @?= (Nothing)+  +   ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1)], rconditionalblocks=[CB [FieldMatcher Not "%csvdate" $ toRegex' "b"] [("date","%csvdate")]]}+    in testCase "negated-conditional-true" $ getEffectiveAssignment rules ["a","b"] "date" @?= (Just "%csvdate")     ,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher None "%description" $ toRegex' "b"] [("date","%csvdate")]]}     in testCase "conditional-with-or-a" $ getEffectiveAssignment rules ["a"] "date" @?= (Just "%csvdate")

@@ -52,6 +52,11 @@ import Hledger.Data import Hledger.Read.Common hiding (emptyorcommentlinep) import Hledger.Utils+import Data.Decimal (roundTo)+import Data.Functor ((<&>))+import Data.List (sort)+import Data.List (group)+-- import Text.Megaparsec.Debug (dbg)  --- ** doctest setup -- $setup@@ -125,9 +130,8 @@   pos <- getSourcePos   (date,desc,comment,tags) <- datelinep   commentlinesp-  ps <- many $ timedotentryp <* commentlinesp+  ps <- (many $ timedotentryp <* commentlinesp) <&> concat   endpos <- getSourcePos-  -- lift $ traceparse' "dayp end"   let t = txnTieKnot $ nulltransaction{     tsourcepos   = (pos, endpos),     tdate        = date,@@ -146,7 +150,6 @@   date <- datep   desc <- T.strip <$> lift descriptionp   (comment, tags) <- lift transactioncommentp-  -- lift $ traceparse' "datelinep end"   return (date, desc, comment, tags)  -- | Zero or more empty lines or hash/semicolon comment lines@@ -164,51 +167,52 @@ --   void $ lift restofline --   lift $ traceparse' "orgnondatelinep" -orgheadingprefixp = do-  -- traceparse "orgheadingprefixp"-  skipSome (char '*') >> skipNonNewlineSpaces1+orgheadingprefixp = skipSome (char '*') >> skipNonNewlineSpaces1  -- | Parse a single timedot entry to one (dateless) transaction. -- @ -- fos.haskell  .... .. -- @-timedotentryp :: JournalParser m Posting+timedotentryp :: JournalParser m [Posting] timedotentryp = do   lift $ traceparse "timedotentryp"   notFollowedBy datelinep   lift $ optional $ choice [orgheadingprefixp, skipNonNewlineSpaces1]   a <- modifiedaccountnamep   lift skipNonNewlineSpaces-  (hours, comment, tags) <--    try (do-      (c,ts) <- lift transactioncommentp  -- or postingp, but let's not bother supporting date:/date2:-      return (0, c, ts)-    )-    <|> (do-      h <- lift durationp-      (c,ts) <- try (lift transactioncommentp) <|> (newline >> return ("",[]))-      return (h,c,ts)-    )+  taggedhours <- lift durationsp+  (comment0, tags0) <-+         lift transactioncommentp    -- not postingp, don't bother with date: tags here+     <|> (newline >> return ("",[]))   mcs <- getDefaultCommodityAndStyle   let      (c,s) = case mcs of-      Just (defc,defs) -> (defc, defs{asprecision=max (asprecision defs) (Just $ Precision 2)})-      _ -> ("", amountstyle{asprecision=Just $ Precision 2})-  -- lift $ traceparse' "timedotentryp end"-  return $ nullposting{paccount=a-                      ,pamount=mixedAmount $ nullamt{acommodity=c, aquantity=hours, astyle=s}-                      ,ptype=VirtualPosting-                      ,pcomment=comment-                      ,ptags=tags-                      }+      Just (defc,defs) -> (defc, defs{asprecision=max (asprecision defs) (Precision 2)})+      _ -> ("", amountstyle{asprecision=Precision 2})+    ps = [+      nullposting{paccount=a+                ,pamount=mixedAmount $ nullamt{acommodity=c, aquantity=hours, astyle=s}+                ,ptype=VirtualPosting+                ,pcomment=comment+                ,ptags=tags+                }+      | (hours,tagval) <- taggedhours+      , let tag = ("t",tagval)+      , let tags    = if T.null tagval then tags0    else tags0 ++ [tag]+      , let comment = if T.null tagval then comment0 else comment0 `commentAddTagUnspaced` tag+      ]+  return ps  type Hours = Quantity -durationp :: TextParser m Hours-durationp = do-  traceparse "durationp"-  try numericquantityp <|> dotquantityp-    -- <* traceparse' "durationp"+-- | Parse one or more durations in hours, each with an optional tag value+-- (or empty string for none).+durationsp :: TextParser m [(Hours,TagValue)]+durationsp =+      (dotquantityp     <&> \h -> [(h,"")])+  <|> (numericquantityp <&> \h -> [(h,"")])+  <|> letterquantitiesp+  <|> pure [(0,"")]  -- | Parse a duration of seconds, minutes, hours, days, weeks, months or years, -- written as a decimal number followed by s, m, h, d, w, mo or y, assuming h@@ -228,7 +232,7 @@   let q' =         case msymbol of           Nothing  -> q-          Just sym ->+          Just sym -> roundTo 2 $             case lookup sym timeUnits of               Just mult -> q * mult               Nothing   -> q  -- shouldn't happen.. ignore@@ -245,15 +249,33 @@   ,("y",61320)   ] --- | Parse a quantity written as a line of dots, each representing 0.25.+-- | Parse a quantity written as a line of one or more dots,+-- each representing 0.25, ignoring any interspersed spaces+-- after the first dot. -- @ -- .... .. -- @-dotquantityp :: TextParser m Quantity+dotquantityp :: TextParser m Hours dotquantityp = do   -- lift $ traceparse "dotquantityp"-  dots <- filter (not.isSpace) <$> many (oneOf (". " :: [Char]))-  return $ fromIntegral (length dots) / 4+  char '.'+  dots <- many (oneOf ['.', ' ']) <&> filter (not.isSpace)+  return $ fromIntegral (1 + length dots) / 4++-- | Parse a quantity written as a line of one or more letters,+-- each representing 0.25 with a tag "t" whose value is the letter,+-- ignoring any interspersed spaces after the first letter.+letterquantitiesp :: TextParser m [(Hours, TagValue)]+letterquantitiesp =+  -- dbg "letterquantitiesp" $ +  do+    letter1 <- letterChar+    letters <- many (letterChar <|> spacenonewline) <&> filter (not.isSpace)+    let groups =+          [ (fromIntegral (length t) / 4, T.singleton c)+          | t@(c:_) <- group $ sort $ letter1:letters+          ]+    return groups  -- | XXX new comment line parser, move to Hledger.Read.Common.emptyorcommentlinep -- Parse empty lines, all-blank lines, and lines beginning with any of the provided

@@ -110,7 +110,7 @@ journalAddBudgetGoalTransactions :: BalancingOpts -> ReportOpts -> DateSpan -> Journal -> Journal journalAddBudgetGoalTransactions bopts ropts reportspan j =   either error' id $  -- PARTIAL:-    (journalApplyCommodityStyles >=> journalBalanceTransactions bopts) j{ jtxns = budgetts }+    (journalStyleAmounts >=> journalBalanceTransactions bopts) j{ jtxns = budgetts }   where     budgetspan = dbg3 "budget span" $ DateSpan (Exact <$> mbudgetgoalsstartdate) (Exact <$> spanEnd reportspan)       where

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

@@ -83,6 +83,7 @@ import Hledger.Data import Hledger.Query import Hledger.Utils+import Data.Function ((&))   -- | What to calculate for each cell in a balance report.@@ -156,6 +157,7 @@     ,declared_         :: Bool  -- ^ Include accounts declared but not yet posted to ?     ,row_total_        :: Bool     ,no_total_         :: Bool+    ,summary_only_     :: Bool     ,show_costs_       :: Bool  -- ^ Show costs for reports which normally don't show them ?     ,sort_amount_      :: Bool     ,percent_          :: Bool@@ -206,6 +208,7 @@     , declared_         = False     , row_total_        = False     , no_total_         = False+    , summary_only_     = False     , show_costs_       = False     , sort_amount_      = False     , percent_          = False@@ -259,6 +262,7 @@           ,declared_         = boolopt "declared" rawopts           ,row_total_        = boolopt "row-total" rawopts           ,no_total_         = boolopt "no-total" rawopts+          ,summary_only_     = boolopt "summary-only" rawopts           ,show_costs_       = boolopt "show-costs" rawopts           ,sort_amount_      = boolopt "sort-amount" rawopts           ,percent_          = boolopt "percent" rawopts@@ -584,19 +588,28 @@ -- condition. journalApplyValuationFromOpts :: ReportSpec -> Journal -> Journal journalApplyValuationFromOpts rspec j =-    journalApplyValuationFromOptsWith rspec j priceoracle+  journalApplyValuationFromOptsWith rspec j priceoracle   where priceoracle = journalPriceOracle (infer_prices_ $ _rsReportOpts rspec) j  -- | Like journalApplyValuationFromOpts, but takes PriceOracle as an argument. journalApplyValuationFromOptsWith :: ReportSpec -> Journal -> PriceOracle -> Journal journalApplyValuationFromOptsWith rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle =-    case balancecalc_ ropts of-      CalcGain -> journalMapPostings (\p -> postingTransformAmount (gain p) p) j-      _        -> journalMapPostings (\p -> postingTransformAmount (valuation p) p) $ costing j+  costfn j+  & journalMapPostings (\p -> p+    & dbg9With (lbl "before calc".showMixedAmountOneLine.pamount)+    & postingTransformAmount (calcfn p)+    & dbg9With (lbl (show calc).showMixedAmountOneLine.pamount)+    )   where-    valuation p = maybe id (mixedAmountApplyValuation priceoracle styles (postingperiodend p) (_rsDay rspec) (postingDate p)) (value_ ropts)-    gain      p = maybe id (mixedAmountApplyGain      priceoracle styles (postingperiodend p) (_rsDay rspec) (postingDate p)) (value_ ropts)-    costing     = journalToCost (fromMaybe NoConversionOp $ conversionop_ ropts)+    lbl = lbl_ "journalApplyValuationFromOptsWith"+    -- Which custom calculation to do for balance reports. For all other reports, it will be CalcChange.+    calc = balancecalc_ ropts+    calcfn = case calc of+      CalcGain -> \p -> maybe id (mixedAmountApplyGain      priceoracle styles (postingperiodend p) (_rsDay rspec) (postingDate p)) (value_ ropts)+      _        -> \p -> maybe id (mixedAmountApplyValuation priceoracle styles (postingperiodend p) (_rsDay rspec) (postingDate p)) (value_ ropts)+    costfn = case calc of+      CalcGain -> id+      _        -> journalToCost costop where costop = fromMaybe NoConversionOp $ conversionop_ ropts      -- Find the end of the period containing this posting     postingperiodend  = addDays (-1) . fromMaybe err . mPeriodEnd . postingDateOrDate2 (whichDate ropts)@@ -623,7 +636,7 @@     gain mc spn = mixedAmountGainAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd spn)     costing = case fromMaybe NoConversionOp $ conversionop_ ropts of         NoConversionOp -> id-        ToCost         -> mixedAmountSetStyles styles . mixedAmountCost+        ToCost         -> styleAmounts styles . mixedAmountCost     styles = journalCommodityStyles j     err = error "mixedAmountApplyValuationAfterSumFromOptsWith: expected all spans to have an end date" 

@@ -49,6 +49,7 @@   -- * Misc   multicol,   numDigitsInt,+  numDigitsInteger,   makeHledgerClassyLenses,    -- * Other@@ -232,6 +233,12 @@          | a >= 10000000000000000 = 16 + go (a `quot` 10000000000000000)          | a >= 100000000         = 8  + go (a `quot` 100000000)          | otherwise              = 4  + go (a `quot` 10000)++-- | Find the number of digits of an Integer.+-- The integer should not have more digits than an Int can count.+-- This is probably inefficient.+numDigitsInteger :: Integer -> Int+numDigitsInteger = length . dropWhile (=='-') . show  -- | Make classy lenses for Hledger options fields. -- This is intended to be used with BalancingOpts, InputOpt, ReportOpts,

@@ -64,10 +64,27 @@ 9             any other rarely needed / more in-depth info @ +We don't yet have the ability to select debug output by topic. For now, here+are some standardish topic strings to search for in hledger debug messages:++acct+arg+budget+calc+csv+journalFinalise+multiBalanceReport+opts+precision+price+q+style+val+ -} --- Disabled until 0.1.2.0 is released with windows support--- This module also exports Debug.Trace and the breakpoint package's Debug.Breakpoint.+-- Disabled until 0.1.2.0 is released with windows support:+--  This module also exports Debug.Trace and the breakpoint package's Debug.Breakpoint.  -- more: -- http://hackage.haskell.org/packages/archive/TraceUtils/0.1.0.2/doc/html/Debug-TraceUtils.html@@ -75,9 +92,10 @@ -- http://hackage.haskell.org/packages/archive/htrace/0.1/doc/html/Debug-HTrace.html -- http://hackage.haskell.org/packages/archive/traced/2009.7.20/doc/html/Debug-Traced.html -- https://hackage.haskell.org/package/debug+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}  module Hledger.Utils.Debug (- +    debugLevel    -- * Tracing to stderr@@ -142,6 +160,9 @@   ,dbg8With   ,dbg9With +  -- * Utilities+  ,lbl_+   -- * Re-exports   -- ,module Debug.Breakpoint   ,module Debug.Trace@@ -221,7 +242,7 @@ ptraceAt level     | level > 0 && debugLevel < level = const id     | otherwise = \lbl a -> trace (labelledPretty True lbl a) a-    + -- Pretty-print a showable value with a label, with or without allowing ANSI color. labelledPretty :: Show a => Bool -> String -> a -> String labelledPretty allowcolour lbl a = lbl ++ ":" ++ nlorspace ++ intercalate "\n" ls'@@ -290,7 +311,7 @@ -- if the global debug level is at or above the specified level. -- At level 0, always logs. Otherwise, uses unsafePerformIO. traceLogAtWith :: Int -> (a -> String) -> a -> a-traceLogAtWith level f a = traceLogAt level (f a) a +traceLogAtWith level f a = traceLogAt level (f a) a  -- | Pretty-log a label and showable value to the debug log, -- if the global debug level is at or above the specified level. @@ -433,3 +454,25 @@ dbg9With :: Show a => (a -> String) -> a -> a dbg9With = traceOrLogAtWith 9 +-- | Helper for producing debug messages:+-- concatenates a name (eg a function name),+-- short description of the value being logged,+-- and string representation of the value.+lbl_ :: String -> String -> String -> String+lbl_ name desc val = name <> ": " <> desc <> ":" <> " " <> val++-- XXX the resulting function is constrained to only one value type+-- -- | A new helper for defining a local "dbg" function.+-- -- Given a debug level and a topic string (eg, a function name),+-- -- it generates a function which takes+-- -- - a description string,+-- -- - a value-to-string show function,+-- -- - and a value to be inspected,+-- -- debug-logs the topic, description and result of calling the show function on the value,+-- -- formatted nicely, at the specified debug level or above,+-- -- then returns the value.+-- dbg_ :: forall a. Show a => Int -> String -> (String -> (a -> String) -> a -> a)+-- dbg_ level topic =+--   \desc showfn val ->+--     traceOrLogAtWith level (lbl_ topic desc . showfn) val+-- {-# HLINT ignore "Redundant lambda" #-}

@@ -76,6 +76,7 @@ -- and current parser state (position and next input). -- See also: Hledger.Utils.Debug, megaparsec's dbg. -- Uses unsafePerformIO.+-- XXX Can be hard to make this evaluate. traceOrLogParse :: String -> TextParser m () traceOrLogParse msg = do   pos <- getSourcePos

@@ -55,6 +55,7 @@    -- * total regex operations   ,regexMatch   ,regexMatchText+  ,regexMatchTextGroups   ,regexReplace   ,regexReplaceUnmemo   ,regexReplaceAllBy@@ -72,7 +73,8 @@ import Text.Regex.TDFA (   Regex, CompOption(..), defaultCompOpt, defaultExecOpt,   makeRegexOptsM, AllMatches(getAllMatches), match, MatchText,-  RegexLike(..), RegexMaker(..), RegexOptions(..), RegexContext(..)+  RegexLike(..), RegexMaker(..), RegexOptions(..), RegexContext(..),+  (=~)   )  @@ -165,6 +167,14 @@ -- a performance bug in regex-tdfa (#9), which may or may not be relevant here. regexMatchText :: Regexp -> Text -> Bool regexMatchText r = matchTest r . T.unpack++-- | Return a (possibly empty) list of match groups derived by applying the+-- Regex to a Text.+regexMatchTextGroups :: Regexp -> Text -> [Text]+regexMatchTextGroups r txt = let+    pat = reString r+    (_,_,_,matches) = txt =~ pat :: (Text,Text,Text,[Text])+    in matches  -------------------------------------------------------------------------------- -- new total functions

@@ -3,6 +3,7 @@ module Hledger.Utils.String (  takeEnd,  -- * misc+ capitalise,  lowercase,  uppercase,  underline,@@ -55,6 +56,10 @@     go (_:xs) (_:ys) = go xs ys     go []     r      = r     go _      []     = []++capitalise :: String -> String+capitalise (c:cs) = toUpper c : cs+capitalise s = s  lowercase, uppercase :: String -> String lowercase = map toLower

@@ -6,8 +6,7 @@ module Hledger.Utils.Text   (   -- * misc-  -- lowercase,-  -- uppercase,+  textCapitalise,   -- underline,   -- stripbrackets,   textUnbracket,@@ -20,6 +19,7 @@   -- quotechars,   -- whitespacechars,   escapeDoubleQuotes,+  escapeBackslash,   -- escapeSingleQuotes,   -- escapeQuotes,   -- words',@@ -67,9 +67,8 @@ import Text.WideString (WideBuilder(..), wbToText, wbFromText, wbUnpack)  --- lowercase, uppercase :: String -> String--- lowercase = map toLower--- uppercase = map toUpper+textCapitalise :: Text -> Text+textCapitalise t = T.toTitle c <> cs where (c,cs) = T.splitAt 1 t  -- stripbrackets :: String -> String -- stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse :: String -> String@@ -140,6 +139,9 @@  escapeDoubleQuotes :: T.Text -> T.Text escapeDoubleQuotes = T.replace "\"" "\\\""++escapeBackslash :: T.Text -> T.Text+escapeBackslash = T.replace "\\" "\\\\"  -- escapeSingleQuotes :: T.Text -> T.Text -- escapeSingleQuotes = T.replace "'" "\'"

@@ -75,12 +75,13 @@   -- | Render a table according to common options, for backwards compatibility-render :: Bool -> (rh -> Text) -> (ch -> Text) -> (a -> Text) -> Table rh ch a -> TL.Text+render :: Show a => Bool -> (rh -> Text) -> (ch -> Text) -> (a -> Text) -> Table rh ch a -> TL.Text render pretty fr fc f = renderTable def{prettyTable=pretty} (cell . fr) (cell . fc) (cell . f)   where cell = textCell TopRight  -- | Render a table according to various cell specifications>-renderTable :: TableOpts       -- ^ Options controlling Table rendering+renderTable :: Show a =>+               TableOpts       -- ^ Options controlling Table rendering             -> (rh -> Cell)  -- ^ Rendering function for row headers             -> (ch -> Cell)  -- ^ Rendering function for column headers             -> (a -> Cell)   -- ^ Function determining the string and width of a cell@@ -89,7 +90,8 @@ renderTable topts fr fc f = toLazyText . renderTableB topts fr fc f  -- | A version of renderTable which returns the underlying Builder.-renderTableB :: TableOpts       -- ^ Options controlling Table rendering+renderTableB :: Show a =>+                TableOpts       -- ^ Options controlling Table rendering              -> (rh -> Cell)  -- ^ Rendering function for row headers              -> (ch -> Cell)  -- ^ Rendering function for column headers              -> (a -> Cell)   -- ^ Function determining the string and width of a cell@@ -99,7 +101,8 @@  -- | A version of renderTable that operates on rows (including the 'row' of -- column headers) and returns the underlying Builder.-renderTableByRowsB :: TableOpts      -- ^ Options controlling Table rendering+renderTableByRowsB :: Show a =>+                TableOpts      -- ^ Options controlling Table rendering              -> ([ch] -> [Cell])     -- ^ Rendering function for column headers              -> ((rh, [a]) -> (Cell, [Cell])) -- ^ Rendering function for row and row header              -> Table rh ch a

@@ -1,22 +1,29 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.1.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack  name:           hledger-lib-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-                common file formats, command line options, reports etc.+version:        1.32+synopsis:       A library providing the core functionality of hledger+description:    This library contains hledger's core functionality.+                It is used by most hledger* packages so that they support the same+                command line options, file formats, reports, etc.                 .                 hledger is a robust, cross-platform set of tools for tracking money,                 time, or any other commodity, using double-entry accounting and a                 simple, editable file format, with command-line, terminal and web                 interfaces. It is a Haskell rewrite of Ledger, and one of the leading-                implementations of Plain Text Accounting. Read more at:-                <https://hledger.org>+                implementations of Plain Text Accounting.+                .+                See also:+                .+                - https://hledger.org - hledger's home page+                .+                - https://hledger.org/dev.html - starting point for hledger's developer docs+                .+                - https://hackage.haskell.org/package/hledger-lib/docs/Hledger.html - starting point for hledger's haddock docs category:       Finance stability:      stable homepage:       http://hledger.org@@ -137,7 +144,7 @@     , tasty-hunit >=0.10.0.2     , template-haskell     , terminal-size >=0.3.3-    , text >=1.2+    , text >=1.2.4.1     , text-ansi >=0.2.1     , time >=1.5     , timeit@@ -196,7 +203,7 @@     , tasty-hunit >=0.10.0.2     , template-haskell     , terminal-size >=0.3.3-    , text >=1.2+    , text >=1.2.4.1     , text-ansi >=0.2.1     , time >=1.5     , timeit@@ -257,7 +264,7 @@     , tasty-hunit >=0.10.0.2     , template-haskell     , terminal-size >=0.3.3-    , text >=1.2+    , text >=1.2.4.1     , text-ansi >=0.2.1     , time >=1.5     , timeit