hledger-lib 1.21 → 1.22

raw patch · 44 files changed

+1444/−1339 lines, 44 filesdep ~basedep ~containersdep ~megaparsecPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, containers, megaparsec

API changes (from Hackage documentation)

Files

• CHANGES.md +195/−0
• Hledger/Data.hs +1/−1
• Hledger/Data/Account.hs +25/−22
• Hledger/Data/AccountName.hs +4/−7
• Hledger/Data/Amount.hs +227/−148
• Hledger/Data/Commodity.hs +0/−4
• Hledger/Data/Journal.hs +80/−85
• Hledger/Data/Json.hs +66/−37
• Hledger/Data/Ledger.hs +1/−3
• Hledger/Data/PeriodicTransaction.hs +0/−4
• Hledger/Data/Posting.hs +23/−35
• Hledger/Data/Timeclock.hs +5/−6
• Hledger/Data/Transaction.hs +160/−142
• Hledger/Data/TransactionModifier.hs +21/−25
• Hledger/Data/Types.hs +47/−16
• Hledger/Data/Valuation.hs +10/−16
• Hledger/Query.hs +11/−14
• Hledger/Read.hs +0/−4
• Hledger/Read/Common.hs +79/−49
• Hledger/Read/CsvReader.hs +14/−11
• Hledger/Read/JournalReader.hs +14/−20
• Hledger/Read/TimedotReader.hs +1/−1
• Hledger/Reports.hs +3/−1
• Hledger/Reports/AccountTransactionsReport.hs +30/−46
• Hledger/Reports/BalanceReport.hs +16/−14
• Hledger/Reports/BudgetReport.hs +33/−70
• Hledger/Reports/EntriesReport.hs +7/−12
• Hledger/Reports/MultiBalanceReport.hs +50/−65
• Hledger/Reports/PostingsReport.hs +33/−48
• Hledger/Reports/ReportOptions.hs +87/−22
• Hledger/Reports/ReportTypes.hs +3/−7
• Hledger/Reports/TransactionsReport.hs +9/−8
• Hledger/Utils.hs +11/−13
• Hledger/Utils/Color.hs +0/−6
• Hledger/Utils/Debug.hs +117/−41
• Hledger/Utils/Parse.hs +6/−3
• Hledger/Utils/Regex.hs +0/−5
• Hledger/Utils/String.hs +0/−163
• Hledger/Utils/Test.hs +0/−5
• Hledger/Utils/Text.hs +23/−130
• Text/Megaparsec/Custom.hs +2/−2
• Text/Tabular/AsciiWide.hs +16/−5
• Text/WideString.hs +1/−9
• hledger-lib.cabal +13/−14

@@ -1,5 +1,200 @@+<!--+ _ _ _     +| (_) |__  +| | | '_ \ +| | | |_) |+|_|_|_.__/ +           +--> Internal/api/developer-ish changes in the hledger-lib (and hledger) packages. For user-visible changes, see the hledger package changelog.++# 1.22 2021-07-03++- GHC 9.0 is now officially supported, and GHC 8.0, 8.2, 8.4 are not;+  building hledger now requires GHC 8.6 or greater.++- Added now-required lower bound on containers. (#1514)++- Added useColor, colorOption helpers usable in pure code, eg for debug output.++- Added a Show instance for AmountDisplayOpts and WideBuilder, for debug logging.++Many internal refactorings/improvements/optimisations by Stephen Morgan,+including:++- Don't infer a txn price with same-sign amounts. (#1551)++- Clean up valuation functions, and make clear which to use where. (#1560)++- Replace journalSelectingAmountFromOpts with journalApplyValuationFromOpts.+  This also has the effect of allowing valuation in more reports, for+  example the transactionReport.++- Refactor to eliminate use of printf.++- Remove unused String, Text utility functions.++- Replace concat(Top|Bottom)Padded with textConcat(Top|Bottom)Padded.++- Export Text.Tabular from Text.Tabular.AsciiWide, clean up import lists.++- When matching an account query against a posting, don't try to match+  against the same posting twice, in cases when poriginal is Nothing.++- Create mixedAmountApplyValuationAfterSumFromOptsWith for doing any+  valuation needed after summing amounts.++- Create journalApplyValuationFromOpts. This does costing and+  valuation on a journal, and is meant to replace most direct calls of+  costing and valuation. The exception is for reports which require+  amounts to be summed before valuation is applied, for example a+  historical balance report with --value=end.++- Remove unused (amount|mixedAmount|posting|transaction)ApplyCostValuation functions.++- Remove unnecessary normalisedMixedAmount.++- Remove `showAmounts*B` functions, replacing them entirely with+  `showMixedAmount*B` functions.++- Pull "show-costs" option used by the Close command up into ReporOpts.++- Add more efficient toEncoding for custom ToJSON declarations.++- Fix ledgerDateSpan, so that it considers both transaction and+  posting dates. (#772)++- Move reportPeriodName to Hledger.Reports.ReportOptions, use it for+  HTML and CSV output for compound balance reports.++- Simplify the JSON representation of AmountPrecision. It now uses the+  same JSON representation as Maybe Word8. This means that the JSON+  serialisation is now broadly compatible with that used before the+  commit f6fa76bba7530af3be825445a1097ae42498b1cd, differing only in+  how it handles numbers outside Word8 and that it can now produce+  null for NaturalPrecision.++- A number of AccountName and Journal functions which are supposed to+  produce unique sorted results now use Sets internally to be slightly+  more efficient. There is also a new function journalCommodities.++- More efficiently check whether Amounts are or appear to be zero.+  Comparing two Quantity (either with == or compare) does a lot of+  normalisation (calling roundMax) which is unnecessary if we're+  comparing to zero. Do things more directly to save work.+  For `reg -f examples/10000x10000x10.journal`, this results in++  - A 12% reduction in heap allocations, from 70GB to 62GB+  - A 14% reduction in (profiled) time, from 79s to 70s++  Results for bal -f examples/10000x10000x10.journal are of the same+  order of magnitude.++- In sorting account names, perform lookups on HashSets and HashMaps,+  rather than lists. This is probably not an enormous performance sink+  in real situations, but it takes a huge amount of time and memory in+  our benchmarks (specifically 10000x10000x10.journal). For +  `bal -f examples/10000x10000x10.journal`, this results in++  - A 23% reduction in heap allocation, from 27GiB to 21GiB+  - A 33% reduction in (profiled) time running, from 26.5s to 17.9s++- Minor refactor, using foldMap instead of asum . map . toList.++- Do not call showAmount twice for every posting. For print -f+  examples/10000x10000x10.journal, this results in a 7.7% reduction in+  heap allocations, from 7.6GB to 7.1GB.++- Some efficiency improvements in register reports.+  Use renderRow interface for Register report.++  For `reg -f examples/10000x10000x10.journal`, this results in:++  - Heap allocations decreasing by 55%, from 68.6GB to 31.2GB+  - Resident memory decreasing by 75%, from 254GB to 65GB+  - Total (profiled) time decreasing by 55%, from 37s to 20s++- Split showMixedAmountB into showMixedAmountB and showAmountsB, the+  former being a simple wrapper around the latter. This removes the+  need for the showNormalised option, as showMixedAmountB will always+  showNormalised and showAmountsB will never do so.++- Change internal representation of MixedAmount to use a strict Map+  instead of a list of Amounts. No longer export Mixed constructor, to+  keep API clean. (If you really need it, you can import it directly+  from Hledger.Data.Types). We also ensure the JSON representation of+  MixedAmount doesn't change: it is stored as a normalised list of+  Amounts.+  +  This commit improves performance. Here are some indicative results:++      hledger reg -f examples/10000x1000x10.journal+      - Maximum residency decreases from 65MB to 60MB (8% decrease)+      - Total memory in use decreases from 178MiB to 157MiB (12% decrease)++      hledger reg -f examples/10000x10000x10.journal+      - Maximum residency decreases from 69MB to 60MB (13% decrease)+      - Total memory in use decreases from 198MiB to 153MiB (23% decrease)++      hledger bal -f examples/10000x1000x10.journal+      - Total heap usage decreases from 6.4GB to 6.0GB (6% decrease)+      - Total memory in use decreases from 178MiB to 153MiB (14% decrease)++      hledger bal -f examples/10000x10000x10.journal+      - Total heap usage decreases from 7.3GB to 6.9GB (5% decrease)+      - Total memory in use decreases from 196MiB to 185MiB (5% decrease)++      hledger bal -M -f examples/10000x1000x10.journal+      - Total heap usage decreases from 16.8GB to 10.6GB (47% decrease)+      - Total time decreases from 14.3s to 12.0s (16% decrease)++      hledger bal -M -f examples/10000x10000x10.journal+      - Total heap usage decreases from 108GB to 48GB (56% decrease)+      - Total time decreases from 62s to 41s (33% decrease)++  If you never directly use the constructor Mixed or pattern match against+  it then you don't need to make any changes. If you do, then do the+  following:++  - If you really care about the individual Amounts and never normalise+    your MixedAmount (for example, just storing `Mixed amts` and then+    extracting `amts` as a pattern match, then use should switch to using+    [Amount]. This should just involve removing the `Mixed` constructor.+  - If you ever call `mixed`, `normaliseMixedAmount`, or do any sort of+    amount arithmetic (+), (-), then you should replace the constructor+    `Mixed` with the function `mixed`. To extract the list of Amounts, use+    the function `amounts`.+  - Any remaining calls to `normaliseMixedAmount` can be removed, as that+    is now the identity function.++- Create a new API for MixedAmount arithmetic. This should supplant+  the old interface, which relied on the Num typeclass. MixedAmount+  did not have a very good Num instance. The only functions which were+  defined were fromInteger, (+), and negate. Furthermore, it was not+  law-abiding, as 0 + a /= a in general. Replacements for used+  functions are:++      0 -> nullmixedamt / mempty+      (+) -> maPlus / (<>)+      (-) -> maMinus+      negate -> maNegate+      sum -> maSum+      sumStrict -> maSum++  Also creates some new constructors for MixedAmount:++      mixedAmount :: Amount -> MixedAmount+      maAddAmount :: MixedAmount -> Amount -> MixedAmount+      maAddAmounts :: MixedAmount -> [Amount] -> MixedAmount++  Add Semigroup and Monoid instances for MixedAmount.+  Ideally we would remove the Num instance entirely.++  The only change needed have nullmixedamt/mempty substitute for 0+  without problems was to not squash prices in+  mixedAmount(Looks|Is)Zero. This is correct behaviour in any case.+  # 1.21 2021-03-10 

@@ -47,7 +47,7 @@ import Hledger.Data.Timeclock import Hledger.Data.Transaction import Hledger.Data.TransactionModifier-import Hledger.Data.Types+import Hledger.Data.Types hiding (MixedAmountKey, Mixed) import Hledger.Data.Valuation import Hledger.Utils.Test 

@@ -1,4 +1,6 @@-{-# LANGUAGE RecordWildCards, OverloadedStrings #-}+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-} {-|  @@ -9,12 +11,13 @@  module Hledger.Data.Account where+import qualified Data.HashSet as HS+import qualified Data.HashMap.Strict as HM import Data.List (find, sortOn)-import Data.List.Extra (groupSort, groupOn)-import Data.Maybe (fromMaybe)-import Data.Ord (Down(..))+import Data.List.Extra (groupOn) import qualified Data.Map as M-import Safe (headMay, lookupJustDef)+import Data.Ord (Down(..))+import Safe (headMay) import Text.Printf  import Hledger.Data.AccountName@@ -63,12 +66,12 @@ accountsFromPostings :: [Posting] -> [Account] accountsFromPostings ps =   let-    grouped = groupSort [(paccount p,pamount p) | p <- ps]-    counted = [(aname, length amts) | (aname, amts) <- grouped]-    summed =  [(aname, sumStrict amts) | (aname, amts) <- grouped]  -- always non-empty-    acctstree      = accountTree "root" $ map fst summed-    acctswithnumps = mapAccounts setnumps    acctstree      where setnumps    a = a{anumpostings=fromMaybe 0 $ lookup (aname a) counted}-    acctswithebals = mapAccounts setebalance acctswithnumps where setebalance a = a{aebalance=lookupJustDef nullmixedamt (aname a) summed}+    summed = foldr (\p -> HM.insertWith addAndIncrement (paccount p) (1, pamount p)) mempty ps+      where addAndIncrement (n, a) (m, b) = (n + m, a `maPlus` b)+    acctstree      = accountTree "root" $ HM.keys summed+    acctswithebals = mapAccounts setnumpsebalance acctstree+      where setnumpsebalance a = a{anumpostings=numps, aebalance=total}+              where (numps, total) = HM.lookupDefault (0, nullmixedamt) (aname a) summed     acctswithibals = sumAccounts acctswithebals     acctswithparents = tieAccountParents acctswithibals     acctsflattened = flattenAccounts acctswithparents@@ -122,7 +125,7 @@   | otherwise      = a{aibalance=ibal, asubs=subs}   where     subs = map sumAccounts $ asubs a-    ibal = sum $ aebalance a : map aibalance subs+    ibal = maSum $ aebalance a : map aibalance subs  -- | Remove all subaccounts below a certain depth. clipAccounts :: Int -> Account -> Account@@ -139,7 +142,7 @@ clipAccountsAndAggregate (Just d) as = combined     where       clipped  = [a{aname=clipOrEllipsifyAccountName (Just d) $ aname a} | a <- as]-      combined = [a{aebalance=sum $ map aebalance same}+      combined = [a{aebalance=maSum $ map aebalance same}                  | same@(a:_) <- groupOn aname clipped] {- test cases, assuming d=1:@@ -205,7 +208,7 @@     sortSubs = case normalsign of         NormallyPositive -> sortOn (\a -> (Down $ amt a, aname a))         NormallyNegative -> sortOn (\a -> (amt a, aname a))-    amt = normaliseMixedAmountSquashPricesForDisplay . aibalance+    amt = mixedAmountStripPrices . aibalance  -- | Add extra info for this account derived from the Journal's -- account directives, if any (comment, tags, declaration order..).@@ -224,14 +227,14 @@ -- sortAccountNamesByDeclaration :: Journal -> Bool -> [AccountName] -> [AccountName] sortAccountNamesByDeclaration j keepparents as =-  (if keepparents then id else filter (`elem` as)) $  -- maybe discard missing parents that were added-  map aname $                                         -- keep just the names-  drop 1 $                                            -- drop the root node that was added-  flattenAccounts $                                   -- convert to an account list-  sortAccountTreeByDeclaration $                      -- sort by declaration order (and name)-  mapAccounts (accountSetDeclarationInfo j) $         -- add declaration order info-  accountTree "root"                                  -- convert to an account tree-  as+    (if keepparents then id else filter (`HS.member` HS.fromList as)) $  -- maybe discard missing parents that were added+    map aname $                                         -- keep just the names+    drop 1 $                                            -- drop the root node that was added+    flattenAccounts $                                   -- convert to an account list+    sortAccountTreeByDeclaration $                      -- sort by declaration order (and name)+    mapAccounts (accountSetDeclarationInfo j) $         -- add declaration order info+    accountTree "root"                                  -- convert to an account tree+    as  -- | Sort each group of siblings in an account tree by declaration order, then account name. -- So each group will contain first the declared accounts,

@@ -1,6 +1,5 @@ {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-} {-|  'AccountName's are strings like @assets:cash:petty@, with multiple@@ -41,11 +40,9 @@ ) where -import Data.List.Extra (nubSort)+import Data.Foldable (toList) import qualified Data.List.NonEmpty as NE-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif+import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import Data.Tree (Tree(..))@@ -113,7 +110,7 @@ -- ie these plus all their parent accounts up to the root. -- Eg: ["a:b:c","d:e"] -> ["a","a:b","a:b:c","d","d:e"] expandAccountNames :: [AccountName] -> [AccountName]-expandAccountNames as = nubSort $ concatMap expandAccountName as+expandAccountNames = toList . foldMap (S.fromList . expandAccountName)  -- | "a:b:c" -> ["a","a:b","a:b:c"] expandAccountName :: AccountName -> [AccountName]@@ -121,7 +118,7 @@  -- | ["a:b:c","d:e"] -> ["a","d"] topAccountNames :: [AccountName] -> [AccountName]-topAccountNames as = [a | a <- expandAccountNames as, accountNameLevel a == 1]+topAccountNames = filter ((1==) . accountNameLevel) . expandAccountNames  parentAccountName :: AccountName -> AccountName parentAccountName = accountNameFromComponents . init . accountNameComponents

@@ -41,7 +41,6 @@ -}  {-# LANGUAGE BangPatterns       #-}-{-# LANGUAGE CPP                #-} {-# LANGUAGE OverloadedStrings  #-} {-# LANGUAGE RecordWildCards    #-} {-# LANGUAGE StandaloneDeriving #-}@@ -89,12 +88,17 @@   withInternalPrecision,   setAmountDecimalPoint,   withDecimalPoint,+  amountStripPrices,   canonicaliseAmount,   -- * MixedAmount   nullmixedamt,   missingmixedamt,   mixed,+  mixedAmount,+  maAddAmount,+  maAddAmounts,   amounts,+  amountsRaw,   filterMixedAmount,   filterMixedAmountByCommodity,   mapMixedAmount,@@ -104,12 +108,18 @@   mixedAmountStripPrices,   -- ** arithmetic   mixedAmountCost,+  maNegate,+  maPlus,+  maMinus,+  maSum,   divideMixedAmount,   multiplyMixedAmount,   averageMixedAmounts,   isNegativeAmount,   isNegativeMixedAmount,   mixedAmountIsZero,+  maIsZero,+  maIsNonZero,   mixedAmountLooksZero,   mixedAmountTotalPriceToUnitPrice,   -- ** rendering@@ -138,13 +148,11 @@ import Data.Decimal (DecimalRaw(..), decimalPlaces, normalizeDecimal, roundTo) import Data.Default (Default(..)) import Data.Foldable (toList)-import Data.List (intercalate, intersperse, mapAccumL, partition)+import Data.List (find, foldl', intercalate, intersperse, mapAccumL, partition) import Data.List.NonEmpty (NonEmpty(..), nonEmpty) import qualified Data.Map.Strict as M-import Data.Maybe (fromMaybe)-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif+import Data.Maybe (fromMaybe, isNothing)+import Data.Semigroup (Semigroup(..)) import qualified Data.Text as T import qualified Data.Text.Lazy.Builder as TB import Data.Word (Word8)@@ -163,7 +171,6 @@   { displayPrice         :: Bool       -- ^ Whether to display the Price of an Amount.   , displayZeroCommodity :: Bool       -- ^ If the Amount rounds to 0, whether to display its commodity string.   , displayColour        :: Bool       -- ^ Whether to colourise negative Amounts.-  , displayNormalised    :: Bool       -- ^ Whether to normalise MixedAmounts before displaying.   , displayOneLine       :: Bool       -- ^ Whether to display on one line.   , displayMinWidth      :: Maybe Int  -- ^ Minimum width to pad to   , displayMaxWidth      :: Maybe Int  -- ^ Maximum width to clip to@@ -177,7 +184,6 @@ noColour = AmountDisplayOpts { displayPrice         = True                              , displayColour        = False                              , displayZeroCommodity = False-                             , displayNormalised    = True                              , displayOneLine       = False                              , displayMinWidth      = Nothing                              , displayMaxWidth      = Nothing@@ -315,11 +321,15 @@ -- | Do this Amount and (and its total price, if it has one) appear to be zero when rendered with its -- display precision ? amountLooksZero :: Amount -> Bool-amountLooksZero = testAmountAndTotalPrice ((0==) . amountRoundedQuantity)+amountLooksZero = testAmountAndTotalPrice looksZero+  where+    looksZero Amount{aquantity=Decimal e q, astyle=AmountStyle{asprecision=p}} = case p of+        Precision d      -> if e > d then abs q <= 5*10^(e-d-1) else q == 0+        NaturalPrecision -> q == 0  -- | Is this Amount (and its total price, if it has one) exactly zero, ignoring its display precision ? amountIsZero :: Amount -> Bool-amountIsZero = testAmountAndTotalPrice ((0==) . aquantity)+amountIsZero = testAmountAndTotalPrice (\Amount{aquantity=Decimal _ q} -> q == 0)  -- | Set an amount's display precision, flipped. withPrecision :: Amount -> AmountPrecision -> Amount@@ -344,7 +354,7 @@ -- 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 only for internal use, eg when comparing amounts in tests.+-- Intended mainly for internal use, eg when comparing amounts in tests. setAmountInternalPrecision :: Word8 -> Amount -> Amount setAmountInternalPrecision p a@Amount{ aquantity=q, astyle=s } = a{    astyle=s{asprecision=Precision p}@@ -352,7 +362,7 @@   }  -- | Set an amount's internal precision, flipped.--- Intended only for internal use, eg when comparing amounts in tests.+-- Intended mainly for internal use, eg when comparing amounts in tests. withInternalPrecision :: Amount -> Word8 -> Amount withInternalPrecision = flip setAmountInternalPrecision @@ -364,6 +374,10 @@ withDecimalPoint :: Amount -> Maybe Char -> Amount withDecimalPoint = flip setAmountDecimalPoint +-- | Strip all prices from an Amount+amountStripPrices :: Amount -> Amount+amountStripPrices a = a{aprice=Nothing}+ showAmountPrice :: Amount -> WideBuilder showAmountPrice amt = case aprice amt of     Nothing              -> mempty@@ -494,28 +508,123 @@ ------------------------------------------------------------------------------- -- MixedAmount +instance Semigroup MixedAmount where+  (<>) = maPlus+  sconcat = maSum+  stimes n = multiplyMixedAmount (fromIntegral n)++instance Monoid MixedAmount where+  mempty = nullmixedamt+  mconcat = maSum+ instance Num MixedAmount where-    fromInteger i = Mixed [fromInteger i]-    negate (Mixed as) = Mixed $ map negate as-    (+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ as ++ bs+    fromInteger = mixedAmount . fromInteger+    negate = maNegate+    (+)    = maPlus     (*)    = error' "error, mixed amounts do not support multiplication" -- PARTIAL:     abs    = error' "error, mixed amounts do not support abs"     signum = error' "error, mixed amounts do not support signum" +-- | Calculate the key used to store an Amount within a MixedAmount.+amountKey :: Amount -> MixedAmountKey+amountKey amt@Amount{acommodity=c} = case aprice amt of+    Nothing             -> MixedAmountKeyNoPrice    c+    Just (TotalPrice p) -> MixedAmountKeyTotalPrice c (acommodity p)+    Just (UnitPrice  p) -> MixedAmountKeyUnitPrice  c (acommodity p) (aquantity p)+ -- | The empty mixed amount. nullmixedamt :: MixedAmount-nullmixedamt = Mixed []+nullmixedamt = Mixed mempty  -- | A temporary value for parsed transactions which had no amount specified. missingmixedamt :: MixedAmount-missingmixedamt = Mixed [missingamt]+missingmixedamt = mixedAmount missingamt --- | Convert amounts in various commodities into a normalised MixedAmount.-mixed :: [Amount] -> MixedAmount-mixed = normaliseMixedAmount . Mixed+-- | Convert amounts in various commodities into a mixed amount.+mixed :: Foldable t => t Amount -> MixedAmount+mixed = maAddAmounts nullmixedamt --- | Simplify a mixed amount's component amounts:+-- | Create a MixedAmount from a single Amount.+mixedAmount :: Amount -> MixedAmount+mixedAmount a = Mixed $ M.singleton (amountKey a) a++-- | Add an Amount to a MixedAmount, normalising the result.+maAddAmount :: MixedAmount -> Amount -> MixedAmount+maAddAmount (Mixed ma) a = Mixed $ M.insertWith sumSimilarAmountsUsingFirstPrice (amountKey a) a ma++-- | Add a collection of Amounts to a MixedAmount, normalising the result.+maAddAmounts :: Foldable t => MixedAmount -> t Amount -> MixedAmount+maAddAmounts = foldl' maAddAmount++-- | Negate mixed amount's quantities (and total prices, if any).+maNegate :: MixedAmount -> MixedAmount+maNegate = transformMixedAmount negate++-- | Sum two MixedAmount.+maPlus :: MixedAmount -> MixedAmount -> MixedAmount+maPlus (Mixed as) (Mixed bs) = Mixed $ M.unionWith sumSimilarAmountsUsingFirstPrice as bs++-- | Subtract a MixedAmount from another.+maMinus :: MixedAmount -> MixedAmount -> MixedAmount+maMinus a = maPlus a . maNegate++-- | Sum a collection of MixedAmounts.+maSum :: Foldable t => t MixedAmount -> MixedAmount+maSum = foldl' maPlus nullmixedamt++-- | Divide a mixed amount's quantities (and total prices, if any) by a constant.+divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount+divideMixedAmount n = transformMixedAmount (/n)++-- | Multiply a mixed amount's quantities (and total prices, if any) by a constant.+multiplyMixedAmount :: Quantity -> MixedAmount -> MixedAmount+multiplyMixedAmount n = transformMixedAmount (*n)++-- | Apply a function to a mixed amount's quantities (and its total prices, if it has any).+transformMixedAmount :: (Quantity -> Quantity) -> MixedAmount -> MixedAmount+transformMixedAmount f = mapMixedAmountUnsafe (transformAmount f)++-- | Calculate the average of some mixed amounts.+averageMixedAmounts :: [MixedAmount] -> MixedAmount+averageMixedAmounts as = fromIntegral (length as) `divideMixedAmount` maSum as++-- | Is this mixed amount negative, if we can tell that unambiguously?+-- Ie when normalised, are all individual commodity amounts negative ?+isNegativeMixedAmount :: MixedAmount -> Maybe Bool+isNegativeMixedAmount m =+  case amounts $ normaliseMixedAmountSquashPricesForDisplay m of+    []  -> Just False+    [a] -> Just $ isNegativeAmount a+    as | all isNegativeAmount as -> Just True+    as | not (any isNegativeAmount as) -> Just False+    _ -> 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?+mixedAmountLooksZero :: MixedAmount -> Bool+mixedAmountLooksZero = all amountLooksZero . amounts . normaliseMixedAmount++-- | 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?+mixedAmountIsZero :: MixedAmount -> Bool+mixedAmountIsZero = all amountIsZero . amounts . normaliseMixedAmount++-- | Is this mixed amount exactly zero, ignoring its display precision? --+-- A convenient alias for mixedAmountIsZero.+maIsZero :: MixedAmount -> Bool+maIsZero = mixedAmountIsZero++-- | Is this mixed amount non-zero, ignoring its display precision?+--+-- A convenient alias for not . mixedAmountIsZero.+maIsNonZero :: MixedAmount -> Bool+maIsNonZero = not . mixedAmountIsZero++-- | Get a mixed amount's component amounts.+-- -- * amounts in the same commodity are combined unless they have different prices or total prices -- -- * multiple zero amounts, all with the same non-null commodity, are replaced by just the last of them, preserving the commodity and amount style (all but the last zero amount are discarded)@@ -526,34 +635,35 @@ -- -- * the special "missing" mixed amount remains unchanged ---normaliseMixedAmount :: MixedAmount -> MixedAmount-normaliseMixedAmount = normaliseHelper False--normaliseHelper :: Bool -> MixedAmount -> MixedAmount-normaliseHelper squashprices (Mixed as)-  | missingkey `M.member` amtMap = missingmixedamt -- missingamt should always be alone, but detect it even if not-  | M.null nonzeros= Mixed [newzero]-  | otherwise      = Mixed $ toList nonzeros+amounts :: MixedAmount -> [Amount]+amounts (Mixed ma)+  | missingkey `M.member` ma = [missingamt]  -- missingamt should always be alone, but detect it even if not+  | M.null nonzeros          = [newzero]+  | otherwise                = toList nonzeros   where-    newzero = maybe nullamt snd . M.lookupMin $ M.filter (not . T.null . acommodity) zeros-    (zeros, nonzeros) = M.partition amountIsZero amtMap-    amtMap = foldr (\a -> M.insertWith sumSimilarAmountsUsingFirstPrice (key a) a) mempty as-    key Amount{acommodity=c,aprice=p} = (c, if squashprices then Nothing else priceKey <$> p)-      where-        priceKey (UnitPrice  x) = (acommodity x, Just $ aquantity x)-        priceKey (TotalPrice x) = (acommodity x, Nothing)-    missingkey = key missingamt+    newzero = fromMaybe nullamt $ find (not . T.null . acommodity) zeros+    (zeros, nonzeros) = M.partition amountIsZero ma+    missingkey = amountKey missingamt --- | Like normaliseMixedAmount, but combine each commodity's amounts--- into just one by throwing away all prices except the first. This is--- only used as a rendering helper, and could show a misleading price.+-- | Get a mixed amount's component amounts without normalising zero and missing+-- amounts. This is used for JSON serialisation, so the order is important. In+-- particular, we want the Amounts given in the order of the MixedAmountKeys,+-- i.e. lexicographically first by commodity, then by price commodity, then by+-- unit price from most negative to most positive.+amountsRaw :: MixedAmount -> [Amount]+amountsRaw (Mixed ma) = toList ma++normaliseMixedAmount :: MixedAmount -> MixedAmount+normaliseMixedAmount = id  -- XXX Remove++-- | Strip prices from a MixedAmount. normaliseMixedAmountSquashPricesForDisplay :: MixedAmount -> MixedAmount-normaliseMixedAmountSquashPricesForDisplay = normaliseHelper True+normaliseMixedAmountSquashPricesForDisplay = mixedAmountStripPrices  -- XXX Remove  -- | Unify a MixedAmount to a single commodity value if possible.--- Like normaliseMixedAmount, this consolidates amounts of the same commodity--- and discards zero amounts; but this one insists on simplifying to--- a single commodity, and will return Nothing if this is not possible.+-- This consolidates amounts of the same commodity and discards zero+-- amounts; but this one insists on simplifying to a single commodity,+-- and will return Nothing if this is not possible. unifyMixedAmount :: MixedAmount -> Maybe Amount unifyMixedAmount = foldM combine 0 . amounts   where@@ -581,86 +691,51 @@ -- sumSimilarAmountsNotingPriceDifference [] = nullamt -- sumSimilarAmountsNotingPriceDifference as = undefined --- | Get a mixed amount's component amounts.-amounts :: MixedAmount -> [Amount]-amounts (Mixed as) = as- -- | Filter a mixed amount's component amounts by a predicate. filterMixedAmount :: (Amount -> Bool) -> MixedAmount -> MixedAmount-filterMixedAmount p (Mixed as) = Mixed $ filter p as+filterMixedAmount p (Mixed ma) = Mixed $ M.filter p ma  -- | Return an unnormalised MixedAmount containing exactly one Amount -- with the specified commodity and the quantity of that commodity -- found in the original. NB if Amount's quantity is zero it will be -- discarded next time the MixedAmount gets normalised. filterMixedAmountByCommodity :: CommoditySymbol -> MixedAmount -> MixedAmount-filterMixedAmountByCommodity c (Mixed as) = Mixed as'-  where-    as' = case filter ((==c) . acommodity) as of-            []   -> [nullamt{acommodity=c}]-            as'' -> [sum as'']+filterMixedAmountByCommodity c (Mixed ma)+  | M.null ma' = mixedAmount nullamt{acommodity=c}+  | otherwise  = Mixed ma'+  where ma' = M.filter ((c==) . acommodity) ma  -- | Apply a transform to a mixed amount's component 'Amount's. mapMixedAmount :: (Amount -> Amount) -> MixedAmount -> MixedAmount-mapMixedAmount f (Mixed as) = Mixed $ map f as+mapMixedAmount f (Mixed ma) = mixed . map f $ toList ma +-- | Apply a transform to a mixed amount's component 'Amount's, which does not+-- affect the key of the amount (i.e. doesn't change the commodity, price+-- commodity, or unit price amount). This condition is not checked.+mapMixedAmountUnsafe :: (Amount -> Amount) -> MixedAmount -> MixedAmount+mapMixedAmountUnsafe f (Mixed ma) = Mixed $ M.map f ma  -- Use M.map instead of fmap to maintain strictness+ -- | Convert all component amounts to cost/selling price where -- possible (see amountCost). mixedAmountCost :: MixedAmount -> MixedAmount mixedAmountCost = mapMixedAmount amountCost --- | Divide a mixed amount's quantities (and total prices, if any) by a constant.-divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount-divideMixedAmount n = mapMixedAmount (divideAmount n)---- | Multiply a mixed amount's quantities (and total prices, if any) by a constant.-multiplyMixedAmount :: Quantity -> MixedAmount -> MixedAmount-multiplyMixedAmount n = mapMixedAmount (multiplyAmount n)---- | Calculate the average of some mixed amounts.-averageMixedAmounts :: [MixedAmount] -> MixedAmount-averageMixedAmounts [] = 0-averageMixedAmounts as = fromIntegral (length as) `divideMixedAmount` sum as---- | Is this mixed amount negative, if we can tell that unambiguously?--- Ie when normalised, are all individual commodity amounts negative ?-isNegativeMixedAmount :: MixedAmount -> Maybe Bool-isNegativeMixedAmount m =-  case amounts $ normaliseMixedAmountSquashPricesForDisplay m of-    []  -> Just False-    [a] -> Just $ isNegativeAmount a-    as | all isNegativeAmount as -> Just True-    as | not (any isNegativeAmount as) -> Just False-    _ -> 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?-mixedAmountLooksZero :: MixedAmount -> Bool-mixedAmountLooksZero = all amountLooksZero . amounts . normaliseMixedAmountSquashPricesForDisplay---- | Is this mixed amount exactly to be 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?-mixedAmountIsZero :: MixedAmount -> Bool-mixedAmountIsZero = all amountIsZero . amounts . normaliseMixedAmountSquashPricesForDisplay- -- -- | MixedAmount derived Eq instance in Types.hs doesn't know that we -- -- want $0 = EUR0 = 0. Yet we don't want to drag all this code over there. -- -- For now, use this when cross-commodity zero equality is important. -- mixedAmountEquals :: MixedAmount -> MixedAmount -> Bool -- mixedAmountEquals a b = amounts a' == amounts b' || (mixedAmountLooksZero a' && mixedAmountLooksZero b')---     where a' = normaliseMixedAmountSquashPricesForDisplay a---           b' = normaliseMixedAmountSquashPricesForDisplay b+--     where a' = mixedAmountStripPrices a+--           b' = mixedAmountStripPrices b  -- | Given a map of standard commodity display styles, apply the -- appropriate one to each individual amount. styleMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount-styleMixedAmount styles = mapMixedAmount (styleAmount styles)+styleMixedAmount styles = mapMixedAmountUnsafe (styleAmount styles)  -- | Reset each individual amount's display style to the default. mixedAmountUnstyled :: MixedAmount -> MixedAmount-mixedAmountUnstyled = mapMixedAmount amountUnstyled+mixedAmountUnstyled = mapMixedAmountUnsafe amountUnstyled  -- | Get the string representation of a mixed amount, after -- normalising it to one amount per commodity. Assumes amounts have@@ -712,38 +787,37 @@                        | otherwise       = printf "Mixed [%s]" as     where as = intercalate "\n       " $ map showAmountDebug $ amounts m --- | General function to generate a WideBuilder for a MixedAmount, according the+-- | General function to generate a WideBuilder for a MixedAmount, according to the -- supplied AmountDisplayOpts. This is the main function to use for showing -- MixedAmounts, constructing a builder; it can then be converted to a Text with -- wbToText, or to a String with wbUnpack. -- -- If a maximum width is given then: -- - If displayed on one line, it will display as many Amounts as can---   fit in the given width, and further Amounts will be elided.+--   fit in the given width, and further Amounts will be elided. There+--   will always be at least one amount displayed, even if this will+--   exceed the requested maximum width. -- - If displayed on multiple lines, any Amounts longer than the --   maximum width will be elided. showMixedAmountB :: AmountDisplayOpts -> MixedAmount -> WideBuilder showMixedAmountB opts ma-    | displayOneLine opts = showMixedAmountOneLineB opts ma'+    | displayOneLine opts = showMixedAmountOneLineB opts ma     | otherwise           = WideBuilder (wbBuilder . mconcat $ intersperse sep lines) width   where-    ma' = if displayPrice opts then ma else mixedAmountStripPrices ma-    lines = showMixedAmountLinesB opts ma'+    lines = showMixedAmountLinesB opts ma     width = headDef 0 $ map wbWidth lines     sep = WideBuilder (TB.singleton '\n') 0 --- | Helper for showMixedAmountB to show a MixedAmount on multiple lines. This returns--- the list of WideBuilders: one for each Amount in the MixedAmount (possibly--- normalised), and padded/elided to the appropriate width. This does not--- honour displayOneLine: all amounts will be displayed as if displayOneLine--- were False.+-- | Helper for showMixedAmountB to show a list of Amounts on multiple lines. This returns+-- the list of WideBuilders: one for each Amount, and padded/elided to the appropriate+-- width. This does not honour displayOneLine: all amounts will be displayed as if+-- displayOneLine were False. showMixedAmountLinesB :: AmountDisplayOpts -> MixedAmount -> [WideBuilder] showMixedAmountLinesB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma =     map (adBuilder . pad) elided   where-    Mixed amts = if displayNormalised opts then normaliseMixedAmountSquashPricesForDisplay ma else ma--    astrs = amtDisplayList (wbWidth sep) (showAmountB opts) amts+    astrs = amtDisplayList (wbWidth sep) (showAmountB opts) . amounts $+              if displayPrice opts then ma else mixedAmountStripPrices ma     sep   = WideBuilder (TB.singleton '\n') 0     width = maximum $ fromMaybe 0 mmin : map (wbWidth . adBuilder) elided @@ -761,14 +835,14 @@ -- were True. showMixedAmountOneLineB :: AmountDisplayOpts -> MixedAmount -> WideBuilder showMixedAmountOneLineB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma =-    WideBuilder (wbBuilder . pad . mconcat . intersperse sep $ map adBuilder elided) . max width $ fromMaybe 0 mmin+    WideBuilder (wbBuilder . pad . mconcat . intersperse sep $ map adBuilder elided)+    . max width $ fromMaybe 0 mmin   where-    Mixed amts = if displayNormalised opts then normaliseMixedAmountSquashPricesForDisplay ma else ma-     width  = maybe 0 adTotal $ lastMay elided-    astrs  = amtDisplayList (wbWidth sep) (showAmountB opts) amts+    astrs  = amtDisplayList (wbWidth sep) (showAmountB opts) . amounts $+               if displayPrice opts then ma else mixedAmountStripPrices ma     sep    = WideBuilder (TB.fromString ", ") 2-    n      = length amts+    n      = length astrs      pad = (WideBuilder (TB.fromText $ T.replicate w " ") w <>)       where w = fromMaybe 0 mmin - width@@ -779,8 +853,10 @@     addElide [] = []     addElide xs = maybeAppend (snd $ last xs) $ map fst xs     -- Return the elements of the display list which fit within the maximum width-    -- (including their elision strings)-    takeFitting m = dropWhileRev (\(a,e) -> m < adTotal (fromMaybe a e))+    -- (including their elision strings). Always display at least one amount,+    -- regardless of width.+    takeFitting _ []     = []+    takeFitting m (x:xs) = x : dropWhileRev (\(a,e) -> m < adTotal (fromMaybe a e)) xs     dropWhileRev p = foldr (\x xs -> if null xs && p x then [] else x:xs) []      -- Add the elision strings (if any) to each amount@@ -790,7 +866,7 @@   { adBuilder :: !WideBuilder  -- ^ String representation of the Amount   , adTotal   :: !Int            -- ^ Cumulative length of MixedAmount this Amount is part of,                                 --   including separators-  }+  } deriving (Show)  nullAmountDisplay :: AmountDisplay nullAmountDisplay = AmountDisplay mempty 0@@ -828,19 +904,22 @@  -- | Set the display precision in the amount's commodities. mixedAmountSetPrecision :: AmountPrecision -> MixedAmount -> MixedAmount-mixedAmountSetPrecision p = mapMixedAmount (amountSetPrecision p)+mixedAmountSetPrecision p = mapMixedAmountUnsafe (amountSetPrecision p)  -- | In each component amount, increase the display precision sufficiently -- to render it exactly (showing all significant decimal digits). mixedAmountSetFullPrecision :: MixedAmount -> MixedAmount-mixedAmountSetFullPrecision = mapMixedAmount amountSetFullPrecision+mixedAmountSetFullPrecision = mapMixedAmountUnsafe amountSetFullPrecision +-- | Remove all prices from a MixedAmount. mixedAmountStripPrices :: MixedAmount -> MixedAmount-mixedAmountStripPrices = mapMixedAmount (\a -> a{aprice=Nothing})+mixedAmountStripPrices (Mixed ma) =+    foldl' (\m a -> maAddAmount m a{aprice=Nothing}) (Mixed noPrices) withPrices+  where (noPrices, withPrices) = M.partition (isNothing . aprice) ma  -- | Canonicalise a mixed amount's display styles using the provided commodity style map. canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount-canonicaliseMixedAmount styles = mapMixedAmount (canonicaliseAmount styles)+canonicaliseMixedAmount styles = mapMixedAmountUnsafe (canonicaliseAmount styles)  -- | Replace each component amount's TotalPrice, if it has one, with an equivalent UnitPrice. -- Has no effect on amounts without one.@@ -888,52 +967,52 @@   ,tests "MixedAmount" [       test "adding mixed amounts to zero, the commodity and amount style are preserved" $-      sum (map (Mixed . (:[]))-               [usd 1.25-               ,usd (-1) `withPrecision` Precision 3-               ,usd (-0.25)-               ])-        @?= Mixed [usd 0 `withPrecision` Precision 3]+      maSum (map mixedAmount+        [usd 1.25+        ,usd (-1) `withPrecision` Precision 3+        ,usd (-0.25)+        ])+        @?= mixedAmount (usd 0 `withPrecision` Precision 3)      ,test "adding mixed amounts with total prices" $ do-      sum (map (Mixed . (:[]))-       [usd 1 @@ eur 1-       ,usd (-2) @@ eur 1-       ])-        @?= Mixed [usd (-1) @@ eur 2 ]+      maSum (map mixedAmount+        [usd 1 @@ eur 1+        ,usd (-2) @@ eur 1+        ])+        @?= mixedAmount (usd (-1) @@ eur 2)      ,test "showMixedAmount" $ do-       showMixedAmount (Mixed [usd 1]) @?= "$1.00"-       showMixedAmount (Mixed [usd 1 `at` eur 2]) @?= "$1.00 @ €2.00"-       showMixedAmount (Mixed [usd 0]) @?= "0"-       showMixedAmount (Mixed []) @?= "0"+       showMixedAmount (mixedAmount (usd 1)) @?= "$1.00"+       showMixedAmount (mixedAmount (usd 1 `at` eur 2)) @?= "$1.00 @ €2.00"+       showMixedAmount (mixedAmount (usd 0)) @?= "0"+       showMixedAmount nullmixedamt @?= "0"        showMixedAmount missingmixedamt @?= ""      ,test "showMixedAmountWithoutPrice" $ do       let a = usd 1 `at` eur 2-      showMixedAmountWithoutPrice False (Mixed [a]) @?= "$1.00"-      showMixedAmountWithoutPrice False (Mixed [a, -a]) @?= "0"+      showMixedAmountWithoutPrice False (mixedAmount (a)) @?= "$1.00"+      showMixedAmountWithoutPrice False (mixed [a, -a]) @?= "0" -    ,tests "normaliseMixedAmount" [+    ,tests "amounts" [        test "a missing amount overrides any other amounts" $-        normaliseMixedAmount (Mixed [usd 1, missingamt]) @?= missingmixedamt+        amounts (mixed [usd 1, missingamt]) @?= [missingamt]       ,test "unpriced same-commodity amounts are combined" $-        normaliseMixedAmount (Mixed [usd 0, usd 2]) @?= Mixed [usd 2]+        amounts (mixed [usd 0, usd 2]) @?= [usd 2]       ,test "amounts with same unit price are combined" $-        normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) @?= Mixed [usd 2 `at` eur 1]+        amounts (mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) @?= [usd 2 `at` eur 1]       ,test "amounts with different unit prices are not combined" $-        normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) @?= Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]+        amounts (mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) @?= [usd 1 `at` eur 1, usd 1 `at` eur 2]       ,test "amounts with total prices are combined" $-        normaliseMixedAmount (Mixed  [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= Mixed [usd 2 @@ eur 2]+        amounts (mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= [usd 2 @@ eur 2]     ] -    ,test "normaliseMixedAmountSquashPricesForDisplay" $ do-       normaliseMixedAmountSquashPricesForDisplay (Mixed []) @?= Mixed [nullamt]-       assertBool "" $ mixedAmountLooksZero $ normaliseMixedAmountSquashPricesForDisplay-        (Mixed [usd 10+    ,test "mixedAmountStripPrices" $ do+       amounts (mixedAmountStripPrices nullmixedamt) @?= [nullamt]+       assertBool "" $ mixedAmountLooksZero $ mixedAmountStripPrices+        (mixed [usd 10                ,usd 10 @@ eur 7                ,usd (-10)-               ,usd (-10) @@ eur 7+               ,usd (-10) @@ eur (-7)                ])    ]

@@ -8,7 +8,6 @@ -}  {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}  module Hledger.Data.Commodity where@@ -16,9 +15,6 @@ import Data.Char (isDigit) import Data.List import Data.Maybe (fromMaybe)-#if !(MIN_VERSION_base(4,11,0))-import Data.Monoid-#endif import qualified Data.Text as T -- import qualified Data.Map as M 

@@ -1,11 +1,9 @@-{-# LANGUAGE PackageImports #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE NamedFieldPuns      #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE PackageImports      #-}+{-# LANGUAGE Rank2Types          #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}  {-| @@ -57,6 +55,7 @@   journalPayeesUsed,   journalPayeesDeclaredOrUsed,   journalCommoditiesDeclared,+  journalCommodities,   journalDateSpan,   journalDateSpanBothDates,   journalStartDate,@@ -101,6 +100,7 @@ import Data.Array.ST (STArray, getElems, newListArray, writeArray) import Data.Char (toUpper, isDigit) import Data.Default (Default(..))+import Data.Foldable (toList) import Data.Function ((&)) import qualified Data.HashTable.Class as H (toList) import qualified Data.HashTable.ST.Cuckoo as H@@ -108,9 +108,6 @@ import Data.List.Extra (nubSort) import qualified Data.Map.Strict as M import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, mapMaybe, maybeToList)-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup (Semigroup(..))-#endif import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T@@ -277,9 +274,13 @@ journalPostings = concatMap tpostings . jtxns  -- | Sorted unique commodity symbols declared by commodity directives in this journal.-journalCommoditiesDeclared :: Journal -> [AccountName]-journalCommoditiesDeclared = nubSort . M.keys . jcommodities+journalCommoditiesDeclared :: Journal -> [CommoditySymbol]+journalCommoditiesDeclared = M.keys . jcommodities +-- | Sorted unique commodity symbols declared or inferred from this journal.+journalCommodities :: Journal -> S.Set CommoditySymbol+journalCommodities j = M.keysSet (jcommodities j) <> M.keysSet (jinferredcommodities j)+ -- | Unique transaction descriptions used in this journal. journalDescriptions :: Journal -> [Text] journalDescriptions = nubSort . map tdescription . jtxns@@ -294,7 +295,8 @@  -- | Sorted unique payees used in transactions or declared by payee directives in this journal. journalPayeesDeclaredOrUsed :: Journal -> [Payee]-journalPayeesDeclaredOrUsed j = nubSort $ journalPayeesDeclared j ++ journalPayeesUsed j+journalPayeesDeclaredOrUsed j = toList $ foldMap S.fromList+    [journalPayeesDeclared j, journalPayeesUsed j]  -- | Sorted unique account names posted to by this journal's transactions. journalAccountNamesUsed :: Journal -> [AccountName]@@ -312,19 +314,21 @@ -- | Sorted unique account names declared by account directives or posted to -- by transactions in this journal. journalAccountNamesDeclaredOrUsed :: Journal -> [AccountName]-journalAccountNamesDeclaredOrUsed j = nubSort $ journalAccountNamesDeclared j ++ journalAccountNamesUsed j+journalAccountNamesDeclaredOrUsed j = toList $ foldMap S.fromList+    [journalAccountNamesDeclared j, journalAccountNamesUsed j]  -- | Sorted unique account names declared by account directives, or posted to -- or implied as parents by transactions in this journal. journalAccountNamesDeclaredOrImplied :: Journal -> [AccountName]-journalAccountNamesDeclaredOrImplied j = nubSort $ journalAccountNamesDeclared j ++ journalAccountNamesImplied j+journalAccountNamesDeclaredOrImplied j = toList $ foldMap S.fromList+    [journalAccountNamesDeclared j, expandAccountNames $ journalAccountNamesUsed j]  -- | Convenience/compatibility alias for journalAccountNamesDeclaredOrImplied. journalAccountNames :: Journal -> [AccountName] journalAccountNames = journalAccountNamesDeclaredOrImplied  journalAccountNameTree :: Journal -> Tree AccountName-journalAccountNameTree = accountNameTreeFrom . journalAccountNames+journalAccountNameTree = accountNameTreeFrom . journalAccountNamesDeclaredOrImplied  -- | Find up to N most similar and most recent transactions matching -- the given transaction description and query. Transactions are@@ -524,7 +528,7 @@  -- | Filter out all parts of this posting's amount which do not match the query. filterPostingAmount :: Query -> Posting -> Posting-filterPostingAmount q p@Posting{pamount=Mixed as} = p{pamount=Mixed $ filter (q `matchesAmount`) as}+filterPostingAmount q p@Posting{pamount=as} = p{pamount=filterMixedAmount (q `matchesAmount`) as}  filterTransactionPostings :: Query -> Transaction -> Transaction filterTransactionPostings q t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps}@@ -538,8 +542,8 @@ journalMapPostings f j@Journal{jtxns=ts} = j{jtxns=map (transactionMapPostings f) ts}  -- | Apply a transformation to a journal's posting amounts.-journalMapPostingAmounts :: (Amount -> Amount) -> Journal -> Journal-journalMapPostingAmounts f = journalMapPostings (postingTransformAmount (mapMixedAmount f))+journalMapPostingAmounts :: (MixedAmount -> MixedAmount) -> Journal -> Journal+journalMapPostingAmounts f = journalMapPostings (postingTransformAmount f)  {- -------------------------------------------------------------------------------@@ -713,7 +717,7 @@ -- | Check any balance assertions in the journal and return an error message -- if any of them fail (or if the transaction balancing they require fails). journalCheckBalanceAssertions :: Journal -> Maybe String-journalCheckBalanceAssertions = either Just (const Nothing) . journalBalanceTransactions True+journalCheckBalanceAssertions = either Just (const Nothing) . journalBalanceTransactions def  -- "Transaction balancing", including: inferring missing amounts, -- applying balance assignments, checking transaction balancedness,@@ -765,14 +769,14 @@ -- | Get this account's current exclusive running balance. getRunningBalanceB :: AccountName -> Balancing s MixedAmount getRunningBalanceB acc = withRunningBalance $ \BalancingState{bsBalances} -> do-  fromMaybe 0 <$> H.lookup bsBalances acc+  fromMaybe nullmixedamt <$> H.lookup bsBalances acc  -- | Add this amount to this account's exclusive running balance. -- Returns the new running balance. addToRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount addToRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances} -> do-  old <- fromMaybe 0 <$> H.lookup bsBalances acc-  let new = old + amt+  old <- fromMaybe nullmixedamt <$> H.lookup bsBalances acc+  let new = maPlus old amt   H.insert bsBalances acc new   return new @@ -780,9 +784,9 @@ -- Returns the change in exclusive running balance. setRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount setRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances} -> do-  old <- fromMaybe 0 <$> H.lookup bsBalances acc+  old <- fromMaybe nullmixedamt <$> H.lookup bsBalances acc   H.insert bsBalances acc amt-  return $ amt - old+  return $ maMinus amt old  -- | Set this account's exclusive running balance to whatever amount -- makes its *inclusive* running balance (the sum of exclusive running@@ -790,13 +794,13 @@ -- Returns the change in exclusive running balance. setInclusiveRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount setInclusiveRunningBalanceB acc newibal = withRunningBalance $ \BalancingState{bsBalances} -> do-  oldebal  <- fromMaybe 0 <$> H.lookup bsBalances acc+  oldebal  <- fromMaybe nullmixedamt <$> H.lookup bsBalances acc   allebals <- H.toList bsBalances   let subsibal =  -- sum of any subaccounts' running balances-        sum $ map snd $ filter ((acc `isAccountNamePrefixOf`).fst) allebals-  let newebal = newibal - subsibal+        maSum . map snd $ filter ((acc `isAccountNamePrefixOf`).fst) allebals+  let newebal = maMinus newibal subsibal   H.insert bsBalances acc newebal-  return $ newebal - oldebal+  return $ maMinus newebal oldebal  -- | Update (overwrite) this transaction in the balancing state. updateTransactionB :: Transaction -> Balancing s ()@@ -813,13 +817,14 @@ -- -- This does multiple things at once because amount inferring, balance -- assignments, balance assertions and posting dates are interdependent.-journalBalanceTransactions :: Bool -> Journal -> Either String Journal-journalBalanceTransactions assrt j' =+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+    bopts = bopts'{commodity_styles_=styles}     -- balance assignments will not be allowed on these     txnmodifieraccts = S.fromList $ map paccount $ concatMap tmpostingrules $ jtxnmodifiers j   in@@ -836,7 +841,7 @@         -- and leaving the others for later. The balanced ones are split into their postings.         -- The postings and not-yet-balanced transactions remain in the same relative order.         psandts :: [Either Posting Transaction] <- fmap concat $ forM ts $ \case-          t | null $ assignmentPostings t -> case balanceTransaction styles t of+          t | null $ assignmentPostings t -> case balanceTransaction bopts t of               Left  e  -> throwError e               Right t' -> do                 lift $ writeArray balancedtxns (tindex t') t'@@ -846,7 +851,7 @@         -- 2. Sort these items by date, preserving the order of same-day items,         -- and step through them while keeping running account balances,         runningbals <- lift $ H.newSized (length $ journalAccountNamesUsed j)-        flip runReaderT (BalancingState styles txnmodifieraccts assrt runningbals balancedtxns) $ do+        flip runReaderT (BalancingState styles txnmodifieraccts (not $ ignore_assertions_ bopts) runningbals balancedtxns) $ do           -- performing balance assignments in, and balancing, the remaining transactions,           -- and checking balance assertions as each posting is processed.           void $ mapM' balanceTransactionAndCheckAssertionsB $ sortOn (either postingDate tdate) psandts@@ -866,16 +871,16 @@ balanceTransactionAndCheckAssertionsB :: Either Posting Transaction -> Balancing s () balanceTransactionAndCheckAssertionsB (Left p@Posting{}) =   -- update the account's running balance and check the balance assertion if any-  void $ addAmountAndCheckAssertionB $ removePrices p+  void . addAmountAndCheckAssertionB $ postingStripPrices p balanceTransactionAndCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do   -- make sure we can handle the balance assignments   mapM_ checkIllegalBalanceAssignmentB ps   -- for each posting, infer its amount from the balance assignment if applicable,   -- update the account's running balance and check the balance assertion if any-  ps' <- forM ps $ \p -> pure (removePrices p) >>= addOrAssignAmountAndCheckAssertionB+  ps' <- mapM (addOrAssignAmountAndCheckAssertionB . postingStripPrices) ps   -- infer any remaining missing amounts, and make sure the transaction is now fully balanced   styles <- R.reader bsStyles-  case balanceTransactionHelper styles t{tpostings=ps'} of+  case balanceTransactionHelper balancingOpts{commodity_styles_=styles} t{tpostings=ps'} of     Left err -> throwError err     Right (t', inferredacctsandamts) -> do       -- for each amount just inferred, update the running balance@@ -897,21 +902,15 @@       return p    -- no explicit posting amount, but there is a balance assignment-  -- TODO this doesn't yet handle inclusive assignments right, #1207   | Just BalanceAssertion{baamount,batotal,bainclusive} <- mba = do-      (diff,newbal) <- case batotal of-        -- a total balance assignment (==, all commodities)-        True  -> do-          let newbal = Mixed [baamount]-          diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal-          return (diff,newbal)-        -- a partial balance assignment (=, one commodity)-        False -> do-          oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getRunningBalanceB acc-          let assignedbalthiscommodity = Mixed [baamount]-              newbal = oldbalothercommodities + assignedbalthiscommodity-          diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal-          return (diff,newbal)+      newbal <- if batotal+                   -- a total balance assignment (==, all commodities)+                   then return $ mixedAmount baamount+                   -- a partial balance assignment (=, one commodity)+                   else do+                     oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getRunningBalanceB acc+                     return $ maAddAmount oldbalothercommodities baamount+      diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal       let p' = p{pamount=diff, poriginal=Just $ originalPosting p}       whenM (R.reader bsAssrt) $ checkBalanceAssertionB p' newbal       return p'@@ -926,7 +925,7 @@ -- need to see the balance as it stands after each individual posting. addAmountAndCheckAssertionB :: Posting -> Balancing s Posting addAmountAndCheckAssertionB p | hasAmount p = do-  newbal <- addToRunningBalanceB (paccount p) (pamount p)+  newbal <- addToRunningBalanceB (paccount p) $ pamount p   whenM (R.reader bsAssrt) $ checkBalanceAssertionB p newbal   return p addAmountAndCheckAssertionB p = return p@@ -937,13 +936,12 @@ -- are ignored; if it is total, they will cause the assertion to fail. checkBalanceAssertionB :: Posting -> MixedAmount -> Balancing s () checkBalanceAssertionB p@Posting{pbalanceassertion=Just (BalanceAssertion{baamount,batotal})} actualbal =-  forM_ assertedamts $ \amt -> checkBalanceAssertionOneCommodityB p amt actualbal+    forM_ (baamount : otheramts) $ \amt -> checkBalanceAssertionOneCommodityB p amt actualbal   where-    assertedamts = baamount : otheramts-      where-        assertedcomm = acommodity baamount-        otheramts | batotal   = map (\a -> a{aquantity=0}) $ amounts $ filterMixedAmount ((/=assertedcomm).acommodity) actualbal-                  | otherwise = []+    assertedcomm = acommodity baamount+    otheramts | batotal   = map (\a -> a{aquantity=0}) . amountsRaw+                          $ filterMixedAmount ((/=assertedcomm).acommodity) actualbal+              | otherwise = [] checkBalanceAssertionB _ _ = return ()  -- | Does this (single commodity) expected balance match the amount of that@@ -961,14 +959,14 @@       -- sum the running balances of this account and any of its subaccounts seen so far       withRunningBalance $ \BalancingState{bsBalances} ->         H.foldM-          (\ibal (acc, amt) -> return $ ibal +-            if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc then amt else 0)-          0+          (\ibal (acc, amt) -> return $+            if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc then maPlus ibal amt else ibal)+          nullmixedamt           bsBalances     else return actualbal   let     assertedcomm    = acommodity assertedamt-    actualbalincomm = headDef 0 $ amounts $ filterMixedAmountByCommodity assertedcomm $ actualbal'+    actualbalincomm = headDef nullamt . amountsRaw . filterMixedAmountByCommodity assertedcomm $ actualbal'     pass =       aquantity         -- traceWith (("asserted:"++).showAmountDebug)@@ -1093,10 +1091,8 @@ -- "the format of the first amount, adjusted to the highest precision of all amounts". -- Can return an error message eg if inconsistent number formats are found. journalInferCommodityStyles :: Journal -> Either String Journal-journalInferCommodityStyles j = -  case-    commodityStylesFromAmounts $ journalStyleInfluencingAmounts j-  of+journalInferCommodityStyles j =+  case commodityStylesFromAmounts $ journalStyleInfluencingAmounts j of     Left e   -> Left e     Right cs -> Right j{jinferredcommodities = dbg7 "journalInferCommodityStyles" cs} @@ -1117,7 +1113,6 @@ -- | Given a list of amount styles (assumed to be from parsed amounts -- in a single commodity), in parse order, choose a canonical style. canonicalStyleFrom :: [AmountStyle] -> AmountStyle--- canonicalStyleFrom [] = amountstyle canonicalStyleFrom ss = foldl' canonicalStyle amountstyle ss  -- TODO: should probably detect and report inconsistencies here.@@ -1153,7 +1148,7 @@ --       fixtransaction t@Transaction{tdate=d, tpostings=ps} = t{tpostings=map fixposting ps} --        where --         fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}---         fixmixedamount (Mixed as) = Mixed $ map fixamount as+--         fixmixedamount = mapMixedAmount fixamount --         fixamount = fixprice --         fixprice a@Amount{price=Just _} = a --         fixprice a@Amount{commodity=c} = a{price=maybe Nothing (Just . UnitPrice) $ journalPriceDirectiveFor j d c}@@ -1181,16 +1176,16 @@ -- first commodity amount is considered. postingInferredmarketPrice :: Posting -> Maybe MarketPrice postingInferredmarketPrice p@Posting{pamount} =-  -- convert any total prices to unit prices-  case mixedAmountTotalPriceToUnitPrice pamount of-    Mixed ( Amount{acommodity=fromcomm, aprice = Just (UnitPrice Amount{acommodity=tocomm, aquantity=rate})} : _) ->-      Just MarketPrice {-         mpdate = postingDate p-        ,mpfrom = fromcomm-        ,mpto   = tocomm-        ,mprate = rate-        }-    _ -> Nothing+    -- convert any total prices to unit prices+    case amountsRaw $ mixedAmountTotalPriceToUnitPrice pamount of+      Amount{acommodity=fromcomm, aprice = Just (UnitPrice Amount{acommodity=tocomm, aquantity=rate})}:_ ->+        Just MarketPrice {+           mpdate = postingDate p+          ,mpfrom = fromcomm+          ,mpto   = tocomm+          ,mprate = rate+          }+      _ -> Nothing  -- | Convert all this journal's amounts to cost using the transaction prices, if any. -- The journal's commodity styles are applied to the resulting amounts.@@ -1229,12 +1224,12 @@ -- Transaction price amounts (posting amounts' aprice field) are not included. -- journalStyleInfluencingAmounts :: Journal -> [Amount]-journalStyleInfluencingAmounts j = +journalStyleInfluencingAmounts j =   dbg7 "journalStyleInfluencingAmounts" $   catMaybes $ concat [    [mdefaultcommodityamt]   ,map (Just . pdamount) $ jpricedirectives j-  ,map Just $ concatMap amounts $ map pamount $ journalPostings j+  ,map Just . concatMap (amountsRaw . pamount) $ journalPostings j   ]   where     -- D's amount style isn't actually stored as an amount, make it into one@@ -1410,7 +1405,7 @@ --     liabilities:debts  $1 --     assets:bank:checking ---Right samplejournal = journalBalanceTransactions False $+Right samplejournal = journalBalanceTransactions def $          nulljournal          {jtxns = [            txnTieKnot $ Transaction {@@ -1553,7 +1548,7 @@   ,tests "journalBalanceTransactions" [       test "balance-assignment" $ do-      let ej = journalBalanceTransactions True $+      let ej = journalBalanceTransactions def $             --2019/01/01             --  (a)            = 1             nulljournal{ jtxns = [@@ -1561,10 +1556,10 @@             ]}       assertRight ej       let Right j = ej-      (jtxns j & head & tpostings & head & pamount) @?= Mixed [num 1]+      (jtxns j & head & tpostings & head & pamount & amountsRaw) @?= [num 1]      ,test "same-day-1" $ do-      assertRight $ journalBalanceTransactions True $+      assertRight $ journalBalanceTransactions def $             --2019/01/01             --  (a)            = 1             --2019/01/01@@ -1575,7 +1570,7 @@             ]}      ,test "same-day-2" $ do-      assertRight $ journalBalanceTransactions True $+      assertRight $ journalBalanceTransactions def $             --2019/01/01             --    (a)                  2 = 2             --2019/01/01@@ -1593,7 +1588,7 @@             ]}      ,test "out-of-order" $ do-      assertRight $ journalBalanceTransactions True $+      assertRight $ journalBalanceTransactions def $             --2019/1/2             --  (a)    1 = 2             --2019/1/1

@@ -4,12 +4,12 @@  {-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE CPP                 #-} --{-# LANGUAGE DataKinds           #-} --{-# LANGUAGE DeriveAnyClass      #-} {-# LANGUAGE DeriveGeneric       #-} --{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE LambdaCase          #-} --{-# LANGUAGE NamedFieldPuns #-} --{-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE OverloadedStrings #-}@@ -33,15 +33,12 @@   ,readJsonFile ) where -#if !(MIN_VERSION_base(4,13,0))-import           Data.Semigroup ((<>))-#endif import           Data.Aeson import           Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder) --import           Data.Aeson.TH import qualified Data.ByteString.Lazy as BL-import           Data.Decimal-import           Data.Maybe+import           Data.Decimal (DecimalRaw(..), roundTo)+import           Data.Maybe (fromMaybe) import qualified Data.Text.Lazy    as TL import qualified Data.Text.Lazy.IO as TL import qualified Data.Text.Lazy.Builder as TB@@ -49,6 +46,7 @@ import           System.Time (ClockTime)  import           Hledger.Data.Types+import           Hledger.Data.Amount (amountsRaw, mixed)  -- To JSON @@ -79,41 +77,61 @@ -- and that the overall number of significant digits in the floating point -- remains manageable in practice. (I'm not sure how to limit the number -- of significant digits in a Decimal right now.)-instance ToJSON Decimal where-  toJSON d = object-    ["decimalPlaces"   .= toJSON decimalPlaces-    ,"decimalMantissa" .= toJSON decimalMantissa-    ,"floatingPoint"   .= toJSON (fromRational $ toRational d' :: Double)+instance (Integral a, ToJSON a) => ToJSON (DecimalRaw a) where+  toJSON = object . decimalKV+  toEncoding = pairs . mconcat . decimalKV++decimalKV :: (KeyValue kv, Integral a, ToJSON a) => DecimalRaw a -> [kv]+decimalKV d = let d' = if decimalPlaces d <= 10 then d else roundTo 10 d in+    [ "decimalPlaces"   .= decimalPlaces d'+    , "decimalMantissa" .= decimalMantissa d'+    , "floatingPoint"   .= (realToFrac d' :: Double)     ]-    where d'@Decimal{..} = roundTo 10 d  instance ToJSON Amount instance ToJSON AmountStyle-instance ToJSON AmountPrecision++-- Use the same JSON serialisation as Maybe Word8+instance ToJSON AmountPrecision where+  toJSON = toJSON . \case+    Precision n      -> Just n+    NaturalPrecision -> Nothing+  toEncoding = toEncoding . \case+    Precision n      -> Just n+    NaturalPrecision -> Nothing+ instance ToJSON Side instance ToJSON DigitGroupStyle-instance ToJSON MixedAmount++instance ToJSON MixedAmount where+  toJSON = toJSON . amountsRaw+  toEncoding = toEncoding . amountsRaw+ instance ToJSON BalanceAssertion instance ToJSON AmountPrice instance ToJSON MarketPrice instance ToJSON PostingType  instance ToJSON Posting where-  toJSON Posting{..} = object-    ["pdate"             .= pdate-    ,"pdate2"            .= pdate2-    ,"pstatus"           .= pstatus-    ,"paccount"          .= paccount-    ,"pamount"           .= pamount-    ,"pcomment"          .= pcomment-    ,"ptype"             .= ptype-    ,"ptags"             .= ptags-    ,"pbalanceassertion" .= pbalanceassertion+  toJSON = object . postingKV+  toEncoding = pairs . mconcat . postingKV++postingKV :: KeyValue kv => Posting -> [kv]+postingKV Posting{..} =+    [ "pdate"             .= pdate+    , "pdate2"            .= pdate2+    , "pstatus"           .= pstatus+    , "paccount"          .= paccount+    , "pamount"           .= pamount+    , "pcomment"          .= pcomment+    , "ptype"             .= ptype+    , "ptags"             .= ptags+    , "pbalanceassertion" .= pbalanceassertion     -- To avoid a cycle, show just the parent transaction's index number     -- in a dummy field. When re-parsed, there will be no parent.-    ,"ptransaction_"     .= maybe "" (show.tindex) ptransaction+    , "ptransaction_"     .= maybe "" (show.tindex) ptransaction     -- This is probably not wanted in json, we discard it.-    ,"poriginal"         .= (Nothing :: Maybe Posting)+    , "poriginal"         .= (Nothing :: Maybe Posting)     ]  instance ToJSON Transaction@@ -134,21 +152,25 @@ instance ToJSON Journal  instance ToJSON Account where-  toJSON a = object-    ["aname"        .= aname a-    ,"aebalance"    .= aebalance a-    ,"aibalance"    .= aibalance a-    ,"anumpostings" .= anumpostings a-    ,"aboring"      .= aboring a+  toJSON = object . accountKV+  toEncoding = pairs . mconcat . accountKV++accountKV :: KeyValue kv => Account -> [kv]+accountKV a =+    [ "aname"        .= aname 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])     ]  deriving instance Generic (Ledger)@@ -160,10 +182,17 @@ instance FromJSON GenericSourcePos instance FromJSON Amount instance FromJSON AmountStyle-instance FromJSON AmountPrecision++-- Use the same JSON serialisation as Maybe Word8+instance FromJSON AmountPrecision where+  parseJSON = fmap (maybe NaturalPrecision Precision) . parseJSON+ instance FromJSON Side instance FromJSON DigitGroupStyle-instance FromJSON MixedAmount++instance FromJSON MixedAmount where+  parseJSON = fmap (mixed :: [Amount] -> MixedAmount) . parseJSON+ instance FromJSON BalanceAssertion instance FromJSON AmountPrice instance FromJSON MarketPrice

@@ -31,9 +31,7 @@ import Hledger.Utils.Test import Hledger.Data.Types import Hledger.Data.Account-import Hledger.Data.Dates (daysSpan) import Hledger.Data.Journal-import Hledger.Data.Posting (postingDate) import Hledger.Query  @@ -94,7 +92,7 @@ -- | The (fully specified) date span containing all the ledger's (filtered) transactions, -- or DateSpan Nothing Nothing if there are none. ledgerDateSpan :: Ledger -> DateSpan-ledgerDateSpan = daysSpan . map postingDate . ledgerPostings+ledgerDateSpan = journalDateSpanBothDates . ljournal  -- | All commodities used in this ledger. ledgerCommodities :: Ledger -> [CommoditySymbol]

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-|@@ -12,9 +11,6 @@ ) where -#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif import qualified Data.Text as T import qualified Data.Text.IO as T import Text.Printf

@@ -9,7 +9,6 @@ -}  {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}  module Hledger.Data.Posting (   -- * Posting@@ -37,7 +36,7 @@   postingAllTags,   transactionAllTags,   relatedPostings,-  removePrices,+  postingStripPrices,   postingApplyAliases,   -- * date operations   postingDate,@@ -64,7 +63,6 @@   -- * misc.   showComment,   postingTransformAmount,-  postingApplyCostValuation,   postingApplyValuation,   postingToCost,   tests_Posting@@ -75,21 +73,19 @@ import Data.Foldable (asum) import Data.List.Extra (nubSort) import qualified Data.Map as M-import Data.Maybe+import Data.Maybe (fromMaybe, isJust) import Data.MemoUgly (memo)-#if !(MIN_VERSION_base(4,11,0))-import Data.Monoid-#endif+import Data.List (foldl') import Data.Text (Text) import qualified Data.Text as T-import Data.Time.Calendar-import Safe+import Data.Time.Calendar (Day)+import Safe (headDef)  import Hledger.Utils import Hledger.Data.Types import Hledger.Data.Amount import Hledger.Data.AccountName-import Hledger.Data.Dates (nulldate, spanContainsDate)+import Hledger.Data.Dates (nulldate, showDate, spanContainsDate) import Hledger.Data.Valuation  @@ -114,7 +110,7 @@  -- | Make a posting to an account. post :: AccountName -> Amount -> Posting-post acc amt = posting {paccount=acc, pamount=Mixed [amt]}+post acc amt = posting {paccount=acc, pamount=mixedAmount amt}  -- | Make a virtual (unbalanced) posting to an account. vpost :: AccountName -> Amount -> Posting@@ -122,7 +118,7 @@  -- | Make a posting to an account, maybe with a balance assertion. post' :: AccountName -> Amount -> Maybe BalanceAssertion -> Posting-post' acc amt ass = posting {paccount=acc, pamount=Mixed [amt], pbalanceassertion=ass}+post' acc amt ass = posting {paccount=acc, pamount=mixedAmount amt, pbalanceassertion=ass}  -- | Make a virtual (unbalanced) posting to an account, maybe with a balance assertion. vpost' :: AccountName -> Amount -> Maybe BalanceAssertion -> Posting@@ -162,16 +158,16 @@ -- XXX once rendered user output, but just for debugging now; clean up showPosting :: Posting -> String showPosting p@Posting{paccount=a,pamount=amt,ptype=t} =-    unlines $ [concatTopPadded [show (postingDate p) ++ " ", showaccountname a ++ " ", showamount amt, T.unpack . showComment $ pcomment p]]-    where-      ledger3ishlayout = False-      acctnamewidth = if ledger3ishlayout then 25 else 22-      showaccountname = T.unpack . fitText (Just acctnamewidth) Nothing False False . bracket . elideAccountName width-      (bracket,width) = case t of-                          BalancedVirtualPosting -> (wrap "[" "]", acctnamewidth-2)-                          VirtualPosting         -> (wrap "(" ")", acctnamewidth-2)-                          _                      -> (id,acctnamewidth)-      showamount = wbUnpack . showMixedAmountB noColour{displayMinWidth=Just 12}+    T.unpack $ textConcatTopPadded [showDate (postingDate p) <> " ", showaccountname a <> " ", showamt, showComment $ pcomment p]+  where+    ledger3ishlayout = False+    acctnamewidth = if ledger3ishlayout then 25 else 22+    showaccountname = fitText (Just acctnamewidth) Nothing False False . bracket . elideAccountName width+    (bracket,width) = case t of+                        BalancedVirtualPosting -> (wrap "[" "]", acctnamewidth-2)+                        VirtualPosting         -> (wrap "(" ")", acctnamewidth-2)+                        _                      -> (id,acctnamewidth)+    showamt = wbToText $ showMixedAmountB noColour{displayMinWidth=Just 12} amt   showComment :: Text -> Text@@ -196,13 +192,13 @@ accountNamesFromPostings :: [Posting] -> [AccountName] accountNamesFromPostings = nubSort . map paccount +-- | Sum all amounts from a list of postings. sumPostings :: [Posting] -> MixedAmount-sumPostings = sumStrict . map pamount+sumPostings = foldl' (\amt p -> maPlus amt $ pamount p) nullmixedamt --- | Remove all prices of a posting-removePrices :: Posting -> Posting-removePrices p = p{ pamount = Mixed $ remove <$> amounts (pamount p) }-  where remove a = a { aprice = Nothing }+-- | Strip all prices from a Posting.+postingStripPrices :: Posting -> Posting+postingStripPrices = postingTransformAmount mixedAmountStripPrices  -- | Get a posting's (primary) date - it's own primary date if specified, -- otherwise the parent transaction's primary date, or the null date if@@ -330,14 +326,6 @@   | otherwise = Right a aliasReplace (RegexAlias re repl) a =   fmap T.pack . regexReplace re repl $ T.unpack a -- XXX---- | Apply a specified costing and valuation to this posting's amount,--- using the provided price oracle, commodity styles, and reference dates.--- Costing is done first if requested, and after that any valuation.--- See amountApplyValuation and amountCost.-postingApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Costing -> Maybe ValuationType -> Posting -> Posting-postingApplyCostValuation priceoracle styles periodlast today cost v p =-    postingTransformAmount (mixedAmountApplyCostValuation priceoracle styles periodlast today (postingDate p) cost v) p  -- | Apply a specified valuation to this posting's amount, using the -- provided price oracle, commodity styles, and reference dates.

@@ -6,7 +6,6 @@  -} -{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-}  module Hledger.Data.Timeclock (@@ -16,10 +15,6 @@ where  import Data.Maybe (fromMaybe)-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif--- import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar (addDays) import Data.Time.Clock (addUTCTime, getCurrentTime)@@ -121,7 +116,11 @@       showtime = take 5 . show       hours    = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc       acctname = tlaccount i-      amount   = Mixed [hrs hours]+      -- Generate an hours amount. Unusually, we also round the internal Decimal value,+      -- since otherwise it will often have large recurring decimal parts which (since 1.21)+      -- print would display all 255 digits of. timeclock amounts have one second resolution,+      -- so two decimal places is precise enough (#1527).+      amount   = mixedAmount $ setAmountInternalPrecision 2 $ hrs hours       ps       = [posting{paccount=acctname, pamount=amount, ptype=VirtualPosting, ptransaction=Just t}]  

@@ -7,7 +7,6 @@  -} -{-# LANGUAGE CPP               #-} {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE LambdaCase        #-} {-# LANGUAGE OverloadedStrings #-}@@ -29,11 +28,12 @@   virtualPostings,   balancedVirtualPostings,   transactionsPostings,+  BalancingOpts(..),+  balancingOpts,   isTransactionBalanced,   balanceTransaction,   balanceTransactionHelper,   transactionTransformPostings,-  transactionApplyCostValuation,   transactionApplyValuation,   transactionToCost,   transactionApplyAliases,@@ -62,19 +62,18 @@ ) where -import Data.Default (def)+import Data.Default (Default(..))+import Data.Foldable (asum) import Data.List (intercalate, partition) import Data.List.Extra (nubSort)-import Data.Maybe (fromMaybe, mapMaybe)-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif+import Data.Maybe (fromMaybe, isNothing, mapMaybe) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import Data.Time.Calendar (Day, fromGregorian) import qualified Data.Map as M+import Safe (maximumDef)  import Hledger.Utils import Hledger.Data.Types@@ -82,7 +81,6 @@ import Hledger.Data.Posting import Hledger.Data.Amount import Hledger.Data.Valuation-import Text.Tabular import Text.Tabular.AsciiWide  sourceFilePath :: GenericSourcePos -> FilePath@@ -218,9 +216,12 @@ -- -- Posting amounts will be aligned with each other, starting about 4 columns -- beyond the widest account name (see postingAsLines for details).--- postingsAsLines :: Bool -> [Posting] -> [Text]-postingsAsLines onelineamounts ps = concatMap (postingAsLines False onelineamounts ps) ps+postingsAsLines onelineamounts ps = concatMap first3 linesWithWidths+  where+    linesWithWidths = map (postingAsLines False onelineamounts maxacctwidth maxamtwidth) ps+    maxacctwidth = maximumDef 0 $ map second3 linesWithWidths+    maxamtwidth  = maximumDef 0 $ map third3 linesWithWidths  -- | Render one posting, on one or more lines, suitable for `print` output. -- There will be an indented account name, plus one or more of status flag,@@ -241,9 +242,10 @@ -- increased if needed to match the posting with the longest account name. -- This is used to align the amounts of a transaction's postings. ---postingAsLines :: Bool -> Bool -> [Posting] -> Posting -> [Text]-postingAsLines elideamount onelineamounts pstoalignwith p =-    concatMap (++ newlinecomments) postingblocks+-- Also returns the account width and amount width used.+postingAsLines :: Bool -> Bool -> Int -> Int -> Posting -> ([Text], Int, Int)+postingAsLines elideamount onelineamounts 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@@ -253,30 +255,34 @@     postingblocks = [map T.stripEnd . T.lines . TL.toStrict $                        render [ textCell BottomLeft statusandaccount                               , textCell BottomLeft "  "-                              , Cell BottomLeft [amt]+                              , Cell BottomLeft [pad amt]                               , Cell BottomLeft [assertion]                               , textCell BottomLeft samelinecomment                               ]                     | amt <- shownAmounts]     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+     assertion = maybe mempty ((WideBuilder (TB.singleton ' ') 1 <>).showBalanceAssertion) $ pbalanceassertion p-    statusandaccount = lineIndent . fitText (Just $ minwidth) Nothing False True $ pstatusandacct p-      where-        -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned-        minwidth = maximum $ map ((2+) . textWidth . pacctstr) pstoalignwith-        pstatusandacct p' = pstatusprefix p' <> pacctstr p'-        pstatusprefix p' = case pstatus p' of-            Unmarked -> ""-            s        -> T.pack (show s) <> " "-        pacctstr p' = showAccountName Nothing (ptype p') (paccount 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 = textWidth $ pacctstr p +    pacctstr p' = showAccountName Nothing (ptype p') (paccount p')+    pstatusandacct p' = pstatusprefix p' <> pacctstr p'+    pstatusprefix p' = case pstatus p' of+        Unmarked -> ""+        s        -> T.pack (show s) <> " "+     -- 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 || null (amounts $ pamount p) = [mempty]-      | otherwise = showMixedAmountLinesB displayopts $ pamount p-      where-        displayopts = noColour{displayOneLine=onelineamounts, displayMinWidth = Just amtwidth, displayNormalised=False}-        amtwidth = maximum $ 12 : map (wbWidth . showMixedAmountB displayopts{displayMinWidth=Nothing} . pamount) pstoalignwith  -- min. 12 for backwards compatibility+      | elideamount = [mempty]+      | otherwise   = showMixedAmountLinesB noColour{displayOneLine=onelineamounts} $ pamount p+    thisamtwidth = maximumDef 0 $ map wbWidth shownAmounts      (samelinecomment, newlinecomments) =       case renderCommentLines (pcomment p) of []   -> ("",[])@@ -306,9 +312,11 @@ -- | Render a posting, at the appropriate width for aligning with -- its siblings if any. Used by the rewrite command. showPostingLines :: Posting -> [Text]-showPostingLines p = postingAsLines False False ps p where-    ps | Just t <- ptransaction p = tpostings t-       | otherwise = [p]+showPostingLines p = first3 $ postingAsLines False False maxacctwidth maxamtwidth p+  where+    linesWithWidths = map (postingAsLines False False maxacctwidth maxamtwidth) . maybe [p] tpostings $ ptransaction p+    maxacctwidth = maximumDef 0 $ map second3 linesWithWidths+    maxamtwidth  = maximumDef 0 $ map third3 linesWithWidths  -- | Prepend a suitable indent for a posting (or transaction/posting comment) line. lineIndent :: Text -> Text@@ -345,6 +353,21 @@ transactionsPostings :: [Transaction] -> [Posting] transactionsPostings = concatMap tpostings +data BalancingOpts = BalancingOpts+  { ignore_assertions_ :: Bool  -- ^ Ignore balance assertions+  , infer_prices_      :: Bool  -- ^ Infer prices in unbalanced multicommodity amounts+  , commodity_styles_  :: Maybe (M.Map CommoditySymbol AmountStyle)  -- ^ commodity display styles+  } deriving (Show)++instance Default BalancingOpts where def = balancingOpts++balancingOpts :: BalancingOpts+balancingOpts = BalancingOpts+  { ignore_assertions_ = False+  , infer_prices_      = True+  , commodity_styles_  = Nothing+  }+ -- | Check that this transaction would appear balanced to a human when displayed. -- On success, returns the empty list, otherwise one or more error messages. --@@ -362,13 +385,13 @@ -- 3. Does the amounts' sum appear non-zero when displayed ? --    (using the given display styles if provided) ---transactionCheckBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> [String]-transactionCheckBalanced mstyles t = errs+transactionCheckBalanced :: BalancingOpts -> Transaction -> [String]+transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs   where     (rps, bvps) = (realPostings t, balancedVirtualPostings t)      -- check for mixed signs, detecting nonzeros at display precision-    canonicalise = maybe id canonicaliseMixedAmount mstyles+    canonicalise = maybe id canonicaliseMixedAmount commodity_styles_     signsOk ps =       case filter (not.mixedAmountLooksZero) $ map (canonicalise.mixedAmountCost.pamount) ps of         nonzeros | length nonzeros >= 2@@ -395,8 +418,8 @@           | otherwise     = ""  -- | Legacy form of transactionCheckBalanced.-isTransactionBalanced :: Maybe (M.Map CommoditySymbol AmountStyle) -> Transaction -> Bool-isTransactionBalanced mstyles = null . transactionCheckBalanced mstyles+isTransactionBalanced :: BalancingOpts -> Transaction -> Bool+isTransactionBalanced bopts = null . transactionCheckBalanced bopts  -- | Balance this transaction, ensuring that its postings -- (and its balanced virtual postings) sum to 0,@@ -412,22 +435,22 @@ -- if provided, so that the result agrees with the numbers users can see. -- balanceTransaction ::-     Maybe (M.Map CommoditySymbol AmountStyle)  -- ^ commodity display styles+     BalancingOpts   -> Transaction   -> Either String Transaction-balanceTransaction mstyles = fmap fst . balanceTransactionHelper mstyles+balanceTransaction bopts = fmap fst . balanceTransactionHelper bopts  -- | Helper used by balanceTransaction and balanceTransactionWithBalanceAssignmentAndCheckAssertionsB; -- use one of those instead. It also returns a list of accounts -- and amounts that were inferred. balanceTransactionHelper ::-     Maybe (M.Map CommoditySymbol AmountStyle)  -- ^ commodity display styles+     BalancingOpts   -> Transaction   -> Either String (Transaction, [(AccountName, MixedAmount)])-balanceTransactionHelper mstyles t = do-  (t', inferredamtsandaccts) <--    inferBalancingAmount (fromMaybe M.empty mstyles) $ inferBalancingPrices t-  case transactionCheckBalanced mstyles t' of+balanceTransactionHelper bopts t = do+  (t', inferredamtsandaccts) <- inferBalancingAmount (fromMaybe M.empty $ commodity_styles_ bopts) $+    if infer_prices_ bopts then inferBalancingPrices t else t+  case transactionCheckBalanced bopts t' of     []   -> Right (txnTieKnot t', inferredamtsandaccts)     errs -> Left $ transactionBalanceError t' errs @@ -471,9 +494,9 @@         in Right (t{tpostings=map fst psandinferredamts}, inferredacctsandamts)   where     (amountfulrealps, amountlessrealps) = partition hasAmount (realPostings t)-    realsum = sumStrict $ map pamount amountfulrealps+    realsum = sumPostings amountfulrealps     (amountfulbvps, amountlessbvps) = partition hasAmount (balancedVirtualPostings t)-    bvsum = sumStrict $ map pamount amountfulbvps+    bvsum = sumPostings amountfulbvps      inferamount :: Posting -> (Posting, Maybe MixedAmount)     inferamount p =@@ -490,7 +513,7 @@               -- Inferred amounts are converted to cost.               -- Also ensure the new amount has the standard style for its commodity               -- (since the main amount styling pass happened before this balancing pass);-              a' = styleMixedAmount styles $ normaliseMixedAmount $ mixedAmountCost (-a)+              a' = styleMixedAmount styles . mixedAmountCost $ maNegate a  -- | Infer prices for this transaction's posting amounts, if needed to make -- the postings balance, and if possible. This is done once for the real@@ -537,42 +560,50 @@  -- | Generate a posting update function which assigns a suitable balancing -- price to the posting, if and as appropriate for the given transaction and--- posting type (real or balanced virtual).+-- posting type (real or balanced virtual). If we cannot or should not infer+-- prices, just act as the identity on postings. priceInferrerFor :: Transaction -> PostingType -> (Posting -> Posting)-priceInferrerFor t pt = inferprice+priceInferrerFor t pt = maybe id inferprice inferFromAndTo   where-    postings       = filter ((==pt).ptype) $ tpostings t-    pmixedamounts  = map pamount postings-    pamounts       = concatMap amounts pmixedamounts-    pcommodities   = map acommodity pamounts-    sumamounts     = amounts $ sumStrict pmixedamounts -- sum normalises to one amount per commodity & price-    sumcommodities = map acommodity sumamounts-    sumprices      = filter (/=Nothing) $ map aprice sumamounts-    caninferprices = length sumcommodities == 2 && null sumprices+    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 -    inferprice p@Posting{pamount=Mixed [a]}-      | caninferprices && ptype p == pt && acommodity a == fromcommodity-        = p{pamount=Mixed [a{aprice=Just conversionprice}], poriginal=Just $ originalPosting p}+    -- We can infer prices if there are no prices given, exactly two commodities in the normalised+    -- sum of postings in this transaction, and these two have opposite signs. The amount we are+    -- converting from is the first commodity to appear in the ordered list of postings, and the+    -- commodity we are converting to is the other. If we cannot infer prices, return Nothing.+    inferFromAndTo = case sumamounts of+      [a,b] | noprices, oppositesigns -> asum $ map orderIfMatches pcommodities+        where+          noprices      = all (isNothing . aprice) sumamounts+          oppositesigns = signum (aquantity a) /= signum (aquantity b)+          orderIfMatches x | x == acommodity a = Just (a,b)+                           | x == acommodity b = Just (b,a)+                           | otherwise         = Nothing+      _ -> Nothing++    -- For each posting, if the posting type matches, there is only a single amount in the posting,+    -- and the commodity of the amount matches the amount we're converting from,+    -- then set its price based on the ratio between fromamount and toamount.+    inferprice (fromamount, toamount) posting+        | [a] <- amounts (pamount posting), ptype posting == pt, acommodity a == acommodity fromamount+            = posting{ pamount   = mixedAmount a{aprice=Just conversionprice}+                     , poriginal = Just $ originalPosting posting }+        | otherwise = posting       where-        fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe-        totalpricesign = if aquantity a < 0 then negate else id-        conversionprice-          | fromcount==1 = TotalPrice $ totalpricesign (abs toamount) `withPrecision` NaturalPrecision-          | otherwise    = UnitPrice $ abs unitprice `withPrecision` unitprecision-          where-            fromcount     = length $ filter ((==fromcommodity).acommodity) pamounts-            fromamount    = head $ filter ((==fromcommodity).acommodity) sumamounts-            fromprecision = asprecision $ astyle fromamount-            tocommodity   = head $ filter (/=fromcommodity) sumcommodities-            toamount      = head $ filter ((==tocommodity).acommodity) sumamounts-            toprecision   = asprecision $ astyle toamount-            unitprice     = (aquantity fromamount) `divideAmount` toamount-            -- Sum two display precisions, capping the result at the maximum bound-            unitprecision = case (fromprecision, toprecision) of-                (Precision a, Precision b) -> Precision $ if maxBound - a < b then maxBound else max 2 (a + b)-                _                          -> NaturalPrecision-    inferprice p = p+        -- If only one Amount in the posting list matches fromamount we can use TotalPrice.+        -- Otherwise divide the conversion equally among the Amounts by using a unit price.+        conversionprice = case filter (== acommodity fromamount) pcommodities of+            [_] -> TotalPrice $ negate toamount+            _   -> UnitPrice  $ negate unitprice `withPrecision` unitprecision +        unitprice     = aquantity fromamount `divideAmount` toamount+        unitprecision = case (asprecision $ astyle fromamount, asprecision $ astyle toamount) of+            (Precision a, Precision b) -> Precision . max 2 $ saturatedAdd a b+            _                          -> NaturalPrecision+        saturatedAdd a b = if maxBound - a < b then maxBound else a + b+ -- Get a transaction's secondary date, defaulting to the primary date. transactionDate2 :: Transaction -> Day transactionDate2 t = fromMaybe (tdate t) $ tdate2 t@@ -596,13 +627,6 @@ transactionTransformPostings :: (Posting -> Posting) -> Transaction -> Transaction transactionTransformPostings f t@Transaction{tpostings=ps} = t{tpostings=map f ps} --- | Apply a specified costing and valuation to this transaction's amounts,--- using the provided price oracle, commodity styles, and reference dates.--- See amountApplyValuation and amountCost.-transactionApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Costing -> Maybe ValuationType -> Transaction -> Transaction-transactionApplyCostValuation priceoracle styles periodlast today cost v =-  transactionTransformPostings (postingApplyCostValuation priceoracle styles periodlast today cost v)- -- | Apply a specified valuation to this transaction's amounts, using -- the provided price oracle, commodity styles, and reference dates. -- See amountApplyValuation.@@ -612,7 +636,7 @@  -- | Convert this transaction's amounts to cost, and apply the appropriate amount styles. transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction-transactionToCost styles t@Transaction{tpostings=ps} = t{tpostings=map (postingToCost styles) ps}+transactionToCost styles = transactionTransformPostings (postingToCost styles)  -- | Apply some account aliases to all posting account names in the transaction, as described by accountNameApplyAliases. -- This can fail due to a bad replacement pattern in a regular expression alias.@@ -627,8 +651,8 @@ transactionMapPostings f t@Transaction{tpostings=ps} = t{tpostings=map f ps}  -- | Apply a transformation to a transaction's posting amounts.-transactionMapPostingAmounts :: (Amount -> Amount) -> Transaction -> Transaction-transactionMapPostingAmounts f  = transactionMapPostings (postingTransformAmount (mapMixedAmount f))+transactionMapPostingAmounts :: (MixedAmount -> MixedAmount) -> Transaction -> Transaction+transactionMapPostingAmounts f  = transactionMapPostings (postingTransformAmount f)  -- | The file path from which this transaction was parsed. transactionFile :: Transaction -> FilePath@@ -643,19 +667,19 @@ tests_Transaction =   tests "Transaction" [ -      tests "postingAsLines" [-          test "null posting" $ postingAsLines False False [posting] posting @?= [""]+      tests "showPostingLines" [+          test "null posting" $ showPostingLines nullposting @?= ["                   0"]         , test "non-null posting" $            let p =                 posting                   { pstatus = Cleared                   , paccount = "a"-                  , pamount = Mixed [usd 1, hrs 2]+                  , pamount = mixed [usd 1, hrs 2]                   , pcomment = "pcomment1\npcomment2\n  tag3: val3  \n"                   , ptype = RegularPosting                   , ptags = [("ptag1", "val1"), ("ptag2", "val2")]                   }-           in postingAsLines False False [p] p @?=+           in showPostingLines p @?=               [ "    * a         $1.00  ; pcomment1"               , "    ; pcomment2"               , "    ;   tag3: val3  "@@ -731,7 +755,7 @@                   [ nullposting                       { pstatus = Cleared                       , paccount = "a"-                      , pamount = Mixed [usd 1, hrs 2]+                      , pamount = mixed [usd 1, hrs 2]                       , pcomment = "\npcomment2\n"                       , ptype = RegularPosting                       , ptags = [("ptag1", "val1"), ("ptag2", "val2")]@@ -760,8 +784,8 @@                    "coopportunity"                    ""                    []-                   [ posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18], ptransaction = Just t}-                   , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.18)], ptransaction = Just t}+                   [ posting {paccount = "expenses:food:groceries", pamount = mixedAmount (usd 47.18), ptransaction = Just t}+                   , posting {paccount = "assets:checking", pamount = mixedAmount (usd (-47.18)), ptransaction = Just t}                    ]             in showTransaction t) @?=           (T.unlines@@ -784,8 +808,8 @@                 "coopportunity"                 ""                 []-                [ posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18]}-                , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.19)]}+                [ posting {paccount = "expenses:food:groceries", pamount = mixedAmount (usd 47.18)}+                , posting {paccount = "assets:checking", pamount = mixedAmount (usd (-47.19))}                 ])) @?=           (T.unlines              [ "2007-01-28 coopportunity"@@ -823,7 +847,7 @@                 "x"                 ""                 []-                [ posting {paccount = "a", pamount = Mixed [num 1 `at` (usd 2 `withPrecision` Precision 0)]}+                [ posting {paccount = "a", pamount = mixedAmount $ num 1 `at` (usd 2 `withPrecision` Precision 0)}                 , posting {paccount = "b", pamount = missingmixedamt}                 ])) @?=           (T.unlines ["2010-01-01 x", "    a          1 @ $2", "    b", ""])@@ -831,8 +855,7 @@     , tests "balanceTransaction" [          test "detect unbalanced entry, sign error" $           assertLeft-            (balanceTransaction-               Nothing+            (balanceTransaction def                (Transaction                   0                   ""@@ -844,11 +867,10 @@                   "test"                   ""                   []-                  [posting {paccount = "a", pamount = Mixed [usd 1]}, posting {paccount = "b", pamount = Mixed [usd 1]}]))+                  [posting {paccount = "a", pamount = mixedAmount (usd 1)}, posting {paccount = "b", pamount = mixedAmount (usd 1)}]))         ,test "detect unbalanced entry, multiple missing amounts" $           assertLeft $-             balanceTransaction-               Nothing+             balanceTransaction def                (Transaction                   0                   ""@@ -865,8 +887,7 @@                   ])         ,test "one missing amount is inferred" $           (pamount . last . tpostings <$>-           balanceTransaction-             Nothing+           balanceTransaction def              (Transaction                 0                 ""@@ -878,12 +899,11 @@                 ""                 ""                 []-                [posting {paccount = "a", pamount = Mixed [usd 1]}, posting {paccount = "b", pamount = missingmixedamt}])) @?=-          Right (Mixed [usd (-1)])+                [posting {paccount = "a", pamount = mixedAmount (usd 1)}, posting {paccount = "b", pamount = missingmixedamt}])) @?=+          Right (mixedAmount $ usd (-1))         ,test "conversion price is inferred" $           (pamount . head . tpostings <$>-           balanceTransaction-             Nothing+           balanceTransaction def              (Transaction                 0                 ""@@ -895,14 +915,13 @@                 ""                 ""                 []-                [ posting {paccount = "a", pamount = Mixed [usd 1.35]}-                , posting {paccount = "b", pamount = Mixed [eur (-1)]}+                [ posting {paccount = "a", pamount = mixedAmount (usd 1.35)}+                , posting {paccount = "b", pamount = mixedAmount (eur (-1))}                 ])) @?=-          Right (Mixed [usd 1.35 @@ (eur 1 `withPrecision` NaturalPrecision)])+          Right (mixedAmount $ usd 1.35 @@ eur 1)         ,test "balanceTransaction balances based on cost if there are unit prices" $           assertRight $-          balanceTransaction-            Nothing+          balanceTransaction def             (Transaction                0                ""@@ -914,13 +933,12 @@                ""                ""                []-               [ posting {paccount = "a", pamount = Mixed [usd 1 `at` eur 2]}-               , posting {paccount = "a", pamount = Mixed [usd (-2) `at` eur 1]}+               [ posting {paccount = "a", pamount = mixedAmount $ usd 1 `at` eur 2}+               , posting {paccount = "a", pamount = mixedAmount $ usd (-2) `at` eur 1}                ])         ,test "balanceTransaction balances based on cost if there are total prices" $           assertRight $-          balanceTransaction-            Nothing+          balanceTransaction def             (Transaction                0                ""@@ -932,14 +950,14 @@                ""                ""                []-               [ posting {paccount = "a", pamount = Mixed [usd 1 @@ eur 1]}-               , posting {paccount = "a", pamount = Mixed [usd (-2) @@ eur (-1)]}+               [ posting {paccount = "a", pamount = mixedAmount $ usd 1 @@ eur 1}+               , posting {paccount = "a", pamount = mixedAmount $ usd (-2) @@ eur (-1)}                ])         ]     , tests "isTransactionBalanced" [          test "detect balanced" $           assertBool "" $-          isTransactionBalanced Nothing $+          isTransactionBalanced def $           Transaction             0             ""@@ -951,13 +969,13 @@             "a"             ""             []-            [ posting {paccount = "b", pamount = Mixed [usd 1.00]}-            , posting {paccount = "c", pamount = Mixed [usd (-1.00)]}+            [ posting {paccount = "b", pamount = mixedAmount (usd 1.00)}+            , posting {paccount = "c", pamount = mixedAmount (usd (-1.00))}             ]         ,test "detect unbalanced" $           assertBool "" $           not $-          isTransactionBalanced Nothing $+          isTransactionBalanced def $           Transaction             0             ""@@ -969,13 +987,13 @@             "a"             ""             []-            [ posting {paccount = "b", pamount = Mixed [usd 1.00]}-            , posting {paccount = "c", pamount = Mixed [usd (-1.01)]}+            [ posting {paccount = "b", pamount = mixedAmount (usd 1.00)}+            , posting {paccount = "c", pamount = mixedAmount (usd (-1.01))}             ]         ,test "detect unbalanced, one posting" $           assertBool "" $           not $-          isTransactionBalanced Nothing $+          isTransactionBalanced def $           Transaction             0             ""@@ -987,10 +1005,10 @@             "a"             ""             []-            [posting {paccount = "b", pamount = Mixed [usd 1.00]}]+            [posting {paccount = "b", pamount = mixedAmount (usd 1.00)}]         ,test "one zero posting is considered balanced for now" $           assertBool "" $-          isTransactionBalanced Nothing $+          isTransactionBalanced def $           Transaction             0             ""@@ -1002,10 +1020,10 @@             "a"             ""             []-            [posting {paccount = "b", pamount = Mixed [usd 0]}]+            [posting {paccount = "b", pamount = mixedAmount (usd 0)}]         ,test "virtual postings don't need to balance" $           assertBool "" $-          isTransactionBalanced Nothing $+          isTransactionBalanced def $           Transaction             0             ""@@ -1017,14 +1035,14 @@             "a"             ""             []-            [ posting {paccount = "b", pamount = Mixed [usd 1.00]}-            , posting {paccount = "c", pamount = Mixed [usd (-1.00)]}-            , posting {paccount = "d", pamount = Mixed [usd 100], ptype = VirtualPosting}+            [ posting {paccount = "b", pamount = mixedAmount (usd 1.00)}+            , posting {paccount = "c", pamount = mixedAmount (usd (-1.00))}+            , posting {paccount = "d", pamount = mixedAmount (usd 100), ptype = VirtualPosting}             ]         ,test "balanced virtual postings need to balance among themselves" $           assertBool "" $           not $-          isTransactionBalanced Nothing $+          isTransactionBalanced def $           Transaction             0             ""@@ -1036,13 +1054,13 @@             "a"             ""             []-            [ posting {paccount = "b", pamount = Mixed [usd 1.00]}-            , posting {paccount = "c", pamount = Mixed [usd (-1.00)]}-            , posting {paccount = "d", pamount = Mixed [usd 100], ptype = BalancedVirtualPosting}+            [ posting {paccount = "b", pamount = mixedAmount (usd 1.00)}+            , posting {paccount = "c", pamount = mixedAmount (usd (-1.00))}+            , posting {paccount = "d", pamount = mixedAmount (usd 100), ptype = BalancedVirtualPosting}             ]         ,test "balanced virtual postings need to balance among themselves (2)" $           assertBool "" $-          isTransactionBalanced Nothing $+          isTransactionBalanced def $           Transaction             0             ""@@ -1054,10 +1072,10 @@             "a"             ""             []-            [ posting {paccount = "b", pamount = Mixed [usd 1.00]}-            , posting {paccount = "c", pamount = Mixed [usd (-1.00)]}-            , posting {paccount = "d", pamount = Mixed [usd 100], ptype = BalancedVirtualPosting}-            , posting {paccount = "3", pamount = Mixed [usd (-100)], ptype = BalancedVirtualPosting}+            [ posting {paccount = "b", pamount = mixedAmount (usd 1.00)}+            , posting {paccount = "c", pamount = mixedAmount (usd (-1.00))}+            , posting {paccount = "d", pamount = mixedAmount (usd 100), ptype = BalancedVirtualPosting}+            , posting {paccount = "3", pamount = mixedAmount (usd (-100)), ptype = BalancedVirtualPosting}             ]         ]     ]

@@ -1,7 +1,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE CPP #-} {-|  A 'TransactionModifier' is a rule that modifies certain 'Transaction's,@@ -13,20 +12,18 @@ ) where -import Control.Applicative ((<|>))-import Data.Maybe-#if !(MIN_VERSION_base(4,11,0))-import Data.Monoid ((<>))-#endif+import Control.Applicative ((<|>), liftA2)+import Data.Maybe (catMaybes) import qualified Data.Text as T-import Data.Time.Calendar+import Data.Time.Calendar (Day) import Hledger.Data.Types import Hledger.Data.Dates import Hledger.Data.Amount-import Hledger.Data.Transaction-import Hledger.Query+import Hledger.Data.Transaction (txnTieKnot)+import Hledger.Query (Query, filterQuery, matchesAmount, matchesPosting,+                      parseQuery, queryIsAmt, queryIsSym, simplifyQuery) import Hledger.Data.Posting (commentJoin, commentAddTag)-import Hledger.Utils+import Hledger.Utils (dbg6, wrap)  -- $setup -- >>> :set -XOverloadedStrings@@ -61,8 +58,8 @@ -- Currently the only kind of modification possible is adding automated -- postings when certain other postings are present. ----- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]} -- >>> import qualified Data.Text.IO as T+-- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]} -- >>> test = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction nulldate -- >>> test $ TransactionModifier "" ["pong" `post` usd 2] -- 0000-01-01@@ -83,9 +80,8 @@ transactionModifierToFunction refdate TransactionModifier{tmquerytxt, tmpostingrules} = do   q <- simplifyQuery . fst <$> parseQuery refdate tmquerytxt   let-    fs = map (tmPostingRuleToFunction tmquerytxt) tmpostingrules-    generatePostings ps = [p' | p <- ps-                              , p' <- if q `matchesPosting` p then p:[f p | f <- fs] else [p]]+    fs = map (tmPostingRuleToFunction q tmquerytxt) tmpostingrules+    generatePostings ps = concatMap (\p -> p : map ($p) (if q `matchesPosting` p then fs else [])) ps   Right $ \t@(tpostings -> ps) -> txnTieKnot t{tpostings=generatePostings ps}  -- | Converts a 'TransactionModifier''s posting rule to a 'Posting'-generating function,@@ -96,8 +92,8 @@ -- and a hidden _generated-posting: tag which does not. -- The TransactionModifier's query text is also provided, and saved -- as the tags' value.-tmPostingRuleToFunction :: T.Text -> TMPostingRule -> (Posting -> Posting)-tmPostingRuleToFunction querytxt pr =+tmPostingRuleToFunction :: Query -> T.Text -> TMPostingRule -> (Posting -> Posting)+tmPostingRuleToFunction query querytxt pr =   \p -> renderPostingCommentDates $ pr       { pdate    = pdate  pr <|> pdate  p       , pdate2   = pdate2 pr <|> pdate2 p@@ -109,31 +105,31 @@       }   where     qry = "= " <> querytxt+    symq = filterQuery (liftA2 (||) queryIsSym queryIsAmt) query     amount' = case postingRuleMultiplier pr of         Nothing -> const $ pamount pr         Just n  -> \p ->           -- Multiply the old posting's amount by the posting rule's multiplier.           let-            pramount = dbg6 "pramount" $ head $ amounts $ pamount pr-            matchedamount = dbg6 "matchedamount" $ pamount p+            pramount = dbg6 "pramount" . head . amountsRaw $ pamount pr+            matchedamount = dbg6 "matchedamount" . filterMixedAmount (symq `matchesAmount`) $ pamount p             -- Handle a matched amount with a total price carefully so as to keep the transaction balanced (#928).             -- Approach 1: convert to a unit price and increase the display precision slightly             -- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount             -- Approach 2: multiply the total price (keeping it positive) as well as the quantity-            Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` matchedamount+            as = dbg6 "multipliedamount" $ multiplyMixedAmount n matchedamount           in             case acommodity pramount of-              "" -> Mixed as+              "" -> as               -- TODO multipliers with commodity symbols are not yet a documented feature.               -- For now: in addition to multiplying the quantity, it also replaces the               -- matched amount's commodity, display style, and price with those of the posting rule.-              c  -> Mixed [a{acommodity = c, astyle = astyle pramount, aprice = aprice pramount} | a <- as]+              c  -> mapMixedAmount (\a -> a{acommodity = c, astyle = astyle pramount, aprice = aprice pramount}) as  postingRuleMultiplier :: TMPostingRule -> Maybe Quantity-postingRuleMultiplier p =-    case amounts $ pamount p of-        [a] | aismultiplier a -> Just $ aquantity a-        _                   -> Nothing+postingRuleMultiplier p = case amountsRaw $ pamount p of+    [a] | aismultiplier a -> Just $ aquantity a+    _                     -> Nothing  renderPostingCommentDates :: Posting -> Posting renderPostingCommentDates p = p { pcomment = comment' }

@@ -17,12 +17,11 @@ -}  -- {-# LANGUAGE DeriveAnyClass #-}  -- https://hackage.haskell.org/package/deepseq-1.4.4.0/docs/Control-DeepSeq.html#v:rnf-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE DeriveGeneric        #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE RecordWildCards      #-}+{-# LANGUAGE StandaloneDeriving   #-}  module Hledger.Data.Types where@@ -38,13 +37,12 @@ --You will eventually need all the values stored. --The stored values don't represent large virtual data structures to be lazily computed. import qualified Data.Map as M+import Data.Ord (comparing) import Data.Text (Text)--- import qualified Data.Text as T import Data.Time.Calendar import Data.Time.LocalTime import Data.Word (Word8) import System.Time (ClockTime(..))-import Text.Printf  import Hledger.Utils.Regex @@ -191,13 +189,15 @@ } deriving (Eq,Ord,Read,Generic)  instance Show AmountStyle where-  show AmountStyle{..} =-    printf "AmountStylePP \"%s %s %s %s %s..\""-    (show ascommodityside)-    (show ascommodityspaced)-    (show asprecision)-    (show asdecimalpoint)-    (show asdigitgroups)+  show AmountStyle{..} = concat+    [ "AmountStylePP \""+    , show ascommodityside+    , show ascommodityspaced+    , show asprecision+    , show asdecimalpoint+    , show asdigitgroups+    , "..\""+    ]  -- | The "display precision" for a hledger amount, by which we mean -- the number of decimal digits to display to the right of the decimal mark.@@ -230,7 +230,38 @@       aprice      :: !(Maybe AmountPrice)  -- ^ the (fixed, transaction-specific) price for this amount, if any     } deriving (Eq,Ord,Generic,Show) -newtype MixedAmount = Mixed [Amount] deriving (Eq,Ord,Generic,Show)+newtype MixedAmount = Mixed (M.Map MixedAmountKey Amount) deriving (Eq,Ord,Generic,Show)++-- | Stores the CommoditySymbol of the Amount, along with the CommoditySymbol of+-- the price, and its unit price if being used.+data MixedAmountKey+  = MixedAmountKeyNoPrice    !CommoditySymbol+  | MixedAmountKeyTotalPrice !CommoditySymbol !CommoditySymbol+  | MixedAmountKeyUnitPrice  !CommoditySymbol !CommoditySymbol !Quantity+  deriving (Eq,Generic,Show)++-- | We don't auto-derive the Ord instance because it would give an undesired ordering.+-- We want the keys to be sorted lexicographically:+-- (1) By the primary commodity of the amount.+-- (2) By the commodity of the price, with no price being first.+-- (3) By the unit price, from most negative to most positive, with total prices+-- before unit prices.+-- For example, we would like the ordering to give+-- MixedAmountKeyNoPrice "X" < MixedAmountKeyTotalPrice "X" "Z" < MixedAmountKeyNoPrice "Y"+instance Ord MixedAmountKey where+  compare = comparing commodity <> comparing pCommodity <> comparing pPrice+    where+      commodity (MixedAmountKeyNoPrice    c)     = c+      commodity (MixedAmountKeyTotalPrice c _)   = c+      commodity (MixedAmountKeyUnitPrice  c _ _) = c++      pCommodity (MixedAmountKeyNoPrice    _)      = Nothing+      pCommodity (MixedAmountKeyTotalPrice _ pc)   = Just pc+      pCommodity (MixedAmountKeyUnitPrice  _ pc _) = Just pc++      pPrice (MixedAmountKeyNoPrice    _)     = Nothing+      pPrice (MixedAmountKeyTotalPrice _ _)   = Nothing+      pPrice (MixedAmountKeyUnitPrice  _ _ q) = Just q  data PostingType = RegularPosting | VirtualPosting | BalancedVirtualPosting                    deriving (Eq,Show,Generic)

@@ -17,9 +17,7 @@   ,ValuationType(..)   ,PriceOracle   ,journalPriceOracle-  -- ,amountApplyValuation-  -- ,amountValueAtDate-  ,mixedAmountApplyCostValuation+  ,mixedAmountToCost   ,mixedAmountApplyValuation   ,mixedAmountValueAtDate   ,marketPriceReverse@@ -99,18 +97,9 @@ ------------------------------------------------------------------------------ -- Converting things to value --- | Apply a specified costing and valuation to this mixed amount,--- using the provided price oracle, commodity styles, and reference dates.--- Costing is done first if requested, and after that any valuation.--- See amountApplyValuation and amountCost.-mixedAmountApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> Costing -> Maybe ValuationType -> MixedAmount -> MixedAmount-mixedAmountApplyCostValuation priceoracle styles periodlast today postingdate cost v =-    valuation . costing-  where-    valuation = maybe id (mixedAmountApplyValuation priceoracle styles periodlast today postingdate) v-    costing = case cost of-        Cost   -> styleMixedAmount styles . mixedAmountCost-        NoCost -> id+-- | Convert all component amounts to cost/selling price if requested, and style them.+mixedAmountToCost :: Costing -> M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount+mixedAmountToCost cost styles = mapMixedAmount (amountToCost cost styles)  -- | Apply a specified valuation to this mixed amount, using the -- provided price oracle, commodity styles, and reference dates.@@ -119,6 +108,11 @@ mixedAmountApplyValuation priceoracle styles periodlast today postingdate v =   mapMixedAmount (amountApplyValuation priceoracle styles periodlast today postingdate v) +-- | Convert an Amount to its cost if requested, and style it appropriately.+amountToCost :: Costing -> M.Map CommoditySymbol AmountStyle -> Amount -> Amount+amountToCost NoCost _      = id+amountToCost Cost   styles = styleAmount styles . amountCost+ -- | Apply a specified valuation to this amount, using the provided -- price oracle, reference dates, and whether this is for a -- multiperiod report or not. Also fix up its display style using the@@ -142,7 +136,7 @@ -- -- - the provided "today" date - (--value=now, or -V/X with no report --   end date).--- +-- -- This is all a bit complicated. See the reference doc at -- https://hledger.org/hledger.html#effect-of-valuation-on-reports -- (hledger_options.m4.md "Effect of valuation on reports"), and #1083.

@@ -5,7 +5,6 @@  -} -{-# LANGUAGE CPP                #-} {-# LANGUAGE FlexibleContexts   #-} {-# LANGUAGE OverloadedStrings  #-} {-# LANGUAGE ViewPatterns       #-}@@ -65,9 +64,6 @@ import Data.Either (partitionEithers) import Data.List (partition) import Data.Maybe (fromMaybe, isJust, mapMaybe)-#if !(MIN_VERSION_base(4,11,0))-import Data.Monoid ((<>))-#endif import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar (Day, fromGregorian )@@ -78,7 +74,7 @@ import Hledger.Utils hiding (words') import Hledger.Data.Types import Hledger.Data.AccountName-import Hledger.Data.Amount (nullamt, usd)+import Hledger.Data.Amount (amountsRaw, mixedAmount, nullamt, usd) import Hledger.Data.Dates import Hledger.Data.Posting import Hledger.Data.Transaction@@ -562,8 +558,9 @@ matchesAccount _ _ = True  matchesMixedAmount :: Query -> MixedAmount -> Bool-matchesMixedAmount q (Mixed []) = q `matchesAmount` nullamt-matchesMixedAmount q (Mixed as) = any (q `matchesAmount`) as+matchesMixedAmount q ma = case amountsRaw ma of+    [] -> q `matchesAmount` nullamt+    as -> any (q `matchesAmount`) as  matchesCommodity :: Query -> CommoditySymbol -> Bool matchesCommodity (Sym r) = regexMatchText r@@ -607,15 +604,15 @@ matchesPosting (And qs) p = all (`matchesPosting` p) qs matchesPosting (Code r) p = maybe False (regexMatchText r . tcode) $ ptransaction p matchesPosting (Desc r) p = maybe False (regexMatchText r . tdescription) $ ptransaction p-matchesPosting (Acct r) p = matches p || matches (originalPosting p)+matchesPosting (Acct r) p = matches p || maybe False matches (poriginal p)   where matches = regexMatchText r . paccount matchesPosting (Date span) p = span `spanContainsDate` postingDate p matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p matchesPosting (StatusQ s) p = postingStatus p == s matchesPosting (Real v) p = v == isReal p matchesPosting q@(Depth _) Posting{paccount=a} = q `matchesAccount` a-matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt-matchesPosting (Sym r) Posting{pamount=Mixed as} = any (matchesCommodity (Sym r)) $ map acommodity as+matchesPosting q@(Amt _ _) Posting{pamount=as} = q `matchesMixedAmount` as+matchesPosting (Sym r) Posting{pamount=as} = any (matchesCommodity (Sym r)) . map acommodity $ amountsRaw as matchesPosting (Tag n v) p = case (reString n, v) of   ("payee", Just v) -> maybe False (regexMatchText v . transactionPayee) $ ptransaction p   ("note", Just v) -> maybe False (regexMatchText v . transactionNote) $ ptransaction p@@ -811,10 +808,10 @@     ,test "a tag match on a posting also sees inherited tags" $ assertBool "" $ (Tag (toRegex' "txntag") Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}}     ,test "cur:" $ do       let toSym = either id (const $ error' "No query opts") . either error' id . parseQueryTerm (fromGregorian 2000 01 01) . ("cur:"<>)-      assertBool "" $ not $ toSym "$" `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- becomes "^$$", ie testing for null symbol-      assertBool "" $ (toSym "\\$") `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- have to quote $ for regexpr-      assertBool "" $ (toSym "shekels") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]}-      assertBool "" $ not $ (toSym "shek") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]}+      assertBool "" $ not $ toSym "$" `matchesPosting` nullposting{pamount=mixedAmount $ usd 1} -- becomes "^$$", ie testing for null symbol+      assertBool "" $ (toSym "\\$") `matchesPosting` nullposting{pamount=mixedAmount $ usd 1} -- have to quote $ for regexpr+      assertBool "" $ (toSym "shekels") `matchesPosting` nullposting{pamount=mixedAmount nullamt{acommodity="shekels"}}+      assertBool "" $ not $ (toSym "shek") `matchesPosting` nullposting{pamount=mixedAmount nullamt{acommodity="shekels"}}   ]    ,test "matchesTransaction" $ do

@@ -11,7 +11,6 @@ -}  --- ** language-{-# LANGUAGE CPP                 #-} {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE PackageImports      #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -54,9 +53,6 @@ import Data.List.NonEmpty (nonEmpty) import Data.Maybe (fromMaybe) import Data.Ord (comparing)-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif import Data.Semigroup (sconcat) import Data.Text (Text) import qualified Data.Text as T

@@ -95,9 +95,10 @@   rawnumberp,    -- ** comments+  isLineCommentStart,+  isSameLineCommentStart,   multilinecommentp,   emptyorcommentlinep,-   followingcommentp,   transactioncommentp,   postingcommentp,@@ -106,8 +107,11 @@   bracketeddatetagsp,    -- ** misc-  singlespacedtextp,-  singlespacedtextsatisfyingp,+  noncommenttextp,+  noncommenttext1p,+  singlespacedtext1p,+  singlespacednoncommenttext1p,+  singlespacedtextsatisfying1p,   singlespacep,   skipNonNewlineSpaces,   skipNonNewlineSpaces1,@@ -151,7 +155,6 @@  import Hledger.Data import Hledger.Utils-import Safe (headMay) import Text.Printf (printf)  --- ** doctest setup@@ -197,13 +200,12 @@     ,mrules_file_       :: Maybe FilePath       -- ^ a conversion rules file to use (when reading CSV)     ,aliases_           :: [String]             -- ^ account name aliases to apply     ,anon_              :: Bool                 -- ^ do light anonymisation/obfuscation of the data-    ,ignore_assertions_ :: Bool                 -- ^ don't check balance assertions     ,new_               :: Bool                 -- ^ read only new transactions since this file was last read     ,new_save_          :: Bool                 -- ^ save latest new transactions state for next time     ,pivot_             :: String               -- ^ use the given field's value as the account name     ,auto_              :: Bool                 -- ^ generate automatic postings when journal is parsed-    ,commoditystyles_   :: Maybe (M.Map CommoditySymbol AmountStyle) -- ^ optional commodity display styles affecting all files-    ,strict_            :: Bool                 -- ^ do extra error checking (eg, all posted accounts are declared)+    ,balancingopts_     :: BalancingOpts        -- ^ options for balancing transactions+    ,strict_            :: Bool                 -- ^ do extra error checking (eg, all posted accounts are declared, no prices are inferred)  } deriving (Show)  instance Default InputOpts where def = definputopts@@ -214,30 +216,31 @@     , mrules_file_       = Nothing     , aliases_           = []     , anon_              = False-    , ignore_assertions_ = False     , new_               = False     , new_save_          = True     , pivot_             = ""     , auto_              = False-    , commoditystyles_   = Nothing+    , balancingopts_     = def     , strict_            = False     }  rawOptsToInputOpts :: RawOpts -> InputOpts rawOptsToInputOpts rawopts = InputOpts{-   -- files_             = listofstringopt "file" rawopts-   mformat_           = Nothing-  ,mrules_file_       = maybestringopt "rules-file" rawopts-  ,aliases_           = listofstringopt "alias" rawopts-  ,anon_              = boolopt "anon" rawopts-  ,ignore_assertions_ = boolopt "ignore-assertions" rawopts-  ,new_               = boolopt "new" rawopts-  ,new_save_          = True-  ,pivot_             = stringopt "pivot" rawopts-  ,auto_              = boolopt "auto" rawopts-  ,commoditystyles_   = Nothing-  ,strict_            = boolopt "strict" rawopts-  }+     -- files_             = listofstringopt "file" rawopts+     mformat_           = Nothing+    ,mrules_file_       = maybestringopt "rules-file" rawopts+    ,aliases_           = listofstringopt "alias" rawopts+    ,anon_              = boolopt "anon" rawopts+    ,new_               = boolopt "new" rawopts+    ,new_save_          = True+    ,pivot_             = stringopt "pivot" rawopts+    ,auto_              = boolopt "auto" rawopts+    ,balancingopts_     = def{ ignore_assertions_ = boolopt "ignore-assertions" rawopts+                             , infer_prices_      = not noinferprice+                             }+    ,strict_            = boolopt "strict" rawopts+    }+  where noinferprice = boolopt "strict" rawopts || stringopt "args" rawopts == "balancednoautoconversion"  --- ** parsing utilities @@ -325,11 +328,11 @@ -- - infer transaction-implied market prices from transaction prices -- journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal-journalFinalise InputOpts{auto_,ignore_assertions_,commoditystyles_,strict_} f txt pj = do+journalFinalise InputOpts{auto_,balancingopts_,strict_} f txt pj = do   t <- liftIO getClockTime   d <- liftIO getCurrentDay   let pj' =-        pj{jglobalcommoditystyles=fromMaybe M.empty commoditystyles_}  -- save any global commodity styles+        pj{jglobalcommoditystyles=fromMaybe M.empty $ commodity_styles_ balancingopts_}  -- save any global commodity styles         & journalAddFile (f, txt)  -- save the main file's info         & journalSetLastReadTime t -- save the last read time         & journalReverse -- convert all lists to the order they were parsed@@ -354,11 +357,11 @@                 then                   -- Auto postings are not active.                   -- Balance all transactions and maybe check balance assertions.-                  journalBalanceTransactions (not ignore_assertions_)+                  journalBalanceTransactions balancingopts_                 else \j -> do  -- Either monad                   -- Auto postings are active.                   -- Balance all transactions without checking balance assertions,-                  j' <- journalBalanceTransactions False j+                  j' <- journalBalanceTransactions balancingopts_{ignore_assertions_=True} j                   -- then add the auto postings                   -- (Note adding auto postings after balancing means #893b fails;                   -- adding them before balancing probably means #893a, #928, #938 fail.)@@ -368,7 +371,7 @@                       -- then apply commodity styles once more, to style the auto posting amounts. (XXX inefficient ?)                       j''' <- journalApplyCommodityStyles j''                       -- then check balance assertions.-                      journalBalanceTransactions (not ignore_assertions_) j'''+                      journalBalanceTransactions balancingopts_ j'''                 )             & fmap journalInferMarketPricesFromTransactions  -- infer market prices from commodity-exchanging transactions @@ -408,7 +411,7 @@ -- | Check that all the commodities used in this journal's postings have been declared -- by commodity directives, returning an error message otherwise. journalCheckCommoditiesDeclared :: Journal -> Either String ()-journalCheckCommoditiesDeclared j = +journalCheckCommoditiesDeclared j =   sequence_ $ map checkcommodities $ journalPostings j   where     checkcommodities Posting{..} =@@ -423,10 +426,8 @@                           (linesPrepend "  " . (<>"\n") . textChomp $ showTransaction t)       where         mfirstundeclaredcomm =-          headMay $ filter (not . (`elem` cs)) $ catMaybes $-          (acommodity . baamount <$> pbalanceassertion) :-          (map (Just . acommodity) . filter (/= missingamt) $ amounts pamount)-        cs = journalCommoditiesDeclared j+          find (`M.notMember` jcommodities j) . map acommodity $+          (maybe id ((:) . baamount) pbalanceassertion) . filter (/= missingamt) $ amountsRaw pamount   setYear :: Year -> JournalParser m ()@@ -535,9 +536,11 @@   char ')' <?> "closing bracket ')' for transaction code"   pure code +-- | Parse possibly empty text until a semicolon or newline.+-- Whitespace is preserved (for now - perhaps helps preserve alignment +-- of same-line comments ?). descriptionp :: TextParser m Text-descriptionp = takeWhileP Nothing (not . semicolonOrNewline)-  where semicolonOrNewline c = c == ';' || c == '\n'+descriptionp = noncommenttextp <?> "description"  --- *** dates @@ -697,19 +700,32 @@ -- It should have required parts to start with an alphanumeric; -- for now it remains as-is for backwards compatibility. accountnamep :: TextParser m AccountName-accountnamep = singlespacedtextp+accountnamep = singlespacedtext1p +-- | Parse possibly empty text, including whitespace, +-- until a comment start (semicolon) or newline.+noncommenttextp :: TextParser m T.Text+noncommenttextp = takeWhileP Nothing (\c -> not $ isSameLineCommentStart c || isNewline c) --- | Parse any text beginning with a non-whitespace character, until a--- double space or the end of input.--- TODO including characters which normally start a comment (;#) - exclude those ? -singlespacedtextp :: TextParser m T.Text-singlespacedtextp = singlespacedtextsatisfyingp (const True)+-- | Parse non-empty text, including whitespace, +-- until a comment start (semicolon) or newline.+noncommenttext1p :: TextParser m T.Text+noncommenttext1p = takeWhile1P Nothing (\c -> not $ isSameLineCommentStart c || isNewline c) --- | Similar to 'singlespacedtextp', except that the text must only contain--- characters satisfying the given predicate.-singlespacedtextsatisfyingp :: (Char -> Bool) -> TextParser m T.Text-singlespacedtextsatisfyingp pred = do+-- | Parse non-empty, single-spaced text starting and ending with non-whitespace,+-- until a double space or newline.+singlespacedtext1p :: TextParser m T.Text+singlespacedtext1p = singlespacedtextsatisfying1p (const True)++-- | Parse non-empty, single-spaced text starting and ending with non-whitespace,+-- until a comment start (semicolon), double space, or newline.+singlespacednoncommenttext1p :: TextParser m T.Text+singlespacednoncommenttext1p = singlespacedtextsatisfying1p (not . isSameLineCommentStart)++-- | Parse non-empty, single-spaced text starting and ending with non-whitespace,+-- where all characters satisfy the given predicate.+singlespacedtextsatisfying1p :: (Char -> Bool) -> TextParser m T.Text+singlespacedtextsatisfying1p pred = do   firstPart <- partp   otherParts <- many $ try $ singlespacep *> partp   pure $! T.unwords $ firstPart : otherParts@@ -729,7 +745,7 @@ spaceandamountormissingp =   option missingmixedamt $ try $ do     lift $ skipNonNewlineSpaces1-    Mixed . (:[]) <$> amountp+    mixedAmount <$> amountp  -- | Parse a single-commodity amount, with optional symbol on the left -- or right, followed by, in any order: an optional transaction price,@@ -855,7 +871,7 @@  -- | Parse a mixed amount from a string, or get an error. mamountp' :: String -> MixedAmount-mamountp' = Mixed . (:[]) . amountp'+mamountp' = mixedAmount . amountp'  -- | Parse a minus or plus sign followed by zero or more spaces, -- or nothing, returning a function that negates or does nothing.@@ -1182,13 +1198,27 @@   where     skiplinecommentp :: TextParser m ()     skiplinecommentp = do-      satisfy $ \c -> c == ';' || c == '#' || c == '*'-      void $ takeWhileP Nothing (\c -> c /= '\n')+      satisfy isLineCommentStart+      void $ takeWhileP Nothing (/= '\n')       optional newline       pure ()  {-# INLINABLE emptyorcommentlinep #-} +-- | Is this a character that, as the first non-whitespace on a line,+-- starts a comment line ?+isLineCommentStart :: Char -> Bool+isLineCommentStart '#' = True+isLineCommentStart '*' = True+isLineCommentStart ';' = True+isLineCommentStart _   = False++-- | Is this a character that, appearing anywhere within a line,+-- starts a comment ?+isSameLineCommentStart :: Char -> Bool+isSameLineCommentStart ';' = True+isSameLineCommentStart _   = False+ -- A parser combinator for parsing (possibly multiline) comments -- following journal items. --@@ -1560,7 +1590,7 @@      assertParseError p "1.5555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" ""    ,tests "spaceandamountormissingp" [-     test "space and amount" $ assertParseEq spaceandamountormissingp " $47.18" (Mixed [usd 47.18])+     test "space and amount" $ assertParseEq spaceandamountormissingp " $47.18" (mixedAmount $ usd 47.18)     ,test "empty string" $ assertParseEq spaceandamountormissingp "" missingmixedamt     -- ,test "just space" $ assertParseEq spaceandamountormissingp " " missingmixedamt  -- XXX should it ?     -- ,test "just amount" $ assertParseError spaceandamountormissingp "$47.18" ""  -- succeeds, consuming nothing

@@ -14,13 +14,11 @@ {-# LANGUAGE FlexibleContexts     #-} {-# LANGUAGE FlexibleInstances    #-} {-# LANGUAGE MultiWayIf           #-}-{-# LANGUAGE NamedFieldPuns       #-} {-# LANGUAGE OverloadedStrings    #-} {-# LANGUAGE PackageImports       #-} {-# LANGUAGE RecordWildCards      #-} {-# LANGUAGE ScopedTypeVariables  #-} {-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns         #-}  --- ** exports@@ -118,7 +116,7 @@               -- apply any command line account aliases. Can fail with a bad replacement pattern.               in case journalApplyAliases (aliasesFromOpts iopts) pj' of                   Left e -> throwError e-                  Right pj'' -> journalFinalise iopts{ignore_assertions_=True} f t pj''+                  Right pj'' -> journalFinalise iopts{balancingopts_=(balancingopts_ iopts){ignore_assertions_=True}} f t pj''  --- ** reading rules files --- *** rules utilities@@ -813,8 +811,8 @@  printCSV :: CSV -> TL.Text printCSV = TB.toLazyText . unlinesB . map printRecord-    where printRecord = mconcat . map TB.fromText . intersperse "," . map printField-          printField = wrap "\"" "\"" . T.replace "\"" "\\\"\\\""+    where printRecord = foldMap TB.fromText . intersperse "," . map printField+          printField = wrap "\"" "\"" . T.replace "\"" "\"\""  -- | Return the cleaned up and validated CSV data (can be empty), or an error. validateCsv :: CsvRules -> Int -> Either String CSV -> Either String [CsvRecord]@@ -976,9 +974,10 @@ -- If there's multiple non-zeros, or no non-zeros but multiple zeros, it throws an error. getAmount :: CsvRules -> CsvRecord -> Text -> Bool -> Int -> Maybe MixedAmount getAmount rules record currency p1IsVirtual n =-  -- Warning, many tricky corner cases here.-  -- docs: hledger_csv.m4.md #### amount-  -- tests: hledger/test/csv.test ~ 13, 31-34+  -- Warning! Many tricky corner cases here.+  -- Keep synced with:+  -- hledger_csv.m4.md -> CSV FORMAT -> "amount", "Setting amounts",+  -- hledger/test/csv.test -> 13, 31-34   let     unnumberedfieldnames = ["amount","amount-in","amount-out"] @@ -992,10 +991,11 @@     assignments = [(f,a') | f <- fieldnames                           , Just v <- [T.strip . renderTemplate rules record <$> 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                           -- With amount/amount-in/amount-out, in posting 2,                           -- flip the sign and convert to cost, as they did before 1.17-                          , let a' = if f `elem` unnumberedfieldnames && n==2 then mixedAmountCost (-a) else a+                          , let a' = if f `elem` unnumberedfieldnames && n==2 then mixedAmountCost (maNegate a) else a                           ]      -- if any of the numbered field names are present, discard all the unnumbered ones@@ -1013,7 +1013,8 @@   in case -- dbg0 ("amounts for posting "++show n)           assignments'' of       [] -> Nothing-      [(f,a)] | "-out" `T.isSuffixOf` f -> Just (-a)  -- for -out fields, flip the sign+      [(f,a)] | "-out" `T.isSuffixOf` f -> Just (maNegate a)  -- for -out fields, flip the sign+                                                              -- XXX unless it's already negative ? back compat issues / too confusing ?       [(_,a)] -> Just a       fs      -> error' . T.unpack . T.unlines $ [  -- PARTIAL:          "multiple non-zero amounts or multiple zero amounts assigned,"@@ -1048,7 +1049,7 @@ -- The whole CSV record is provided for the error message. parseAmount :: CsvRules -> CsvRecord -> Text -> Text -> MixedAmount parseAmount rules record currency s =-    either mkerror (Mixed . (:[])) $  -- PARTIAL:+    either mkerror mixedAmount $  -- PARTIAL:     runParser (evalStateT (amountp <* eof) journalparsestate) "" $     currency <> simplifySign s   where@@ -1182,6 +1183,8 @@ -- "" simplifySign :: CsvAmountString -> CsvAmountString simplifySign amtstr+  | Just (' ',t) <- T.uncons amtstr = simplifySign t+  | Just (t,' ') <- T.unsnoc amtstr = simplifySign t   | Just ('(',t) <- T.uncons amtstr, Just (amt,')') <- T.unsnoc t = simplifySign $ negateStr amt   | Just ('-',b) <- T.uncons amtstr, Just ('(',t) <- T.uncons b, Just (amt,')') <- T.unsnoc t = simplifySign amt   | Just ('-',m) <- T.uncons amtstr, Just ('-',amt) <- T.uncons m = amt

@@ -26,15 +26,12 @@  --- ** language -{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE NoMonoLocalBinds #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE NamedFieldPuns      #-}+{-# LANGUAGE NoMonoLocalBinds    #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE PackageImports      #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}  --- ** exports module Hledger.Read.JournalReader (@@ -85,9 +82,6 @@ import Data.Char (toLower) import Data.Either (isRight) import qualified Data.Map.Strict as M-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif import Data.Text (Text) import Data.String import Data.List@@ -535,7 +529,7 @@ payeedirectivep = do   string "payee" <?> "payee directive"   lift skipNonNewlineSpaces1-  payee <- lift descriptionp  -- all text until ; or \n+  payee <- lift $ T.strip <$> noncommenttext1p   (comment, tags) <- lift transactioncommentp   addPayeeDeclaration (payee, comment, tags)   return ()@@ -626,7 +620,7 @@                   Nothing -> today                   Just y  -> fromGregorian y 1 1   periodExcerpt <- lift $ excerpt_ $-                    singlespacedtextsatisfyingp (\c -> c /= ';' && c /= '\n')+                    singlespacedtextsatisfying1p (\c -> c /= ';' && c /= '\n')   let periodtxt = T.strip $ getExcerptText periodExcerpt    -- first parsing with 'singlespacedtextp', then "re-parsing" with@@ -711,7 +705,7 @@     return (status, account)   let (ptype, account') = (accountNamePostingType account, textUnbracket account)   lift skipNonNewlineSpaces-  amount <- option missingmixedamt $ Mixed . (:[]) <$> amountp+  amount <- optional amountp   lift skipNonNewlineSpaces   massertion <- optional balanceassertionp   lift skipNonNewlineSpaces@@ -721,7 +715,7 @@    , pdate2=mdate2    , pstatus=status    , paccount=account'-   , pamount=amount+   , pamount=maybe missingmixedamt mixedAmount amount    , pcomment=comment    , ptype=ptype    , ptags=tags@@ -823,7 +817,7 @@       "  expenses:food:dining  $10.00   ; a: a a \n   ; b: b b \n"       posting{         paccount="expenses:food:dining",-        pamount=Mixed [usd 10],+        pamount=mixedAmount (usd 10),         pcomment="a: a a\nb: b b\n",         ptags=[("a","a a"), ("b","b b")]         }@@ -832,7 +826,7 @@       " a  1. ; date:2012/11/28, date2=2012/11/29,b:b\n"       nullposting{          paccount="a"-        ,pamount=Mixed [num 1]+        ,pamount=mixedAmount (num 1)         ,pcomment="date:2012/11/28, date2=2012/11/29,b:b\n"         ,ptags=[("date", "2012/11/28"), ("date2=2012/11/29,b", "b")] -- TODO tag name parsed too greedily         ,pdate=Just $ fromGregorian 2012 11 28@@ -843,7 +837,7 @@       " a  1. ; [2012/11/28=2012/11/29]\n"       nullposting{          paccount="a"-        ,pamount=Mixed [num 1]+        ,pamount=mixedAmount (num 1)         ,pcomment="[2012/11/28=2012/11/29]\n"         ,ptags=[]         ,pdate= Just $ fromGregorian 2012 11 28@@ -872,7 +866,7 @@       "= (some value expr)\n some:postings  1.\n"       nulltransactionmodifier {         tmquerytxt = "(some value expr)"-       ,tmpostingrules = [nullposting{paccount="some:postings", pamount=Mixed[num 1]}]+       ,tmpostingrules = [nullposting{paccount="some:postings", pamount=mixedAmount (num 1)}]       }     ] @@ -905,7 +899,7 @@             pdate=Nothing,             pstatus=Cleared,             paccount="a",-            pamount=Mixed [usd 1],+            pamount=mixedAmount (usd 1),             pcomment="pcomment1\npcomment2\nptag1: val1\nptag2: val2\n",             ptype=RegularPosting,             ptags=[("ptag1","val1"),("ptag2","val2")],

@@ -182,7 +182,7 @@         tstatus    = Cleared,         tpostings  = [           nullposting{paccount=a-                     ,pamount=Mixed [amountSetPrecision (Precision 2) $ num hours]  -- don't assume hours; do set precision to 2+                     ,pamount=mixedAmount . amountSetPrecision (Precision 2) $ num hours  -- don't assume hours; do set precision to 2                      ,ptype=VirtualPosting                      ,ptransaction=Just t                      }

@@ -1,4 +1,6 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+ {-|  Generate several common kinds of report from a journal, as \"*Report\" -

@@ -1,4 +1,5 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-} {-|  An account-centric transactions report.@@ -15,12 +16,12 @@ ) where -import Data.List-import Data.Ord-import Data.Maybe+import Data.List (mapAccumL, nub, partition, sortBy)+import Data.Ord (comparing)+import Data.Maybe (catMaybes) import Data.Text (Text) import qualified Data.Text as T-import Data.Time.Calendar+import Data.Time.Calendar (Day)  import Hledger.Data import Hledger.Query@@ -82,45 +83,28 @@   where     -- a depth limit should not affect the account transactions report     -- seems unnecessary for some reason XXX-    reportq' = -- filterQuery (not . queryIsDepth)-               reportq--    -- get all transactions-    ts1 =-      -- ptraceAtWith 5 (("ts1:\n"++).pshowTransactions) $-      jtxns j--    -- apply any cur:SYM filters in reportq'-    symq  = filterQuery queryIsSym reportq'-    ts2 =-      ptraceAtWith 5 (("ts2:\n"++).pshowTransactions) $-      (if queryIsNull symq then id else map (filterTransactionAmounts symq)) ts1--    -- keep just the transactions affecting this account (via possibly realness or status-filtered postings)-    realq = filterQuery queryIsReal reportq'-    statusq = filterQuery queryIsStatus reportq'-    ts3 =-      traceAt 3 ("thisacctq: "++show thisacctq) $-      ptraceAtWith 5 (("ts3:\n"++).pshowTransactions) $-      filter (matchesTransaction thisacctq . filterTransactionPostings (And [realq, statusq])) ts2--    -- maybe convert these transactions to cost or value-    -- PARTIAL:-    prices = journalPriceOracle (infer_value_ ropts) j-    styles = journalCommodityStyles j-    periodlast =-      fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen-      reportPeriodOrJournalLastDay rspec j-    tval = transactionApplyCostValuation prices styles periodlast (rsToday rspec) (cost_ ropts) $ value_ ropts-    ts4 =-      ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $-      map tval ts3+    reportq'   = reportq -- filterQuery (not . queryIsDepth)+    symq       = filterQuery queryIsSym reportq'+    realq      = filterQuery queryIsReal reportq'+    statusq    = filterQuery queryIsStatus reportq'      -- sort by the transaction's register date, for accurate starting balance     -- these are not yet filtered by tdate, we want to search them all for priorps-    ts5 =-      ptraceAtWith 5 (("ts5:\n"++).pshowTransactions) $-      sortBy (comparing (transactionRegisterDate reportq' thisacctq)) ts4+    transactions =+        ptraceAtWith 5 (("ts5:\n"++).pshowTransactions)+      . sortBy (comparing (transactionRegisterDate reportq' thisacctq))+      . jtxns+      . ptraceAtWith 5 (("ts4:\n"++).pshowTransactions.jtxns)+      -- keep just the transactions affecting this account (via possibly realness or status-filtered postings)+      . traceAt 3 ("thisacctq: "++show thisacctq)+      . ptraceAtWith 5 (("ts3:\n"++).pshowTransactions.jtxns)+      . filterJournalTransactions thisacctq+      . filterJournalPostings (And [realq, statusq])+      -- apply any cur:SYM filters in reportq'+      . ptraceAtWith 5 (("ts2:\n"++).pshowTransactions.jtxns)+      . (if queryIsNull symq then id else filterJournalAmounts symq)+      -- maybe convert these transactions to cost or value+      $ journalApplyValuationFromOpts rspec j      startbal       | balancetype_ ropts == HistoricalBalance = sumPostings priorps@@ -130,7 +114,7 @@                   filter (matchesPosting                           (dbg5 "priorq" $                            And [thisacctq, tostartdateq, datelessreportq]))-                         $ transactionsPostings ts5+                         $ transactionsPostings transactions         tostartdateq =           case mstartdate of             Just _  -> Date (DateSpan Nothing mstartdate)@@ -145,9 +129,9 @@     filtertxns = txn_dates_ ropts      items = reverse $-            accountTransactionsReportItems reportq' thisacctq startbal negate $+            accountTransactionsReportItems reportq' thisacctq startbal maNegate $             (if filtertxns then filter (reportq' `matchesTransaction`) else id) $-            ts5+            transactions  pshowTransactions :: [Transaction] -> String pshowTransactions = pshow . map (\t -> unwords [show $ tdate t, T.unpack $ tdescription t])@@ -179,8 +163,8 @@                   otheracctstr | thisacctq == None  = summarisePostingAccounts reportps     -- no current account ? summarise all matched postings                                | numotheraccts == 0 = summarisePostingAccounts thisacctps   -- only postings to current account ? summarise those                                | otherwise          = summarisePostingAccounts otheracctps  -- summarise matched postings to other account(s)-                  a = signfn $ negate $ sum $ map pamount thisacctps-                  b = bal + a+                  a = signfn . maNegate $ sumPostings thisacctps+                  b = bal `maPlus` a  -- | What is the transaction's date in the context of a particular account -- (specified with a query) and report query, as in an account register ?

@@ -4,7 +4,9 @@  -} -{-# LANGUAGE FlexibleInstances, RecordWildCards, ScopedTypeVariables, OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Hledger.Reports.BalanceReport (   BalanceReport,@@ -76,7 +78,7 @@ -- tests  Right samplejournal2 =-  journalBalanceTransactions False+  journalBalanceTransactions balancingOpts     nulljournal{       jtxns = [         txnTieKnot Transaction{@@ -90,7 +92,7 @@           tcomment="",           ttags=[],           tpostings=-            [posting {paccount="assets:bank:checking", pamount=Mixed [usd 1]}+            [posting {paccount="assets:bank:checking", pamount=mixedAmount (usd 1)}             ,posting {paccount="income:salary", pamount=missingmixedamt}             ],           tprecedingcomment=""@@ -112,7 +114,7 @@     tests "balanceReport" [       test "no args, null journal" $-     (defreportspec, nulljournal) `gives` ([], 0)+     (defreportspec, nulljournal) `gives` ([], nullmixedamt)      ,test "no args, sample journal" $      (defreportspec, samplejournal) `gives`@@ -125,7 +127,7 @@        ,("income:gifts","income:gifts",0, mamountp' "$-1.00")        ,("income:salary","income:salary",0, mamountp' "$-1.00")        ],-       Mixed [usd 0])+       mixedAmount (usd 0))      ,test "with --tree" $      (defreportspec{rsOpts=defreportopts{accountlistmode_=ALTree}}, samplejournal) `gives`@@ -142,7 +144,7 @@        ,("income:gifts","gifts",1, mamountp' "$-1.00")        ,("income:salary","salary",1, mamountp' "$-1.00")        ],-       Mixed [usd 0])+       mixedAmount (usd 0))      ,test "with --depth=N" $      (defreportspec{rsOpts=defreportopts{depth_=Just 1}}, samplejournal) `gives`@@ -150,7 +152,7 @@        ("expenses",    "expenses",    0, mamountp'  "$2.00")        ,("income",      "income",      0, mamountp' "$-2.00")        ],-       Mixed [usd 0])+       mixedAmount (usd 0))      ,test "with depth:N" $      (defreportspec{rsQuery=Depth 1}, samplejournal) `gives`@@ -158,11 +160,11 @@        ("expenses",    "expenses",    0, mamountp'  "$2.00")        ,("income",      "income",      0, mamountp' "$-2.00")        ],-       Mixed [usd 0])+       mixedAmount (usd 0))      ,test "with date:" $      (defreportspec{rsQuery=Date $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`-      ([], 0)+      ([], nullmixedamt)      ,test "with date2:" $      (defreportspec{rsQuery=Date2 $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`@@ -170,7 +172,7 @@         ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")        ,("income:salary","income:salary",0,mamountp' "$-1.00")        ],-       Mixed [usd 0])+       mixedAmount (usd 0))      ,test "with desc:" $      (defreportspec{rsQuery=Desc $ toRegexCI' "income"}, samplejournal) `gives`@@ -178,7 +180,7 @@         ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")        ,("income:salary","income:salary",0, mamountp' "$-1.00")        ],-       Mixed [usd 0])+       mixedAmount (usd 0))      ,test "with not:desc:" $      (defreportspec{rsQuery=Not . Desc $ toRegexCI' "income"}, samplejournal) `gives`@@ -189,7 +191,7 @@        ,("expenses:supplies","expenses:supplies",0, mamountp' "$1.00")        ,("income:gifts","income:gifts",0, mamountp' "$-1.00")        ],-       Mixed [usd 0])+       mixedAmount (usd 0))      ,test "with period on a populated period" $       (defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2)}}, samplejournal) `gives`@@ -198,11 +200,11 @@          ("assets:bank:checking","assets:bank:checking",0, mamountp' "$1.00")         ,("income:salary","income:salary",0, mamountp' "$-1.00")         ],-        Mixed [usd 0])+        mixedAmount (usd 0))       ,test "with period on an unpopulated period" $       (defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}}, samplejournal) `gives`-       ([], 0)+       ([], nullmixedamt)   

@@ -1,12 +1,7 @@-{- |--}--{-# LANGUAGE CPP                 #-} {-# LANGUAGE NamedFieldPuns      #-} {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE RecordWildCards     #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections       #-}  module Hledger.Reports.BudgetReport (   BudgetGoal,@@ -20,36 +15,30 @@   budgetReportAsText,   budgetReportAsCsv,   -- * Helpers-  reportPeriodName,   combineBudgetAndActual,   -- * Tests   tests_BudgetReport ) where +import Control.Applicative ((<|>)) import Data.Decimal (roundTo) import Data.Default (def) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM-import Data.List (nub, partition, transpose)+import Data.List (find, partition, transpose) import Data.List.Extra (nubSort) import Data.Maybe (fromMaybe)-#if !(MIN_VERSION_base(4,11,0))-import Data.Monoid ((<>))-#endif-import Safe (headDef)---import Data.List---import Data.Maybe-import qualified Data.Map as Map import Data.Map (Map)+import qualified Data.Map as Map+import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB --import System.Console.CmdArgs.Explicit as C --import Lucid as L-import Text.Tabular as T-import Text.Tabular.AsciiWide as T+import Text.Tabular.AsciiWide as Tab  import Hledger.Data import Hledger.Utils@@ -74,8 +63,8 @@ -- from all periodic transactions, calculate actual balance changes  -- from the regular transactions, and compare these to get a 'BudgetReport'. -- Unbudgeted accounts may be hidden or renamed (see journalWithBudgetAccountNames).-budgetReport :: ReportSpec -> Bool -> DateSpan -> Journal -> BudgetReport-budgetReport rspec assrt reportspan j = dbg4 "sortedbudgetreport" budgetreport+budgetReport :: ReportSpec -> BalancingOpts -> DateSpan -> Journal -> BudgetReport+budgetReport rspec bopts reportspan j = dbg4 "sortedbudgetreport" budgetreport   where     -- Budget report demands ALTree mode to ensure subaccounts and subaccount budgets are properly handled     -- and that reports with and without --empty make sense when compared side by side@@ -83,14 +72,14 @@     showunbudgeted = empty_ ropts     budgetedaccts =       dbg3 "budgetedacctsinperiod" $-      nub $-      concatMap expandAccountName $+      S.fromList $+      expandAccountNames $       accountNamesFromPostings $       concatMap tpostings $       concatMap (`runPeriodicTransaction` reportspan) $       jperiodictxns j     actualj = journalWithBudgetAccountNames budgetedaccts showunbudgeted j-    budgetj = journalAddBudgetGoalTransactions assrt ropts reportspan j+    budgetj = journalAddBudgetGoalTransactions bopts ropts reportspan j     actualreport@(PeriodicReport actualspans _ _) =         dbg5 "actualreport" $ multiBalanceReport rspec{rsOpts=ropts{empty_=True}} actualj     budgetgoalreport@(PeriodicReport _ budgetgoalitems budgetgoaltotals) =@@ -108,9 +97,9 @@ -- Budget goal transactions are similar to forecast transactions except -- their purpose and effect is to define balance change goals, per account and period, -- for BudgetReport.-journalAddBudgetGoalTransactions :: Bool -> ReportOpts -> DateSpan -> Journal -> Journal-journalAddBudgetGoalTransactions assrt _ropts reportspan j =-  either error' id $ journalBalanceTransactions assrt j{ jtxns = budgetts }  -- PARTIAL:+journalAddBudgetGoalTransactions :: BalancingOpts -> ReportOpts -> DateSpan -> Journal -> Journal+journalAddBudgetGoalTransactions bopts _ropts reportspan j =+  either error' id $ journalBalanceTransactions bopts j{ jtxns = budgetts }  -- PARTIAL:   where     budgetspan = dbg3 "budget span" $ reportspan     budgetts =@@ -130,25 +119,20 @@ --    with a budget goal, so that only budgeted accounts are shown. --    This can be disabled by -E/--empty. ---journalWithBudgetAccountNames :: [AccountName] -> Bool -> Journal -> Journal-journalWithBudgetAccountNames budgetedaccts showunbudgeted j = -  dbg5With (("budget account names: "++).pshow.journalAccountNamesUsed) $ +journalWithBudgetAccountNames :: S.Set AccountName -> Bool -> Journal -> Journal+journalWithBudgetAccountNames budgetedaccts showunbudgeted j =+  dbg5With (("budget account names: "++).pshow.journalAccountNamesUsed) $   j { jtxns = remapTxn <$> jtxns j }   where-    remapTxn = mapPostings (map remapPosting)+    remapTxn = txnTieKnot . transactionTransformPostings remapPosting+    remapPosting p = p { paccount = remapAccount $ paccount p, poriginal = poriginal p <|> Just p }+    remapAccount a+      | a `S.member` budgetedaccts = a+      | Just p <- budgetedparent   = if showunbudgeted then a else p+      | otherwise                  = if showunbudgeted then u <> acctsep <> a else u       where-        mapPostings f t = txnTieKnot $ t { tpostings = f $ tpostings t }-        remapPosting p = p { paccount = remapAccount $ paccount p, poriginal = Just . fromMaybe p $ poriginal p }-          where-            remapAccount a-              | hasbudget         = a-              | hasbudgetedparent = if showunbudgeted then a else budgetedparent-              | otherwise         = if showunbudgeted then u <> acctsep <> a else u-              where-                hasbudget = a `elem` budgetedaccts-                hasbudgetedparent = not $ T.null budgetedparent-                budgetedparent = headDef "" $ filter (`elem` budgetedaccts) $ parentAccountNames a-                u = unbudgetedAccountName+        budgetedparent = find (`S.member` budgetedaccts) $ parentAccountNames a+        u = unbudgetedAccountName  -- | Combine a per-account-and-subperiod report of budget goals, and one -- of actual change amounts, into a budget performance report.@@ -206,7 +190,7 @@     sortedrows :: [BudgetReportRow] = sortRowsLike (mbrsorted unbudgetedrows ++ mbrsorted rows') rows       where         (unbudgetedrows, rows') = partition ((==unbudgetedAccountName) . prrFullName) rows-        mbrsorted = map prrFullName . sortRows ropts j . map (fmap $ fromMaybe 0 . fst)+        mbrsorted = map prrFullName . sortRows ropts j . map (fmap $ fromMaybe nullmixedamt . fst)         rows = rows1 ++ rows2      -- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells@@ -244,7 +228,7 @@      displayCell (actual, budget) = (showamt actual', budgetAndPerc <$> budget)       where-        actual' = fromMaybe 0 actual+        actual' = fromMaybe nullmixedamt actual         budgetAndPerc b = (showamt b, showper <$> percentage actual' b)         showamt = (\(WideBuilder b w) -> (TL.toStrict $ TB.toLazyText b, w)) . showMixedAmountB oneLine{displayColour=color_, displayMaxWidth=Just 32}         showper p = let str = T.pack (show $ roundTo 0 p) in (str, T.length str)@@ -280,15 +264,15 @@     -- - the goal is zero     percentage :: Change -> BudgetGoal -> Maybe Percentage     percentage actual budget =-      case (maybecost $ normaliseMixedAmount actual, maybecost $ normaliseMixedAmount budget) of-        (Mixed [a], Mixed [b]) | (acommodity a == acommodity b || amountLooksZero a) && not (amountLooksZero b)+      case (costedAmounts actual, costedAmounts budget) of+        ([a], [b]) | (acommodity a == acommodity b || amountLooksZero a) && not (amountLooksZero b)             -> Just $ 100 * aquantity a / aquantity b         _   -> -- trace (pshow $ (maybecost actual, maybecost budget))  -- debug missing percentage                Nothing       where-        maybecost = case cost_ of-            Cost   -> mixedAmountCost-            NoCost -> id+        costedAmounts = case cost_ of+            Cost   -> amounts . mixedAmountCost+            NoCost -> amounts      maybetranspose | transpose_ = \(Table rh ch vals) -> Table ch rh (transpose vals)                    | otherwise  = id@@ -300,8 +284,8 @@   (PeriodicReport spans rows (PeriodicReportRow _ coltots grandtot grandavg)) =     addtotalrow $     Table-      (T.Group NoLine $ map Header accts)-      (T.Group NoLine $ map Header colheadings)+      (Tab.Group NoLine $ map Header accts)+      (Tab.Group NoLine $ map Header colheadings)       (map rowvals rows)   where     colheadings = map (reportPeriodName balancetype_ spans) spans@@ -323,27 +307,6 @@                        coltots ++ [grandtot | row_total_ ropts && not (null coltots)]                                ++ [grandavg | average_ ropts && not (null coltots)]                     ))---- | Make a name for the given period in a multiperiod report, given--- the type of balance being reported and the full set of report--- periods. This will be used as a column heading (or row heading, in--- a register summary report). We try to pick a useful name as follows:------ - ending-balance reports: the period's end date------ - balance change reports where the periods are months and all in the same year:---   the short month name in the current locale------ - all other balance change reports: a description of the datespan,---   abbreviated to compact form if possible (see showDateSpan).----reportPeriodName :: BalanceType -> [DateSpan] -> DateSpan -> T.Text-reportPeriodName balancetype spans =-  case balancetype of-    PeriodChange -> if multiyear then showDateSpan else showDateSpanMonthAbbrev-      where-        multiyear = (>1) $ length $ nubSort $ map spanStartYear spans-    _ -> maybe "" (showDate . prevday) . spanEnd  -- XXX generalise this with multiBalanceReportAsCsv ? -- | Render a budget report as CSV. Like multiBalanceReportAsCsv,

@@ -1,4 +1,6 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances, ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-} {-|  Journal entries report, used by the print command.@@ -15,12 +17,11 @@ where  import Data.List (sortBy)-import Data.Maybe (fromMaybe) import Data.Ord (comparing) import Data.Time (fromGregorian)  import Hledger.Data-import Hledger.Query+import Hledger.Query (Query(..)) import Hledger.Reports.ReportOptions import Hledger.Utils @@ -33,15 +34,9 @@  -- | Select transactions for an entries report. entriesReport :: ReportSpec -> Journal -> EntriesReport-entriesReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j@Journal{..} =-  sortBy (comparing getdate) $ filter (rsQuery rspec `matchesTransaction`) $ map tvalue jtxns-  where-    getdate = transactionDateFn ropts-    -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".-    tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings}-      where-        pvalue = postingApplyCostValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) cost_ value_-          where periodlast  = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j+entriesReport rspec@ReportSpec{rsOpts=ropts} =+    sortBy (comparing $ transactionDateFn ropts) . jtxns . filterJournalTransactions (rsQuery rspec)+    . journalApplyValuationFromOpts rspec{rsOpts=ropts{show_costs_=True}}  tests_EntriesReport = tests "EntriesReport" [   tests "entriesReport" [

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP                 #-} {-# LANGUAGE FlexibleInstances   #-} {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE RecordWildCards     #-}@@ -42,13 +41,10 @@ import qualified Data.HashMap.Strict as HM import Data.Map (Map) import qualified Data.Map as M-import Data.Maybe (fromMaybe, mapMaybe)+import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Ord (Down(..))-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif import Data.Semigroup (sconcat)-import Data.Time.Calendar (Day, addDays, fromGregorian)+import Data.Time.Calendar (Day, fromGregorian) import Safe (lastDef, minimumMay)  import Hledger.Data@@ -115,7 +111,7 @@     rspec      = dbg3 "reportopts" $ makeReportQuery rspec' reportspan      -- Group postings into their columns.-    colps    = dbg5 "colps"  $ getPostingsByColumn rspec j reportspan+    colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle reportspan      -- The matched accounts with a starting balance. All of these should appear     -- in the report, even if they have no postings during the report period.@@ -143,7 +139,7 @@     rspec      = dbg3 "reportopts" $ makeReportQuery rspec' reportspan      -- Group postings into their columns.-    colps    = dbg5 "colps"  $ getPostingsByColumn rspec j reportspan+    colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle reportspan      -- The matched accounts with a starting balance. All of these should appear     -- in the report, even if they have no postings during the report period.@@ -174,7 +170,7 @@         (r:rs) -> sconcat $ fmap subreportTotal (r:|rs)       where         subreportTotal (_, sr, increasestotal) =-            (if increasestotal then id else fmap negate) $ prTotals sr+            (if increasestotal then id else fmap maNegate) $ prTotals sr      cbr = CompoundPeriodicReport "" (M.keys colps) subreports overalltotals @@ -191,7 +187,7 @@     fmap (M.findWithDefault nullacct precedingspan) acctmap   where     acctmap = calculateReportMatrix rspec' j priceoracle mempty-            . M.singleton precedingspan . map fst $ getPostings rspec' j+            . M.singleton precedingspan . map fst $ getPostings rspec' j priceoracle      rspec' = rspec{rsQuery=startbalq,rsOpts=ropts'}     -- If we're re-valuing every period, we need to have the unvalued start@@ -229,11 +225,11 @@     dateqcons        = if date2_ (rsOpts rspec) then Date2 else Date  -- | Group postings, grouped by their column-getPostingsByColumn :: ReportSpec -> Journal -> DateSpan -> Map DateSpan [Posting]-getPostingsByColumn rspec j reportspan = columns+getPostingsByColumn :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> Map DateSpan [Posting]+getPostingsByColumn rspec j priceoracle reportspan = columns   where     -- Postings matching the query within the report period.-    ps :: [(Posting, Day)] = dbg5 "getPostingsByColumn" $ getPostings rspec j+    ps :: [(Posting, Day)] = dbg5 "getPostingsByColumn" $ getPostings rspec j priceoracle      -- The date spans to be included as report columns.     colspans = dbg3 "colspans" $ splitSpan (interval_ $ rsOpts rspec) reportspan@@ -244,12 +240,13 @@     columns = foldr addPosting emptyMap ps  -- | Gather postings matching the query within the report period.-getPostings :: ReportSpec -> Journal -> [(Posting, Day)]-getPostings ReportSpec{rsQuery=query,rsOpts=ropts} =+getPostings :: ReportSpec -> Journal -> PriceOracle -> [(Posting, Day)]+getPostings rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j priceoracle =     map (\p -> (p, date p)) .     journalPostings .-    filterJournalAmounts symq .    -- remove amount parts excluded by cur:-    filterJournalPostings reportq  -- remove postings not matched by (adjusted) query+    filterJournalAmounts symq .      -- remove amount parts excluded by cur:+    filterJournalPostings reportq $  -- remove postings not matched by (adjusted) query+    valuedJournal   where     symq = dbg3 "symq" . filterQuery queryIsSym $ dbg3 "requested q" query     -- The user's query with no depth limit, and expanded to the report span@@ -257,6 +254,8 @@     -- handles the hledger-ui+future txns case above).     reportq = dbg3 "reportq" $ depthless query     depthless = dbg3 "depthless" . filterQuery (not . queryIsDepth)+    valuedJournal | isJust (valuationAfterSum ropts) = j+                  | otherwise = journalApplyValuationFromOptsWith rspec j priceoracle      date = case whichDateFromOpts ropts of         PrimaryDate   -> postingDate@@ -295,7 +294,7 @@     -- starting-balance-based historical balances.     rowbals name changes = dbg5 "rowbals" $ case balancetype_ ropts of         PeriodChange      -> changeamts-        CumulativeChange  -> cumulativeSum avalue nullacct changeamts+        CumulativeChange  -> cumulative         HistoricalBalance -> historical       where         -- changes to report on: usually just the changes itself, but use the@@ -304,6 +303,7 @@             ChangeReport      -> M.mapWithKey avalue changes             BudgetReport      -> M.mapWithKey avalue changes             ValueChangeReport -> periodChanges valuedStart historical+        cumulative = cumulativeSum avalue nullacct changeamts         historical = cumulativeSum avalue startingBalance changes         startingBalance = HM.lookupDefault nullacct name startbals         valuedStart = avalue (DateSpan Nothing historicalDate) startingBalance@@ -312,10 +312,10 @@     -- pad with zeros     allchanges     = ((<>zeros) <$> acctchanges) <> (zeros <$ startbals)     acctchanges    = dbg5 "acctchanges" . addElided $ transposeMap colacctchanges-    colacctchanges = dbg5 "colacctchanges" $ fmap (acctChangesFromPostings rspec) valuedps-    valuedps = M.mapWithKey (\colspan -> map (pvalue colspan)) colps+    colacctchanges = dbg5 "colacctchanges" $ fmap (acctChangesFromPostings rspec) colps -    (pvalue, avalue) = postingAndAccountValuations rspec j priceoracle+    avalue = acctApplyBoth . mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle+    acctApplyBoth f a = a{aibalance = f $ aibalance a, aebalance = f $ aebalance a}     addElided = if queryDepth (rsQuery rspec) == Just 0 then HM.insert "..." zeros else id     historicalDate = minimumMay $ mapMaybe spanStart colspans     zeros = M.fromList [(span, nullacct) | span <- colspans]@@ -338,7 +338,7 @@     displaynames = dbg5 "displaynames" $ displayedAccounts rspec matrix      -- All the rows of the report.-    rows = dbg5 "rows" . (if invert_ ropts then map (fmap negate) else id)  -- Negate amounts if applicable+    rows = dbg5 "rows" . (if invert_ ropts then map (fmap maNegate) else id)  -- Negate amounts if applicable              $ buildReportRows ropts displaynames matrix      -- Calculate column totals@@ -357,7 +357,7 @@                 -> HashMap AccountName DisplayName                 -> HashMap AccountName (Map DateSpan Account)                 -> [MultiBalanceReportRow]-buildReportRows ropts displaynames = +buildReportRows ropts displaynames =   toList . HM.mapMaybeWithKey mkRow  -- toList of HashMap's Foldable instance - does not sort consistently   where     mkRow name accts = do@@ -369,8 +369,8 @@         -- These are always simply the sum/average of the displayed row amounts.         -- Total for a cumulative/historical report is always the last column.         rowtot = case balancetype_ ropts of-            PeriodChange -> sum rowbals-            _            -> lastDef 0 rowbals+            PeriodChange -> maSum rowbals+            _            -> lastDef nullmixedamt rowbals         rowavg = averageMixedAmounts rowbals     balance = case accountlistmode_ ropts of ALTree -> aibalance; ALFlat -> aebalance @@ -407,8 +407,9 @@            || not (isZeroRow balance amts))            -- Throw out anything with zero balance       where         d = accountNameLevel name-        balance | ALTree <- accountlistmode_ ropts, d == depth = aibalance-                | otherwise = aebalance+        balance | ALTree <- accountlistmode_ ropts, d == depth = maybeStripPrices . aibalance+                | otherwise = maybeStripPrices . aebalance+          where maybeStripPrices = if show_costs_ ropts then id else mixedAmountStripPrices      -- Accounts interesting because they are a fork for interesting subaccounts     interestingParents = dbg5 "interestingParents" $ case accountlistmode_ ropts of@@ -439,7 +440,7 @@         -- Set the inclusive balance of an account from the rows, or sum the         -- subaccounts if it's not present         accounttreewithbals = mapAccounts setibalance accounttree-        setibalance a = a{aibalance = maybe (sum . map aibalance $ asubs a) prrTotal $+        setibalance a = a{aibalance = maybe (maSum . map aibalance $ asubs a) prrTotal $                                           HM.lookup (aname a) rowMap}         sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ ropts) accounttreewithbals         sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree@@ -449,7 +450,7 @@     sortFlatMBRByAmount = case fromMaybe NormallyPositive $ normalbalance_ ropts of         NormallyPositive -> sortOn (\r -> (Down $ amt r, prrFullName r))         NormallyNegative -> sortOn (\r -> (amt r, prrFullName r))-      where amt = normaliseMixedAmountSquashPricesForDisplay . prrTotal+      where amt = mixedAmountStripPrices . prrTotal      -- Sort the report rows by account declaration order then account name.     sortMBRByAccountDeclaration :: [MultiBalanceReportRow] -> [MultiBalanceReportRow]@@ -470,14 +471,14 @@      colamts = transpose . map prrAmounts $ filter isTopRow rows -    coltotals :: [MixedAmount] = dbg5 "coltotals" $ map sum colamts+    coltotals :: [MixedAmount] = dbg5 "coltotals" $ map maSum colamts      -- Calculate the grand total and average. These are always the sum/average     -- of the column totals.     -- Total for a cumulative/historical report is always the last column.     grandtotal = case balancetype_ ropts of-        PeriodChange -> sum coltotals-        _            -> lastDef 0 coltotals+        PeriodChange -> maSum coltotals+        _            -> lastDef nullmixedamt coltotals     grandaverage = averageMixedAmounts coltotals  -- | Map the report rows to percentages if needed@@ -515,8 +516,7 @@ -- those which fork between different branches subaccountTallies :: [AccountName] -> HashMap AccountName Int subaccountTallies = foldr incrementParent mempty . expandAccountNames-  where-    incrementParent a = HM.insertWith (+) (parentAccountName a) 1+  where incrementParent a = HM.insertWith (+) (parentAccountName a) 1  -- | A helper: what percentage is the second mixed amount of the first ? -- Keeps the sign of the first amount.@@ -535,12 +535,12 @@ -- in scanl, so other properties (such as anumpostings) stay in the right place sumAcct :: Account -> Account -> Account sumAcct Account{aibalance=i1,aebalance=e1} a@Account{aibalance=i2,aebalance=e2} =-    a{aibalance = i1 + i2, aebalance = e1 + e2}+    a{aibalance = i1 `maPlus` i2, aebalance = e1 `maPlus` e2}  -- Subtract the values in one account from another. Should be left-biased. subtractAcct :: Account -> Account -> Account subtractAcct a@Account{aibalance=i1,aebalance=e1} Account{aibalance=i2,aebalance=e2} =-    a{aibalance = i1 - i2, aebalance = e1 - e2}+    a{aibalance = i1 `maMinus` i2, aebalance = e1 `maMinus` e2}  -- | Extract period changes from a cumulative list periodChanges :: Account -> Map k Account -> Map k Account@@ -554,21 +554,6 @@ cumulativeSum value start = snd . M.mapAccumWithKey accumValued start   where accumValued startAmt date newAmt = let s = sumAcct startAmt newAmt in (s, value date s) --- | Calculate the Posting and Account valuation functions required by this--- MultiBalanceReport.-postingAndAccountValuations :: ReportSpec -> Journal -> PriceOracle-                            -> (DateSpan -> Posting -> Posting, DateSpan -> Account -> Account)-postingAndAccountValuations ReportSpec{rsToday=today, rsOpts=ropts} j priceoracle = case value_ ropts of-    Just (AtEnd _) -> (const id, avalue' (cost_ ropts) (value_ ropts))-    _              -> (pvalue' (cost_ ropts) (value_ ropts), const id)-  where-    avalue' c v span a = a{aibalance = value (aibalance a), aebalance = value (aebalance a)}-      where value = mixedAmountApplyCostValuation priceoracle styles (end span) today (error "multiBalanceReport: did not expect amount valuation to be called ") c v  -- PARTIAL: should not happen-    pvalue' c v span = postingApplyCostValuation priceoracle styles (end span) today c v-    end = fromMaybe (error "multiBalanceReport: expected all spans to have an end date")  -- XXX should not happen-        . fmap (addDays (-1)) . spanEnd-    styles = journalCommodityStyles j- -- tests  tests_MultiBalanceReport = tests "MultiBalanceReport" [@@ -586,13 +571,13 @@   in    tests "multiBalanceReport" [       test "null journal"  $-      (defreportspec, nulljournal) `gives` ([], Mixed [nullamt])+      (defreportspec, nulljournal) `gives` ([], nullmixedamt)       ,test "with -H on a populated period"  $       (defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}}, samplejournal) `gives`        (-        [ PeriodicReportRow (flatDisplayName "assets:bank:checking") [mamountp' "$1.00"]  (mamountp' "$1.00")  (Mixed [amt0 {aquantity=1}])-        , PeriodicReportRow (flatDisplayName "income:salary")        [mamountp' "$-1.00"] (mamountp' "$-1.00") (Mixed [amt0 {aquantity=(-1)}])+        [ PeriodicReportRow (flatDisplayName "assets:bank:checking") [mamountp' "$1.00"]  (mamountp' "$1.00")  (mixedAmount amt0{aquantity=1})+        , PeriodicReportRow (flatDisplayName "income:salary")        [mamountp' "$-1.00"] (mamountp' "$-1.00") (mixedAmount amt0{aquantity=(-1)})         ],         mamountp' "$0.00") @@ -600,23 +585,23 @@      --  (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3), balancetype_=HistoricalBalance}, samplejournal) `gives`      --   (      --    [-     --     ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}])-     --    ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amt0 {aquantity=(-1)}])+     --     ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=1})+     --    ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",mixedAmount amt0 {aquantity=(-1)})      --    ],-     --    Mixed [usd0])+     --    mixedAmount usd0)       -- ,test "a valid history on an empty period (more complex)"  $      --  (defreportopts{period_= PeriodBetween (fromGregorian 2009 1 1) (fromGregorian 2009 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives`      --   (      --    [-     --    ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}])-     --    ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}])-     --    ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",Mixed [amt0 {aquantity=(-2)}])-     --    ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=(1)}])-     --    ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=(1)}])-     --    ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amt0 {aquantity=(-1)}])-     --    ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amt0 {aquantity=(-1)}])+     --    ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=1})+     --    ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=1})+     --    ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",mixedAmount amt0 {aquantity=(-2)})+     --    ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=(1)})+     --    ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=(1)})+     --    ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",mixedAmount amt0 {aquantity=(-1)})+     --    ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",mixedAmount amt0 {aquantity=(-1)})      --    ],-     --    Mixed [usd0])+     --    mixedAmount usd0)     ]  ]

@@ -4,11 +4,11 @@  -} -{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE RecordWildCards     #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TupleSections       #-}  module Hledger.Reports.PostingsReport (   PostingsReport,@@ -21,11 +21,11 @@ ) where -import Data.List+import Data.List (nub, sortOn) import Data.List.Extra (nubSort)-import Data.Maybe+import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Text (Text)-import Data.Time.Calendar+import Data.Time.Calendar (Day, addDays) import Safe (headMay, lastMay)  import Hledger.Data@@ -68,28 +68,18 @@       reportspan  = reportSpanBothDates j rspec       whichdate   = whichDateFromOpts ropts       mdepth      = queryDepth $ rsQuery rspec-      styles      = journalCommodityStyles j-      priceoracle = journalPriceOracle infer_value_ j       multiperiod = interval_ /= NoInterval        -- postings to be included in the report, and similarly-matched postings before the report start date       (precedingps, reportps) = matchedPostingsBeforeAndDuring rspec j reportspan -      -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".-      pvalue periodlast = postingApplyCostValuation priceoracle styles periodlast (rsToday rspec) cost_ value_-       -- Postings, or summary postings with their subperiod's end date, to be displayed.       displayps :: [(Posting, Maybe Day)]-        | multiperiod, Just (AtEnd _) <- value_ = [(pvalue lastday p, Just periodend) | (p, periodend) <- summariseps reportps, let lastday = addDays (-1) periodend]-        | multiperiod = [(p, Just periodend) | (p, periodend) <- summariseps valuedps]-        | otherwise   = [(p, Nothing) | p <- valuedps]+        | multiperiod = [(p, Just periodend) | (p, periodend) <- summariseps reportps]+        | otherwise   = [(p, Nothing) | p <- reportps]         where           summariseps = summarisePostingsByInterval interval_ whichdate mdepth showempty reportspan-          valuedps = map (pvalue reportorjournallast) reportps           showempty = empty_ || average_-          reportorjournallast =-            fromMaybe (error' "postingsReport: expected a non-empty journal") $  -- PARTIAL: shouldn't happen-            reportPeriodOrJournalLastDay rspec j        -- Posting report items ready for display.       items =@@ -101,16 +91,11 @@           -- of --value on reports".           -- XXX balance report doesn't value starting balance.. should this ?           historical = balancetype_ == HistoricalBalance-          startbal | average_  = if historical then precedingavg else 0-                   | otherwise = if historical then precedingsum else 0+          startbal | average_  = if historical then precedingavg else nullmixedamt+                   | otherwise = if historical then precedingsum else nullmixedamt             where-              precedingsum = sumPostings $ map (pvalue daybeforereportstart) precedingps-              precedingavg | null precedingps = 0-                           | otherwise        = divideMixedAmount (fromIntegral $ length precedingps) precedingsum-              daybeforereportstart =-                maybe (error' "postingsReport: expected a non-empty journal")  -- PARTIAL: shouldn't happen-                (addDays (-1))-                $ reportPeriodOrJournalStart rspec j+              precedingsum = sumPostings precedingps+              precedingavg = divideMixedAmount (fromIntegral $ length precedingps) precedingsum            runningcalc = registerRunningCalculationFn ropts           startnum = if historical then length precedingps + 1 else 1@@ -121,18 +106,18 @@ -- and return the new average/total. registerRunningCalculationFn :: ReportOpts -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) registerRunningCalculationFn ropts-  | average_ ropts = \i avg amt -> avg + divideMixedAmount (fromIntegral i) (amt - avg)-  | otherwise      = \_ bal amt -> bal + amt+  | average_ ropts = \i avg amt -> avg `maPlus` divideMixedAmount (fromIntegral i) (amt `maMinus` avg)+  | otherwise      = \_ bal amt -> bal `maPlus` amt  -- | Find postings matching a given query, within a given date span, -- and also any similarly-matched postings before that date span. -- Date restrictions and depth restrictions in the query are ignored. -- A helper for the postings report. matchedPostingsBeforeAndDuring :: ReportSpec -> Journal -> DateSpan -> ([Posting],[Posting])-matchedPostingsBeforeAndDuring ReportSpec{rsOpts=ropts,rsQuery=q} j (DateSpan mstart mend) =+matchedPostingsBeforeAndDuring rspec@ReportSpec{rsOpts=ropts,rsQuery=q} j reportspan =   dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps   where-    beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing mstart+    beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing $ spanStart reportspan     beforeandduringps =       dbg5 "ps5" $ sortOn sortdate $                                             -- sort postings by date or date2       dbg5 "ps4" $ (if invert_ ropts then map negatePostingAmount else id) $     -- with --invert, invert amounts@@ -140,13 +125,13 @@       dbg5 "ps2" $ (if related_ ropts then concatMap relatedPostings else id) $  -- with -r, replace each with its sibling postings       dbg5 "ps1" $ filter (beforeandduringq `matchesPosting`) $                  -- filter postings by the query, with no start date or depth limit                   journalPostings $-                  journalSelectingAmountFromOpts ropts j    -- maybe convert to cost early, will be seen by amt:. XXX what about converting to value ?+                  journalApplyValuationFromOpts rspec j                          -- convert to cost and apply valuation       where         beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq]           where             depthless  = filterQuery (not . queryIsDepth)             dateless   = filterQuery (not . queryIsDateOrDate2)-            beforeendq = dateqtype $ DateSpan Nothing mend+            beforeendq = dateqtype $ DateSpan Nothing $ spanEnd reportspan         sortdate = if date2_ ropts then postingDate2 else postingDate         symq = dbg4 "symq" $ filterQuery queryIsSym q     dateqtype@@ -169,7 +154,7 @@     isdifferentdate = case wd of PrimaryDate   -> postingDate p  /= postingDate pprev                                  SecondaryDate -> postingDate2 p /= postingDate2 pprev     p' = p{paccount= clipOrEllipsifyAccountName d $ paccount p}-    b' = runningcalcfn itemnum b (pamount p)+    b' = runningcalcfn itemnum b $ pamount p  -- | Generate one postings report line item, containing the posting, -- the current running balance, and optionally the posting date and/or@@ -218,7 +203,7 @@     e' = fromMaybe (maybe (addDays 1 nulldate) postingdate $ lastMay ps) e     summaryp = nullposting{pdate=Just b'}     clippedanames = nub $ map (clipAccountName mdepth) anames-    summaryps | mdepth == Just 0 = [summaryp{paccount="...",pamount=sum $ map pamount ps}]+    summaryps | mdepth == Just 0 = [summaryp{paccount="...",pamount=sumPostings ps}]               | otherwise        = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames]     summarypes = map (, e') $ (if showempty then id else filter (not . mixedAmountLooksZero . pamount)) summaryps     anames = nubSort $ map paccount ps@@ -227,10 +212,10 @@     balance a = maybe nullmixedamt bal $ lookupAccount a accts       where         bal = if isclipped a then aibalance else aebalance-        isclipped a = maybe True (accountNameLevel a >=) mdepth+        isclipped a = maybe False (accountNameLevel a >=) mdepth  negatePostingAmount :: Posting -> Posting-negatePostingAmount p = p { pamount = negate $ pamount p }+negatePostingAmount = postingTransformAmount negate   -- tests@@ -407,10 +392,10 @@     --           (summarisePostingsInDateSpan (DateSpan b e) depth showempty ps `is`)     --   let ps =     --           [-    --            nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]}-    --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=Mixed [usd 2]}-    --           ,nullposting{lpdescription="desc",lpaccount="expenses:food",          lpamount=Mixed [usd 4]}-    --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=Mixed [usd 8]}+    --            nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=mixedAmount (usd 1)}+    --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=mixedAmount (usd 2)}+    --           ,nullposting{lpdescription="desc",lpaccount="expenses:food",          lpamount=mixedAmount (usd 4)}+    --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=mixedAmount (usd 8)}     --           ]     --   ("2008/01/01","2009/01/01",0,9999,False,[]) `gives`     --    []@@ -420,21 +405,21 @@     --    ]     --   ("2008/01/01","2009/01/01",0,9999,False,ts) `gives`     --    [-    --     nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food",          lpamount=Mixed [usd 4]}-    --    ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:dining",   lpamount=Mixed [usd 10]}-    --    ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]}+    --     nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food",          lpamount=mixedAmount (usd 4)}+    --    ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:dining",   lpamount=mixedAmount (usd 10)}+    --    ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=mixedAmount (usd 1)}     --    ]     --   ("2008/01/01","2009/01/01",0,2,False,ts) `gives`     --    [-    --     nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=Mixed [usd 15]}+    --     nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=mixedAmount (usd 15)}     --    ]     --   ("2008/01/01","2009/01/01",0,1,False,ts) `gives`     --    [-    --     nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=Mixed [usd 15]}+    --     nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=mixedAmount (usd 15)}     --    ]     --   ("2008/01/01","2009/01/01",0,0,False,ts) `gives`     --    [-    --     nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [usd 15]}+    --     nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="",lpamount=mixedAmount (usd 15)}     --    ]   ]

@@ -28,7 +28,10 @@   reportOptsToggleStatus,   simplifyStatuses,   whichDateFromOpts,-  journalSelectingAmountFromOpts,+  journalApplyValuationFromOpts,+  journalApplyValuationFromOptsWith,+  mixedAmountApplyValuationAfterSumFromOptsWith,+  valuationAfterSum,   intervalFromRawOpts,   forecastPeriodFromRawOpts,   queryFromFlags,@@ -42,20 +45,19 @@   reportPeriodOrJournalStart,   reportPeriodLastDay,   reportPeriodOrJournalLastDay,+  reportPeriodName ) where  import Control.Applicative ((<|>))+import Control.Monad ((<=<)) import Data.List.Extra (nubSort)-import Data.Maybe (fromMaybe, isJust, mapMaybe)+import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Text as T import Data.Time.Calendar (Day, addDays) import Data.Default (Default(..)) import Safe (headMay, lastDef, lastMay, maximumMay) -import System.Console.ANSI (hSupportsANSIColor)-import System.Environment (lookupEnv)-import System.IO (stdout) import Text.Megaparsec.Custom  import Hledger.Data@@ -118,6 +120,7 @@     ,drop_           :: Int     ,row_total_      :: Bool     ,no_total_       :: Bool+    ,show_costs_     :: Bool  -- ^ Whether to show costs for reports which normally don't show them     ,pretty_tables_  :: Bool     ,sort_amount_    :: Bool     ,percent_        :: Bool@@ -165,6 +168,7 @@     , drop_            = 0     , row_total_       = False     , no_total_        = False+    , show_costs_      = False     , pretty_tables_   = False     , sort_amount_     = False     , percent_         = False@@ -178,11 +182,8 @@ rawOptsToReportOpts :: RawOpts -> IO ReportOpts rawOptsToReportOpts rawopts = do     d <- getCurrentDay-    no_color <- isJust <$> lookupEnv "NO_COLOR"-    supports_color <- hSupportsANSIColor stdout -    let colorflag    = stringopt "color" rawopts-        formatstring = T.pack <$> maybestringopt "format" rawopts+    let formatstring = T.pack <$> maybestringopt "format" rawopts         querystring  = map T.pack $ listofstringopt "args" rawopts  -- doesn't handle an arg like "" right         (costing, valuation) = valuationTypeFromRawOpts rawopts @@ -214,14 +215,12 @@           ,drop_        = posintopt "drop" rawopts           ,row_total_   = boolopt "row-total" rawopts           ,no_total_    = boolopt "no-total" rawopts+          ,show_costs_  = boolopt "show-costs" rawopts           ,sort_amount_ = boolopt "sort-amount" rawopts           ,percent_     = boolopt "percent" rawopts           ,invert_      = boolopt "invert" rawopts           ,pretty_tables_ = boolopt "pretty-tables" rawopts-          ,color_       = and [not no_color-                              ,not $ colorflag `elem` ["never","no"]-                              ,colorflag `elem` ["always","yes"] || supports_color-                              ]+          ,color_       = useColorOnStdout -- a lower-level helper           ,forecast_    = forecastPeriodFromRawOpts d rawopts           ,transpose_   = boolopt "transpose" rawopts           }@@ -493,14 +492,62 @@ -- depthFromOpts :: ReportOpts -> Int -- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts) --- | Convert this journal's postings' amounts to cost using their--- transaction prices, if specified by options (-B/--cost).--- Maybe soon superseded by newer valuation code.-journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal-journalSelectingAmountFromOpts opts = case cost_ opts of-    Cost   -> journalToCost-    NoCost -> id+-- | Convert this journal's postings' amounts to cost and/or to value, if specified+-- by options (-B/--cost/-V/-X/--value etc.). Strip prices if not needed. This+-- should be the main stop for performing costing and valuation. The exception is+-- whenever you need to perform valuation _after_ summing up amounts, as in a+-- historical balance report with --value=end. valuationAfterSum will check for this+-- condition.+journalApplyValuationFromOpts :: ReportSpec -> Journal -> Journal+journalApplyValuationFromOpts rspec j =+    journalApplyValuationFromOptsWith rspec j priceoracle+  where priceoracle = journalPriceOracle (infer_value_ $ rsOpts rspec) j +-- | Like journalApplyValuationFromOpts, but takes PriceOracle as an argument.+journalApplyValuationFromOptsWith :: ReportSpec -> Journal -> PriceOracle -> Journal+journalApplyValuationFromOptsWith rspec@ReportSpec{rsOpts=ropts} j priceoracle =+    journalMapPostings valuation $ costing j+  where+    valuation p = maybe id (postingApplyValuation priceoracle styles (periodEnd p) (rsToday rspec)) (value_ ropts) p+    costing = case cost_ ropts of+        Cost   -> journalToCost+        NoCost -> id++    -- Find the end of the period containing this posting+    periodEnd  = addDays (-1) . fromMaybe err . mPeriodEnd . postingDate+    mPeriodEnd = spanEnd <=< latestSpanContaining (historical : spans)+    historical = DateSpan Nothing $ spanStart =<< headMay spans+    spans = splitSpan (interval_ ropts) $ reportSpanBothDates j rspec+    styles = journalCommodityStyles j+    err = error "journalApplyValuationFromOpts: expected all spans to have an end date"++-- | Select the Account valuation functions required for performing valuation after summing+-- amounts. Used in MultiBalanceReport to value historical and similar reports.+mixedAmountApplyValuationAfterSumFromOptsWith :: ReportOpts -> Journal -> PriceOracle+                                              -> (DateSpan -> MixedAmount -> MixedAmount)+mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle =+    case valuationAfterSum ropts of+      Just mc -> \span -> valuation mc span . costing+      Nothing -> const id+  where+    valuation mc span = mixedAmountValueAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd span)+      where err = error "mixedAmountApplyValuationAfterSumFromOptsWith: expected all spans to have an end date"+    costing = case cost_ ropts of+        Cost   -> styleMixedAmount styles . mixedAmountCost+        NoCost -> id+    styles = journalCommodityStyles j++-- | If the ReportOpts specify that we are performing valuation after summing amounts,+-- return Just the commodity symbol we're converting to, otherwise return Nothing.+-- Used for example with historical reports with --value=end.+valuationAfterSum :: ReportOpts -> Maybe (Maybe CommoditySymbol)+valuationAfterSum ropts = case value_ ropts of+    Just (AtEnd mc) | valueAfterSum -> Just mc+    _                               -> Nothing+  where valueAfterSum = reporttype_  ropts == ValueChangeReport+                     || balancetype_ ropts /= PeriodChange++ -- | Convert report options to a query, ignoring any non-flag command line arguments. queryFromFlags :: ReportOpts -> Query queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq@@ -519,8 +566,6 @@ -- options or queries, or otherwise the earliest and latest transaction or -- posting dates in the journal. If no dates are specified by options/queries -- and the journal is empty, returns the null date span.--- The boolean argument flags whether primary and secondary dates are considered--- equivalently. reportSpan :: Journal -> ReportSpec -> DateSpan reportSpan = reportSpanHelper False @@ -594,3 +639,23 @@         Just (AtEnd _) -> max (journalEndDate False j) lastPriceDirective         _              -> journalEndDate False j     lastPriceDirective = fmap (addDays 1) . maximumMay . map pddate $ jpricedirectives j++-- | Make a name for the given period in a multiperiod report, given+-- the type of balance being reported and the full set of report+-- periods. This will be used as a column heading (or row heading, in+-- a register summary report). We try to pick a useful name as follows:+--+-- - ending-balance reports: the period's end date+--+-- - balance change reports where the periods are months and all in the same year:+--   the short month name in the current locale+--+-- - all other balance change reports: a description of the datespan,+--   abbreviated to compact form if possible (see showDateSpan).+reportPeriodName :: BalanceType -> [DateSpan] -> DateSpan -> T.Text+reportPeriodName balancetype spans =+  case balancetype of+    PeriodChange -> if multiyear then showDateSpan else showDateSpanMonthAbbrev+      where+        multiyear = (>1) $ length $ nubSort $ map spanStartYear spans+    _ -> maybe "" (showDate . prevday) . spanEnd

@@ -1,7 +1,6 @@ {- | New common report types, used by the BudgetReport for now, perhaps all reports later. -}-{-# LANGUAGE CPP            #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveFunctor  #-} {-# LANGUAGE DeriveGeneric  #-}@@ -36,9 +35,6 @@ import Data.Decimal (Decimal) import Data.Maybe (mapMaybe) import Data.Text (Text)-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup (Semigroup(..))-#endif import GHC.Generics (Generic)  import Hledger.Data@@ -98,11 +94,11 @@   , prrAverage :: b    -- The average of this row's values.   } deriving (Show, Functor, Generic, ToJSON) -instance Num b => Semigroup (PeriodicReportRow a b) where+instance Semigroup b => Semigroup (PeriodicReportRow a b) where   (PeriodicReportRow _ amts1 t1 a1) <> (PeriodicReportRow n2 amts2 t2 a2) =-      PeriodicReportRow n2 (sumPadded amts1 amts2) (t1 + t2) (a1 + a2)+      PeriodicReportRow n2 (sumPadded amts1 amts2) (t1 <> t2) (a1 <> a2)     where-      sumPadded (a:as) (b:bs) = (a + b) : sumPadded as bs+      sumPadded (a:as) (b:bs) = (a <> b) : sumPadded as bs       sumPadded as     []     = as       sumPadded []     bs     = bs 

@@ -1,4 +1,5 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-} {-|  A transactions report. Like an EntriesReport, but with more@@ -21,10 +22,10 @@ ) where -import Data.List+import Data.List (sortBy) import Data.List.Extra (nubSort)+import Data.Ord (comparing) import Data.Text (Text)-import Data.Ord  import Hledger.Data import Hledger.Query@@ -60,13 +61,13 @@ -- "postingsReport" except with transaction-based report items which -- are ordered most recent first. XXX Or an EntriesReport - use that instead ? -- This is used by hledger-web's journal view.-transactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport-transactionsReport opts j q = items+transactionsReport :: ReportSpec -> Journal -> Query -> TransactionsReport+transactionsReport rspec j q = items    where      -- XXX items' first element should be the full transaction with all postings      items = reverse $ accountTransactionsReportItems q None nullmixedamt id ts-     ts    = sortBy (comparing date) $ filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts opts j-     date  = transactionDateFn opts+     ts    = sortBy (comparing date) $ filter (q `matchesTransaction`) $ jtxns $ journalApplyValuationFromOpts rspec j+     date = transactionDateFn $ rsOpts rspec  -- | Split a transactions report whose items may involve several commodities, -- into one or more single-commodity transactions reports.@@ -99,7 +100,7 @@         startbal = filterMixedAmountByCommodity c $ triBalance i         go _ [] = []         go bal ((t,t2,s,o,amt,_):is) = (t,t2,s,o,amt,bal'):go bal' is-          where bal' = bal + amt+          where bal' = bal `maPlus` amt  -- tests 

@@ -4,7 +4,9 @@ in the module hierarchy. This is the bottom of hledger's module graph.  -}-{-# LANGUAGE OverloadedStrings, LambdaCase #-}+{-# LANGUAGE CPP               #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}  module Hledger.Utils (---- provide these frequently used modules - or not, for clearer api:                           -- module Control.Monad,@@ -35,25 +37,21 @@ where  import Control.Monad (liftM, when)--- import Data.Char import Data.FileEmbed (makeRelativeToProject, embedStringFile)-import Data.List--- import Data.Maybe--- import Data.PPrint+import Data.List (foldl', foldl1') -- import Data.String.Here (hereFile) import Data.Text (Text) import qualified Data.Text.IO as T-import Data.Time.Clock-import Data.Time.LocalTime--- import Data.Text (Text)--- import qualified Data.Text as T+import Data.Time.Clock (getCurrentTime)+import Data.Time.LocalTime (LocalTime, ZonedTime, getCurrentTimeZone,+                            utcToLocalTime, utcToZonedTime) -- import Language.Haskell.TH.Quote (QuasiQuoter(..)) import Language.Haskell.TH.Syntax (Q, Exp) import System.Directory (getHomeDirectory)-import System.FilePath((</>), isRelative)+import System.FilePath (isRelative, (</>)) import System.IO--- import Text.Printf--- import qualified Data.Map as Map+  (Handle, IOMode (..), hGetEncoding, hSetEncoding, hSetNewlineMode,+   openFile, stdin, universalNewlineMode, utf8_bom)  import Hledger.Utils.Debug import Hledger.Utils.Parse@@ -160,7 +158,7 @@ expandPath _ "-" = return "-" expandPath curdir p = (if isRelative p then (curdir </>) else id) `liftM` expandHomePath p -- PARTIAL:-  + -- | Expand user home path indicated by tilde prefix expandHomePath :: FilePath -> IO FilePath expandHomePath = \case

@@ -1,8 +1,5 @@ -- | Basic color helpers for prettifying console output. -{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}- module Hledger.Utils.Color (   color,@@ -14,9 +11,6 @@ ) where -#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif import qualified Data.Text.Lazy.Builder as TB import System.Console.ANSI import Hledger.Utils.Text (WideBuilder(..))

@@ -87,14 +87,13 @@   ,dbg7IO   ,dbg8IO   ,dbg9IO-  -- ** Trace to a file-  ,plog-  ,plogAt   -- ** Trace the state of hledger parsers   ,traceParse   ,dbgparse   ,module Debug.Trace-)+  ,useColorOnStdout+  ,useColorOnStderr+  ) where  import           Control.Monad (when)@@ -105,20 +104,25 @@ import           Debug.Trace import           Hledger.Utils.Parse import           Safe (readDef)-import           System.Environment (getArgs)+import           System.Environment (getArgs, lookupEnv) import           System.Exit import           System.IO.Unsafe (unsafePerformIO) import           Text.Megaparsec import           Text.Printf import           Text.Pretty.Simple  -- (defaultOutputOptionsDarkBg, OutputOptions(..), pShowOpt, pPrintOpt)+import Data.Maybe (isJust)+import System.Console.ANSI (hSupportsANSIColor)+import System.IO (stdout, Handle, stderr)  prettyopts = -    defaultOutputOptionsDarkBg-    -- defaultOutputOptionsLightBg-    -- defaultOutputOptionsNoColor+  baseopts     { outputOptionsIndentAmount=2     , outputOptionsCompact=True     }+  where+    baseopts+      | useColorOnStderr = defaultOutputOptionsDarkBg -- defaultOutputOptionsLightBg+      | otherwise        = defaultOutputOptionsNoColor  -- | Pretty print. Generic alias for pretty-simple's pPrint. pprint :: Show a => a -> IO ()@@ -139,8 +143,8 @@ traceWith :: Show a => (a -> String) -> a -> a traceWith f a = trace (f a) a --- | Global debug level, which controls the verbosity of debug output--- on the console. The default is 0 meaning no debug output. The+-- | Global debug level, which controls the verbosity of debug errput+-- on the console. The default is 0 meaning no debug errput. The -- @--debug@ command line flag sets it to 1, or @--debug=N@ sets it to -- a higher value (note: not @--debug N@ for some reason).  This uses -- unsafePerformIO and can be accessed from anywhere and before normal@@ -148,6 +152,7 @@ -- touch and reload this module to see the effect of a new --debug option. -- {-# OPTIONS_GHC -fno-cse #-} -- {-# NOINLINE debugLevel #-}+-- Avoid using dbg* in this function (infinite loop). debugLevel :: Int debugLevel = case snd $ break (=="--debug") args of                "--debug":[]  -> 1@@ -160,6 +165,108 @@     where       args = unsafePerformIO getArgs +-- Avoid using dbg*, pshow etc. in this function (infinite loop).+-- | Check the IO environment to see if ANSI colour codes should be used on stdout.+-- This is done using unsafePerformIO so it can be used anywhere, eg in +-- low-level debug utilities, which should be ok since we are just reading.+-- The logic is: use color if +-- a NO_COLOR environment variable is not defined+-- and the program was not started with --color=no|never+-- and (+--   the program was started with --color=yes|always+--   or stdout supports ANSI color and -o/--output-file was not used or is "-"+-- ).+-- Caveats:+-- When running code in GHCI, this module must be reloaded to see a change.+-- {-# OPTIONS_GHC -fno-cse #-}+-- {-# NOINLINE useColorOnStdout #-}+useColorOnStdout :: Bool+useColorOnStdout = not hasOutputFile && useColorOnHandle stdout++-- Avoid using dbg*, pshow etc. in this function (infinite loop).+-- | Like useColorOnStdout, but checks for ANSI color support on stderr,+-- and is not affected by -o/--output-file.+-- {-# OPTIONS_GHC -fno-cse #-}+-- {-# NOINLINE useColorOnStdout #-}+useColorOnStderr :: Bool+useColorOnStderr = useColorOnHandle stderr++-- Avoid using dbg*, pshow etc. in this function (infinite loop).+-- XXX sorry, I'm just cargo-culting these pragmas:+-- {-# OPTIONS_GHC -fno-cse #-}+-- {-# NOINLINE useColorOnHandle #-}+useColorOnHandle :: Handle -> Bool+useColorOnHandle h = unsafePerformIO $ do+  no_color       <- isJust <$> lookupEnv "NO_COLOR"+  supports_color <- hSupportsANSIColor h+  let coloroption = colorOption+  return $ and [+     not no_color+    ,not $ coloroption `elem` ["never","no"]+    ,coloroption `elem` ["always","yes"] || supports_color+    ]++-- Keep synced with color/colour flag definition in hledger:CliOptions.+-- Avoid using dbg*, pshow etc. in this function (infinite loop).+-- | Read the value of the --color or --colour command line option provided at program startup+-- using unsafePerformIO. If this option was not provided, returns the empty string.+-- (When running code in GHCI, this module must be reloaded to see a change.)+-- {-# OPTIONS_GHC -fno-cse #-}+-- {-# NOINLINE colorOption #-}+colorOption :: String+colorOption = +  -- similar to debugLevel+  let args = unsafePerformIO getArgs in+  case snd $ break (=="--color") args of+    -- --color ARG+    "--color":v:_ -> v+    _ ->+      case take 1 $ filter ("--color=" `isPrefixOf`) args of+        -- --color=ARG+        ['-':'-':'c':'o':'l':'o':'r':'=':v] -> v+        _ ->+          case snd $ break (=="--colour") args of+            -- --colour ARG+            "--colour":v:_ -> v+            _ ->+              case take 1 $ filter ("--colour=" `isPrefixOf`) args of+                -- --colour=ARG+                ['-':'-':'c':'o':'l':'o':'u':'r':'=':v] -> v+                _ -> ""++-- Avoid using dbg*, pshow etc. in this function (infinite loop).+-- | Check whether the -o/--output-file option has been used at program startup+-- with an argument other than "-", using unsafePerformIO.+-- {-# OPTIONS_GHC -fno-cse #-}+-- {-# NOINLINE hasOutputFile #-}+hasOutputFile :: Bool+hasOutputFile = not $ outputFileOption `elem` [Nothing, Just "-"]++-- Keep synced with output-file flag definition in hledger:CliOptions.+-- Avoid using dbg*, pshow etc. in this function (infinite loop).+-- | Read the value of the -o/--output-file command line option provided at program startup,+-- if any, using unsafePerformIO.+-- (When running code in GHCI, this module must be reloaded to see a change.)+-- {-# OPTIONS_GHC -fno-cse #-}+-- {-# NOINLINE outputFileOption #-}+outputFileOption :: Maybe String+outputFileOption = +  let args = unsafePerformIO getArgs in+  case snd $ break ("-o" `isPrefixOf`) args of+    -- -oARG+    ('-':'o':v@(_:_)):_ -> Just v+    -- -o ARG+    "-o":v:_ -> Just v+    _ ->+      case snd $ break (=="--output-file") args of+        -- --output-file ARG+        "--output-file":v:_ -> Just v+        _ ->+          case take 1 $ filter ("--output-file=" `isPrefixOf`) args of+            -- --output=file=ARG+            ['-':'-':'o':'u':'t':'p':'u':'t':'-':'f':'i':'l':'e':'=':v] -> Just v+            _ -> Nothing+ -- | Trace (print to stderr) a string if the global debug level is at -- or above the specified level. At level 0, always prints. Otherwise, -- uses unsafePerformIO.@@ -311,37 +418,6 @@  dbg9IO :: (MonadIO m, Show a) => String -> a -> m () dbg9IO = ptraceAtIO 9---- | Log a label and a pretty-printed showable value to ./debug.log, then return it.--- Can fail, see plogAt.-plog :: Show a => String -> a -> a-plog = plogAt 0---- | Log a label and a pretty-printed showable value to ./debug.log,--- if the global debug level is at or above the specified level.--- At level 0, always logs. Otherwise, uses unsafePerformIO.--- Tends to fail if called more than once too quickly, at least when built with -threaded--- ("Exception: debug.log: openFile: resource busy (file is locked)").-plogAt :: Show a => Int -> String -> a -> a-plogAt lvl-    | lvl > 0 && debugLevel < lvl = flip const-    | otherwise = \s a ->-        let p = pshow a-            ls = lines p-            nlorspace | length ls > 1 = "\n"-                      | otherwise     = " " ++ take (10 - length s) (repeat ' ')-            ls' | length ls > 1 = map (" "++) ls-                | otherwise     = ls-            output = s++":"++nlorspace++intercalate "\n" ls'++"\n"-        in unsafePerformIO $ appendFile "debug.log" output >> return a---- XXX redundant ? More/less robust than plogAt ?--- -- | Like dbg, but writes the output to "debug.log" in the current directory.--- dbglog :: Show a => String -> a -> a--- dbglog label a =---   (unsafePerformIO $---     appendFile "debug.log" $ label ++ ": " ++ ppShow a ++ "\n")---   `seq` a  -- | Print the provided label (if non-null) and current parser state -- (position and next input) to the console. See also megaparsec's dbg.

@@ -19,6 +19,7 @@   parseerror,   showDateParseError,   nonspace,+  isNewline,   isNonNewlineSpace,   restofline,   eolof,@@ -119,13 +120,15 @@   :: (Show t, Show (Token t), Show e) => ParseErrorBundle t e -> String showDateParseError e = printf "date parse error (%s)" (intercalate ", " $ tail $ lines $ show e) +isNewline :: Char -> Bool +isNewline '\n' = True+isNewline _    = False+ nonspace :: TextParser m Char nonspace = satisfy (not . isSpace)  isNonNewlineSpace :: Char -> Bool-isNonNewlineSpace c = c /= '\n' && isSpace c--- XXX support \r\n ?--- isNonNewlineSpace c = c /= '\n' && c /= '\r' && isSpace c+isNonNewlineSpace c = not (isNewline c) && isSpace c  spacenonewline :: (Stream s, Char ~ Token s) => ParsecT CustomErr s m Char spacenonewline = satisfy isNonNewlineSpace

@@ -1,9 +1,7 @@-{-# LANGUAGE CPP                   #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TypeSynonymInstances  #-} {-|  Easy regular expression helpers, currently based on regex-tdfa. These should:@@ -69,9 +67,6 @@ import Data.Char (isDigit) import Data.List (foldl') import Data.MemoUgly (memo)-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif import Data.Text (Text) import qualified Data.Text as T import Text.Regex.TDFA (

@@ -7,7 +7,6 @@  uppercase,  underline,  stripbrackets,- unbracket,  -- quoting  quoteIfNeeded,  singleQuoteIfNeeded,@@ -26,43 +25,23 @@  elideLeft,  elideRight,  formatString,- -- * multi-line layout- concatTopPadded,- concatBottomPadded,- concatOneLine,- vConcatLeftAligned,- vConcatRightAligned,- padtop,- padbottom,- padleft,- padright,- cliptopleft,- fitto,  -- * wide-character-aware layout  charWidth,  strWidth,  strWidthAnsi,  takeWidth,- fitString,- fitStringMulti,- padLeftWide,- padRightWide  ) where   import Data.Char (isSpace, toLower, toUpper)-import Data.Default (def) import Data.List (intercalate) import qualified Data.Text as T-import qualified Data.Text.Lazy as TL import Text.Megaparsec ((<|>), between, many, noneOf, sepBy) import Text.Megaparsec.Char (char) import Text.Printf (printf)  import Hledger.Utils.Parse import Hledger.Utils.Regex (toRegex', regexReplace)-import Text.Tabular (Header(..), Properties(..))-import Text.Tabular.AsciiWide (Align(..), TableOpts(..), textCell, renderRow) import Text.WideString (charWidth, strWidth)  @@ -176,149 +155,7 @@ isDoubleQuoted s@(_:_:_) = head s == '"' && last s == '"' isDoubleQuoted _ = False -unbracket :: String -> String-unbracket s-    | (head s == '[' && last s == ']') || (head s == '(' && last s == ')') = init $ tail s-    | otherwise = s---- | Join several multi-line strings as side-by-side rectangular strings of the same height, top-padded.--- Treats wide characters as double width.-concatTopPadded :: [String] -> String-concatTopPadded = TL.unpack . renderRow def{tableBorders=False, borderSpaces=False}-                . Group NoLine . map (Header . textCell BottomLeft . T.pack)---- | Join several multi-line strings as side-by-side rectangular strings of the same height, bottom-padded.--- Treats wide characters as double width.-concatBottomPadded :: [String] -> String-concatBottomPadded = TL.unpack . renderRow def{tableBorders=False, borderSpaces=False}-                   . Group NoLine . map (Header . textCell TopLeft . T.pack)---- | Join multi-line strings horizontally, after compressing each of--- them to a single line with a comma and space between each original line.-concatOneLine :: [String] -> String-concatOneLine strs = concat $ map ((intercalate ", ").lines) strs---- | Join strings vertically, left-aligned and right-padded.-vConcatLeftAligned :: [String] -> String-vConcatLeftAligned ss = intercalate "\n" $ map showfixedwidth ss-    where-      showfixedwidth = printf (printf "%%-%ds" width)-      width = maximum $ map length ss---- | Join strings vertically, right-aligned and left-padded.-vConcatRightAligned :: [String] -> String-vConcatRightAligned ss = intercalate "\n" $ map showfixedwidth ss-    where-      showfixedwidth = printf (printf "%%%ds" width)-      width = maximum $ map length ss---- | Convert a multi-line string to a rectangular string top-padded to the specified height.-padtop :: Int -> String -> String-padtop h s = intercalate "\n" xpadded-    where-      ls = lines s-      sh = length ls-      sw | null ls = 0-         | otherwise = maximum $ map length ls-      ypadded = replicate (difforzero h sh) "" ++ ls-      xpadded = map (padleft sw) ypadded---- | Convert a multi-line string to a rectangular string bottom-padded to the specified height.-padbottom :: Int -> String -> String-padbottom h s = intercalate "\n" xpadded-    where-      ls = lines s-      sh = length ls-      sw | null ls = 0-         | otherwise = maximum $ map length ls-      ypadded = ls ++ replicate (difforzero h sh) ""-      xpadded = map (padleft sw) ypadded--difforzero :: (Num a, Ord a) => a -> a -> a-difforzero a b = maximum [(a - b), 0]---- | Convert a multi-line string to a rectangular string left-padded to the specified width.--- Treats wide characters as double width.-padleft :: Int -> String -> String-padleft w "" = concat $ replicate w " "-padleft w s = intercalate "\n" $ map (printf (printf "%%%ds" w)) $ lines s---- | Convert a multi-line string to a rectangular string right-padded to the specified width.--- Treats wide characters as double width.-padright :: Int -> String -> String-padright w "" = concat $ replicate w " "-padright w s = intercalate "\n" $ map (printf (printf "%%-%ds" w)) $ lines s---- | Clip a multi-line string to the specified width and height from the top left.-cliptopleft :: Int -> Int -> String -> String-cliptopleft w h = intercalate "\n" . take h . map (take w) . lines---- | Clip and pad a multi-line string to fill the specified width and height.-fitto :: Int -> Int -> String -> String-fitto w h s = intercalate "\n" $ take h $ rows ++ repeat blankline-    where-      rows = map (fit w) $ lines s-      fit w = take w . (++ repeat ' ')-      blankline = replicate w ' '- -- Functions below treat wide (eg CJK) characters as double-width.---- | General-purpose wide-char-aware single-line string layout function.--- It can left- or right-pad a short string to a minimum width.--- It can left- or right-clip a long string to a maximum width, optionally inserting an ellipsis (the third argument).--- It clips and pads on the right when the fourth argument is true, otherwise on the left.--- It treats wide characters as double width.-fitString :: Maybe Int -> Maybe Int -> Bool -> Bool -> String -> String-fitString mminwidth mmaxwidth ellipsify rightside s = (clip . pad) s-  where-    clip :: String -> String-    clip s =-      case mmaxwidth of-        Just w-          | strWidth s > w ->-            case rightside of-              True  -> takeWidth (w - length ellipsis) s ++ ellipsis-              False -> ellipsis ++ reverse (takeWidth (w - length ellipsis) $ reverse s)-          | otherwise -> s-          where-            ellipsis = if ellipsify then ".." else ""-        Nothing -> s-    pad :: String -> String-    pad s =-      case mminwidth of-        Just w-          | sw < w ->-            case rightside of-              True  -> s ++ replicate (w - sw) ' '-              False -> replicate (w - sw) ' ' ++ s-          | otherwise -> s-        Nothing -> s-      where sw = strWidth s---- | A version of fitString that works on multi-line strings,--- separate for now to avoid breakage.--- This will rewrite any line endings to unix newlines.-fitStringMulti :: Maybe Int -> Maybe Int -> Bool -> Bool -> String -> String-fitStringMulti mminwidth mmaxwidth ellipsify rightside s =-  (intercalate "\n" . map (fitString mminwidth mmaxwidth ellipsify rightside) . lines) s---- | Left-pad a string to the specified width.--- Treats wide characters as double width.--- Works on multi-line strings too (but will rewrite non-unix line endings).-padLeftWide :: Int -> String -> String-padLeftWide w "" = replicate w ' '-padLeftWide w s  = intercalate "\n" $ map (fitString (Just w) Nothing False False) $ lines s--- XXX not yet replaceable by--- padLeftWide w = fitStringMulti (Just w) Nothing False False---- | Right-pad a string to the specified width.--- Treats wide characters as double width.--- Works on multi-line strings too (but will rewrite non-unix line endings).-padRightWide :: Int -> String -> String-padRightWide w "" = replicate w ' '-padRightWide w s  = intercalate "\n" $ map (fitString (Just w) Nothing False True) $ lines s--- XXX not yet replaceable by--- padRightWide w = fitStringMulti (Just w) Nothing False True  -- | Double-width-character-aware string truncation. Take as many -- characters as possible from a string without exceeding the

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -26,10 +25,6 @@ import Control.Monad.Except (ExceptT, runExceptT) import Control.Monad.State.Strict (StateT, evalStateT, execStateT) import Data.Default (Default(..))-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif--- import Data.CallStack import Data.List (isInfixOf) import qualified Data.Text as T import Test.Tasty hiding (defaultMain)

@@ -2,82 +2,65 @@ -- There may be better alternatives out there.  {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}  module Hledger.Utils.Text   (- -- -- * misc- -- lowercase,- -- uppercase,- -- underline,- -- stripbrackets,+  -- * misc+  -- lowercase,+  -- uppercase,+  -- underline,+  -- stripbrackets,   textUnbracket,   wrap,   textChomp,- -- -- quoting+  -- quoting   quoteIfSpaced,   textQuoteIfNeeded,- -- singleQuoteIfNeeded,- -- -- quotechars,- -- -- whitespacechars,+  -- singleQuoteIfNeeded,+  -- quotechars,+  -- whitespacechars,   escapeDoubleQuotes,- -- escapeSingleQuotes,- -- escapeQuotes,- -- words',- -- unwords',+  -- escapeSingleQuotes,+  -- escapeQuotes,+  -- words',+  -- unwords',   stripquotes,- -- isSingleQuoted,- -- isDoubleQuoted,- -- -- * single-line layout- -- elideLeft,+  -- isSingleQuoted,+  -- isDoubleQuoted,+  -- * single-line layout+  -- elideLeft,   textElideRight,   formatText,- -- -- * multi-line layout+  -- * multi-line layout   textConcatTopPadded,   textConcatBottomPadded,- -- concatOneLine,- -- vConcatLeftAligned,- -- vConcatRightAligned,- -- padtop,- -- padbottom,- -- padleft,- -- padright,- -- cliptopleft,- -- fitto,   fitText,   linesPrepend,   linesPrepend2,   unlinesB,- -- -- * wide-character-aware layout+  -- * wide-character-aware layout   WideBuilder(..),   wbToText,   wbUnpack,   textWidth,   textTakeWidth,- -- fitString,- -- fitStringMulti,-  textPadLeftWide,-  textPadRightWide,-  -- -- * Reading+  -- * Reading   readDecimal,-  -- -- * tests+  -- * tests   tests_Text   ) where  import Data.Char (digitToInt) import Data.Default (def)-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB  import Hledger.Utils.Test ((@?=), test, tests)-import Text.Tabular (Header(..), Properties(..))-import Text.Tabular.AsciiWide (Align(..), TableOpts(..), textCell, renderRow)+import Text.Tabular.AsciiWide+  (Align(..), Header(..), Properties(..), TableOpts(..), renderRow, textCell) import Text.WideString (WideBuilder(..), wbToText, wbUnpack, charWidth, textWidth)  @@ -207,71 +190,6 @@ textConcatBottomPadded = TL.toStrict . renderRow def{tableBorders=False, borderSpaces=False}                        . Group NoLine . map (Header . textCell TopLeft) --- -- | Join multi-line strings horizontally, after compressing each of--- -- them to a single line with a comma and space between each original line.--- concatOneLine :: [String] -> String--- concatOneLine strs = concat $ map ((intercalate ", ").lines) strs---- -- | Join strings vertically, left-aligned and right-padded.--- vConcatLeftAligned :: [String] -> String--- vConcatLeftAligned ss = intercalate "\n" $ map showfixedwidth ss---     where---       showfixedwidth = printf (printf "%%-%ds" width)---       width = maximum $ map length ss---- -- | Join strings vertically, right-aligned and left-padded.--- vConcatRightAligned :: [String] -> String--- vConcatRightAligned ss = intercalate "\n" $ map showfixedwidth ss---     where---       showfixedwidth = printf (printf "%%%ds" width)---       width = maximum $ map length ss---- -- | Convert a multi-line string to a rectangular string top-padded to the specified height.--- padtop :: Int -> String -> String--- padtop h s = intercalate "\n" xpadded---     where---       ls = lines s---       sh = length ls---       sw | null ls = 0---          | otherwise = maximum $ map length ls---       ypadded = replicate (difforzero h sh) "" ++ ls---       xpadded = map (padleft sw) ypadded---- -- | Convert a multi-line string to a rectangular string bottom-padded to the specified height.--- padbottom :: Int -> String -> String--- padbottom h s = intercalate "\n" xpadded---     where---       ls = lines s---       sh = length ls---       sw | null ls = 0---          | otherwise = maximum $ map length ls---       ypadded = ls ++ replicate (difforzero h sh) ""---       xpadded = map (padleft sw) ypadded---- -- | Convert a multi-line string to a rectangular string left-padded to the specified width.--- -- Treats wide characters as double width.--- padleft :: Int -> String -> String--- padleft w "" = concat $ replicate w " "--- padleft w s = intercalate "\n" $ map (printf (printf "%%%ds" w)) $ lines s---- -- | Convert a multi-line string to a rectangular string right-padded to the specified width.--- -- Treats wide characters as double width.--- padright :: Int -> String -> String--- padright w "" = concat $ replicate w " "--- padright w s = intercalate "\n" $ map (printf (printf "%%-%ds" w)) $ lines s---- -- | Clip a multi-line string to the specified width and height from the top left.--- cliptopleft :: Int -> Int -> String -> String--- cliptopleft w h = intercalate "\n" . take h . map (take w) . lines---- -- | Clip and pad a multi-line string to fill the specified width and height.--- fitto :: Int -> Int -> String -> String--- fitto w h s = intercalate "\n" $ take h $ rows ++ repeat blankline---     where---       rows = map (fit w) $ lines s---       fit w = take w . (++ repeat ' ')---       blankline = replicate w ' '- -- -- Functions below treat wide (eg CJK) characters as double-width.  -- | General-purpose wide-char-aware single-line text layout function.@@ -305,31 +223,6 @@           | otherwise -> s         Nothing -> s       where sw = textWidth s---- -- | A version of fitString that works on multi-line strings,--- -- separate for now to avoid breakage.--- -- This will rewrite any line endings to unix newlines.--- fitStringMulti :: Maybe Int -> Maybe Int -> Bool -> Bool -> String -> String--- fitStringMulti mminwidth mmaxwidth ellipsify rightside s =---   (intercalate "\n" . map (fitString mminwidth mmaxwidth ellipsify rightside) . lines) s---- | Left-pad a text to the specified width.--- Treats wide characters as double width.--- Works on multi-line texts too (but will rewrite non-unix line endings).-textPadLeftWide :: Int -> Text -> Text-textPadLeftWide w "" = T.replicate w " "-textPadLeftWide w s  = T.intercalate "\n" $ map (fitText (Just w) Nothing False False) $ T.lines s--- XXX not yet replaceable by--- padLeftWide w = fitStringMulti (Just w) Nothing False False---- | Right-pad a string to the specified width.--- Treats wide characters as double width.--- Works on multi-line strings too (but will rewrite non-unix line endings).-textPadRightWide :: Int -> Text -> Text-textPadRightWide w "" = T.replicate w " "-textPadRightWide w s  = T.intercalate "\n" $ map (fitText (Just w) Nothing False True) $ T.lines s--- XXX not yet replaceable by--- padRightWide w = fitStringMulti (Just w) Nothing False True  -- | Double-width-character-aware string truncation. Take as many -- characters as possible from a string without exceeding the

@@ -52,8 +52,8 @@  import Control.Monad.Except import Control.Monad.State.Strict (StateT, evalStateT)-import Data.Foldable (asum, toList) import qualified Data.List.NonEmpty as NE+import Data.Monoid (Alt(..)) import qualified Data.Set as S import Data.Text (Text) import Text.Megaparsec@@ -244,7 +244,7 @@       _ -> Nothing      finds :: (Foldable t) => (a -> Maybe b) -> t a -> Maybe b-    finds f = asum . map f . toList+    finds f = getAlt . foldMap (Alt . f)   --- * "Final" parse errors

@@ -1,17 +1,28 @@ -- | Text.Tabular.AsciiArt from tabular-0.2.2.7, modified to treat -- wide characters as double width. -{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-} -module Text.Tabular.AsciiWide where+module Text.Tabular.AsciiWide+( module Text.Tabular +, TableOpts(..)+, render+, renderTable+, renderTableB+, renderRow+, renderRowB++, Cell(..)+, Align(..)+, emptyCell+, textCell+, cellWidth+) where+ import Data.Maybe (fromMaybe) import Data.Default (Default(..)) import Data.List (intersperse, transpose)-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif import Data.Semigroup (stimesMonoid) import Data.Text (Text) import qualified Data.Text as T

@@ -1,7 +1,5 @@ -- | Calculate the width of String and Text, being aware of wide characters. -{-# LANGUAGE CPP #-}- module Text.WideString (   -- * wide-character-aware layout   strWidth,@@ -13,9 +11,6 @@   wbToText   ) where -#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup (Semigroup(..))-#endif import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL@@ -26,16 +21,13 @@ data WideBuilder = WideBuilder   { wbBuilder :: !TB.Builder   , wbWidth   :: !Int-  }+  } deriving (Show)  instance Semigroup WideBuilder where   WideBuilder x i <> WideBuilder y j = WideBuilder (x <> y) (i + j)  instance Monoid WideBuilder where   mempty = WideBuilder mempty 0-#if !(MIN_VERSION_base(4,11,0))-  mappend = (<>)-#endif  -- | Convert a WideBuilder to a strict Text. wbToText :: WideBuilder -> Text

@@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack------ hash: 2724f18a071add9d644b3060aba58a3f4f6c71b66d88af1e8ca3f526043d461f  name:           hledger-lib-version:        1.21+version:        1.22 synopsis:       A reusable library providing the core functionality of hledger description:    A reusable library containing hledger's core functionality.                 This is used by most hledger* packages so that they support the same@@ -27,8 +25,9 @@ maintainer:     Simon Michael <simon@joyful.com> license:        GPL-3 license-file:   LICENSE-tested-with:    GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.3, GHC==8.10.0.20200123 build-type:     Simple+tested-with:+    GHC==8.6.5, GHC==8.8.4, GHC==8.10.4 extra-source-files:     CHANGES.md     README.md@@ -94,7 +93,7 @@       Text.WideString       Paths_hledger_lib   hs-source-dirs:-      ./.+      ./   ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans   build-depends:       Decimal >=0.5.1@@ -103,7 +102,7 @@     , aeson-pretty     , ansi-terminal >=0.9     , array-    , base >=4.9 && <4.15+    , base >=4.10.1.0 && <4.16     , base-compat-batteries >=0.10.1 && <0.12     , blaze-markup >=0.5.1     , bytestring@@ -111,7 +110,7 @@     , cassava     , cassava-megaparsec     , cmdargs >=0.10-    , containers+    , containers >=0.5.9     , data-default >=0.5     , directory     , extra >=1.6.3@@ -142,7 +141,7 @@   type: exitcode-stdio-1.0   main-is: doctests.hs   hs-source-dirs:-      ./.+      ./       test   ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans   build-depends:@@ -152,7 +151,7 @@     , aeson-pretty     , ansi-terminal >=0.9     , array-    , base >=4.9 && <4.15+    , base >=4.10.1.0 && <4.16     , base-compat-batteries >=0.10.1 && <0.12     , blaze-markup >=0.5.1     , bytestring@@ -160,7 +159,7 @@     , cassava     , cassava-megaparsec     , cmdargs >=0.10-    , containers+    , containers >=0.5.9     , data-default >=0.5     , directory     , doctest >=0.16.3@@ -194,7 +193,7 @@   type: exitcode-stdio-1.0   main-is: unittest.hs   hs-source-dirs:-      ./.+      ./       test   ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans   build-depends:@@ -204,7 +203,7 @@     , aeson-pretty     , ansi-terminal >=0.9     , array-    , base >=4.9 && <4.15+    , base >=4.10.1.0 && <4.16     , base-compat-batteries >=0.10.1 && <0.12     , blaze-markup >=0.5.1     , bytestring@@ -212,7 +211,7 @@     , cassava     , cassava-megaparsec     , cmdargs >=0.10-    , containers+    , containers >=0.5.9     , data-default >=0.5     , directory     , extra >=1.6.3