hledger-lib 1.14.1 → 1.15

raw patch · 61 files changed

+5265/−4001 lines, 61 filesdep +fgldep +timeitdep ~extraPVP ok

version bump matches the API change (PVP)

Dependencies added: fgl, timeit

Dependency ranges changed: extra

API changes (from Hackage documentation)

Files

• CHANGES.md +39/−0
• Hledger/Data.hs +3/−2
• Hledger/Data/Account.hs +9/−9
• Hledger/Data/AccountName.hs +5/−5
• Hledger/Data/Amount.hs +87/−105
• Hledger/Data/Dates.hs +39/−34
• Hledger/Data/Journal.hs +144/−98
• Hledger/Data/Ledger.hs +6/−5
• Hledger/Data/MarketPrice.hs +0/−27
• Hledger/Data/Period.hs +24/−2
• Hledger/Data/PeriodicTransaction.hs +24/−16
• Hledger/Data/Posting.hs +75/−24
• Hledger/Data/StringFormat.hs +1/−1
• Hledger/Data/Timeclock.hs +3/−3
• Hledger/Data/Transaction.hs +84/−53
• Hledger/Data/TransactionModifier.hs +42/−23
• Hledger/Data/Types.hs +42/−22
• Hledger/Data/Valuation.hs +341/−0
• Hledger/Query.hs +24/−24
• Hledger/Read.hs +22/−6
• Hledger/Read/Common.hs +31/−31
• Hledger/Read/CsvReader.hs +41/−29
• Hledger/Read/JournalReader.hs +38/−37
• Hledger/Read/TimeclockReader.hs +1/−1
• Hledger/Read/TimedotReader.hs +3/−3
• Hledger/Reports.hs +8/−8
• Hledger/Reports/AccountTransactionsReport.hs +190/−0
• Hledger/Reports/BalanceHistoryReport.hs +0/−31
• Hledger/Reports/BalanceReport.hs +84/−77
• Hledger/Reports/BudgetReport.hs +51/−39
• Hledger/Reports/EntriesReport.hs +28/−7
• Hledger/Reports/MultiBalanceReport.hs +462/−0
• Hledger/Reports/MultiBalanceReports.hs +0/−355
• Hledger/Reports/PostingsReport.hs +100/−46
• Hledger/Reports/ReportOptions.hs +132/−30
• Hledger/Reports/ReportTypes.hs +1/−1
• Hledger/Reports/TransactionsReport.hs +112/−0
• Hledger/Reports/TransactionsReports.hs +0/−282
• Hledger/Utils.hs +25/−4
• Hledger/Utils/Color.hs +1/−1
• Hledger/Utils/Debug.hs +67/−12
• Hledger/Utils/String.hs +2/−2
• Hledger/Utils/Test.hs +23/−23
• Hledger/Utils/Text.hs +11/−11
• Hledger/Utils/UTF8IOCompat.hs +2/−2
• Text/Megaparsec/Custom.hs +1/−1
• Text/Tabular/AsciiWide.hs +1/−1
• hledger-lib.cabal +27/−19
• hledger_csv.5 +170/−135
• hledger_csv.info +92/−57
• hledger_csv.txt +59/−32
• hledger_journal.5 +1817/−1748
• hledger_journal.info +260/−173
• hledger_journal.txt +306/−242
• hledger_timeclock.5 +29/−29
• hledger_timeclock.info +2/−1
• hledger_timeclock.txt +6/−5
• hledger_timedot.5 +52/−52
• hledger_timedot.info +4/−3
• hledger_timedot.txt +5/−5
• test/doctests.hs +7/−7

@@ -1,6 +1,45 @@ Internal/api/developer-ish changes in the hledger-lib (and hledger) packages. For user-visible changes, see the hledger package changelog. +# 1.15 2019-09-01++Removals include:++- journalPrices+- BalanceHistoryReport+- postingValueAtDate++Additions include:++- MarketPrice (more pure form of PriceDirective without the amount style information)+- PriceOracle (efficient lookup of exchange rates)+- ValuationType (ways to convert amount value)+- aliasnamep (export)+- setNaturalPrecisionUpTo+- dbgNWith, ptraceAtWith+- postingTransformAmount, postingToCost, postingValue+- amountToCost, mixedAmountToCost+- valueTypeFromOpts+- mapJournalTransactions, mapJournalPostings, mapTransactionPostings+- journalStartDate, journalEndDate+- journalPriceOracle+- marketPriceReverse+- priceDirectiveToMarketPrice+- mixedAmountApplyValuation+- mixedAmountValueAtDate++Changes include:++- Price -> AmountPrice,  AKA "transaction price"+- old MarketPrice -> PriceDirective+- TransactionsReport/AccountTransactionsReport split into separate files+- journalTransactionsReport -> transactionsReport+- accountTransactionsReportItems: rewrite using catMaybes and mapAccumL (Henning Thielemann)+- optionally save the current date in ReportOpts+- Hledger.Cli tests now have correct prefix; add Cli.Utils tests+- MultiBalanceReport now returns zero for row totals when in cumulative or historical mode (#329)++ # 1.14.1 2019-03-20  - require easytest <0.3 to fix build issue

@@ -16,7 +16,6 @@                module Hledger.Data.Dates,                module Hledger.Data.Journal,                module Hledger.Data.Ledger,-               module Hledger.Data.MarketPrice,                module Hledger.Data.Period,                module Hledger.Data.PeriodicTransaction,                module Hledger.Data.Posting,@@ -26,6 +25,7 @@                module Hledger.Data.Transaction,                module Hledger.Data.TransactionModifier,                module Hledger.Data.Types,+               module Hledger.Data.Valuation,                tests_Data               ) where@@ -37,7 +37,6 @@ import Hledger.Data.Dates import Hledger.Data.Journal import Hledger.Data.Ledger-import Hledger.Data.MarketPrice import Hledger.Data.Period import Hledger.Data.PeriodicTransaction import Hledger.Data.Posting@@ -47,6 +46,7 @@ import Hledger.Data.Transaction import Hledger.Data.TransactionModifier import Hledger.Data.Types+import Hledger.Data.Valuation import Hledger.Utils.Test  tests_Data = tests "Data" [@@ -55,6 +55,7 @@   ,tests_Journal   ,tests_Ledger   ,tests_Posting+  ,tests_Valuation   ,tests_StringFormat   ,tests_Timeclock   ,tests_Transaction

@@ -76,8 +76,8 @@   in     acctsflattened --- | Convert a list of account names to a tree of Account objects, --- with just the account names filled in. +-- | Convert a list of account names to a tree of Account objects,+-- with just the account names filled in. -- A single root account with the given name is added. accountTree :: AccountName -> [AccountName] -> Account accountTree rootname as = nullacct{aname=rootname, asubs=map (uncurry accountTree') $ M.assocs m }@@ -193,7 +193,7 @@     | otherwise = concatMap (filterAccounts p) (asubs a)  -- | Sort each group of siblings in an account tree by inclusive amount,--- so that the accounts with largest normal balances are listed first.  +-- so that the accounts with largest normal balances are listed first. -- The provided normal balance sign determines whether normal balances -- are negative or positive, affecting the sort order. Ie, -- if balances are normally negative, then the most negative balances@@ -217,10 +217,10 @@ -- | Sort account names by the order in which they were declared in -- the journal, at each level of the account tree (ie within each -- group of siblings). Undeclared accounts are sorted last and--- alphabetically. +-- alphabetically. -- This is hledger's default sort for reports organised by account. -- The account list is converted to a tree temporarily, adding any--- missing parents; these can be kept (suitable for a tree-mode report) +-- missing parents; these can be kept (suitable for a tree-mode report) -- or removed (suitable for a flat-mode report). -- sortAccountNamesByDeclaration :: Journal -> Bool -> [AccountName] -> [AccountName]@@ -235,14 +235,14 @@   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, --- in the same order as their account directives were parsed, --- and then the undeclared accounts, sorted by account name. +-- So each group will contain first the declared accounts,+-- in the same order as their account directives were parsed,+-- and then the undeclared accounts, sorted by account name. sortAccountTreeByDeclaration :: Account -> Account sortAccountTreeByDeclaration a   | null $ asubs a = a   | otherwise      = a{asubs=-      sortOn accountDeclarationOrderAndName $ +      sortOn accountDeclarationOrderAndName $       map sortAccountTreeByDeclaration $ asubs a       } 

@@ -29,7 +29,7 @@   ,expandAccountName   ,expandAccountNames   ,isAccountNamePrefixOf---  ,isAccountRegex +--  ,isAccountRegex   ,isSubAccountNameOf   ,parentAccountName   ,parentAccountNames@@ -50,7 +50,7 @@ import Text.Printf  import Hledger.Data.Types-import Hledger.Utils +import Hledger.Utils  -- $setup -- >>> :set -XOverloadedStrings@@ -88,13 +88,13 @@ accountNameLevel a = T.length (T.filter (==acctsepchar) a) + 1  -- | A top-level account prefixed to some accounts in budget reports.--- Defined here so it can be ignored by accountNameDrop. +-- Defined here so it can be ignored by accountNameDrop. unbudgetedAccountName :: T.Text unbudgetedAccountName = "<unbudgeted>"  -- | Remove some number of account name components from the front of the account name. -- If the special "<unbudgeted>" top-level account is present, it is preserved and--- dropping affects the rest of the account name. +-- dropping affects the rest of the account name. accountNameDrop :: Int -> AccountName -> AccountName accountNameDrop n a   | a == unbudgetedAccountName = a@@ -103,7 +103,7 @@         "" -> unbudgetedAccountName         a' -> unbudgetedAccountAndSep <> a'   | otherwise = accountNameFromComponents $ drop n $ accountNameComponents a-  where +  where     unbudgetedAccountAndSep = unbudgetedAccountName <> acctsep  -- | Sorted unique account names implied by these account names,

@@ -57,11 +57,11 @@   amountWithCommodity,   -- ** arithmetic   costOfAmount,+  amountToCost,   divideAmount,   multiplyAmount,   divideAmountAndPrice,   multiplyAmountAndPrice,-  amountValue,   amountTotalPriceToUnitPrice,   -- ** rendering   amountstyle,@@ -76,7 +76,8 @@   setAmountPrecision,   withPrecision,   setFullPrecision,-  setMinimalPrecision,+  setNaturalPrecision,+  setNaturalPrecisionUpTo,   setAmountInternalPrecision,   withInternalPrecision,   setAmountDecimalPoint,@@ -93,6 +94,7 @@   normaliseMixedAmount,   -- ** arithmetic   costOfMixedAmount,+  mixedAmountToCost,   divideMixedAmount,   multiplyMixedAmount,   divideMixedAmountAndPrice,@@ -105,7 +107,6 @@   isZeroMixedAmount,   isReallyZeroMixedAmount,   isReallyZeroMixedAmountCost,-  mixedAmountValue,   mixedAmountTotalPriceToUnitPrice,   -- ** rendering   styleMixedAmount,@@ -129,18 +130,16 @@ import Data.Decimal (roundTo, decimalPlaces, normalizeDecimal) import Data.Function (on) import Data.List+import qualified Data.Map as M import Data.Map (findWithDefault) import Data.Maybe-import Data.Time.Calendar (Day)--- import Data.Text (Text) import qualified Data.Text as T import Safe (maximumDef) import Text.Printf-import qualified Data.Map as M  import Hledger.Data.Types import Hledger.Data.Commodity-import Hledger.Utils +import Hledger.Utils   deriving instance Show MarketPrice@@ -149,7 +148,7 @@ ------------------------------------------------------------------------------- -- Amount styles --- | Default amount style +-- | Default amount style amountstyle = AmountStyle L False 0 (Just '.') Nothing  @@ -167,7 +166,7 @@  -- | The empty simple amount. amount, nullamt :: Amount-amount = Amount{acommodity="", aquantity=0, aprice=NoPrice, astyle=amountstyle, aismultiplier=False}+amount = Amount{acommodity="", aquantity=0, aprice=Nothing, astyle=amountstyle, aismultiplier=False} nullamt = amount  -- | A temporary value for parsed transactions which had no amount specified.@@ -181,8 +180,8 @@ usd n = amount{acommodity="$", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}} eur n = amount{acommodity="€", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}} gbp n = amount{acommodity="£", aquantity=roundTo 2 n, astyle=amountstyle{asprecision=2}}-amt `at` priceamt = amt{aprice=UnitPrice priceamt}-amt @@ priceamt = amt{aprice=TotalPrice priceamt}+amt `at` priceamt = amt{aprice=Just $ UnitPrice priceamt}+amt @@ priceamt = amt{aprice=Just $ TotalPrice priceamt}  -- | Apply a binary arithmetic operator to two amounts, which should -- be in the same commodity if non-zero (warning, this is not checked).@@ -202,7 +201,7 @@ -- | Convert an amount to the specified commodity, ignoring and discarding -- any assigned prices and assuming an exchange rate of 1. amountWithCommodity :: CommoditySymbol -> Amount -> Amount-amountWithCommodity c a = a{acommodity=c, aprice=NoPrice}+amountWithCommodity c a = a{acommodity=c, aprice=Nothing}  -- | Convert an amount to the commodity of its assigned price, if any.  Notes: --@@ -210,21 +209,25 @@ -- -- - price amounts should be positive, though this is not currently enforced costOfAmount :: Amount -> Amount-costOfAmount a@Amount{aquantity=q, aprice=price} =-    case price of-      NoPrice -> a-      UnitPrice  p@Amount{aquantity=pq} -> p{aquantity=pq * q}-      TotalPrice p@Amount{aquantity=pq} -> p{aquantity=pq * signum q}+costOfAmount a@Amount{aquantity=q, aprice=mp} =+    case mp of+      Nothing                                  -> a+      Just (UnitPrice  p@Amount{aquantity=pq}) -> p{aquantity=pq * q}+      Just (TotalPrice p@Amount{aquantity=pq}) -> p{aquantity=pq * signum q} +-- | Convert this amount to cost, and apply the appropriate amount style.+amountToCost :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount+amountToCost styles = styleAmount styles . costOfAmount+ -- | Replace an amount's TotalPrice, if it has one, with an equivalent UnitPrice. -- Has no effect on amounts without one. -- Also increases the unit price's display precision to show one extra decimal place,--- to help keep transaction amounts balancing. +-- to help keep transaction amounts balancing. -- Does Decimal division, might be some rounding/irrational number issues. amountTotalPriceToUnitPrice :: Amount -> Amount-amountTotalPriceToUnitPrice -  a@Amount{aquantity=q, aprice=TotalPrice pa@Amount{aquantity=pq, astyle=ps@AmountStyle{asprecision=pp}}}-  = a{aprice = UnitPrice pa{aquantity=abs (pq/q), astyle=ps{asprecision=pp+1}}}+amountTotalPriceToUnitPrice+  a@Amount{aquantity=q, aprice=Just (TotalPrice pa@Amount{aquantity=pq, astyle=ps@AmountStyle{asprecision=pp}})}+  = a{aprice = Just $ UnitPrice pa{aquantity=abs (pq/q), astyle=ps{asprecision=pp+1}}} amountTotalPriceToUnitPrice a = a  -- | Divide an amount's quantity by a constant.@@ -238,7 +241,7 @@ -- | Divide an amount's quantity (and its total price, if it has one) by a constant. -- The total price will be kept positive regardless of the multiplier's sign. divideAmountAndPrice :: Quantity -> Amount -> Amount-divideAmountAndPrice n a@Amount{aquantity=q,aprice=p} = a{aquantity=q/n, aprice=f p}+divideAmountAndPrice n a@Amount{aquantity=q,aprice=p} = a{aquantity=q/n, aprice=f <$> p}   where     f (TotalPrice a) = TotalPrice $ abs $ n `divideAmount` a     f p = p@@ -246,7 +249,7 @@ -- | Multiply an amount's quantity (and its total price, if it has one) by a constant. -- The total price will be kept positive regardless of the multiplier's sign. multiplyAmountAndPrice :: Quantity -> Amount -> Amount-multiplyAmountAndPrice n a@Amount{aquantity=q,aprice=p} = a{aquantity=q*n, aprice=f p}+multiplyAmountAndPrice n a@Amount{aquantity=q,aprice=p} = a{aquantity=q*n, aprice=f <$> p}   where     f (TotalPrice a) = TotalPrice $ abs $ n `multiplyAmount` a     f p = p@@ -291,35 +294,43 @@  -- | Set an amount's display precision to just enough so that it will -- be shown exactly, with all significant decimal places.-setMinimalPrecision :: Amount -> Amount-setMinimalPrecision a = setAmountPrecision normalprecision a+setNaturalPrecision :: Amount -> Amount+setNaturalPrecision a = setAmountPrecision normalprecision a   where     normalprecision  = fromIntegral $ decimalPlaces $ normalizeDecimal $ aquantity a +-- | Set an amount's display precision to just enough so that all+-- significant decimal digits will be shown, but not more than the+-- given maximum number of decimal digits.+setNaturalPrecisionUpTo :: Int -> Amount -> Amount+setNaturalPrecisionUpTo n a = setAmountPrecision (min n normalprecision) a+  where+    normalprecision  = fromIntegral $ decimalPlaces $ normalizeDecimal $ aquantity a+ -- | Get a string representation of an amount for debugging, -- appropriate to the current debug level. 9 shows maximum detail. showAmountDebug :: Amount -> String showAmountDebug Amount{acommodity="AUTO"} = "(missing)"-showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}" (show acommodity) (show aquantity) (showPriceDebug aprice) (show astyle)+showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}" (show acommodity) (show aquantity) (showAmountPriceDebug aprice) (show astyle)  -- | Get the string representation of an amount, without any \@ price. showAmountWithoutPrice :: Amount -> String-showAmountWithoutPrice a = showAmount a{aprice=NoPrice}+showAmountWithoutPrice a = showAmount a{aprice=Nothing} --- | Set an amount's internal precision, ie rounds the Decimal representing +-- | Set an amount's internal precision, ie rounds the Decimal representing -- the amount's quantity to some number of decimal places. -- Rounding is done with Data.Decimal's default roundTo function: -- "If the value ends in 5 then it is rounded to the nearest even value (Banker's Rounding)". -- Does not change the amount's display precision.--- Intended only for internal use, eg when comparing amounts in tests. +-- Intended only for internal use, eg when comparing amounts in tests. setAmountInternalPrecision :: Int -> Amount -> Amount-setAmountInternalPrecision p a@Amount{ aquantity=q, astyle=s } = a{ -   astyle=s{asprecision=p} +setAmountInternalPrecision p a@Amount{ aquantity=q, astyle=s } = a{+   astyle=s{asprecision=p}   ,aquantity=roundTo (fromIntegral p) q   }  -- | Set an amount's internal precision, flipped.--- Intended only for internal use, eg when comparing amounts in tests. +-- Intended only for internal use, eg when comparing amounts in tests. withInternalPrecision :: Amount -> Int -> Amount withInternalPrecision = flip setAmountInternalPrecision @@ -333,21 +344,21 @@  -- | Colour version. cshowAmountWithoutPrice :: Amount -> String-cshowAmountWithoutPrice a = cshowAmount a{aprice=NoPrice}+cshowAmountWithoutPrice a = cshowAmount a{aprice=Nothing}  -- | Get the string representation of an amount, without any price or commodity symbol. showAmountWithoutPriceOrCommodity :: Amount -> String-showAmountWithoutPriceOrCommodity a = showAmount a{acommodity="", aprice=NoPrice}+showAmountWithoutPriceOrCommodity a = showAmount a{acommodity="", aprice=Nothing} -showPrice :: Price -> String-showPrice NoPrice         = ""-showPrice (UnitPrice pa)  = " @ "  ++ showAmount pa-showPrice (TotalPrice pa) = " @@ " ++ showAmount pa+showAmountPrice :: Maybe AmountPrice -> String+showAmountPrice Nothing                = ""+showAmountPrice (Just (UnitPrice pa))  = " @ "  ++ showAmount pa+showAmountPrice (Just (TotalPrice pa)) = " @@ " ++ showAmount pa -showPriceDebug :: Price -> String-showPriceDebug NoPrice         = ""-showPriceDebug (UnitPrice pa)  = " @ "  ++ showAmountDebug pa-showPriceDebug (TotalPrice pa) = " @@ " ++ showAmountDebug pa+showAmountPriceDebug :: Maybe AmountPrice -> String+showAmountPriceDebug Nothing                = ""+showAmountPriceDebug (Just (UnitPrice pa))  = " @ "  ++ showAmountDebug pa+showAmountPriceDebug (Just (TotalPrice pa)) = " @@ " ++ showAmountDebug pa  -- | Given a map of standard amount display styles, apply the appropriate one to this amount. -- If there's no standard style for this amount's commodity, return the amount unchanged.@@ -355,7 +366,7 @@ styleAmount styles a =   case M.lookup (acommodity a) styles of     Just s  -> a{astyle=s}-    Nothing -> a +    Nothing -> a  -- | Get the string representation of an amount, based on its -- commodity's display settings. String representations equivalent to@@ -364,7 +375,7 @@ showAmount :: Amount -> String showAmount = showAmountHelper False --- | Colour version. For a negative amount, adds ANSI codes to change the colour, +-- | Colour version. For a negative amount, adds ANSI codes to change the colour, -- currently to hard-coded red. cshowAmount :: Amount -> String cshowAmount a =@@ -373,7 +384,7 @@  showAmountHelper :: Bool -> Amount -> String showAmountHelper _ Amount{acommodity="AUTO"} = ""-showAmountHelper showzerocommodity a@Amount{acommodity=c, aprice=p, astyle=AmountStyle{..}} =+showAmountHelper showzerocommodity a@Amount{acommodity=c, aprice=mp, astyle=AmountStyle{..}} =     case ascommodityside of       L -> printf "%s%s%s%s" (T.unpack c') space quantity' price       R -> printf "%s%s%s%s" quantity' space (T.unpack c') price@@ -383,7 +394,7 @@       (quantity',c') | displayingzero && not showzerocommodity = ("0","")                      | otherwise = (quantity, quoteCommoditySymbolIfNeeded c)       space = if not (T.null c') && ascommodityspaced then " " else "" :: String-      price = showPrice p+      price = showAmountPrice mp  -- | Like showAmount, but show a zero amount's commodity if it has one. showAmountWithZeroCommodity :: Amount -> String@@ -444,36 +455,6 @@     where       s' = findWithDefault s c styles --- | Find the market value of this amount on the given date, in it's--- default valuation commodity, based on recorded market prices.--- If no default valuation commodity can be found, the amount is left--- unchanged.-amountValue :: Journal -> Day -> Amount -> Amount-amountValue j d a =-  case commodityValue j d (acommodity a) of-    Just v  -> v{aquantity=aquantity v * aquantity a}-    Nothing -> a---- This is here not in Commodity.hs to use the Amount Show instance above for debugging. --- | Find the market value, if known, of one unit of this commodity (A) on--- the given valuation date, in the commodity (B) mentioned in the latest--- applicable market price. The latest applicable market price is the market--- price directive for commodity A with the latest date that is on or before--- the valuation date; or if there are multiple such prices with the same date,--- the last parsed.-commodityValue :: Journal -> Day -> CommoditySymbol -> Maybe Amount-commodityValue j valuationdate c-    | null applicableprices = dbg Nothing-    | otherwise             = dbg $ Just $ mpamount $ last applicableprices-  where-    dbg = dbg8 ("using market price for "++T.unpack c)-    applicableprices =-      [p | p <- sortOn mpdate $ jmarketprices j-      , mpcommodity p == c-      , mpdate p <= valuationdate-      ]-- ------------------------------------------------------------------------------- -- MixedAmount @@ -531,8 +512,8 @@     groupfn | squashprices = (==) `on` acommodity             | otherwise    = \a1 a2 -> acommodity a1 == acommodity a2 && combinableprices a1 a2 -    combinableprices Amount{aprice=NoPrice} Amount{aprice=NoPrice} = True-    combinableprices Amount{aprice=UnitPrice p1} Amount{aprice=UnitPrice p2} = p1 == p2+    combinableprices Amount{aprice=Nothing} Amount{aprice=Nothing} = True+    combinableprices Amount{aprice=Just (UnitPrice p1)} Amount{aprice=Just (UnitPrice p2)} = p1 == p2     combinableprices _ _ = False  -- | Like normaliseMixedAmount, but combine each commodity's amounts@@ -583,6 +564,10 @@ costOfMixedAmount :: MixedAmount -> MixedAmount costOfMixedAmount (Mixed as) = Mixed $ map costOfAmount as +-- | Convert all component amounts to cost, and apply the appropriate amount styles.+mixedAmountToCost :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount+mixedAmountToCost styles (Mixed as) = Mixed $ map (amountToCost styles) as+ -- | Divide a mixed amount's quantities by a constant. divideMixedAmount :: Quantity -> MixedAmount -> MixedAmount divideMixedAmount n = mapMixedAmount (divideAmount n)@@ -604,7 +589,7 @@ -- | Calculate the average of some mixed amounts. averageMixedAmounts :: [MixedAmount] -> MixedAmount averageMixedAmounts [] = 0-averageMixedAmounts as = fromIntegral (length as) `divideMixedAmount` sum as +averageMixedAmounts as = fromIntegral (length as) `divideMixedAmount` sum as  -- | Is this mixed amount negative, if it can be normalised to a single commodity ? isNegativeMixedAmount :: MixedAmount -> Maybe Bool@@ -635,7 +620,7 @@  -- | Given a map of standard amount display styles, apply the appropriate ones to each individual amount. styleMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount-styleMixedAmount styles (Mixed as) = Mixed $ map (styleAmount styles) as +styleMixedAmount styles (Mixed as) = Mixed $ map (styleAmount styles) as  -- | Get the string representation of a mixed amount, after -- normalising it to one amount per commodity. Assumes amounts have@@ -706,7 +691,7 @@         width = maximumDef 0 $ map (length . showAmount) as  mixedAmountStripPrices :: MixedAmount -> MixedAmount-mixedAmountStripPrices (Mixed as) = Mixed $ map (\a -> a{aprice=NoPrice}) as+mixedAmountStripPrices (Mixed as) = Mixed $ map (\a -> a{aprice=Nothing}) as  -- | Get the one-line string representation of a mixed amount, but without -- any \@ prices.@@ -714,24 +699,21 @@ showMixedAmountOneLineWithoutPrice m = intercalate ", " $ map showAmountWithoutPrice as     where       (Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m-      stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice}+      stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=Nothing}  -- | Colour version. cshowMixedAmountOneLineWithoutPrice :: MixedAmount -> String cshowMixedAmountOneLineWithoutPrice m = intercalate ", " $ map cshowAmountWithoutPrice as     where       (Mixed as) = normaliseMixedAmountSquashPricesForDisplay $ stripPrices m-      stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=NoPrice}+      stripPrices (Mixed as) = Mixed $ map stripprice as where stripprice a = a{aprice=Nothing}  -- | Canonicalise a mixed amount's display styles using the provided commodity style map. canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styles) as -mixedAmountValue :: Journal -> Day -> MixedAmount -> MixedAmount-mixedAmountValue j d (Mixed as) = Mixed $ map (amountValue j d) as- -- | Replace each component amount's TotalPrice, if it has one, with an equivalent UnitPrice.--- Has no effect on amounts without one. +-- Has no effect on amounts without one. -- Does Decimal division, might be some rounding/irrational number issues. mixedAmountTotalPriceToUnitPrice :: MixedAmount -> MixedAmount mixedAmountTotalPriceToUnitPrice (Mixed as) = Mixed $ map amountTotalPriceToUnitPrice as@@ -745,21 +727,21 @@       tests "costOfAmount" [        costOfAmount (eur 1) `is` eur 1-      ,costOfAmount (eur 2){aprice=UnitPrice $ usd 2} `is` usd 4-      ,costOfAmount (eur 1){aprice=TotalPrice $ usd 2} `is` usd 2-      ,costOfAmount (eur (-1)){aprice=TotalPrice $ usd 2} `is` usd (-2)+      ,costOfAmount (eur 2){aprice=Just $ UnitPrice $ usd 2} `is` usd 4+      ,costOfAmount (eur 1){aprice=Just $ TotalPrice $ usd 2} `is` usd 2+      ,costOfAmount (eur (-1)){aprice=Just $ TotalPrice $ usd 2} `is` usd (-2)     ]-  +     ,tests "isZeroAmount" [        expect $ isZeroAmount amount       ,expect $ isZeroAmount $ usd 0     ]-  +     ,tests "negating amounts" [        negate (usd 1) `is` (usd 1){aquantity= -1}-      ,let b = (usd 1){aprice=UnitPrice $ eur 2} in negate b `is` b{aquantity= -1}+      ,let b = (usd 1){aprice=Just $ UnitPrice $ eur 2} in negate b `is` b{aquantity= -1}     ]-  +     ,tests "adding amounts without prices" [        (usd 1.23 + usd (-1.23)) `is` usd 0       ,(usd 1.23 + usd (-1.23)) `is` usd 0@@ -771,7 +753,7 @@       -- adding different commodities assumes conversion rate 1       ,expect $ isZeroAmount (usd 1.23 - eur 1.23)     ]-  +     ,tests "showAmount" [       showAmount (usd 0 + gbp 0) `is` "0"     ]@@ -788,7 +770,7 @@                ])         `is` Mixed [usd 0 `withPrecision` 3]     ]-  +     ,tests "adding mixed amounts with total prices" [       sum (map (Mixed . (:[]))        [usd 1 @@ eur 1@@ -798,7 +780,7 @@                    ,usd (-2) @@ eur 1                    ]     ]-  +     ,tests "showMixedAmount" [        showMixedAmount (Mixed [usd 1]) `is` "$1.00"       ,showMixedAmount (Mixed [usd 1 `at` eur 2]) `is` "$1.00 @ €2.00"@@ -806,27 +788,27 @@       ,showMixedAmount (Mixed []) `is` "0"       ,showMixedAmount missingmixedamt `is` ""     ]-  +     ,tests "showMixedAmountWithoutPrice" $-      let a = usd 1 `at` eur 2 in +      let a = usd 1 `at` eur 2 in     [         showMixedAmountWithoutPrice (Mixed [a]) `is` "$1.00"        ,showMixedAmountWithoutPrice (Mixed [a, -a]) `is` "0"     ]-  +     ,tests "normaliseMixedAmount" [-       test "a missing amount overrides any other amounts" $ +       test "a missing amount overrides any other amounts" $         normaliseMixedAmount (Mixed [usd 1, missingamt]) `is` missingmixedamt-      ,test "unpriced same-commodity amounts are combined" $ +      ,test "unpriced same-commodity amounts are combined" $         normaliseMixedAmount (Mixed [usd 0, usd 2]) `is` Mixed [usd 2]-      ,test "amounts with same unit price are combined" $ +      ,test "amounts with same unit price are combined" $         normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) `is` Mixed [usd 2 `at` eur 1]-      ,test "amounts with different unit prices are not combined" $ +      ,test "amounts with different unit prices are not combined" $         normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) `is` Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]       ,test "amounts with total prices are not combined" $         normaliseMixedAmount (Mixed  [usd 1 @@ eur 1, usd 1 @@ eur 1]) `is` Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]     ]-  +     ,tests "normaliseMixedAmountSquashPricesForDisplay" [        normaliseMixedAmountSquashPricesForDisplay (Mixed []) `is` Mixed [nullamt]       ,expect $ isZeroMixedAmount $ normaliseMixedAmountSquashPricesForDisplay

@@ -156,8 +156,8 @@ -- If no interval is specified, the original span is returned. -- If the original span is the null date span, ie unbounded, the null date span is returned. -- If the original span is empty, eg if the end date is <= the start date, no spans are returned.---  --+-- -- ==== Examples: -- >>> let t i d1 d2 = splitSpan i $ mkdatespan d1 d2 -- >>> t NoInterval "2008/01/01" "2009/01/01"@@ -531,19 +531,19 @@ -- Examples: lets take 2017-11-22. Year-long intervals covering it that -- starts before Nov 22 will start in 2017. However -- intervals that start after Nov 23rd should start in 2016:--- >>> let wed22nd = parsedate "2017-11-22"          +-- >>> let wed22nd = parsedate "2017-11-22" -- >>> nthdayofyearcontaining 11 21 wed22nd--- 2017-11-21          +-- 2017-11-21 -- >>> nthdayofyearcontaining 11 22 wed22nd--- 2017-11-22          +-- 2017-11-22 -- >>> nthdayofyearcontaining 11 23 wed22nd--- 2016-11-23          +-- 2016-11-23 -- >>> nthdayofyearcontaining 12 02 wed22nd--- 2016-12-02          +-- 2016-12-02 -- >>> nthdayofyearcontaining 12 31 wed22nd--- 2016-12-31          +-- 2016-12-31 -- >>> nthdayofyearcontaining 1 1 wed22nd--- 2017-01-01          +-- 2017-01-01 nthdayofyearcontaining :: Month -> MonthDay -> Day -> Day nthdayofyearcontaining m md date   | not (validMonth $ show m)  = error' $ "nthdayofyearcontaining: invalid month "++show m@@ -555,23 +555,23 @@         s = startofyear date  -- | For given date d find month-long interval that starts on nth day of month--- and covers it. +-- and covers it. -- The given day of month should be basically valid (1-31), or an error is raised. -- -- Examples: lets take 2017-11-22. Month-long intervals covering it that -- start on 1st-22nd of month will start in Nov. However -- intervals that start on 23rd-30th of month should start in Oct:--- >>> let wed22nd = parsedate "2017-11-22"          +-- >>> let wed22nd = parsedate "2017-11-22" -- >>> nthdayofmonthcontaining 1 wed22nd--- 2017-11-01          +-- 2017-11-01 -- >>> nthdayofmonthcontaining 12 wed22nd--- 2017-11-12          +-- 2017-11-12 -- >>> nthdayofmonthcontaining 22 wed22nd--- 2017-11-22          +-- 2017-11-22 -- >>> nthdayofmonthcontaining 23 wed22nd--- 2017-10-23          +-- 2017-10-23 -- >>> nthdayofmonthcontaining 30 wed22nd--- 2017-10-30          +-- 2017-10-30 nthdayofmonthcontaining :: MonthDay -> Day -> Day nthdayofmonthcontaining md date   | not (validDay $ show md) = error' $ "nthdayofmonthcontaining: invalid day "  ++show md@@ -582,22 +582,22 @@         s = startofmonth date  -- | For given date d find week-long interval that starts on nth day of week--- and covers it. +-- and covers it. -- -- Examples: 2017-11-22 is Wed. Week-long intervals that cover it and -- start on Mon, Tue or Wed will start in the same week. However--- intervals that start on Thu or Fri should start in prev week:          --- >>> let wed22nd = parsedate "2017-11-22"          +-- intervals that start on Thu or Fri should start in prev week:+-- >>> let wed22nd = parsedate "2017-11-22" -- >>> nthdayofweekcontaining 1 wed22nd--- 2017-11-20          +-- 2017-11-20 -- >>> nthdayofweekcontaining 2 wed22nd -- 2017-11-21 -- >>> nthdayofweekcontaining 3 wed22nd--- 2017-11-22          +-- 2017-11-22 -- >>> nthdayofweekcontaining 4 wed22nd--- 2017-11-16          +-- 2017-11-16 -- >>> nthdayofweekcontaining 5 wed22nd--- 2017-11-17          +-- 2017-11-17 nthdayofweekcontaining :: WeekDay -> Day -> Day nthdayofweekcontaining n d | nthOfSameWeek <= d = nthOfSameWeek                            | otherwise = nthOfPrevWeek@@ -606,12 +606,12 @@           s = startofweek d  -- | For given date d find month-long interval that starts on nth weekday of month--- and covers it. +-- and covers it. -- -- Examples: 2017-11-22 is 3rd Wed of Nov. Month-long intervals that cover it and -- start on 1st-4th Wed will start in Nov. However--- intervals that start on 4th Thu or Fri or later should start in Oct:          --- >>> let wed22nd = parsedate "2017-11-22"          +-- intervals that start on 4th Thu or Fri or later should start in Oct:+-- >>> let wed22nd = parsedate "2017-11-22" -- >>> nthweekdayofmonthcontaining 1 3 wed22nd -- 2017-11-01 -- >>> nthweekdayofmonthcontaining 3 2 wed22nd@@ -630,12 +630,12 @@  -- | Advance to nth weekday wd after given start day s advancetonthweekday :: Int -> WeekDay -> Day -> Day-advancetonthweekday n wd s = +advancetonthweekday n wd s =   maybe err (addWeeks (n-1)) $ firstMatch (>=s) $ iterate (addWeeks 1) $ firstweekday s   where     err = error' "advancetonthweekday: should not happen"     addWeeks k = addDays (7 * fromIntegral k)-    firstMatch p = headMay . dropWhile (not . p) +    firstMatch p = headMay . dropWhile (not . p)     firstweekday = addDays (fromIntegral wd-1) . startofweek  ----------------------------------------------------------------------@@ -834,7 +834,7 @@   failIfInvalidDay d   return ("",m,d) --- These are compared case insensitively, and should all be kept lower case. +-- These are compared case insensitively, and should all be kept lower case. months         = ["january","february","march","april","may","june",                   "july","august","september","october","november","december"] monthabbrevs   = ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"]@@ -864,8 +864,8 @@   wday <- T.toLower <$> (choice . map string' $ weekdays ++ weekdayabbrevs)   case catMaybes $ [wday `elemIndex` weekdays, wday `elemIndex` weekdayabbrevs] of     (i:_) -> return (i+1)-    []    -> fail  $ "weekday: should not happen: attempted to find " <> -                      show wday <> " in " <> show (weekdays ++ weekdayabbrevs) +    []    -> fail  $ "weekday: should not happen: attempted to find " <>+                      show wday <> " in " <> show (weekdays ++ weekdayabbrevs)  today,yesterday,tomorrow :: TextParser m SmartDate today     = string' "today"     >> return ("","","today")@@ -892,7 +892,11 @@    return ("", T.unpack r, T.unpack p) --- |+-- | Parse a period expression, specifying a date span and optionally+-- a reporting interval. Requires a reference "today" date for+-- resolving any relative start/end dates (only; it is not needed for+-- parsing the reporting interval).+-- -- >>> let p = parsePeriodExpr (parsedate "2008/11/26") -- >>> p "from Aug to Oct" -- Right (NoInterval,DateSpan 2008/08/01-2008/09/30)@@ -909,7 +913,7 @@ -- >>> p "every 2nd day" -- Right (DayOfMonth 2,DateSpan -) -- >>> p "every 2nd day 2009-"--- Right (DayOfMonth 2,DateSpan 2009/01/01-)  +-- Right (DayOfMonth 2,DateSpan 2009/01/01-) -- >>> p "every 29th Nov" -- Right (DayOfYear 11 29,DateSpan -) -- >>> p "every 29th nov -2009"@@ -944,6 +948,7 @@                     (,) NoInterval <$> periodexprdatespanp rdate                    ] +-- Parse a reporting interval and a date span. intervalanddateperiodexprp :: Day -> TextParser m (Interval, DateSpan) intervalanddateperiodexprp rdate = do   i <- reportingintervalp@@ -1007,9 +1012,9 @@         string' "of"         skipMany spacenonewline         string' period-        +       optOf_ period = optional $ try $ of_ period-      +       nth = do n <- some digitChar                choice' $ map string' ["st","nd","rd","th"]                return $ read n

@@ -16,7 +16,7 @@  module Hledger.Data.Journal (   -- * Parsing helpers-  addMarketPrice,+  addPriceDirective,   addTransactionModifier,   addPeriodicTransaction,   addTransaction,@@ -35,6 +35,10 @@   filterTransactionAmounts,   filterTransactionPostings,   filterPostingAmount,+  -- * Mapping+  mapJournalTransactions,+  mapJournalPostings,+  mapTransactionPostings,   -- * Querying   journalAccountNamesUsed,   journalAccountNamesImplied,@@ -48,6 +52,8 @@   traverseJournalAmounts,   -- journalCanonicalCommodities,   journalDateSpan,+  journalStartDate,+  journalEndDate,   journalDescriptions,   journalFilePath,   journalFilePaths,@@ -55,6 +61,7 @@   journalNextTransaction,   journalPrevTransaction,   journalPostings,+  -- journalPrices,   -- * Standard account types   journalBalanceSheetAccountQuery,   journalProfitAndLossAccountQuery,@@ -104,7 +111,7 @@ import System.Time (ClockTime(TOD)) import Text.Printf -import Hledger.Utils +import Hledger.Utils import Hledger.Data.Types import Hledger.Data.AccountName import Hledger.Data.Amount@@ -146,19 +153,19 @@ --                      ,show (jtxnmodifiers j) --                      ,show (jperiodictxns j) --                      ,show $ jparsetimeclockentries j---                      ,show $ jmarketprices j+--                      ,show $ jpricedirectives j --                      ,show $ jfinalcommentlines j --                      ,show $ jparsestate j --                      ,show $ map fst $ jfiles j --                      ]  -- The monoid instance for Journal is useful for two situations.--- +-- -- 1. concatenating finalised journals, eg with multiple -f options: -- FIRST <> SECOND. The second's list fields are appended to the -- first's, map fields are combined, transaction counts are summed, -- the parse state of the second is kept.--- +-- -- 2. merging a child parsed journal, eg with the include directive: -- CHILD <> PARENT. A parsed journal's data is in reverse order, so -- this gives what we want.@@ -176,7 +183,7 @@     ,jdeclaredaccounttypes      = jdeclaredaccounttypes      j1 <> jdeclaredaccounttypes      j2     ,jcommodities               = jcommodities               j1 <> jcommodities               j2     ,jinferredcommodities       = jinferredcommodities       j1 <> jinferredcommodities       j2-    ,jmarketprices              = jmarketprices              j1 <> jmarketprices              j2+    ,jpricedirectives              = jpricedirectives              j1 <> jpricedirectives              j2     ,jtxnmodifiers              = jtxnmodifiers              j1 <> jtxnmodifiers              j2     ,jperiodictxns              = jperiodictxns              j1 <> jperiodictxns              j2     ,jtxns                      = jtxns                      j1 <> jtxns                      j2@@ -205,7 +212,7 @@   ,jdeclaredaccounttypes      = M.empty   ,jcommodities               = M.empty   ,jinferredcommodities       = M.empty-  ,jmarketprices              = []+  ,jpricedirectives              = []   ,jtxnmodifiers              = []   ,jperiodictxns              = []   ,jtxns                      = []@@ -232,8 +239,8 @@ addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal addPeriodicTransaction pt j = j { jperiodictxns = pt : jperiodictxns j } -addMarketPrice :: MarketPrice -> Journal -> Journal-addMarketPrice h j = j { jmarketprices = h : jmarketprices j }+addPriceDirective :: PriceDirective -> Journal -> Journal+addPriceDirective h j = j { jpricedirectives = h : jpricedirectives j }  -- XXX #999 keep sorted  -- | Get the transaction with this index (its 1-based position in the input stream), if any. journalTransactionAt :: Journal -> Integer -> Maybe Transaction@@ -261,7 +268,7 @@ journalAccountNamesUsed :: Journal -> [AccountName] journalAccountNamesUsed = accountNamesFromPostings . journalPostings --- | Sorted unique account names implied by this journal's transactions - +-- | Sorted unique account names implied by this journal's transactions - -- accounts posted to and all their implied parent accounts. journalAccountNamesImplied :: Journal -> [AccountName] journalAccountNamesImplied = expandAccountNames . journalAccountNamesUsed@@ -282,31 +289,31 @@  -- | Convenience/compatibility alias for journalAccountNamesDeclaredOrImplied. journalAccountNames :: Journal -> [AccountName]-journalAccountNames = journalAccountNamesDeclaredOrImplied +journalAccountNames = journalAccountNamesDeclaredOrImplied  journalAccountNameTree :: Journal -> Tree AccountName journalAccountNameTree = accountNameTreeFrom . journalAccountNames  -- queries for standard account types --- | Get a query for accounts of a certain type (Asset, Liability..) in this journal.  --- The query will match all accounts which were declared as that type by account directives, --- plus all their subaccounts which have not been declared as a different type. --- If no accounts were declared as this type, the query will instead match accounts +-- | Get a query for accounts of a certain type (Asset, Liability..) in this journal.+-- The query will match all accounts which were declared as that type by account directives,+-- plus all their subaccounts which have not been declared as a different type.+-- If no accounts were declared as this type, the query will instead match accounts -- with names matched by the provided case-insensitive regular expression. journalAccountTypeQuery :: AccountType -> Regexp -> Journal -> Query journalAccountTypeQuery atype fallbackregex j =   case M.lookup atype (jdeclaredaccounttypes j) of     Nothing -> Acct fallbackregex     Just as ->-      -- XXX Query isn't able to match account type since that requires extra info from the journal. +      -- XXX Query isn't able to match account type since that requires extra info from the journal.       -- So we do a hacky search by name instead.-      And [ +      And [          Or $ map (Acct . accountNameToAccountRegex) as         ,Not $ Or $ map (Acct . accountNameToAccountRegex) differentlytypedsubs         ]       where-        differentlytypedsubs = concat +        differentlytypedsubs = concat           [subs | (t,bs) <- M.toList (jdeclaredaccounttypes j)               , t /= atype               , let subs = [b | b <- bs, any (`isAccountNamePrefixOf` b) as]@@ -314,35 +321,35 @@  -- | A query for accounts in this journal which have been -- declared as Asset by account directives, or otherwise for--- accounts with names matched by the case-insensitive regular expression +-- accounts with names matched by the case-insensitive regular expression -- @^assets?(:|$)@. journalAssetAccountQuery :: Journal -> Query journalAssetAccountQuery = journalAccountTypeQuery Asset "^assets?(:|$)"  -- | A query for accounts in this journal which have been -- declared as Liability by account directives, or otherwise for--- accounts with names matched by the case-insensitive regular expression +-- accounts with names matched by the case-insensitive regular expression -- @^(debts?|liabilit(y|ies))(:|$)@. journalLiabilityAccountQuery :: Journal -> Query journalLiabilityAccountQuery = journalAccountTypeQuery Liability "^(debts?|liabilit(y|ies))(:|$)"  -- | A query for accounts in this journal which have been -- declared as Equity by account directives, or otherwise for--- accounts with names matched by the case-insensitive regular expression +-- accounts with names matched by the case-insensitive regular expression -- @^equity(:|$)@. journalEquityAccountQuery :: Journal -> Query journalEquityAccountQuery = journalAccountTypeQuery Equity "^equity(:|$)"  -- | A query for accounts in this journal which have been -- declared as Revenue by account directives, or otherwise for--- accounts with names matched by the case-insensitive regular expression +-- accounts with names matched by the case-insensitive regular expression -- @^(income|revenue)s?(:|$)@. journalRevenueAccountQuery :: Journal -> Query journalRevenueAccountQuery = journalAccountTypeQuery Revenue "^(income|revenue)s?(:|$)"  -- | A query for accounts in this journal which have been -- declared as Expense by account directives, or otherwise for--- accounts with names matched by the case-insensitive regular expression +-- accounts with names matched by the case-insensitive regular expression -- @^(income|revenue)s?(:|$)@. journalExpenseAccountQuery  :: Journal -> Query journalExpenseAccountQuery = journalAccountTypeQuery Expense "^expenses?(:|$)"@@ -364,7 +371,7 @@  -- | A query for Cash (-equivalent) accounts in this journal (ie, -- accounts which appear on the cashflow statement.)  This is currently--- hard-coded to be all the Asset accounts except for those with names +-- hard-coded to be all the Asset accounts except for those with names -- containing the case-insensitive regular expression @(receivable|:A/R|:fixed)@. journalCashAccountQuery  :: Journal -> Query journalCashAccountQuery j = And [journalAssetAccountQuery j, Not $ Acct "(receivable|:A/R|:fixed)"]@@ -401,7 +408,18 @@ filterTransactionPostings :: Query -> Transaction -> Transaction filterTransactionPostings q t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps} +-- | Apply a transformation to a journal's transactions.+mapJournalTransactions :: (Transaction -> Transaction) -> Journal -> Journal+mapJournalTransactions f j@Journal{jtxns=ts} = j{jtxns=map f ts} +-- | Apply a transformation to a journal's postings.+mapJournalPostings :: (Posting -> Posting) -> Journal -> Journal+mapJournalPostings f j@Journal{jtxns=ts} = j{jtxns=map (mapTransactionPostings f) ts}++-- | Apply a transformation to a transaction's postings.+mapTransactionPostings :: (Posting -> Posting) -> Transaction -> Transaction+mapTransactionPostings f t@Transaction{tpostings=ps} = t{tpostings=map f ps}+ {- ------------------------------------------------------------------------------- -- filtering V1@@ -527,9 +545,9 @@  -} --- | Reverse parsed data to normal order. This is used for post-parse--- processing, since data is added to the head of the list during--- parsing.+-- | Reverse all lists of parsed items, which during parsing were+-- prepended to, so that the items are in parse order. Part of+-- post-parse finalisation. journalReverse :: Journal -> Journal journalReverse j =   j {jfiles            = reverse $ jfiles j@@ -537,7 +555,7 @@     ,jtxns             = reverse $ jtxns j     ,jtxnmodifiers     = reverse $ jtxnmodifiers j     ,jperiodictxns     = reverse $ jperiodictxns j-    ,jmarketprices     = reverse $ jmarketprices j+    ,jpricedirectives     = reverse $ jpricedirectives j     }  -- | Set this journal's last read time, ie when its files were last read.@@ -561,7 +579,7 @@ journalUntieTransactions :: Transaction -> Transaction journalUntieTransactions t@Transaction{tpostings=ps} = t{tpostings=map (\p -> p{ptransaction=Nothing}) ps} --- | Apply any transaction modifier rules in the journal +-- | Apply any transaction modifier rules in the journal -- (adding automated postings to transactions, eg). journalModifyTransactions :: Journal -> Journal journalModifyTransactions j = j{ jtxns = modifyTransactions (jtxnmodifiers j) (jtxns j) }@@ -573,7 +591,7 @@  -- "Transaction balancing" - inferring missing amounts and checking transaction balancedness and balance assertions --- | Monad used for statefully balancing/amount-inferring/assertion-checking +-- | Monad used for statefully balancing/amount-inferring/assertion-checking -- a sequence of transactions. -- Perhaps can be simplified, or would a different ordering of layers make sense ? -- If you see a way, let us know.@@ -595,9 +613,9 @@ withB :: (BalancingState s -> ST s a) -> Balancing s a withB f = ask >>= lift . lift . f --- | Get an account's running balance so far. +-- | Get an account's running balance so far. getAmountB :: AccountName -> Balancing s MixedAmount-getAmountB acc = withB $ \BalancingState{bsBalances} -> do +getAmountB acc = withB $ \BalancingState{bsBalances} -> do   fromMaybe 0 <$> H.lookup bsBalances acc  -- | Add an amount to an account's running balance, and return the new running balance.@@ -608,7 +626,7 @@   H.insert bsBalances acc new   return new --- | Set an account's running balance to this amount, and return the difference from the old. +-- | Set an account's running balance to this amount, and return the difference from the old. setAmountB :: AccountName -> MixedAmount -> Balancing s MixedAmount setAmountB acc amt = withB $ \BalancingState{bsBalances} -> do   old <- fromMaybe 0 <$> H.lookup bsBalances acc@@ -621,15 +639,15 @@   void $ writeArray bsTransactions (tindex t) t  -- | Infer any missing amounts (to satisfy balance assignments and--- to balance transactions) and check that all transactions balance +-- to balance transactions) and check that all transactions balance -- and (optional) all balance assertions pass. Or return an error message -- (just the first error encountered). -- -- Assumes journalInferCommodityStyles has been called, since those affect transaction balancing. ----- This does multiple things because amount inferring, balance assignments, +-- This does multiple things because amount inferring, balance assignments, -- balance assertions and posting dates are interdependent.--- +-- -- This can be simplified further. Overview as of 20190219: -- @ -- ****** parseAndFinaliseJournal['] (Cli/Utils.hs), journalAddForecast (Common.hs), budgetJournal (BudgetReport.hs), tests (BalanceReport.hs)@@ -652,19 +670,19 @@ journalBalanceTransactions :: Bool -> Journal -> Either String Journal journalBalanceTransactions assrt j' =   let-    -- ensure transactions are numbered, so we can store them by number +    -- 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     -- balance assignments will not be allowed on these-    txnmodifieraccts = S.fromList $ map paccount $ concatMap tmpostingrules $ jtxnmodifiers j -  in -    runST $ do +    txnmodifieraccts = S.fromList $ map paccount $ concatMap tmpostingrules $ jtxnmodifiers j+  in+    runST $ do       -- We'll update a mutable array of transactions as we balance them,       -- not strictly necessary but avoids a sort at the end I think.       balancedtxns <- newListArray (1, genericLength ts) ts -      -- Infer missing posting amounts, check transactions are balanced, +      -- Infer missing posting amounts, check transactions are balanced,       -- and check balance assertions. This is done in two passes:       runExceptT $ do @@ -673,14 +691,14 @@         -- 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-              Left  e  -> throwError e +              Left  e  -> throwError e               Right t' -> do                 lift $ writeArray balancedtxns (tindex t') t'                 return $ map Left $ tpostings t'           t -> return [Right t]          -- 2. Sort these items by date, preserving the order of same-day items,-        -- and step through them while keeping running account balances, +        -- 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           -- performing balance assignments in, and balancing, the remaining transactions,@@ -688,17 +706,17 @@           void $ mapM' balanceTransactionAndCheckAssertionsB $ sortOn (either postingDate tdate) psandts          ts' <- lift $ getElems balancedtxns-        return j{jtxns=ts'} +        return j{jtxns=ts'} --- | This function is called statefully on each of a date-ordered sequence of --- 1. fully explicit postings from already-balanced transactions and +-- | This function is called statefully on each of a date-ordered sequence of+-- 1. fully explicit postings from already-balanced transactions and -- 2. not-yet-balanced transactions containing balance assignments.--- It executes balance assignments and finishes balancing the transactions, +-- It executes balance assignments and finishes balancing the transactions, -- and checks balance assertions on each posting as it goes.--- An error will be thrown if a transaction can't be balanced +-- An error will be thrown if a transaction can't be balanced -- or if an illegal balance assignment is found (cf checkIllegalBalanceAssignment). -- Transaction prices are removed, which helps eg balance-assertions.test: 15. Mix different commodities and assignments.--- This stores the balanced transactions in case 2 but not in case 1.  +-- This stores the balanced transactions in case 2 but not in case 1. balanceTransactionAndCheckAssertionsB :: Either Posting Transaction -> Balancing s ()  balanceTransactionAndCheckAssertionsB (Left p@Posting{}) =@@ -708,28 +726,28 @@ 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, +  -- 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-  -- infer any remaining missing amounts, and make sure the transaction is now fully balanced +  -- 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-    Left err -> throwError err +    Left err -> throwError err     Right (t', inferredacctsandamts) -> do-      -- for each amount just inferred, update the running balance +      -- for each amount just inferred, update the running balance       mapM_ (uncurry addAmountB) inferredacctsandamts       -- and save the balanced transaction.-      storeTransactionB t' +      storeTransactionB t'  -- | If this posting has an explicit amount, add it to the account's running balance.--- If it has a missing amount and a balance assignment, infer the amount from, and +-- If it has a missing amount and a balance assignment, infer the amount from, and -- reset the running balance to, the assigned balance. -- If it has a missing amount and no balance assignment, leave it for later. -- Then test the balance assertion if any. addOrAssignAmountAndCheckAssertionB :: Posting -> Balancing s Posting addOrAssignAmountAndCheckAssertionB p@Posting{paccount=acc, pamount=amt, pbalanceassertion=mba}   | hasAmount p = do-      newbal <- addAmountB acc amt +      newbal <- addAmountB acc amt       whenM (R.reader bsAssrt) $ checkBalanceAssertionB p newbal       return p   | Just BalanceAssertion{baamount,batotal} <- mba = do@@ -742,8 +760,8 @@         False -> do           -- a partial balance assignment           oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getAmountB acc-          let assignedbalthiscommodity = Mixed [baamount] -              newbal = oldbalothercommodities + assignedbalthiscommodity   +          let assignedbalthiscommodity = Mixed [baamount]+              newbal = oldbalothercommodities + assignedbalthiscommodity           diff <- setAmountB acc newbal           return (diff,newbal)       let p' = p{pamount=diff, poriginal=Just $ originalPosting p}@@ -756,7 +774,7 @@ -- optionally check the posting's balance assertion if any. -- The posting is expected to have an explicit amount (otherwise this does nothing). -- Adding and checking balance assertions are tightly paired because we--- need to see the balance as it stands after each individual posting. +-- need to see the balance as it stands after each individual posting. addAmountAndCheckAssertionB :: Posting -> Balancing s Posting addAmountAndCheckAssertionB p | hasAmount p = do   newbal <- addAmountB (paccount p) (pamount p)@@ -788,17 +806,17 @@ checkBalanceAssertionOneCommodityB :: Posting -> Amount -> MixedAmount -> Balancing s () checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt actualbal = do   let isinclusive = maybe False bainclusive $ pbalanceassertion p-  actualbal' <- -    if isinclusive -    then -      -- sum the running balances of this account and any of its subaccounts seen so far -      withB $ \BalancingState{bsBalances} -> -        H.foldM -          (\ibal (acc, amt) -> return $ ibal + +  actualbal' <-+    if isinclusive+    then+      -- sum the running balances of this account and any of its subaccounts seen so far+      withB $ \BalancingState{bsBalances} ->+        H.foldM+          (\ibal (acc, amt) -> return $ ibal +             if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc then amt else 0)-          0 +          0           bsBalances-    else return actualbal  +    else return actualbal   let     assertedcomm    = acommodity assertedamt     actualbalincomm = headDef 0 $ amounts $ filterMixedAmountByCommodity assertedcomm $ actualbal'@@ -845,17 +863,17 @@  -- | Throw an error if this posting is trying to do an illegal balance assignment. checkIllegalBalanceAssignmentB :: Posting -> Balancing s ()-checkIllegalBalanceAssignmentB p = do +checkIllegalBalanceAssignmentB p = do   checkBalanceAssignmentPostingDateB p   checkBalanceAssignmentUnassignableAccountB p-  + -- XXX these should show position. annotateErrorWithTransaction t ?  -- | Throw an error if this posting is trying to do a balance assignment and -- has a custom posting date (which makes amount inference too hard/impossible). checkBalanceAssignmentPostingDateB :: Posting -> Balancing s () checkBalanceAssignmentPostingDateB p =-  when (hasBalanceAssignment p && isJust (pdate p)) $ +  when (hasBalanceAssignment p && isJust (pdate p)) $     throwError $ unlines $       ["postings which are balance assignments may not have a custom date."       ,"Please write the posting amount explicitly, or remove the posting date:"@@ -889,17 +907,19 @@ -- a commodity format directive, or otherwise inferred from posting -- amounts as in hledger < 0.28. journalApplyCommodityStyles :: Journal -> Journal-journalApplyCommodityStyles j@Journal{jtxns=ts, jmarketprices=mps} = j''+journalApplyCommodityStyles j@Journal{jtxns=ts, jpricedirectives=pds} = j''     where       j' = journalInferCommodityStyles j       styles = journalCommodityStyles j'-      j'' = j'{jtxns=map fixtransaction ts, jmarketprices=map fixmarketprice mps}+      j'' = j'{jtxns=map fixtransaction ts, jpricedirectives=map fixpricedirective pds}       fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}-      fixposting p@Posting{pamount=a} = p{pamount=styleMixedAmount styles a}-      fixmarketprice mp@MarketPrice{mpamount=a} = mp{mpamount=styleAmount styles a}+      fixposting p = p{pamount=styleMixedAmount styles $ pamount p+                      ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p}+      fixbalanceassertion ba = ba{baamount=styleAmount styles $ baamount ba}+      fixpricedirective pd@PriceDirective{pdamount=a} = pd{pdamount=styleAmount styles a} --- | Get all the amount styles defined in this journal, either declared by --- a commodity directive or inferred from amounts, as a map from symbol to style. +-- | Get all the amount styles defined in this journal, either declared by+-- a commodity directive or inferred from amounts, as a map from symbol to style. -- Styles declared by commodity directives take precedence, and these also are -- guaranteed to know their decimal point character. journalCommodityStyles :: Journal -> M.Map CommoditySymbol AmountStyle@@ -942,8 +962,8 @@     --   []    -> (Just '.', 0)  -- -- | Apply this journal's historical price records to unpriced amounts where possible.--- journalApplyMarketPrices :: Journal -> Journal--- journalApplyMarketPrices j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}+-- journalApplyPriceDirectives :: Journal -> Journal+-- journalApplyPriceDirectives j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts} --     where --       fixtransaction t@Transaction{tdate=d, tpostings=ps} = t{tpostings=map fixposting ps} --        where@@ -951,17 +971,18 @@ --         fixmixedamount (Mixed as) = Mixed $ map fixamount as --         fixamount = fixprice --         fixprice a@Amount{price=Just _} = a---         fixprice a@Amount{commodity=c} = a{price=maybe Nothing (Just . UnitPrice) $ journalMarketPriceFor j d c}+--         fixprice a@Amount{commodity=c} = a{price=maybe Nothing (Just . UnitPrice) $ journalPriceDirectiveFor j d c}  -- -- | Get the price for a commodity on the specified day from the price database, if known. -- -- Does only one lookup step, ie will not look up the price of a price.--- journalMarketPriceFor :: Journal -> Day -> CommoditySymbol -> Maybe MixedAmount--- journalMarketPriceFor j d CommoditySymbol{symbol=s} = do---   let ps = reverse $ filter ((<= d).mpdate) $ filter ((s==).hsymbol) $ sortBy (comparing mpdate) $ jmarketprices j---   case ps of (MarketPrice{mpamount=a}:_) -> Just a+-- journalPriceDirectiveFor :: Journal -> Day -> CommoditySymbol -> Maybe MixedAmount+-- journalPriceDirectiveFor j d CommoditySymbol{symbol=s} = do+--   let ps = reverse $ filter ((<= d).pddate) $ filter ((s==).hsymbol) $ sortBy (comparing pddate) $ jpricedirectives j+--   case ps of (PriceDirective{pdamount=a}:_) -> Just a --              _ -> Nothing --- | Convert all this journal's amounts to cost by applying their prices, if any.+-- | 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. journalConvertAmountsToCost :: Journal -> Journal journalConvertAmountsToCost j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}     where@@ -1008,19 +1029,19 @@ overJournalAmounts :: (Amount -> Amount) -> Journal -> Journal overJournalAmounts f = runIdentity . traverseJournalAmounts (Identity . f) --- | Traverses over all ofthe amounts in the journal, in the order+-- | Traverses over all of the amounts in the journal, in the order -- indicated by 'journalAmounts'. traverseJournalAmounts     :: Applicative f     => (Amount -> f Amount)     -> Journal -> f Journal traverseJournalAmounts f j =-    recombine <$> (traverse . mpa) f (jmarketprices j)+    recombine <$> (traverse . mpa) f (jpricedirectives j)               <*> (traverse . tp . traverse . pamt . maa . traverse) f (jtxns j)   where-    recombine mps txns = j { jmarketprices = mps, jtxns = txns }+    recombine mps txns = j { jpricedirectives = mps, jtxns = txns }     -- a bunch of traversals-    mpa  g mp = (\amt -> mp { mpamount  = amt }) <$> g (mpamount mp)+    mpa  g pd = (\amt -> pd { pdamount  = amt }) <$> g (pdamount pd)     tp   g t  = (\ps  -> t  { tpostings = ps  }) <$> g (tpostings t)     pamt g p  = (\amt -> p  { pamount   = amt }) <$> g (pamount p)     maa  g (Mixed as) = Mixed <$> g as@@ -1040,6 +1061,16 @@       pdates   = concatMap (mapMaybe (if secondary then (Just . postingDate2) else pdate) . tpostings) ts       ts       = jtxns j +-- | The earliest of this journal's transaction and posting dates, or+-- Nothing if there are none.+journalStartDate :: Bool -> Journal -> Maybe Day+journalStartDate secondary j = b where DateSpan b _ = journalDateSpan secondary j++-- | The latest of this journal's transaction and posting dates, or+-- Nothing if there are none.+journalEndDate :: Bool -> Journal -> Maybe Day+journalEndDate secondary j = e where DateSpan _ e = journalDateSpan secondary j+ -- | Apply the pivot transformation to all postings in a journal, -- replacing their account name by their value for the given field or tag. journalPivot :: Text -> Journal -> Journal@@ -1047,25 +1078,40 @@  -- | Replace this transaction's postings' account names with the value -- of the given field or tag, if any.-transactionPivot :: Text -> Transaction -> Transaction         +transactionPivot :: Text -> Transaction -> Transaction transactionPivot fieldortagname t = t{tpostings = map (postingPivot fieldortagname) . tpostings $ t}  -- | Replace this posting's account name with the value -- of the given field or tag, if any, otherwise the empty string.-postingPivot :: Text -> Posting -> Posting         +postingPivot :: Text -> Posting -> Posting postingPivot fieldortagname p = p{paccount = pivotedacct, poriginal = Just $ originalPosting p}   where     pivotedacct-      | Just t <- ptransaction p, fieldortagname == "code"        = tcode t  -      | Just t <- ptransaction p, fieldortagname == "description" = tdescription t  -      | Just t <- ptransaction p, fieldortagname == "payee"       = transactionPayee t  -      | Just t <- ptransaction p, fieldortagname == "note"        = transactionNote t  +      | Just t <- ptransaction p, fieldortagname == "code"        = tcode t+      | Just t <- ptransaction p, fieldortagname == "description" = tdescription t+      | Just t <- ptransaction p, fieldortagname == "payee"       = transactionPayee t+      | Just t <- ptransaction p, fieldortagname == "note"        = transactionNote t       | Just (_, value) <- postingFindTag fieldortagname p        = value       | otherwise                                                 = "" -postingFindTag :: TagName -> Posting -> Maybe (TagName, TagValue)         +postingFindTag :: TagName -> Posting -> Maybe (TagName, TagValue) postingFindTag tagname p = find ((tagname==) . fst) $ postingAllTags p +-- -- | Build a database of market prices in effect on the given date,+-- -- from the journal's price directives.+-- journalPrices :: Day -> Journal -> Prices+-- journalPrices d = toPrices d . jpricedirectives++-- -- | Render a market price as a P directive.+-- showPriceDirectiveDirective :: PriceDirective -> String+-- showPriceDirectiveDirective pd = unwords+--     [ "P"+--     , showDate (pddate pd)+--     , T.unpack (pdcommodity pd)+--     , (showAmount . setAmountPrecision maxprecision) (pdamount pd+--     )+--     ]+ -- Misc helpers  -- | Check if a set of hledger account/description filter patterns matches the@@ -1287,8 +1333,8 @@             nulljournal{ jtxns = [                transaction "2019/01/01" [ vpost' "a" (num 2)    (balassert (num 2)) ]               ,transaction "2019/01/01" [-                 post' "b" (num 1)     Nothing  -                ,post' "a"  missingamt Nothing  +                 post' "b" (num 1)     Nothing+                ,post' "a"  missingamt Nothing               ]               ,transaction "2019/01/01" [ post' "a" (num 0)     (balassert (num 1)) ]             ]}

@@ -31,7 +31,7 @@ import Safe (headDef) import Text.Printf -import Hledger.Utils.Test +import Hledger.Utils.Test import Hledger.Data.Types import Hledger.Data.Account import Hledger.Data.Journal@@ -53,10 +53,11 @@   laccounts = []   } --- | Filter a journal's transactions with the given query, then derive--- a ledger containing the chart of accounts and balances. If the--- query includes a depth limit, that will affect the ledger's--- journal but not the ledger's account tree.+-- | Filter a journal's transactions with the given query, then build+-- a "Ledger", containing the journal plus the tree of all its+-- accounts with their subaccount-inclusive and subaccount-exclusive+-- balances. If the query includes a depth limit, the ledger's journal+-- will be depth limited, but the ledger's account tree will not. ledgerFromJournal :: Query -> Journal -> Ledger ledgerFromJournal q j = nullledger{ljournal=j'', laccounts=as}   where

@@ -1,27 +0,0 @@-{-|--A 'MarketPrice' represents a historical exchange rate between two-commodities. (Ledger calls them historical prices.) For example, prices-published by a stock exchange or the foreign exchange market.  Some-commands (balance, currently) can use this information to show the market-value of things at a given date.---}--module Hledger.Data.MarketPrice-where-import qualified Data.Text as T--import Hledger.Data.Amount-import Hledger.Data.Dates-import Hledger.Data.Types---- | Get the string representation of an market price, based on its--- commodity's display settings.-showMarketPrice :: MarketPrice -> String-showMarketPrice mp = unwords-    [ "P"-    , showDate (mpdate mp)-    , T.unpack (mpcommodity mp)-    , (showAmount . setAmountPrecision maxprecision) (mpamount mp)-    ]

@@ -5,7 +5,29 @@  -} -module Hledger.Data.Period+module Hledger.Data.Period (+   periodAsDateSpan+  ,dateSpanAsPeriod+  ,simplifyPeriod+  ,isLastDayOfMonth+  ,isStandardPeriod+  ,showPeriod+  ,showPeriodMonthAbbrev+  ,periodStart+  ,periodEnd+  ,periodNext+  ,periodPrevious+  ,periodNextIn+  ,periodPreviousIn+  ,periodMoveTo+  ,periodGrow+  ,periodShrink+  ,mondayBefore+  ,yearMonthContainingWeekStarting+  ,quarterContainingMonth+  ,firstMonthOfQuarter+  ,startOfFirstWeekInMonth+) where  import Data.Time.Calendar@@ -144,7 +166,7 @@ showPeriod (PeriodTo e)        = formatTime defaultTimeLocale "-%0C%y/%m/%d" (addDays (-1) e)    -- -INCLUSIVEENDDATE showPeriod PeriodAll           = "-" --- | Like showPeriod, but if it's a month period show just +-- | Like showPeriod, but if it's a month period show just -- the 3 letter month name abbreviation for the current locale. showPeriodMonthAbbrev (MonthPeriod _ m)                           -- Jan   | m > 0 && m <= length monthnames = snd $ monthnames !! (m-1)

@@ -21,7 +21,7 @@ import Hledger.Data.Types import Hledger.Data.Dates import Hledger.Data.Amount-import Hledger.Data.Posting (post)+import Hledger.Data.Posting (post, commentAddTagNextLine) import Hledger.Data.Transaction import Hledger.Utils.UTF8IOCompat (error') -- import Hledger.Utils.Debug@@ -34,7 +34,7 @@ -- doctest helper, too much hassle to define in the comment -- XXX duplicates some logic in periodictransactionp _ptgen str = do-  let +  let     t = T.pack str     (i,s) = parsePeriodExpr' nulldate t   case checkPeriodicTransactionStartDate i s t of@@ -42,7 +42,7 @@     Nothing ->       mapM_ (putStr . showTransaction) $         runPeriodicTransaction-          nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] } +          nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] }           nulldatespan  @@ -69,6 +69,10 @@ -- | Generate transactions from 'PeriodicTransaction' within a 'DateSpan' -- -- Note that new transactions require 'txnTieKnot' post-processing.+-- The new transactions will have three tags added: +-- - a recur:PERIODICEXPR tag whose value is the generating periodic expression+-- - a generated-transaction: tag+-- - a hidden _generated-transaction: tag which does not appear in the comment.  -- -- >>> _ptgen "monthly from 2017/1 to 2017/4" -- 2017/01/01@@ -184,13 +188,13 @@ -- *** Exception: Unable to generate transactions according to "weekly from 2017" because 2017-01-01 is not a first day of the week -- -- >>> _ptgen "monthly from 2017/5/4"--- *** Exception: Unable to generate transactions according to "monthly from 2017/5/4" because 2017-05-04 is not a first day of the month        +-- *** Exception: Unable to generate transactions according to "monthly from 2017/5/4" because 2017-05-04 is not a first day of the month -- -- >>> _ptgen "every quarter from 2017/1/2"--- *** Exception: Unable to generate transactions according to "every quarter from 2017/1/2" because 2017-01-02 is not a first day of the quarter        +-- *** Exception: Unable to generate transactions according to "every quarter from 2017/1/2" because 2017-01-02 is not a first day of the quarter -- -- >>> _ptgen "yearly from 2017/1/14"--- *** Exception: Unable to generate transactions according to "yearly from 2017/1/14" because 2017-01-14 is not a first day of the year        +-- *** Exception: Unable to generate transactions according to "yearly from 2017/1/14" because 2017-01-14 is not a first day of the year -- -- >>> let reportperiod="daily from 2018/01/03" in let (i,s) = parsePeriodExpr' nulldate reportperiod in runPeriodicTransaction (nullperiodictransaction{ptperiodexpr=reportperiod, ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1]}) (DateSpan (Just $ parsedate "2018-01-01") (Just $ parsedate "2018-01-03")) -- []@@ -203,28 +207,32 @@     t = nulltransaction{            tstatus      = ptstatus           ,tcode        = ptcode-          ,tdescription = ptdescription -          ,tcomment     = (if T.null ptcomment then "\n" else ptcomment) <> "recur: " <> ptperiodexpr-          ,ttags        = ("recur", ptperiodexpr) : pttags +          ,tdescription = ptdescription+          ,tcomment     = ptcomment+                          `commentAddTagNextLine` ("generated-transaction",period)+          ,ttags        = ("_generated-transaction",period) :+                          ("generated-transaction" ,period) :+                          pttags           ,tpostings    = ptpostings           }+    period = "~ " <> ptperiodexpr --- | Check that this date span begins at a boundary of this interval, +-- | Check that this date span begins at a boundary of this interval, -- or return an explanatory error message including the provided period expression -- (from which the span and interval are derived).-checkPeriodicTransactionStartDate :: Interval -> DateSpan -> T.Text -> Maybe String -checkPeriodicTransactionStartDate i s periodexpr = +checkPeriodicTransactionStartDate :: Interval -> DateSpan -> T.Text -> Maybe String+checkPeriodicTransactionStartDate i s periodexpr =   case (i, spanStart s) of     (Weeks _,    Just d) -> checkStart d "week"     (Months _,   Just d) -> checkStart d "month"     (Quarters _, Just d) -> checkStart d "quarter"     (Years _,    Just d) -> checkStart d "year"-    _                    -> Nothing +    _                    -> Nothing     where       checkStart d x =-        let firstDate = fixSmartDate d ("","this",x) -        in   -         if d == firstDate +        let firstDate = fixSmartDate d ("","this",x)+        in+         if d == firstDate          then Nothing          else Just $           "Unable to generate transactions according to "++show (T.unpack periodexpr)

@@ -54,20 +54,24 @@   concatAccountNames,   accountNameApplyAliases,   accountNameApplyAliasesMemo,-  -- * transaction description operations-  transactionPayee,-  transactionNote,-  payeeAndNoteFromDescription,+  -- * comment/tag operations+  commentJoin,+  commentAddTag,+  commentAddTagNextLine,   -- * arithmetic   sumPostings,   -- * rendering   showPosting,   -- * misc.   showComment,+  postingTransformAmount,+  postingApplyValuation,+  postingToCost,   tests_Posting ) where import Data.List+import qualified Data.Map as M import Data.Maybe import Data.MemoUgly (memo) #if !(MIN_VERSION_base(4,11,0))@@ -78,11 +82,12 @@ import Data.Time.Calendar import Safe -import Hledger.Utils +import Hledger.Utils import Hledger.Data.Types import Hledger.Data.Amount import Hledger.Data.AccountName import Hledger.Data.Dates (nulldate, spanContainsDate)+import Hledger.Data.Valuation   @@ -195,7 +200,7 @@ -- | Remove all prices of a posting removePrices :: Posting -> Posting removePrices p = p{ pamount = Mixed $ remove <$> amounts (pamount p) }-  where remove a = a { aprice = NoPrice }+  where remove a = a { aprice = Nothing }  -- | 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@@ -220,7 +225,7 @@ -- | Get a posting's status. This is cleared or pending if those are -- explicitly set on the posting, otherwise the status of its parent -- transaction, or unmarked if there is no parent transaction. (Note--- the ambiguity, unmarked can mean "posting and transaction are both +-- the ambiguity, unmarked can mean "posting and transaction are both -- unmarked" or "posting is unmarked and don't know about the transaction". postingStatus :: Posting -> Status postingStatus Posting{pstatus=s, ptransaction=mt}@@ -228,23 +233,6 @@                                Nothing -> Unmarked   | otherwise = s -transactionPayee :: Transaction -> Text-transactionPayee = fst . payeeAndNoteFromDescription . tdescription--transactionNote :: Transaction -> Text-transactionNote = snd . payeeAndNoteFromDescription . tdescription---- | Parse a transaction's description into payee and note (aka narration) fields,--- assuming a convention of separating these with | (like Beancount).--- Ie, everything up to the first | is the payee, everything after it is the note.--- When there's no |, payee == note == description.-payeeAndNoteFromDescription :: Text -> (Text,Text)-payeeAndNoteFromDescription t-  | T.null n = (t, t)-  | otherwise = (textstrip p, textstrip $ T.drop 1 n)-  where-    (p, n) = T.span (/= '|') t- -- | Tags for this posting including any inherited from its parent transaction. postingAllTags :: Posting -> [Tag] postingAllTags p = ptags p ++ maybe [] ttags (ptransaction p)@@ -331,6 +319,7 @@ -- | Memoising version of accountNameApplyAliases, maybe overkill. accountNameApplyAliasesMemo :: [AccountAlias] -> AccountName -> AccountName accountNameApplyAliasesMemo aliases = memo (accountNameApplyAliases aliases)+  -- XXX re-test this memoisation  -- aliasMatches :: AccountAlias -> AccountName -> Bool -- aliasMatches (BasicAlias old _) a = old `isAccountNamePrefixOf` a@@ -342,7 +331,60 @@   | otherwise = a aliasReplace (RegexAlias re repl) a = T.pack $ regexReplaceCIMemo re repl $ T.unpack a -- XXX +-- Apply a specified valuation to this posting's amount, using the provided+-- price oracle, commodity styles, period-end/current dates, and whether+-- this is for a multiperiod report or not.+postingApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> Posting -> ValuationType -> Posting+postingApplyValuation priceoracle styles periodend today ismultiperiod p v =+  case v of+    AtCost    Nothing            -> postingToCost styles p+    AtCost    mc                 -> postingValueAtDate priceoracle styles mc periodend $ postingToCost styles p+    AtEnd     mc                 -> postingValueAtDate priceoracle styles mc periodend p+    AtNow     mc                 -> postingValueAtDate priceoracle styles mc today     p+    AtDefault mc | ismultiperiod -> postingValueAtDate priceoracle styles mc periodend p+    AtDefault mc                 -> postingValueAtDate priceoracle styles mc today     p+    AtDate d  mc                 -> postingValueAtDate priceoracle styles mc d         p +-- | Convert this posting's amount to cost, and apply the appropriate amount styles.+postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting+postingToCost styles p@Posting{pamount=a} = p{pamount=mixedAmountToCost styles a}++-- | Convert this posting's amount to market value in the given commodity,+-- or the default valuation commodity, at the given valuation date,+-- using the given market price oracle.+-- When market prices available on that date are not sufficient to+-- calculate the value, amounts are left unchanged.+postingValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> Posting -> Posting+postingValueAtDate priceoracle styles mc d p = postingTransformAmount (mixedAmountValueAtDate priceoracle styles mc d) p++-- | Apply a transform function to this posting's amount.+postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting+postingTransformAmount f p@Posting{pamount=a} = p{pamount=f a}++-- | Join two parts of a comment, eg a tag and another tag, or a tag+-- and a non-tag, on a single line. Interpolates a comma and space+-- unless one of the parts is empty.+commentJoin :: Text -> Text -> Text+commentJoin c1 c2+  | T.null c1 = c2+  | T.null c2 = c1+  | otherwise = c1 <> ", " <> c2++-- | Add a tag to a comment, comma-separated from any prior content.+commentAddTag :: Text -> Tag -> Text+commentAddTag c (t,v)+  | T.null c' = tag+  | otherwise = c' `commentJoin` tag+  where+    c'  = textchomp c+    tag = t <> ":" <> v++-- | Add a tag on its own line to a comment, preserving any prior content.+commentAddTagNextLine :: Text -> Tag -> Text+commentAddTagNextLine cmt (t,v) =+  cmt <> if "\n" `T.isSuffixOf` cmt then "" else "\n" <> t <> ":" <> v ++ -- tests  tests_Posting = tests "Posting" [@@ -373,5 +415,14 @@     ,concatAccountNames ["a","(b)","[c:d]"] `is` "(a:b:c:d)"   ] + ,tests "commentAddTag" [+    commentAddTag "" ("a","") `is` "a:"+   ,commentAddTag "[1/2]" ("a","") `is` "[1/2], a:"+  ]++ ,tests "commentAddTagNextLine" [+    commentAddTagNextLine "" ("a","") `is` "\na:"+   ,commentAddTagNextLine "[1/2]" ("a","") `is` "[1/2]\na:"+  ]  ] 

@@ -137,7 +137,7 @@  ---------------------------------------------------------------------- -formatStringTester fs value expected = actual `is` expected +formatStringTester fs value expected = actual `is` expected   where     actual = case fs of       FormatLiteral l                   -> formatString False Nothing Nothing l

@@ -26,7 +26,7 @@ #endif import Text.Printf -import Hledger.Utils +import Hledger.Utils import Hledger.Data.Types import Hledger.Data.Dates import Hledger.Data.Amount@@ -130,10 +130,10 @@                   parseTime defaultTimeLocale "%H:%M:%S" #endif        showtime = formatTime defaultTimeLocale "%H:%M"-       txndescs = map (T.unpack . tdescription) . timeclockEntriesToTransactions now +       txndescs = map (T.unpack . tdescription) . timeclockEntriesToTransactions now        future = utcToLocalTime tz $ addUTCTime 100 now'        futurestr = showtime future-   tests "timeclockEntriesToTransactions" [ +   tests "timeclockEntriesToTransactions" [      test "started yesterday, split session at midnight" $       txndescs [clockin (mktime yesterday "23:00:00") "" ""] `is` ["23:00-23:59","00:00-"++nowstr]      ,test "split multi-day sessions at each midnight" $

@@ -35,6 +35,10 @@   transactionDate2,   -- * arithmetic   transactionPostingBalances,+  -- * transaction description parts+  transactionPayee,+  transactionNote,+  -- payeeAndNoteFromDescription,   -- * rendering   showTransaction,   showTransactionUnelided,@@ -58,7 +62,7 @@ import Text.Printf import qualified Data.Map as Map -import Hledger.Utils +import Hledger.Utils import Hledger.Data.Types import Hledger.Data.Dates import Hledger.Data.Posting@@ -97,11 +101,28 @@                   }  -- | Make a simple transaction with the given date and postings.-transaction :: String -> [Posting] -> Transaction +transaction :: String -> [Posting] -> Transaction transaction datestr ps = txnTieKnot $ nulltransaction{tdate=parsedate datestr, tpostings=ps} +transactionPayee :: Transaction -> Text+transactionPayee = fst . payeeAndNoteFromDescription . tdescription++transactionNote :: Transaction -> Text+transactionNote = snd . payeeAndNoteFromDescription . tdescription++-- | Parse a transaction's description into payee and note (aka narration) fields,+-- assuming a convention of separating these with | (like Beancount).+-- Ie, everything up to the first | is the payee, everything after it is the note.+-- When there's no |, payee == note == description.+payeeAndNoteFromDescription :: Text -> (Text,Text)+payeeAndNoteFromDescription t+  | T.null n = (t, t)+  | otherwise = (textstrip p, textstrip $ T.drop 1 n)+  where+    (p, n) = T.span (/= '|') t+ {-|-Render a journal transaction as text in the style of Ledger's print command. +Render a journal transaction as text in the style of Ledger's print command.  Ledger 2.x's standard format looks like this: @@ -118,7 +139,7 @@ @  The output will be parseable journal syntax.-To facilitate this, postings with explicit multi-commodity amounts +To facilitate this, postings with explicit multi-commodity amounts are displayed as multiple similar postings, one per commodity. (Normally does not happen with this function). @@ -127,8 +148,8 @@ (postings sum to 0, without needing to infer conversion prices), the last posting's amount will not be shown. -}--- XXX why that logic ? --- XXX where is/should this be still used ? +-- XXX why that logic ?+-- XXX where is/should this be still used ? -- XXX rename these, after amount expressions/mixed posting amounts lands --     eg showTransactionSimpleAmountsElidingLast, showTransactionSimpleAmounts, showTransaction showTransaction :: Transaction -> String@@ -137,19 +158,19 @@ -- | Like showTransaction, but does not change amounts' explicitness. -- Explicit amounts are shown and implicit amounts are not. -- The output will be parseable journal syntax.--- To facilitate this, postings with explicit multi-commodity amounts +-- To facilitate this, postings with explicit multi-commodity amounts -- are displayed as multiple similar postings, one per commodity. -- Most often, this is the one you want to use. showTransactionUnelided :: Transaction -> String showTransactionUnelided = showTransactionHelper False False --- | Like showTransactionUnelided, but explicit multi-commodity amounts --- are shown on one line, comma-separated. In this case the output will +-- | Like showTransactionUnelided, but explicit multi-commodity amounts+-- are shown on one line, comma-separated. In this case the output will -- not be parseable journal syntax. showTransactionUnelidedOneLineAmounts :: Transaction -> String showTransactionUnelidedOneLineAmounts = showTransactionHelper False True --- | Helper for showTransaction*. +-- | Helper for showTransaction*. showTransactionHelper :: Bool -> Bool -> Transaction -> String showTransactionHelper elide onelineamounts t =     unlines $ [descriptionline]@@ -169,17 +190,22 @@                                                 c:cs -> (c,cs)  -- | Render a transaction or posting's comment as indented, semicolon-prefixed comment lines.+-- The first line (unless empty) will have leading space, subsequent lines will have a larger indent. renderCommentLines :: Text -> [String]-renderCommentLines t  = case lines $ T.unpack t of ("":ls) -> "":map commentprefix ls-                                                   ls      -> map commentprefix ls-    where-      commentprefix = indent . ("; "++)+renderCommentLines t =+  case lines $ T.unpack t of+    []      -> []+    [l]     -> [(commentSpace . comment) l]        -- single-line comment+    ("":ls) -> "" : map (lineIndent . comment) ls  -- multi-line comment with empty first line+    (l:ls)  -> (commentSpace . comment) l : map (lineIndent . comment) ls+  where+    comment = ("; "++)  -- | Given a transaction and its postings, render the postings, suitable -- for `print` output. Normally this output will be valid journal syntax which -- hledger can reparse (though it may include no-longer-valid balance assertions). ----- Explicit amounts are shown, any implicit amounts are not. +-- Explicit amounts are shown, any implicit amounts are not. -- -- Setting elide to true forces the last posting's amount to be implicit, if: -- there are other postings, all with explicit amounts, and the transaction@@ -189,36 +215,36 @@ -- if onelineamounts is true, these amounts are shown on one line, -- comma-separated, and the output will not be valid journal syntax. -- Otherwise, they are shown as several similar postings, one per commodity.--- +-- -- The output will appear to be a balanced transaction. -- Amounts' display precisions, which may have been limited by commodity -- directives, will be increased if necessary to ensure this. -- -- Posting amounts will be aligned with each other, starting about 4 columns -- beyond the widest account name (see postingAsLines for details).--- +-- postingsAsLines :: Bool -> Bool -> Transaction -> [Posting] -> [String] postingsAsLines elide onelineamounts t ps   | elide && length ps > 1 && all hasAmount ps && isTransactionBalanced Nothing t -- imprecise balanced check    = concatMap (postingAsLines False onelineamounts ps) (init ps) ++ postingAsLines True onelineamounts ps (last ps)   | otherwise = concatMap (postingAsLines False onelineamounts ps) ps --- | Render one posting, on one or more lines, suitable for `print` output.  +-- | 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, -- posting amount, balance assertion, same-line comment, next-line comments.--- +-- -- If the posting's amount is implicit or if elideamount is true, no amount is shown. ----- If the posting's amount is explicit and multi-commodity, multiple similar +-- If the posting's amount is explicit and multi-commodity, multiple similar -- postings are shown, one for each commodity, to help produce parseable journal syntax. -- Or if onelineamounts is true, such amounts are shown on one line, comma-separated -- (and the output will not be valid journal syntax). ----- By default, 4 spaces (2 if there's a status flag) are shown between +-- By default, 4 spaces (2 if there's a status flag) are shown between -- account name and start of amount area, which is typically 12 chars wide--- and contains a right-aligned amount (so 10-12 visible spaces between +-- and contains a right-aligned amount (so 10-12 visible spaces between -- account name and amount is typical).--- When given a list of postings to be aligned with, the whitespace will be +-- When given a list of postings to be aligned with, the whitespace will be -- increased if needed to match the posting with the longest account name. -- This is used to align the amounts of a transaction's postings. --@@ -229,10 +255,10 @@     | postingblock <- postingblocks]   where     postingblocks = [map rstrip $ lines $ concatTopPadded [statusandaccount, "  ", amount, assertion, samelinecomment] | amount <- shownAmounts]-    assertion = maybe "" ((' ':).showBalanceAssertion) $ pbalanceassertion p -    statusandaccount = indent $ fitString (Just $ minwidth) Nothing False True $ pstatusandacct p+    assertion = maybe "" ((' ':).showBalanceAssertion) $ pbalanceassertion p+    statusandaccount = lineIndent $ fitString (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  +          -- pad to the maximum account name width, plus 2 to leave room for status flags, to keep amounts aligned           minwidth = maximum $ map ((2+) . textWidth . T.pack . pacctstr) pstoalignwith           pstatusandacct p' = pstatusprefix p' ++ pacctstr p'           pstatusprefix p' | null s    = ""@@ -253,13 +279,13 @@       case renderCommentLines (pcomment p) of []   -> ("",[])                                               c:cs -> (c,cs) --- | Render a balance assertion, as the =[=][*] symbol and expected amount. -showBalanceAssertion BalanceAssertion{..} = +-- | Render a balance assertion, as the =[=][*] symbol and expected amount.+showBalanceAssertion BalanceAssertion{..} =   "=" ++ ['=' | batotal] ++ ['*' | bainclusive] ++ " " ++ showAmountWithZeroCommodity baamount  -- | Render a posting, simply. Used in balance assertion errors. -- showPostingLine p =---   indent $+--   lineIndent $ --   if pstatus p == Cleared then "* " else "" ++  -- XXX show ! --   showAccountName Nothing (ptype p) (paccount p) ++ --   "    " ++@@ -270,15 +296,20 @@ --     assertion = maybe "" ((" = " ++) . showAmountWithZeroCommodity . baamount) $ pbalanceassertion p  -- | Render a posting, at the appropriate width for aligning with--- its siblings if any. Used by the rewrite command. +-- its siblings if any. Used by the rewrite command. showPostingLines :: Posting -> [String] showPostingLines p = postingAsLines False False ps p where     ps | Just t <- ptransaction p = tpostings t        | otherwise = [p] -indent :: String -> String-indent = ("    "++)+-- | Prepend a suitable indent for a posting (or transaction/posting comment) line.+lineIndent :: String -> String+lineIndent = ("    "++) +-- | Prepend the space required before a same-line comment.+commentSpace :: String -> String+commentSpace = ("  "++)+ -- | Show an account name, clipped to the given width if any, and -- appropriately bracketed/parenthesised for the given posting type. showAccountName :: Maybe Int -> PostingType -> AccountName -> String@@ -335,14 +366,14 @@       bvsum' = canonicalise $ costOfMixedAmount bvsum       canonicalise = maybe id canonicaliseMixedAmount styles --- | Balance this transaction, ensuring that its postings +-- | Balance this transaction, ensuring that its postings -- (and its balanced virtual postings) sum to 0,--- by inferring a missing amount or conversion price(s) if needed. +-- by inferring a missing amount or conversion price(s) if needed. -- Or if balancing is not possible, because the amounts don't sum to 0 or -- because there's more than one missing amount, return an error message. -- -- Transactions with balance assignments can have more than one--- missing amount; to balance those you should use the more powerful  +-- missing amount; to balance those you should use the more powerful -- journalBalanceTransactions. -- -- The "sum to 0" test is done using commodity display precisions,@@ -352,18 +383,18 @@      Maybe (Map.Map CommoditySymbol AmountStyle)  -- ^ commodity display styles   -> Transaction   -> Either String Transaction-balanceTransaction mstyles = fmap fst . balanceTransactionHelper mstyles +balanceTransaction mstyles = fmap fst . balanceTransactionHelper mstyles  -- | Helper used by balanceTransaction and balanceTransactionWithBalanceAssignmentAndCheckAssertionsB;--- use one of those instead. It also returns a list of accounts +-- use one of those instead. It also returns a list of accounts -- and amounts that were inferred. balanceTransactionHelper ::      Maybe (Map.Map CommoditySymbol AmountStyle)  -- ^ commodity display styles   -> Transaction   -> Either String (Transaction, [(AccountName, MixedAmount)]) balanceTransactionHelper mstyles t = do-  (t', inferredamtsandaccts) <- -    inferBalancingAmount (fromMaybe Map.empty mstyles) $ inferBalancingPrices t +  (t', inferredamtsandaccts) <-+    inferBalancingAmount (fromMaybe Map.empty mstyles) $ inferBalancingPrices t   if isTransactionBalanced mstyles t'   then Right (txnTieKnot t', inferredamtsandaccts)   else Left $ annotateErrorWithTransaction t' $ nonzerobalanceerror t'@@ -382,7 +413,7 @@           sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String  annotateErrorWithTransaction :: Transaction -> String -> String-annotateErrorWithTransaction t s = intercalate "\n" [showGenericSourcePos $ tsourcepos t, s, showTransactionUnelided t]    +annotateErrorWithTransaction t s = intercalate "\n" [showGenericSourcePos $ tsourcepos t, s, showTransactionUnelided t]  -- | Infer up to one missing amount for this transactions's real postings, and -- likewise for its balanced virtual postings, if needed; or return an error@@ -392,7 +423,7 @@ -- We can infer a missing amount when there are multiple postings and exactly -- one of them is amountless. If the amounts had price(s) the inferred amount -- have the same price(s), and will be converted to the price commodity.-inferBalancingAmount :: +inferBalancingAmount ::      Map.Map CommoditySymbol AmountStyle -- ^ commodity display styles   -> Transaction   -> Either String (Transaction, [(AccountName, MixedAmount)])@@ -415,16 +446,16 @@     inferamount p =       let         minferredamt = case ptype p of-          RegularPosting         | not (hasAmount p) -> Just realsum -          BalancedVirtualPosting | not (hasAmount p) -> Just bvsum -          _                                          -> Nothing +          RegularPosting         | not (hasAmount p) -> Just realsum+          BalancedVirtualPosting | not (hasAmount p) -> Just bvsum+          _                                          -> Nothing       in         case minferredamt of           Nothing -> (p, Nothing)-          Just a  -> (p{pamount=a', poriginal=Just $ originalPosting p}, Just a') +          Just a  -> (p{pamount=a', poriginal=Just $ originalPosting p}, Just a')             where               -- Inferred amounts are converted to cost.-              -- Also ensure the new amount has the standard style for its commodity  +              -- 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 $ costOfMixedAmount (-a) @@ -483,12 +514,12 @@     pcommodities   = map acommodity pamounts     sumamounts     = amounts $ sumStrict pmixedamounts -- sum normalises to one amount per commodity & price     sumcommodities = map acommodity sumamounts-    sumprices      = filter (/=NoPrice) $ map aprice sumamounts+    sumprices      = filter (/=Nothing) $ map aprice sumamounts     caninferprices = length sumcommodities == 2 && null sumprices      inferprice p@Posting{pamount=Mixed [a]}       | caninferprices && ptype p == pt && acommodity a == fromcommodity-        = p{pamount=Mixed [a{aprice=conversionprice}], poriginal=Just $ originalPosting p}+        = p{pamount=Mixed [a{aprice=Just conversionprice}], poriginal=Just $ originalPosting p}       where         fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe         conversionprice@@ -551,7 +582,7 @@                   ]               } `is`           unlines-            [ "2012/05/14=2012/05/15 (code) desc    ; tcomment1"+            [ "2012/05/14=2012/05/15 (code) desc  ; tcomment1"             , "    ; tcomment2"             , "    * a         $1.00"             , "    ; pcomment2"@@ -573,16 +604,16 @@                   , ptags = [("ptag1", "val1"), ("ptag2", "val2")]                   }            in postingAsLines False False [p] p `is`-              [ "    * a         $1.00    ; pcomment1"+              [ "    * a         $1.00  ; pcomment1"               , "    ; pcomment2"               , "    ;   tag3: val3  "-              , "    * a         2.00h    ; pcomment1"+              , "    * a         2.00h  ; pcomment1"               , "    ; pcomment2"               , "    ;   tag3: val3  "               ]         ]    -- postingsAsLines-    -- one implicit amount +    -- one implicit amount     , let timp = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt]}     -- explicit amounts, balanced           texp = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` usd (-1)]}@@ -628,7 +659,7 @@             , test "one-explicit-amount-elide-true" $               let t = texp1                in postingsAsLines True False t (tpostings t) `is`-                  [ "    (a)           $1.00" -- explicit amount remains explicit since only one posting +                  [ "    (a)           $1.00" -- explicit amount remains explicit since only one posting                   ]             , test "explicit-amounts-two-commodities-elide-true" $               let t = texp2

@@ -4,7 +4,7 @@ {-|  A 'TransactionModifier' is a rule that modifies certain 'Transaction's,-typically adding automated postings to them. +typically adding automated postings to them.  -} module Hledger.Data.TransactionModifier (@@ -12,6 +12,7 @@ ) where +import Control.Applicative ((<|>)) import Data.Maybe #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>))@@ -23,6 +24,7 @@ import Hledger.Data.Amount import Hledger.Data.Transaction import Hledger.Query+import Hledger.Data.Posting (commentJoin, commentAddTag) import Hledger.Utils.UTF8IOCompat (error') import Hledger.Utils.Debug @@ -36,12 +38,20 @@ modifyTransactions :: [TransactionModifier] -> [Transaction] -> [Transaction] modifyTransactions tmods = map applymods   where-    applymods = foldr (flip (.) . transactionModifierToFunction) id tmods+    applymods t = taggedt'+      where+        t' = foldr (flip (.) . transactionModifierToFunction) id tmods t+        taggedt'+          -- PERF: compares txns to see if any modifier had an effect, inefficient ?+          | t' /= t   = t'{tcomment = tcomment t' `commentAddTag` ("modified","")+                          ,ttags    = ("modified","") : ttags t'+                          }+          | otherwise = t'  -- | Converts a 'TransactionModifier' to a 'Transaction'-transforming function, -- which applies the modification(s) specified by the TransactionModifier. -- Currently this means adding automated postings when certain other postings are present.--- The postings of the transformed transaction will reference it in the usual +-- The postings of the transformed transaction will reference it in the usual -- way (ie, 'txnTieKnot' is called). -- -- >>> putStr $ showTransaction $ transactionModifierToFunction (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}@@ -60,16 +70,16 @@ -- <BLANKLINE> -- transactionModifierToFunction :: TransactionModifier -> (Transaction -> Transaction)-transactionModifierToFunction mt = -  \t@(tpostings -> ps) -> txnTieKnot t{ tpostings=generatePostings ps } -- TODO add modifier txn comment/tags ?+transactionModifierToFunction mt =+  \t@(tpostings -> ps) -> txnTieKnot t{ tpostings=generatePostings ps }   where     q = simplifyQuery $ tmParseQuery mt (error' "a transaction modifier's query cannot depend on current date")-    mods = map tmPostingRuleToFunction $ tmpostingrules mt+    mods = map (tmPostingRuleToFunction (tmquerytxt mt)) $ tmpostingrules mt     generatePostings ps = [p' | p <- ps                               , p' <- if q `matchesPosting` p then p:[ m p | m <- mods] else [p]]-    --- | Parse the 'Query' from a 'TransactionModifier's 'tmquerytxt', --- and return it as a function requiring the current date. ++-- | Parse the 'Query' from a 'TransactionModifier's 'tmquerytxt',+-- and return it as a function requiring the current date. -- -- >>> tmParseQuery (TransactionModifier "" []) undefined -- Any@@ -85,15 +95,24 @@ -- | Converts a 'TransactionModifier''s posting rule to a 'Posting'-generating function, -- which will be used to make a new posting based on the old one (an "automated posting"). -- The new posting's amount can optionally be the old posting's amount multiplied by a constant.--- If the old posting had a total-priced amount, the new posting's multiplied amount will be unit-priced. -tmPostingRuleToFunction :: TMPostingRule -> (Posting -> Posting)-tmPostingRuleToFunction pr = +-- If the old posting had a total-priced amount, the new posting's multiplied amount will be unit-priced.+-- The new posting will have two tags added: a normal generated-posting: tag which also appears in the comment,+-- 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 =   \p -> renderPostingCommentDates $ pr-      { pdate = pdate p-      , pdate2 = pdate2 p-      , pamount = amount' p+      { pdate    = pdate  pr <|> pdate  p+      , pdate2   = pdate2 pr <|> pdate2 p+      , pamount  = amount' p+      , pcomment = pcomment pr `commentAddTag` ("generated-posting",qry)+      , ptags    = ("generated-posting", qry) :+                   ("_generated-posting",qry) :+                   ptags pr       }   where+    qry = "= " <> querytxt     amount' = case postingRuleMultiplier pr of         Nothing -> const $ pamount pr         Just n  -> \p ->@@ -103,15 +122,15 @@             matchedamount = dbg6 "matchedamount" $ 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 `multiplyMixedAmountAndPrice` matchedamount +            -- 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 `multiplyMixedAmountAndPrice` matchedamount           in             case acommodity pramount of               "" -> Mixed 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.   +              -- 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]  postingRuleMultiplier :: TMPostingRule -> Maybe Quantity@@ -123,7 +142,7 @@ renderPostingCommentDates :: Posting -> Posting renderPostingCommentDates p = p { pcomment = comment' }     where-        datesComment = T.concat $ catMaybes [T.pack . showDate <$> pdate p, ("=" <>) . T.pack . showDate <$> pdate2 p]+        dates = T.concat $ catMaybes [T.pack . showDate <$> pdate p, ("=" <>) . T.pack . showDate <$> pdate2 p]         comment'-            | T.null datesComment = pcomment p-            | otherwise = T.intercalate "\n" $ filter (not . T.null) [T.strip $ pcomment p, "[" <> datesComment <> "]"]+            | T.null dates = pcomment p+            | otherwise    = ("[" <> dates <> "]") `commentJoin` pcomment p

@@ -29,7 +29,7 @@ import Data.Functor (($>)) import Data.List (intercalate) import Text.Blaze (ToMarkup(..))---XXX https://hackage.haskell.org/package/containers/docs/Data-Map.html +--XXX https://hackage.haskell.org/package/containers/docs/Data-Map.html --Note: You should use Data.Map.Strict instead of this module if: --You will eventually need all the values stored. --The stored values don't represent large virtual data structures to be lazily computed.@@ -154,12 +154,13 @@  where    toMarkup = toMarkup . show --- | An amount's price (none, per unit, or total) in another commodity.--- The price amount should always be positive.-data Price = NoPrice | UnitPrice Amount | TotalPrice Amount +-- | An amount's per-unit or total cost/selling price in another+-- commodity, as recorded in the journal entry eg with @ or @@.+-- Docs call this "transaction price". The amount is always positive.+data AmountPrice = UnitPrice Amount | TotalPrice Amount   deriving (Eq,Ord,Typeable,Data,Generic,Show) -instance NFData Price+instance NFData AmountPrice  -- | Display style for an amount. data AmountStyle = AmountStyle {@@ -207,7 +208,7 @@       aismultiplier :: Bool,            -- ^ kludge: a flag marking this amount and posting as a multiplier                                         --   in a TMPostingRule. In a regular Posting, should always be false.       astyle      :: AmountStyle,-      aprice      :: Price            -- ^ the (fixed, transaction-specific) price for this amount, if any+      aprice      :: Maybe AmountPrice  -- ^ the (fixed, transaction-specific) price for this amount, if any     } deriving (Eq,Ord,Typeable,Data,Generic,Show)  instance NFData Amount@@ -299,7 +300,7 @@                                                     --   Tying this knot gets tedious, Maybe makes it easier/optional.       poriginal         :: Maybe Posting            -- ^ When this posting has been transformed in some way                                                     --   (eg its amount or price was inferred, or the account name was-                                                    --   changed by a pivot or budget report), this references the original +                                                    --   changed by a pivot or budget report), this references the original                                                     --   untransformed posting (which will have Nothing in this field).     } deriving (Typeable,Data,Generic) @@ -356,10 +357,10 @@ instance NFData Transaction  -- | A transaction modifier rule. This has a query which matches postings--- in the journal, and a list of transformations to apply to those +-- in the journal, and a list of transformations to apply to those -- postings or their transactions. Currently there is one kind of transformation:--- the TMPostingRule, which adds a posting ("auto posting") to the transaction, --- optionally setting its amount to the matched posting's amount multiplied by a constant. +-- the TMPostingRule, which adds a posting ("auto posting") to the transaction,+-- optionally setting its amount to the matched posting's amount multiplied by a constant. data TransactionModifier = TransactionModifier {       tmquerytxt :: Text,       tmpostingrules :: [TMPostingRule]@@ -381,8 +382,8 @@ -- | A periodic transaction rule, describing a transaction that recurs. data PeriodicTransaction = PeriodicTransaction {       ptperiodexpr   :: Text,     -- ^ the period expression as written-      ptinterval     :: Interval, -- ^ the interval at which this transaction recurs -      ptspan         :: DateSpan, -- ^ the (possibly unbounded) period during which this transaction recurs. Contains a whole number of intervals. +      ptinterval     :: Interval, -- ^ the interval at which this transaction recurs+      ptspan         :: DateSpan, -- ^ the (possibly unbounded) period during which this transaction recurs. Contains a whole number of intervals.       --       ptstatus       :: Status,   -- ^ some of Transaction's fields       ptcode         :: Text,@@ -420,14 +421,32 @@  instance NFData TimeclockEntry +-- | A market price declaration made by the journal format's P directive.+-- It declares two things: a historical exchange rate between two commodities,+-- and an amount display style for the second commodity.+data PriceDirective = PriceDirective {+   pddate      :: Day+  ,pdcommodity :: CommoditySymbol+  ,pdamount    :: Amount+  } deriving (Eq,Ord,Typeable,Data,Generic,Show)+        -- Show instance derived in Amount.hs (XXX why ?)++instance NFData PriceDirective++-- | A historical market price (exchange rate) from one commodity to another.+-- A more concise form of a PriceDirective, without the amount display info. data MarketPrice = MarketPrice {-      mpdate      :: Day,-      mpcommodity :: CommoditySymbol,-      mpamount    :: Amount-    } deriving (Eq,Ord,Typeable,Data,Generic) -- , Show in Amount.hs+   mpdate :: Day                -- ^ Date on which this price becomes effective.+  ,mpfrom :: CommoditySymbol    -- ^ The commodity being converted from.+  ,mpto   :: CommoditySymbol    -- ^ The commodity being converted to.+  ,mprate :: Quantity           -- ^ One unit of the "from" commodity is worth this quantity of the "to" commodity.+  } deriving (Eq,Ord,Typeable,Data,Generic)+        -- Show instance derived in Amount.hs (XXX why ?)  instance NFData MarketPrice +-- additional valuation-related types in Valuation.hs+ -- | A Journal, containing transactions and various other things. -- The basic data model for hledger. --@@ -448,11 +467,12 @@   ,jparsetimeclockentries :: [TimeclockEntry]                       -- ^ timeclock sessions which have not been clocked out   ,jincludefilestack      :: [FilePath]   -- principal data-  ,jdeclaredaccounts      :: [(AccountName,AccountDeclarationInfo)] -- ^ Accounts declared by account directives, in parse order (after journal finalisation) -  ,jdeclaredaccounttypes  :: M.Map AccountType [AccountName]        -- ^ Accounts whose type has been declared in account directives (usually 5 top-level accounts) +  ,jdeclaredaccounts      :: [(AccountName,AccountDeclarationInfo)] -- ^ Accounts declared by account directives, in parse order (after journal finalisation)+  ,jdeclaredaccounttypes  :: M.Map AccountType [AccountName]        -- ^ Accounts whose type has been declared in account directives (usually 5 top-level accounts)   ,jcommodities           :: M.Map CommoditySymbol Commodity        -- ^ commodities and formats declared by commodity directives   ,jinferredcommodities   :: M.Map CommoditySymbol AmountStyle      -- ^ commodities and formats inferred from journal amounts  TODO misnamed - jusedstyles-  ,jmarketprices          :: [MarketPrice]+  ,jpricedirectives       :: [PriceDirective]                       -- ^ All market price declarations (P directives), in parse order (after journal finalisation).+                                                                    --   These will be converted to a Prices db for looking up prices by date.   ,jtxnmodifiers          :: [TransactionModifier]   ,jperiodictxns          :: [PeriodicTransaction]   ,jtxns                  :: [Transaction]@@ -509,12 +529,12 @@   ,aibalance                 :: MixedAmount    -- ^ this account's balance, including subaccounts   } deriving (Typeable, Data, Generic) --- | Whether an account's balance is normally a positive number (in --- accounting terms, a debit balance) or a negative number (credit balance). +-- | Whether an account's balance is normally a positive number (in+-- accounting terms, a debit balance) or a negative number (credit balance). -- Assets and expenses are normally positive (debit), while liabilities, equity -- and income are normally negative (credit). -- https://en.wikipedia.org/wiki/Normal_balance-data NormalSign = NormallyPositive | NormallyNegative deriving (Show, Data, Eq) +data NormalSign = NormallyPositive | NormallyNegative deriving (Show, Data, Eq)  -- | A Ledger has the journal it derives from, and the accounts -- derived from that. Accounts are accessible both list-wise and

@@ -0,0 +1,341 @@+{-|++Convert amounts to some related value in various ways. This involves+looking up historical market prices (exchange rates) between commodities.++-}++{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}++module Hledger.Data.Valuation (+   ValuationType(..)+  ,PriceOracle+  ,journalPriceOracle+  -- ,amountApplyValuation+  -- ,amountValueAtDate+  ,mixedAmountApplyValuation+  ,mixedAmountValueAtDate+  ,marketPriceReverse+  ,priceDirectiveToMarketPrice+  -- ,priceLookup+  ,tests_Valuation+)+where++import Control.Applicative ((<|>))+import Control.DeepSeq (NFData)+import Data.Data+import Data.Decimal (roundTo)+import Data.Function (on)+import Data.Graph.Inductive  (Gr, Node, NodeMap, mkMapGraph, mkNode, lab, out, sp)+import Data.List+import Data.List.Extra (nubSortBy)+import qualified Data.Map as M+import Data.Maybe+import qualified Data.Text as T+import Data.Time.Calendar (Day)+import Data.MemoUgly (memo)+import GHC.Generics (Generic)+import Safe (headMay)++import Hledger.Utils+import Hledger.Data.Types+import Hledger.Data.Amount+import Hledger.Data.Dates (parsedate)+++tests_Valuation = tests "Valuation" [+   tests_priceLookup+  ]+++------------------------------------------------------------------------------+-- Types++-- | A snapshot of the known exchange rates between commodity pairs at a given date,+-- as a graph allowing fast lookup and path finding, along with some helper data.+data PriceGraph = PriceGraph {+   prGraph   :: Gr CommoditySymbol Quantity+    -- ^ A directed graph of exchange rates between commodity pairs.+    -- Node labels are commodities and edge labels are exchange rates,+    -- either explicitly declared (preferred) or inferred by reversing a declared rate.+    -- There will be at most one edge between each directed pair of commodities,+    -- eg there can be one USD->EUR and one EUR->USD.+  ,prNodemap :: NodeMap CommoditySymbol+    -- ^ Mapping of graph node ids to commodity symbols.+  ,prDeclaredPairs :: [(Node,Node)]+    -- ^ Which of the edges in this graph are declared rates,+    --   rather than inferred reverse rates.+    --   A bit ugly. We could encode this in the edges,+    --   but those have to be Real for shortest path finding,+    --   so we'd have to transform them all first.+  }+  deriving (Show,Generic)++instance NFData PriceGraph++-- | A price oracle is a magic function that looks up market prices+-- (exchange rates) from one commodity to another (or if unspecified,+-- to a default valuation commodity) on a given date, somewhat efficiently.+type PriceOracle = (Day, CommoditySymbol, Maybe CommoditySymbol) -> Maybe (CommoditySymbol, Quantity)++-- | What kind of value conversion should be done on amounts ?+-- UI: --value=cost|end|now|DATE[,COMM]+data ValuationType =+    AtCost     (Maybe CommoditySymbol)  -- ^ convert to cost commodity using transaction prices, then optionally to given commodity using market prices at posting date+  | AtEnd      (Maybe CommoditySymbol)  -- ^ convert to default valuation commodity or given commodity, using market prices at period end(s)+  | AtNow      (Maybe CommoditySymbol)  -- ^ convert to default valuation commodity or given commodity, using current market prices+  | AtDate Day (Maybe CommoditySymbol)  -- ^ convert to default valuation commodity or given commodity, using market prices on some date+  | AtDefault  (Maybe CommoditySymbol)  -- ^ works like AtNow in single period reports, like AtEnd in multiperiod reports+  deriving (Show,Data,Eq) -- Typeable+++------------------------------------------------------------------------------+-- Valuation++-- | Apply a specified valuation to this mixed amount, using the provided+-- price oracle, commodity styles, period-end/current dates,+-- and whether this is for a multiperiod report or not.+mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> ValuationType -> MixedAmount -> MixedAmount+mixedAmountApplyValuation priceoracle styles periodend today ismultiperiod v (Mixed as) =+  Mixed $ map (amountApplyValuation priceoracle styles periodend today ismultiperiod v) as++-- | Apply a specified valuation to this amount, using the provided+-- price oracle, commodity styles, period-end/current dates,+-- and whether this is for a multiperiod report or not.+amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> ValuationType -> Amount -> Amount+amountApplyValuation priceoracle styles periodend today ismultiperiod v a =+  case v of+    AtCost    Nothing            -> amountToCost styles a+    AtCost    mc                 -> amountValueAtDate priceoracle styles mc periodend $ amountToCost styles a+    AtEnd     mc                 -> amountValueAtDate priceoracle styles mc periodend a+    AtNow     mc                 -> amountValueAtDate priceoracle styles mc today     a+    AtDefault mc | ismultiperiod -> amountValueAtDate priceoracle styles mc periodend a+    AtDefault mc                 -> amountValueAtDate priceoracle styles mc today     a+    AtDate d  mc                 -> amountValueAtDate priceoracle styles mc d         a++-- | Find the market value of each component amount in the given+-- commodity, or its default valuation commodity, at the given+-- valuation date, using the given market price oracle.+-- When market prices available on that date are not sufficient to+-- calculate the value, amounts are left unchanged.+mixedAmountValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> MixedAmount -> MixedAmount+mixedAmountValueAtDate priceoracle styles mc d (Mixed as) = Mixed $ map (amountValueAtDate priceoracle styles mc d) as++-- | Find the market value of this amount in the given valuation+-- commodity if any, otherwise the default valuation commodity, at the+-- given valuation date. (The default valuation commodity is the+-- commodity of the latest applicable market price before the+-- valuation date.)+--+-- The returned amount will have its commodity's canonical style applied,+-- but with the precision adjusted to show all significant decimal digits+-- up to a maximum of 8. (experimental)+--+-- If the market prices available on that date are not sufficient to+-- calculate this value, the amount is left unchanged.+amountValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> Amount -> Amount+amountValueAtDate priceoracle styles mto d a =+  case priceoracle (d, acommodity a, mto) of+    Nothing           -> a+    Just (comm, rate) ->+      -- setNaturalPrecisionUpTo 8 $  -- XXX force higher precision in case amount appears to be zero ?+                                      -- Make default display style use precision 2 instead of 0 ?+                                      -- Leave as is for now; mentioned in manual.+      styleAmount styles+      amount{acommodity=comm, aquantity=rate * aquantity a}++------------------------------------------------------------------------------+-- Market price lookup++-- From a journal's market price directives, generate a memoising function+-- that efficiently looks up exchange rates between commodities on any date.+-- For best results, you should generate this only once per journal, reusing it+-- across reports if there are more than one (as in compoundBalanceCommand).+journalPriceOracle :: Journal -> PriceOracle+journalPriceOracle Journal{jpricedirectives} =+  -- traceStack "journalPriceOracle" $+  let+    pricesatdate =+      memo $+      pricesAtDate jpricedirectives+  in+    memo $+    uncurry3 $+    priceLookup pricesatdate++-- | Given a list of price directives in parse order, find the market+-- value at the given date of one unit of a given source commodity, in+-- a different specified valuation commodity, or a default valuation+-- commodity.+--+-- When the valuation commodity is specified, this looks for, in order:+--+-- - a price declaration giving the exchange rate from source+--   commodity to valuation commodity ("declared price").+--+-- - a price declaration from valuation to source commodity, which+--   gets inverted ("reverse price").+--+-- - the shortest chain of prices (declared or reverse) leading from+--   source commodity to valuation commodity, which gets collapsed+--   into a single synthetic exchange rate ("indirect price").+--+-- When the valuation commodity is not specified, this looks for the+-- latest applicable declared price, and converts to the commodity+-- mentioned in that price (the default valuation commodity).+--+-- Note this default valuation commodity can vary across successive+-- calls for different dates, since it depends on the price+-- declarations in each period.+--+-- This returns the valuation commodity that was specified or+-- inferred, and the quantity of it that one unit of the source+-- commodity is worth. Or if no applicable market price or chain of+-- prices can be found, or the source commodity and the valuation+-- commodity are the same, returns Nothing.+--+priceLookup :: (Day -> PriceGraph) -> Day -> CommoditySymbol -> Maybe CommoditySymbol -> Maybe (CommoditySymbol, Quantity)+priceLookup pricesatdate d from mto =+  -- trace ("priceLookup ("++show d++", "++show from++", "++show mto++")") $+  let+    -- build a graph of the commodity exchange rates in effect on this day+    -- XXX should hide these fgl details better+    PriceGraph{prGraph=g, prNodemap=m, prDeclaredPairs=dps} = pricesatdate d+    fromnode = node m from+    mto' = mto <|> mdefaultto+      where+        -- If to is unspecified, try to pick a default valuation commodity from declared prices (only).+        -- XXX how to choose ? Take lowest sorted ?+        -- Take first, hoping current order is useful ?       <-+        -- Keep parse order in label and take latest parsed ?+        mdefaultto =+          dbg4 ("default valuation commodity for "++T.unpack from) $+          headMay [t | (f,t,_) <- out g fromnode, (f,t) `elem` dps] >>= lab g+  in+    case mto' of+      Nothing            -> Nothing+      Just to | to==from -> Nothing+      Just to            ->+        -- We have a commodity to convert to. Find the most direct price available.+        case mindirectprice of+          Nothing -> Nothing+          Just q  -> Just (to, q)+        where+          tonode = node m to+          mindirectprice :: Maybe Quantity =+            -- Find the shortest path, if any, between from and to.+            case sp fromnode tonode g :: Maybe [Node] of+              Nothing    -> Nothing+              Just nodes ->+                dbg ("market price "++intercalate "->" (map T.unpack comms)) $+                Just $ product $ pathEdgeLabels g nodes  -- convert to a single exchange rate+                where comms = catMaybes $ map (lab g) nodes++          -- log a message and a Maybe Quantity, hiding Just/Nothing and limiting decimal places+          dbg msg = dbg4With (((msg++": ")++) . maybe "" (show . roundTo 8))++tests_priceLookup =+  let+    d = parsedate+    a q c = amount{acommodity=c, aquantity=q}+    p date from q to = PriceDirective{pddate=d date, pdcommodity=from, pdamount=a q to}+    ps1 = [+       p "2000/01/01" "A" 10 "B"+      ,p "2000/01/01" "B" 10 "C"+      ,p "2000/01/01" "C" 10 "D"+      ,p "2000/01/01" "E"  2 "D"+      ,p "2001/01/01" "A" 11 "B"+      ]+    pricesatdate = pricesAtDate ps1+  in tests "priceLookup" [+     priceLookup pricesatdate (d "1999/01/01") "A" Nothing    `is` Nothing+    ,priceLookup pricesatdate (d "2000/01/01") "A" Nothing    `is` Just ("B",10)+    ,priceLookup pricesatdate (d "2000/01/01") "B" (Just "A") `is` Just ("A",0.1)+    ,priceLookup pricesatdate (d "2000/01/01") "A" (Just "E") `is` Just ("E",500)+    ]++------------------------------------------------------------------------------+-- Building the price graph (network of commodity conversions) on a given day.++-- | Convert a list of market price directives in parse order to a+-- graph of all prices in effect on a given day, allowing efficient+-- lookup of exchange rates between commodity pairs.+pricesAtDate :: [PriceDirective] -> Day -> PriceGraph+pricesAtDate pricedirectives d =+  -- trace ("pricesAtDate ("++show d++")") $+  PriceGraph{prGraph=g, prNodemap=m, prDeclaredPairs=dps}+  where+    declaredprices = latestPriceForEachPairOn pricedirectives d++    -- infer additional reverse prices where not already declared+    reverseprices =+      dbg5 "reverseprices" $+      map marketPriceReverse declaredprices \\ declaredprices++    -- build the graph and associated node map+    (g, m) =+      mkMapGraph+      (dbg5 "g nodelabels" $ sort allcomms) -- this must include all nodes mentioned in edges+      (dbg5 "g edges"      $ [(mpfrom, mpto, mprate) | MarketPrice{..} <- prices])+      :: (Gr CommoditySymbol Quantity, NodeMap CommoditySymbol)+      where+        prices   = declaredprices ++ reverseprices+        allcomms = map mpfrom prices++    -- remember which edges correspond to declared prices+    dps = [(node m mpfrom, node m mpto) | MarketPrice{..} <- declaredprices ]++-- From a list of price directives in parse order, get the latest+-- price declared on or before date d for each commodity pair.+latestPriceForEachPairOn :: [PriceDirective] -> Day -> [MarketPrice]+latestPriceForEachPairOn pricedirectives d =+  dbg5 "latestPriceForEachPairOn" $+  nubSortBy (compare `on` (\(MarketPrice{..})->(mpfrom,mpto))) $  -- keep only the first (ie newest and latest parsed) price for each pair+  map snd $  -- discard the parse order label+  sortBy (flip compare `on` (\(parseorder,mp)->(mpdate mp,parseorder))) $  -- sort with newest dates and latest parse order first+  zip [1..] $  -- label with parse order+  map priceDirectiveToMarketPrice $+  filter ((<=d).pddate) pricedirectives  -- consider only price declarations up to the valuation date++priceDirectiveToMarketPrice :: PriceDirective -> MarketPrice+priceDirectiveToMarketPrice PriceDirective{..} =+  MarketPrice{ mpdate = pddate+             , mpfrom = pdcommodity+             , mpto   = acommodity pdamount+             , mprate = aquantity pdamount+             }++marketPriceReverse :: MarketPrice -> MarketPrice+marketPriceReverse mp@MarketPrice{..} = mp{mpfrom=mpto, mpto=mpfrom, mprate=1/mprate}++------------------------------------------------------------------------------+-- fgl helpers++-- | Look up an existing graph node by its label.+-- (If the node does not exist, a new one will be generated, but not+-- persisted in the nodemap.)+node :: Ord a => NodeMap a -> a -> Node+node m = fst . fst . mkNode m++-- | Convert a valid path within the given graph to the corresponding+-- edge labels. When there are multiple edges between two nodes, the+-- lowest-sorting label is used.+pathEdgeLabels :: (Show b, Ord b) => Gr a b -> [Node] -> [b]+pathEdgeLabels g = map frommaybe . map (nodesEdgeLabel g) . pathEdges+  where frommaybe = fromMaybe (error' "pathEdgeLabels: expected no Nothings here")++-- | Convert a path to node pairs representing the path's edges.+pathEdges :: [Node] -> [(Node,Node)]+pathEdges p = [(f,t) | f:t:_ <- tails p]++-- | Get the label of a graph edge from one node to another.+-- When there are multiple such edges, the lowest-sorting label is used.+nodesEdgeLabel :: Ord b => Gr a b -> (Node, Node) -> Maybe b+nodesEdgeLabel g (from,to) = headMay $ sort [l | (_,t,l) <- out g from, t==to]++------------------------------------------------------------------------------

@@ -43,7 +43,7 @@   matchesMixedAmount,   matchesAmount,   matchesCommodity,-  matchesMarketPrice,+  matchesPriceDirective,   words'',   -- * tests   tests_Query@@ -639,22 +639,22 @@     match npat (Just vpat) (n,v) = regexMatchesCI npat (T.unpack n) && regexMatchesCI vpat (T.unpack v)  -- | Does the query match this market price ?-matchesMarketPrice :: Query -> MarketPrice -> Bool-matchesMarketPrice (None) _      = False-matchesMarketPrice (Not q) p     = not $ matchesMarketPrice q p-matchesMarketPrice (Or qs) p     = any (`matchesMarketPrice` p) qs-matchesMarketPrice (And qs) p    = all (`matchesMarketPrice` p) qs-matchesMarketPrice q@(Amt _ _) p = matchesAmount q (mpamount p)-matchesMarketPrice q@(Sym _) p   = matchesCommodity q (mpcommodity p)-matchesMarketPrice (Date span) p = spanContainsDate span (mpdate p)-matchesMarketPrice _ _           = True+matchesPriceDirective :: Query -> PriceDirective -> Bool+matchesPriceDirective (None) _      = False+matchesPriceDirective (Not q) p     = not $ matchesPriceDirective q p+matchesPriceDirective (Or qs) p     = any (`matchesPriceDirective` p) qs+matchesPriceDirective (And qs) p    = all (`matchesPriceDirective` p) qs+matchesPriceDirective q@(Amt _ _) p = matchesAmount q (pdamount p)+matchesPriceDirective q@(Sym _) p   = matchesCommodity q (pdcommodity p)+matchesPriceDirective (Date span) p = spanContainsDate span (pddate p)+matchesPriceDirective _ _           = True   -- tests  tests_Query = tests "Query" [    tests "simplifyQuery" [-    +      (simplifyQuery $ Or [Acct "a"])      `is` (Acct "a")     ,(simplifyQuery $ Or [Any,None])      `is` (Any)     ,(simplifyQuery $ And [Any,None])     `is` (None)@@ -665,7 +665,7 @@       `is` (Date (DateSpan (Just $ parsedate "2012-01-01") (Just $ parsedate "2013-01-01")))     ,(simplifyQuery $ And [Or [],Or [Desc "b b"]]) `is` (Desc "b b")    ]-  +   ,tests "parseQuery" [      (parseQuery nulldate "acct:'expenses:autres d\233penses' desc:b") `is` (And [Acct "expenses:autres d\233penses", Desc "b"], [])     ,parseQuery nulldate "inacct:a desc:\"b b\""                     `is` (Desc "b b", [QueryOptInAcct "a"])@@ -674,18 +674,18 @@     ,parseQuery nulldate "'a a' 'b"                                  `is` (Or [Acct "a a",Acct "'b"], [])     ,parseQuery nulldate "\""                                        `is` (Acct "\"", [])    ]-  +   ,tests "words''" [-      (words'' [] "a b")                   `is` ["a","b"]        -    , (words'' [] "'a b'")                 `is` ["a b"]          -    , (words'' [] "not:a b")               `is` ["not:a","b"]    -    , (words'' [] "not:'a b'")             `is` ["not:a b"]      -    , (words'' [] "'not:a b'")             `is` ["not:a b"]      -    , (words'' ["desc:"] "not:desc:'a b'") `is` ["not:desc:a b"] +      (words'' [] "a b")                   `is` ["a","b"]+    , (words'' [] "'a b'")                 `is` ["a b"]+    , (words'' [] "not:a b")               `is` ["not:a","b"]+    , (words'' [] "not:'a b'")             `is` ["not:a b"]+    , (words'' [] "'not:a b'")             `is` ["not:a b"]+    , (words'' ["desc:"] "not:desc:'a b'") `is` ["not:desc:a b"]     , (words'' prefixes "\"acct:expenses:autres d\233penses\"") `is` ["acct:expenses:autres d\233penses"]     , (words'' prefixes "\"")              `is` ["\""]     ]-  +   ,tests "filterQuery" [      filterQuery queryIsDepth Any       `is` Any     ,filterQuery queryIsDepth (Depth 1) `is` Depth 1@@ -714,7 +714,7 @@     ,parseQueryTerm nulldate "amt:<0"                           `is` (Left $ Amt Lt 0)     ,parseQueryTerm nulldate "amt:>10000.10"                    `is` (Left $ Amt AbsGt 10000.1)    ]-  +   ,tests "parseAmountQueryTerm" [      parseAmountQueryTerm "<0"        `is` (Lt,0) -- special case for convenience, since AbsLt 0 would be always false     ,parseAmountQueryTerm ">0"        `is` (Gt,0) -- special case for convenience and consistency with above@@ -725,7 +725,7 @@     ,parseAmountQueryTerm "-0.23"     `is` (Eq,(-0.23))     ,_test "number beginning with decimal mark" $ parseAmountQueryTerm "=.23" `is` (AbsEq,0.23)  -- XXX     ]-  +   ,tests "matchesAccount" [      expect $ (Acct "b:c") `matchesAccount` "a:bb:c:d"     ,expect $ not $ (Acct "^a:b") `matchesAccount` "c:a:b"@@ -736,7 +736,7 @@     ,expect $ Date2 nulldatespan `matchesAccount` "a"     ,expect $ not $ (Tag "a" Nothing) `matchesAccount` "a"   ]-  +   ,tests "matchesPosting" [      test "positive match on cleared posting status"  $       expect $ (StatusQ Cleared)  `matchesPosting` nullposting{pstatus=Cleared}@@ -766,7 +766,7 @@     ,test "l" $ expect $ (Sym "shekels") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]}     ,test "m" $ expect $ not $ (Sym "shek") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]}   ]-  +   ,tests "matchesTransaction" [      expect $ Any `matchesTransaction` nulltransaction     ,expect $ not $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x"}

@@ -25,6 +25,7 @@   readJournal',    -- * Re-exported+  JournalReader.accountaliasp,   JournalReader.postingp,   module Hledger.Read.Common, @@ -48,6 +49,7 @@ import System.Environment (getEnv) import System.Exit (exitFailure) import System.FilePath+import System.Info (os) import System.IO import Text.Printf @@ -128,8 +130,13 @@     exitFailure  -- | Ensure there is a journal file at the given path, creating an empty one if needed.+-- On Windows, also ensure that the path contains no trailing dots+-- which could cause data loss (see 'isWindowsUnsafeDotPath'). ensureJournalFileExists :: FilePath -> IO () ensureJournalFileExists f = do+  when (os/="mingw32" && isWindowsUnsafeDotPath f) $ do+    hPrintf stderr "Part of file path %s\n ends with a dot, which is unsafe on Windows; please use a different path.\n" (show f)+    exitFailure   exists <- doesFileExist f   when (not exists) $ do     hPrintf stderr "Creating hledger journal file %s.\n" f@@ -137,6 +144,15 @@     -- we currently require unix line endings on all platforms.     newJournalContent >>= writeFile f +-- | Does any part of this path contain non-. characters and end with a . ?+-- Such paths are not safe to use on Windows (cf #1056).+isWindowsUnsafeDotPath :: FilePath -> Bool+isWindowsUnsafeDotPath =+  not . null .+  filter (not . all (=='.')) .+  filter ((=='.').last) .+  splitDirectories+ -- | Give the content for a new auto-created journal file. newJournalContent :: IO String newJournalContent = do@@ -169,7 +185,7 @@ -- Combining Journals means concatenating them, basically. -- The parse state resets at the start of each file, which means that -- directives & aliases do not affect subsequent sibling or parent files.--- They do affect included child files though. +-- They do affect included child files though. -- Also the final parse state saved in the Journal does span all files. readJournalFiles :: InputOpts -> [PrefixedFilePath] -> IO (Either String Journal) readJournalFiles iopts =@@ -192,7 +208,7 @@ -- generation, a rules file for converting CSV data, etc. readJournalFile :: InputOpts -> PrefixedFilePath -> IO (Either String Journal) readJournalFile iopts prefixedfile = do-  let +  let     (mfmt, f) = splitReaderPrefix prefixedfile     iopts' = iopts{mformat_=firstJust [mfmt, mformat_ iopts]}   requireJournalFileExists f@@ -220,13 +236,13 @@  -- | Remember that these transaction dates were the latest seen when -- reading this journal file.-saveLatestDates :: LatestDates -> FilePath -> IO () +saveLatestDates :: LatestDates -> FilePath -> IO () saveLatestDates dates f = writeFile (latestDatesFileFor f) $ unlines $ map showDate dates --- | What were the latest transaction dates seen the last time this +-- | What were the latest transaction dates seen the last time this -- journal file was read ? If there were multiple transactions on the -- latest date, that number of dates is returned, otherwise just one.--- Or none if no transactions were read, or if latest dates info is not +-- Or none if no transactions were read, or if latest dates info is not -- available for this file. previousLatestDates :: FilePath -> IO LatestDates previousLatestDates f = do@@ -284,7 +300,7 @@ -- -- Try to parse the given text to a Journal using each reader in turn, -- returning the first success, or if all of them fail, the first error message.---    +-- -- Input ioptions (@iopts@) specify CSV conversion rules file to help convert CSV data, -- enable or disable balance assertion checking and automated posting generation. --

@@ -163,12 +163,12 @@     ,mrules_file_       :: Maybe FilePath       -- ^ a conversion rules file to use (when reading CSV)     ,separator_         :: Char                 -- ^ the separator to use (when reading CSV)     ,aliases_           :: [String]             -- ^ account name aliases to apply-    ,anon_              :: Bool                 -- ^ do light anonymisation/obfuscation of the data +    ,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     +    ,pivot_             :: String               -- ^ use the given field's value as the account name+    ,auto_              :: Bool                 -- ^ generate automatic postings when journal is parsed  } deriving (Show, Data) --, Typeable)  instance Default InputOpts where def = definputopts@@ -188,7 +188,7 @@   ,new_               = boolopt "new" rawopts   ,new_save_          = True   ,pivot_             = stringopt "pivot" rawopts-  ,auto_              = boolopt "auto" rawopts                        +  ,auto_              = boolopt "auto" rawopts   }  --- * parsing utilities@@ -219,7 +219,7 @@ genericSourcePos :: SourcePos -> GenericSourcePos genericSourcePos p = GenericSourcePos (sourceName p) (fromIntegral . unPos $ sourceLine p) (fromIntegral . unPos $ sourceColumn p) --- | Construct a generic start & end line parse position from start and end megaparsec SourcePos's. +-- | Construct a generic start & end line parse position from start and end megaparsec SourcePos's. journalSourcePos :: SourcePos -> SourcePos -> GenericSourcePos journalSourcePos p p' = JournalSourcePos (sourceName p) (fromIntegral . unPos $ sourceLine p, fromIntegral $ line')     where line'@@ -355,7 +355,7 @@     return effectiveStyle  addDeclaredAccountType :: AccountName -> AccountType -> JournalParser m ()-addDeclaredAccountType acct atype = +addDeclaredAccountType acct atype =   modify' (\j -> j{jdeclaredaccounttypes = M.insertWith (++) atype [acct] (jdeclaredaccounttypes j)})  pushParentAccount :: AccountName -> JournalParser m ()@@ -542,7 +542,7 @@  --- ** account names --- | Parse an account name (plus one following space if present), +-- | Parse an account name (plus one following space if present), -- then apply any parent account prefix and/or account aliases currently in effect, -- in that order. (Ie first add the parent account prefix, then rewrite with aliases). modifiedaccountnamep :: JournalParser m AccountName@@ -552,13 +552,13 @@   a <- lift accountnamep   return $!     accountNameApplyAliases aliases $-     -- XXX accountNameApplyAliasesMemo ? doesn't seem to make a difference+     -- XXX accountNameApplyAliasesMemo ? doesn't seem to make a difference (retest that function)     joinAccountNames parent     a --- | Parse an account name, plus one following space if present. +-- | Parse an account name, plus one following space if present. -- Account names have one or more parts separated by the account separator character,--- and are terminated by two or more spaces (or end of input). +-- and are terminated by two or more spaces (or end of input). -- Each part is at least one character long, may have single spaces inside it, -- and starts with a non-whitespace. -- Note, this means "{account}", "%^!" and ";comment" are all accepted@@ -606,8 +606,8 @@ amountp = label "amount" $ do   amount <- amountwithoutpricep   lift $ skipMany spacenonewline-  price <- priceamountp-  pure $ amount { aprice = price }+  mprice <- priceamountp+  pure $ amount { aprice = mprice }  amountwithoutpricep :: JournalParser m Amount amountwithoutpricep = do@@ -629,7 +629,7 @@     let numRegion = (offBeforeNum, offAfterNum)     (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent     let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}-    return $ nullamt{acommodity=c, aquantity=sign (sign2 q), aismultiplier=mult, astyle=s, aprice=NoPrice}+    return $ nullamt{acommodity=c, aquantity=sign (sign2 q), aismultiplier=mult, astyle=s, aprice=Nothing}    rightornosymbolamountp :: Bool -> (Decimal -> Decimal) -> JournalParser m Amount   rightornosymbolamountp mult sign = label "amount" $ do@@ -645,7 +645,7 @@         suggestedStyle <- getAmountStyle c         (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent         let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}-        return $ nullamt{acommodity=c, aquantity=sign q, aismultiplier=mult, astyle=s, aprice=NoPrice}+        return $ nullamt{acommodity=c, aquantity=sign q, aismultiplier=mult, astyle=s, aprice=Nothing}       -- no symbol amount       Nothing -> do         suggestedStyle <- getDefaultAmountStyle@@ -656,7 +656,7 @@         let (c,s) = case (mult, defcs) of               (False, Just (defc,defs)) -> (defc, defs{asprecision=max (asprecision defs) prec})               _ -> ("", amountstyle{asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps})-        return $ nullamt{acommodity=c, aquantity=sign q, aismultiplier=mult, astyle=s, aprice=NoPrice}+        return $ nullamt{acommodity=c, aquantity=sign q, aismultiplier=mult, astyle=s, aprice=Nothing}    -- For reducing code duplication. Doesn't parse anything. Has the type   -- of a parser only in order to throw parse errors (for convenience).@@ -714,15 +714,15 @@ simplecommoditysymbolp :: TextParser m CommoditySymbol simplecommoditysymbolp = takeWhile1P Nothing (not . isNonsimpleCommodityChar) -priceamountp :: JournalParser m Price-priceamountp = option NoPrice $ do+priceamountp :: JournalParser m (Maybe AmountPrice)+priceamountp = option Nothing $ do   char '@'   priceConstructor <- char '@' *> pure TotalPrice <|> pure UnitPrice    lift (skipMany spacenonewline)   priceAmount <- amountwithoutpricep <?> "unpriced amount (specifying a price)" -  pure $ priceConstructor priceAmount+  pure $ Just $ priceConstructor priceAmount  balanceassertionp :: JournalParser m BalanceAssertion balanceassertionp = do@@ -791,7 +791,7 @@ -- -- Returns: -- - the decimal number--- - the precision (number of digits after the decimal point)  +-- - the precision (number of digits after the decimal point) -- - the decimal point character, if any -- - the digit group style, if any (digit group character and sizes of digit groups) fromRawNumber@@ -811,7 +811,7 @@     in  Right (quantity, precision, mDecPt, Nothing)    WithSeparators digitSep digitGrps mDecimals -> case mExp of-    Nothing -> +    Nothing ->       let mDecPt = fmap fst mDecimals           decimalGrp = maybe mempty snd mDecimals           digitGroupStyle = DigitGroups digitSep (groupSizes digitGrps)@@ -1038,7 +1038,7 @@     -- if there's just a next-line comment, insert an empty same-line comment     -- so the next-line comment doesn't get rendered as a same-line comment.     sameLine' | null sameLine && not (null nextLines) = [("",mempty)]-              | otherwise = sameLine +              | otherwise = sameLine     (texts, contents) = unzip $ sameLine' ++ nextLines     strippedCommentText = T.unlines $ map T.strip texts     commentContent = mconcat contents@@ -1306,32 +1306,32 @@    tests "amountp" [     test "basic"                  $ expectParseEq amountp "$47.18"     (usd 47.18)    ,test "ends with decimal mark" $ expectParseEq amountp "$1."        (usd 1  `withPrecision` 0)-   ,test "unit price"             $ expectParseEq amountp "$10 @ €0.5" +   ,test "unit price"             $ expectParseEq amountp "$10 @ €0.5"       -- not precise enough:       -- (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- `withStyle` asdecimalpoint=Just '.'       amount{          acommodity="$"-        ,aquantity=10 -- need to test internal precision with roundTo ? I think not +        ,aquantity=10 -- need to test internal precision with roundTo ? I think not         ,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing}-        ,aprice=UnitPrice $+        ,aprice=Just $ UnitPrice $           amount{              acommodity="€"             ,aquantity=0.5             ,astyle=amountstyle{asprecision=1, asdecimalpoint=Just '.'}-            } -        } +            }+        }    ,test "total price"            $ expectParseEq amountp "$10 @@ €5"       amount{          acommodity="$"-        ,aquantity=10 +        ,aquantity=10         ,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing}-        ,aprice=TotalPrice $+        ,aprice=Just $ TotalPrice $           amount{              acommodity="€"             ,aquantity=5             ,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing}-            } -        } +            }+        }     ]    ,let p = lift (numberp Nothing) :: JournalParser IO (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) in@@ -1355,7 +1355,7 @@     ,test "." $ expectParseError p ".1," ""     ,test "." $ expectParseError p ",1." ""     ]-  +   ,tests "spaceandamountormissingp" [      test "space and amount" $ expectParseEq spaceandamountormissingp " $47.18" (Mixed [usd 47.18])     ,test "empty string" $ expectParseEq spaceandamountormissingp "" missingmixedamt

@@ -75,9 +75,6 @@  type Field = String -data CSVError = CSVError (ParseErrorBundle BL.ByteString CassavaMP.ConversionError)-    deriving Show- reader :: Reader reader = Reader   {rFormat     = "csv"@@ -112,7 +109,7 @@ readJournalFromCsv _ Nothing "-" _ = return $ Left "please use --rules-file when reading CSV from stdin" readJournalFromCsv separator mrulesfile csvfile csvdata =  handle (\e -> return $ Left $ show (e :: IOException)) $ do-  let throwerr = throw.userError+  let throwerr = throw . userError    -- parse rules   let rulesfile = fromMaybe (rulesFileFor csvfile) mrulesfile@@ -180,19 +177,17 @@    return $ Right nulljournal{jtxns=txns''} -parseCsv :: Char -> FilePath -> Text -> IO (Either CSVError CSV)+parseCsv :: Char -> FilePath -> Text -> IO (Either String CSV) parseCsv separator filePath csvdata =   case filePath of     "-" -> liftM (parseCassava separator "(stdin)") T.getContents     _   -> return $ parseCassava separator filePath csvdata -parseCassava :: Char -> FilePath -> Text -> Either CSVError CSV+parseCassava :: Char -> FilePath -> Text -> Either String CSV parseCassava separator path content =-    case parseResult of-        Left  msg -> Left $ CSVError msg-        Right a   -> Right a-    where parseResult = fmap parseResultToCsv $ CassavaMP.decodeWith (decodeOptions separator) Cassava.NoHeader path lazyContent-          lazyContent = BL.fromStrict $ T.encodeUtf8 content+  either (Left . errorBundlePretty) (Right . parseResultToCsv) <$>+  CassavaMP.decodeWith (decodeOptions separator) Cassava.NoHeader path $+  BL.fromStrict $ T.encodeUtf8 content  decodeOptions :: Char -> Cassava.DecodeOptions decodeOptions separator = Cassava.defaultDecodeOptions {@@ -214,8 +209,8 @@           unlined = concat . intersperse "\n"  -- | Return the cleaned up and validated CSV data (can be empty), or an error.-validateCsv :: Int -> Either CSVError CSV -> Either String [CsvRecord]-validateCsv _ (Left e) = Left $ show e+validateCsv :: Int -> Either String CSV -> Either String [CsvRecord]+validateCsv _           (Left err) = Left err validateCsv numhdrlines (Right rs) = validate $ drop numhdrlines $ filternulls rs   where     filternulls = filter (/=[""])@@ -452,13 +447,19 @@ validateRules rules = do   unless (isAssigned "date")   $ ExceptT $ return $ Left "Please specify (at top level) the date field. Eg: date %1\n"   unless ((amount && not (amountin || amountout)) ||-          (not amount && (amountin && amountout)))-    $ ExceptT $ return $ Left "Please specify (at top level) either the amount field, or both the amount-in and amount-out fields. Eg: amount %2\n"+          (not amount && (amountin && amountout)) ||+          balance)+    $ ExceptT $ return $ Left $ unlines [+       "Please specify (as a top level CSV rule) either the amount field,"+      ,"both the amount-in and amount-out fields, or the balance field. Eg:"+      ,"amount %2\n"+      ]   ExceptT $ return $ Right rules   where-    amount = isAssigned "amount"-    amountin = isAssigned "amount-in"+    amount    = isAssigned "amount"+    amountin  = isAssigned "amount-in"     amountout = isAssigned "amount-out"+    balance   = isAssigned "balance" || isAssigned "balance1" || isAssigned "balance2"     isAssigned f = isJust $ getEffectiveAssignment rules [] f  -- parsers@@ -563,6 +564,8 @@   ,"amount-in"   ,"amount-out"   ,"amount"+  ,"balance1"+  ,"balance2"   ,"balance"   ,"code"   ,"comment"@@ -672,7 +675,7 @@     mdate2'     = maybe Nothing (maybe (error' $ dateerror "date2" (fromMaybe "" mdate2) mdateformat) Just . mparsedate) mdate2     dateerror datefield value mdateformat = unlines       ["error: could not parse \""++value++"\" as a date using date format "++maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" show mdateformat-      ,"the CSV record is:  "++intercalate ", " (map show record)+      ,"the CSV record is:  "++showRecord record       ,"the "++datefield++" rule is:   "++(fromMaybe "required, but missing" $ mfieldtemplate datefield)       ,"the date-format is: "++fromMaybe "unspecified" mdateformat       ,"you may need to "@@ -712,7 +715,7 @@       ]     amount1 = case maybeamount of                 Just a -> a-                Nothing | balance /= Nothing -> nullmixedamt+                Nothing | balance1 /= Nothing || balance2 /= Nothing -> nullmixedamt                 Nothing -> error' $ "amount and balance have no value\n"++showRecord record     -- convert balancing amount to cost like hledger print, so eg if     -- amount1 is "10 GBP @@ 15 USD", amount2 will be "-15 USD".@@ -724,14 +727,21 @@                    _         -> "expenses:unknown"     account1    = T.pack $ maybe "" render (mfieldtemplate "account1") `or` defaccount1     account2    = T.pack $ maybe "" render (mfieldtemplate "account2") `or` defaccount2-    balance     = maybe Nothing (parsebalance.render) $ mfieldtemplate "balance"-    parsebalance str+    balance1template =+      case (mfieldtemplate "balance", mfieldtemplate "balance1") of+        (Nothing, Nothing)  -> Nothing+        (balance, Nothing)  -> balance+        (Nothing, balance1) -> balance1+        (Just _, Just _)    -> error' "Please use either balance or balance1, but not both"+    balance1     = maybe Nothing (parsebalance "1".render) $ balance1template+    balance2     = maybe Nothing (parsebalance "2".render) $ mfieldtemplate "balance2"+    parsebalance n str       | all isSpace str  = Nothing-      | otherwise = Just $ (either (balanceerror str) id $ runParser (evalStateT (amountp <* eof) mempty) "" $ T.pack $ (currency++) $ simplifySign str, nullsourcepos)-    balanceerror str err = error' $ unlines-      ["error: could not parse \""++str++"\" as balance amount"+      | otherwise = Just $ (either (balanceerror n str) id $ runParser (evalStateT (amountp <* eof) mempty) "" $ T.pack $ (currency++) $ simplifySign str, nullsourcepos)+    balanceerror n str err = error' $ unlines+      ["error: could not parse \""++str++"\" as balance"++n++" amount"       ,showRecord record-      ,"the balance rule is:      "++(fromMaybe "" $ mfieldtemplate "balance")+      ,"the balance"++n++" rule is:      "++(fromMaybe "" $ mfieldtemplate ("balance"++n))       ,"the currency rule is:    "++(fromMaybe "unspecified" $ mfieldtemplate "currency")       ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency       ,"the parse error is:      "++customErrorBundlePretty err@@ -748,8 +758,8 @@       tcomment                 = T.pack comment,       tprecedingcomment = T.pack precomment,       tpostings                =-        [posting {paccount=account1, pamount=amount1, ptransaction=Just t, pbalanceassertion=toAssertion <$> balance}-        ,posting {paccount=account2, pamount=amount2, ptransaction=Just t}+        [posting {paccount=account1, pamount=amount1, ptransaction=Just t, pbalanceassertion=toAssertion <$> balance1}+        ,posting {paccount=account2, pamount=amount2, ptransaction=Just t, pbalanceassertion=toAssertion <$> balance2}         ]       }     toAssertion (a, b) = assertion{@@ -812,7 +822,7 @@  -- | Show a (approximate) recreation of the original CSV record. showRecord :: CsvRecord -> String-showRecord r = "the CSV record is:       "++intercalate ", " (map show r)+showRecord r = "the CSV record is:       "++intercalate "," (map show r)  -- | Given the conversion rules, a CSV record and a journal entry field name, find -- the template value ultimately assigned to this field, either at top@@ -840,10 +850,12 @@                       where                         csvline = intercalate "," record +-- | Render a field assigment's template, possibly interpolating referenced+-- CSV field values. Outer whitespace is removed from interpolated values. renderTemplate ::  CsvRules -> CsvRecord -> FieldTemplate -> String renderTemplate rules record t = regexReplaceBy "%[A-z0-9]+" replace t   where-    replace ('%':pat) = maybe pat (\i -> atDef "" record (i-1)) mindex+    replace ('%':pat) = maybe pat (\i -> strip $ atDef "" record (i-1)) mindex       where         mindex | all isDigit pat = readMay pat                | otherwise       = lookup (map toLower pat) $ rcsvfieldindexes rules

@@ -55,7 +55,8 @@   postingp,   statusp,   emptyorcommentlinep,-  followingcommentp+  followingcommentp,+  accountaliasp    -- * Tests   ,tests_JournalReader@@ -107,9 +108,9 @@ parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal parse iopts = parseAndFinaliseJournal journalp' iopts   where-    journalp' = do +    journalp' = do       -- reverse parsed aliases to ensure that they are applied in order given on commandline-      mapM_ addAccountAlias (reverse $ aliasesFromOpts iopts) +      mapM_ addAccountAlias (reverse $ aliasesFromOpts iopts)       journalp  -- | Get the account name aliases from options, if any.@@ -143,7 +144,7 @@     , transactionp          >>= modify' . addTransaction     , transactionmodifierp  >>= modify' . addTransactionModifier     , periodictransactionp  >>= modify' . addPeriodicTransaction-    , marketpricedirectivep >>= modify' . addMarketPrice+    , marketpricedirectivep >>= modify' . addPriceDirective     , void (lift emptyorcommentlinep)     , void (lift multilinecommentp)     ] <?> "transaction or directive"@@ -267,12 +268,12 @@   -- maybe an account type code (ALERX) after two or more spaces   -- XXX added in 1.11, deprecated in 1.13, remove in 1.14   mtypecode :: Maybe Char <- lift $ optional $ try $ do-    skipSome spacenonewline -- at least one more space in addition to the one consumed by modifiedaccountp +    skipSome spacenonewline -- at least one more space in addition to the one consumed by modifiedaccountp     choice $ map char "ALERX"    -- maybe a comment, on this and/or following lines   (cmt, tags) <- lift transactioncommentp-  +   -- maybe Ledger-style subdirectives (ignored)   skipMany indentedlinep @@ -386,7 +387,7 @@   Amount{acommodity,astyle} <- amountp   _ <- lift followingcommentp   if acommodity==expectedsym-    then +    then       if asdecimalpoint astyle == Nothing       then customFailure $ parseErrorAt off pleaseincludedecimalpoint       else return $ dbg2 "style from format subdirective" astyle@@ -486,7 +487,7 @@   then customFailure $ parseErrorAt off pleaseincludedecimalpoint   else setDefaultCommodityAndStyle (acommodity, astyle) -marketpricedirectivep :: JournalParser m MarketPrice+marketpricedirectivep :: JournalParser m PriceDirective marketpricedirectivep = do   char 'P' <?> "market price"   lift (skipMany spacenonewline)@@ -496,7 +497,7 @@   lift (skipMany spacenonewline)   price <- amountp   lift restofline-  return $ MarketPrice date symbol price+  return $ PriceDirective date symbol price  ignoredpricecommoditydirectivep :: JournalParser m () ignoredpricecommoditydirectivep = do@@ -532,7 +533,7 @@ -- | Parse a periodic transaction -- -- This reuses periodexprp which parses period expressions on the command line.--- This is awkward because periodexprp supports relative and partial dates, +-- This is awkward because periodexprp supports relative and partial dates, -- which we don't really need here, and it doesn't support the notion of a -- default year set by a Y directive, which we do need to consider here. -- We resolve it as follows: in periodic transactions' period expressions,@@ -546,12 +547,12 @@   lift $ skipMany spacenonewline   -- a period expression   off <- getOffset-  +   -- if there's a default year in effect, use Y/1/1 as base for partial/relative dates   today <- liftIO getCurrentDay   mdefaultyear <- getYear   let refdate = case mdefaultyear of-                  Nothing -> today +                  Nothing -> today                   Just y  -> fromGregorian y 1 1   periodExcerpt <- lift $ excerpt_ $                     singlespacedtextsatisfyingp (\c -> c /= ';' && c /= '\n')@@ -576,7 +577,7 @@   case checkPeriodicTransactionStartDate interval span periodtxt of     Just e -> customFailure $ parseErrorAt off e     Nothing -> pure ()-  +   status <- lift statusp <?> "cleared status"   code <- lift codep <?> "transaction code"   description <- lift $ T.strip <$> descriptionp@@ -678,7 +679,7 @@     test "YYYY-MM-DD" $ expectParse datep "2018-01-01"     test "YYYY.MM.DD" $ expectParse datep "2018.01.01"     test "yearless date with no default year" $ expectParseError datep "1/1" "current year is unknown"-    test "yearless date with default year" $ do +    test "yearless date with default year" $ do       let s = "1/1"       ep <- parseWithState mempty{jparsedefaultyear=Just 2018} datep s       either (fail.("parse error at "++).customErrorBundlePretty) (const ok) ep@@ -703,7 +704,7 @@   ,tests "periodictransactionp" [      test "more period text in comment after one space" $ expectParseEq periodictransactionp-      "~ monthly from 2018/6 ;In 2019 we will change this\n" +      "~ monthly from 2018/6 ;In 2019 we will change this\n"       nullperiodictransaction {          ptperiodexpr  = "monthly from 2018/6"         ,ptinterval    = Months 1@@ -713,7 +714,7 @@         }      ,test "more period text in description after two spaces" $ expectParseEq periodictransactionp-      "~ monthly from 2018/6   In 2019 we will change this\n" +      "~ monthly from 2018/6   In 2019 we will change this\n"       nullperiodictransaction {          ptperiodexpr  = "monthly from 2018/6"         ,ptinterval    = Months 1@@ -748,16 +749,16 @@     ]    ,tests "postingp" [-     test "basic" $ expectParseEq (postingp Nothing) +     test "basic" $ expectParseEq (postingp Nothing)       "  expenses:food:dining  $10.00   ; a: a a \n   ; b: b b \n"       posting{-        paccount="expenses:food:dining", -        pamount=Mixed [usd 10], -        pcomment="a: a a\nb: b b\n", +        paccount="expenses:food:dining",+        pamount=Mixed [usd 10],+        pcomment="a: a a\nb: b b\n",         ptags=[("a","a a"), ("b","b b")]         } -    ,test "posting dates" $ expectParseEq (postingp Nothing) +    ,test "posting dates" $ expectParseEq (postingp Nothing)       " a  1. ; date:2012/11/28, date2=2012/11/29,b:b\n"       nullposting{          paccount="a"@@ -768,14 +769,14 @@         ,pdate2=Nothing  -- Just $ fromGregorian 2012 11 29         } -    ,test "posting dates bracket syntax" $ expectParseEq (postingp Nothing) +    ,test "posting dates bracket syntax" $ expectParseEq (postingp Nothing)       " a  1. ; [2012/11/28=2012/11/29]\n"       nullposting{          paccount="a"         ,pamount=Mixed [num 1]         ,pcomment="[2012/11/28=2012/11/29]\n"         ,ptags=[]-        ,pdate= Just $ fromGregorian 2012 11 28 +        ,pdate= Just $ fromGregorian 2012 11 28         ,pdate2=Just $ fromGregorian 2012 11 29         } @@ -788,7 +789,7 @@    ,tests "transactionmodifierp" [ -    test "basic" $ expectParseEq transactionmodifierp +    test "basic" $ expectParseEq transactionmodifierp       "= (some value expr)\n some:postings  1.\n"       nulltransactionmodifier {         tmquerytxt = "(some value expr)"@@ -797,10 +798,10 @@     ]    ,tests "transactionp" [-  +      test "just a date" $ expectParseEq transactionp "2015/1/1\n" nulltransaction{tdate=fromGregorian 2015 1 1}-  -    ,test "more complex" $ expectParseEq transactionp ++    ,test "more complex" $ expectParseEq transactionp       (T.unlines [         "2012/05/14=2012/05/15 (code) desc  ; tcomment1",         "    ; tcomment2",@@ -833,7 +834,7 @@             }           ]       }-  +     ,test "parses a well-formed transaction" $       expect $ isRight $ rjp transactionp $ T.unlines         ["2007/01/28 coopportunity"@@ -841,10 +842,10 @@         ,"    assets:checking                          $-47.18"         ,""         ]-  +     ,test "does not parse a following comment as part of the description" $       expectParseEqOn transactionp "2009/1/1 a ;comment\n b 1\n" tdescription "a"-  +     ,test "transactionp parses a following whitespace line" $       expect $ isRight $ rjp transactionp $ T.unlines         ["2012/1/1"@@ -863,7 +864,7 @@         ]      ,test "comments everywhere, two postings parsed" $-      expectParseEqOn transactionp +      expectParseEqOn transactionp         (T.unlines           ["2009/1/1 x  ; transaction comment"           ," a  1  ; posting 1 comment"@@ -873,13 +874,13 @@           ])         (length . tpostings)         2-  +     ]    -- directives    ,tests "directivep" [-    test "supports !" $ do +    test "supports !" $ do       expectParseE directivep "!account a\n"       expectParseE directivep "!D 1.0\n"     ]@@ -917,10 +918,10 @@    ,test "marketpricedirectivep" $ expectParseEq marketpricedirectivep     "P 2017/01/30 BTC $922.83\n"-    MarketPrice{-      mpdate      = fromGregorian 2017 1 30,-      mpcommodity = "BTC",-      mpamount    = usd 922.83+    PriceDirective{+      pddate      = fromGregorian 2017 1 30,+      pdcommodity = "BTC",+      pdamount    = usd 922.83       }    ,test "tagdirectivep" $ do

@@ -96,7 +96,7 @@       -- As all ledger line types can be distinguished by the first       -- character, excepting transactions versus empty (blank or       -- comment-only) lines, can use choice w/o try-      timeclockitemp = choice [ +      timeclockitemp = choice [                             void (lift emptyorcommentlinep)                           , timeclockentryp >>= \e -> modify' (\j -> j{jparsetimeclockentries = e : jparsetimeclockentries j})                           ] <?> "timeclock entry, or default year or historical price directive"

@@ -142,16 +142,16 @@   (q, _, _, _) <- lift $ numberp Nothing   msymbol <- optional $ choice $ map (string . fst) timeUnits   lift (skipMany spacenonewline)-  let q' = +  let q' =         case msymbol of           Nothing  -> q           Just sym ->             case lookup sym timeUnits of-              Just mult -> q * mult  +              Just mult -> q * mult               Nothing   -> q  -- shouldn't happen.. ignore   return q' --- (symbol, equivalent in hours). +-- (symbol, equivalent in hours). timeUnits =   [("s",2.777777777777778e-4)   ,("mo",5040) -- before "m"

@@ -13,11 +13,11 @@   module Hledger.Reports.ReportTypes,   module Hledger.Reports.EntriesReport,   module Hledger.Reports.PostingsReport,-  module Hledger.Reports.TransactionsReports,+  module Hledger.Reports.TransactionsReport,+  module Hledger.Reports.AccountTransactionsReport,   module Hledger.Reports.BalanceReport,-  module Hledger.Reports.MultiBalanceReports,+  module Hledger.Reports.MultiBalanceReport,   module Hledger.Reports.BudgetReport,---   module Hledger.Reports.BalanceHistoryReport,   -- * Tests   tests_Reports )@@ -25,21 +25,21 @@  import Hledger.Reports.ReportOptions import Hledger.Reports.ReportTypes+import Hledger.Reports.AccountTransactionsReport import Hledger.Reports.EntriesReport import Hledger.Reports.PostingsReport-import Hledger.Reports.TransactionsReports+import Hledger.Reports.TransactionsReport import Hledger.Reports.BalanceReport-import Hledger.Reports.MultiBalanceReports+import Hledger.Reports.MultiBalanceReport import Hledger.Reports.BudgetReport--- import Hledger.Reports.BalanceHistoryReport import Hledger.Utils.Test  tests_Reports = tests "Reports" [    tests_BalanceReport   ,tests_BudgetReport+  ,tests_AccountTransactionsReport   ,tests_EntriesReport-  ,tests_MultiBalanceReports+  ,tests_MultiBalanceReport   ,tests_PostingsReport   ,tests_ReportOptions-  ,tests_TransactionsReports   ]

@@ -0,0 +1,190 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable, FlexibleInstances #-}+{-|++An account-centric transactions report.++-}++module Hledger.Reports.AccountTransactionsReport (+  AccountTransactionsReport,+  AccountTransactionsReportItem,+  accountTransactionsReport,+  accountTransactionsReportItems,+  transactionRegisterDate,+  tests_AccountTransactionsReport+)+where++import Data.List+import Data.Ord+import Data.Maybe+import qualified Data.Text as T+import Data.Time.Calendar++import Hledger.Data+import Hledger.Query+import Hledger.Reports.ReportOptions+import Hledger.Utils+++-- | An account transactions report represents transactions affecting+-- a particular account (or possibly several accounts, but we don't+-- use that). It is used eg by hledger-ui's and hledger-web's account+-- register view, where we want to show one row per transaction, in+-- the context of the current account. Report items consist of:+--+-- - the transaction, unmodified+--+-- - the transaction as seen in the context of the current account and query,+--   which means:+--+--   - the transaction date is set to the "transaction context date",+--     which can be different from the transaction's general date:+--     if postings to the current account (and matched by the report query)+--     have their own dates, it's the earliest of these dates.+--+--   - the transaction's postings are filtered, excluding any which are not+--     matched by the report query+--+-- - a text description of the other account(s) posted to/from+--+-- - a flag indicating whether there's more than one other account involved+--+-- - the total increase/decrease to the current account+--+-- - the report transactions' running total after this transaction;+--   or if historical balance is requested (-H), the historical running total.+--   The historical running total includes transactions from before the+--   report start date if one is specified, filtered by the report query.+--   The historical running total may or may not be the account's historical+--   running balance, depending on the report query.+--+-- Items are sorted by transaction register date (the earliest date the transaction+-- posts to the current account), most recent first.+-- Reporting intervals are currently ignored.+--+type AccountTransactionsReport =+  (String                          -- label for the balance column, eg "balance" or "total"+  ,[AccountTransactionsReportItem] -- line items, one per transaction+  )++type AccountTransactionsReportItem =+  (+   Transaction -- the transaction, unmodified+  ,Transaction -- the transaction, as seen from the current account+  ,Bool        -- is this a split (more than one posting to other accounts) ?+  ,String      -- a display string describing the other account(s), if any+  ,MixedAmount -- the amount posted to the current account(s) (or total amount posted)+  ,MixedAmount -- the register's running total or the current account(s)'s historical balance, after this transaction+  )++totallabel   = "Period Total"+balancelabel = "Historical Total"++accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> AccountTransactionsReport+accountTransactionsReport opts j reportq thisacctq = (label, items)+  where+    -- a depth limit does not affect the account transactions report+    -- seems unnecessary for some reason XXX+    reportq' = -- filterQuery (not . queryIsDepth)+               reportq+    -- get all transactions, with amounts converted to cost basis if -B+    ts1 = jtxns $ journalSelectingAmountFromOpts opts j+    -- apply any cur:SYM filters in reportq'+    symq  = filterQuery queryIsSym reportq'+    ts2 = (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 = filter (matchesTransaction thisacctq . filterTransactionPostings (And [realq, statusq])) ts2+    -- sort by the transaction's register date, for accurate starting balance+    ts = sortBy (comparing (transactionRegisterDate reportq' thisacctq)) ts3++    (startbal,label)+      | balancetype_ opts == HistoricalBalance = (sumPostings priorps, balancelabel)+      | otherwise                              = (nullmixedamt,        totallabel)+      where+        priorps = dbg1 "priorps" $+                  filter (matchesPosting+                          (dbg1 "priorq" $+                           And [thisacctq, tostartdateq, datelessreportq]))+                         $ transactionsPostings ts+        tostartdateq =+          case mstartdate of+            Just _  -> Date (DateSpan Nothing mstartdate)+            Nothing -> None  -- no start date specified, there are no prior postings+        mstartdate = queryStartDate (date2_ opts) reportq'+        datelessreportq = filterQuery (not . queryIsDateOrDate2) reportq'++    items = reverse $+            accountTransactionsReportItems reportq' thisacctq startbal negate ts++-- | Generate transactions report items from a list of transactions,+-- using the provided user-specified report query, a query specifying+-- which account to use as the focus, a starting balance, a sign-setting+-- function and a balance-summing function. Or with a None current account+-- query, this can also be used for the transactionsReport.+accountTransactionsReportItems :: Query -> Query -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [AccountTransactionsReportItem]+accountTransactionsReportItems reportq thisacctq bal signfn =+    catMaybes . snd .+    mapAccumL (accountTransactionsReportItem reportq thisacctq signfn) bal++accountTransactionsReportItem :: Query -> Query -> (MixedAmount -> MixedAmount) -> MixedAmount -> Transaction -> (MixedAmount, Maybe AccountTransactionsReportItem)+accountTransactionsReportItem reportq thisacctq signfn bal torig = balItem+    -- 201403: This is used for both accountTransactionsReport and transactionsReport, which makes it a bit overcomplicated+    -- 201407: I've lost my grip on this, let's just hope for the best+    -- 201606: we now calculate change and balance from filtered postings, check this still works well for all callers XXX+    where+      tfiltered@Transaction{tpostings=reportps} = filterTransactionPostings reportq torig+      tacct = tfiltered{tdate=transactionRegisterDate reportq thisacctq tfiltered}+      balItem = case reportps of+           [] -> (bal, Nothing)  -- no matched postings in this transaction, skip it+           _  -> (b, Just (torig, tacct, numotheraccts > 1, otheracctstr, a, b))+                 where+                  (thisacctps, otheracctps) = partition (matchesPosting thisacctq) reportps+                  numotheraccts = length $ nub $ map paccount otheracctps+                  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++-- | 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 ?+-- It's normally the transaction's general date, but if any posting(s)+-- matched by the report query and affecting the matched account(s) have+-- their own earlier dates, it's the earliest of these dates.+-- Secondary transaction/posting dates are ignored.+transactionRegisterDate :: Query -> Query -> Transaction -> Day+transactionRegisterDate reportq thisacctq t+  | null thisacctps = tdate t+  | otherwise       = minimum $ map postingDate thisacctps+  where+    reportps   = tpostings $ filterTransactionPostings reportq t+    thisacctps = filter (matchesPosting thisacctq) reportps++-- -- | Generate a short readable summary of some postings, like+-- -- "from (negatives) to (positives)".+-- summarisePostings :: [Posting] -> String+-- summarisePostings ps =+--     case (summarisePostingAccounts froms, summarisePostingAccounts tos) of+--        ("",t) -> "to "++t+--        (f,"") -> "from "++f+--        (f,t)  -> "from "++f++" to "++t+--     where+--       (froms,tos) = partition (fromMaybe False . isNegativeMixedAmount . pamount) ps++-- | Generate a simplified summary of some postings' accounts.+-- To reduce noise, if there are both real and virtual postings, show only the real ones.+summarisePostingAccounts :: [Posting] -> String+summarisePostingAccounts ps =+  (intercalate ", " . map (T.unpack . accountSummarisedName) . nub . map paccount) displayps -- XXX pack+  where+    realps = filter isReal ps+    displayps | null realps = ps+              | otherwise   = realps++-- tests++tests_AccountTransactionsReport = tests "AccountTransactionsReport" [+ ]

@@ -1,31 +0,0 @@-{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances #-}-{-|--Account balance history report.---}--- XXX not used--module Hledger.Reports.BalanceHistoryReport (-  accountBalanceHistory-)-where--import Data.Time.Calendar--import Hledger.Data-import Hledger.Query-import Hledger.Reports.ReportOptions-import Hledger.Reports.TransactionsReports----- | Get the historical running inclusive balance of a particular account,--- from earliest to latest posting date.-accountBalanceHistory :: ReportOpts -> Journal -> Account -> [(Day, MixedAmount)]-accountBalanceHistory ropts j a = [(getdate t, bal) | (t,_,_,_,_,bal) <- items]-  where-    (_,items) = journalTransactionsReport ropts j acctquery-    inclusivebal = True-    acctquery = Acct $ (if inclusivebal then accountNameToAccountRegex else accountNameToAccountOnlyRegex) $ aname a-    getdate = if date2_ ropts then transactionDate2 else tdate-

@@ -4,21 +4,14 @@  -} --------{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances, RecordWildCards, ScopedTypeVariables, OverloadedStrings #-}  module Hledger.Reports.BalanceReport (   BalanceReport,   BalanceReportItem,   balanceReport,   flatShowsExclusiveBalance,-  sortAccountItemsLike, +  sortAccountItemsLike,    -- * Tests   tests_BalanceReport@@ -33,16 +26,10 @@ import Hledger.Data import Hledger.Read (mamountp') import Hledger.Query-import Hledger.Utils +import Hledger.Utils import Hledger.Reports.ReportOptions  ------ -- | A simple balance report. It has: -- -- 1. a list of items, one per account, each containing:@@ -77,70 +64,89 @@ -- This is like PeriodChangeReport with a single column (but more mature, -- eg this can do hierarchical display). balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport-balanceReport opts q j = -  (if invert_ opts then brNegate else id) $ +balanceReport ropts@ReportOpts{..} q j@Journal{..} =+  (if invert_ then brNegate  else id) $   (sorteditems, total)     where       -- dbg1 = const id -- exclude from debug output       dbg1 s = let p = "balanceReport" in Hledger.Utils.dbg1 (p++" "++s)  -- add prefix in debug output -      accts = ledgerRootAccount $ ledgerFromJournal q $ journalSelectingAmountFromOpts opts j-      accts' :: [Account]+      today = fromMaybe (error' "balanceReport: ReportOpts today_ is unset so could not satisfy --value=now") today_+      multiperiod = interval_ /= NoInterval+      styles = journalCommodityStyles j++      -- Get all the summed accounts & balances, according to the query, as an account tree.+      -- If doing cost valuation, amounts will be converted to cost first.+      accttree = ledgerRootAccount $ ledgerFromJournal q $ journalSelectingAmountFromOpts ropts j++      -- For other kinds of valuation, convert the summed amounts to value.+      priceoracle = journalPriceOracle j+      valuedaccttree = mapAccounts valueaccount accttree+        where+          valueaccount a@Account{..} = a{aebalance=val aebalance, aibalance=val aibalance}+            where+              val = maybe id (mixedAmountApplyValuation priceoracle styles periodlastday today multiperiod) value_+                where+                  periodlastday =+                    fromMaybe (error' "balanceReport: expected a non-empty journal") $ -- XXX shouldn't happen+                    reportPeriodOrJournalLastDay ropts j++      -- Modify this tree for display - depth limit, boring parents, zeroes - and convert to a list.+      displayaccts :: [Account]           | queryDepth q == 0 =-                         dbg1 "accts" $-                         take 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts accts-          | flat_ opts = dbg1 "accts" $+                         dbg1 "displayaccts" $+                         take 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts valuedaccttree+          | flat_ ropts = dbg1 "displayaccts" $                          filterzeros $                          filterempty $-                         drop 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts accts-          | otherwise  = dbg1 "accts" $+                         drop 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts valuedaccttree+          | otherwise  = dbg1 "displayaccts" $                          filter (not.aboring) $                          drop 1 $ flattenAccounts $                          markboring $                          prunezeros $-                         sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ opts) $-                         clipAccounts (queryDepth q) accts+                         sortAccountTreeByAmount (fromMaybe NormallyPositive normalbalance_) $+                         clipAccounts (queryDepth q) valuedaccttree           where-            balance   = if flat_ opts then aebalance else aibalance-            filterzeros = if empty_ opts then id else filter (not . isZeroMixedAmount . balance)+            balance     = if flat_ ropts then aebalance else aibalance+            filterzeros = if empty_ then id else filter (not . isZeroMixedAmount . balance)             filterempty = filter (\a -> anumpostings a > 0 || not (isZeroMixedAmount (balance a)))-            prunezeros  = if empty_ opts then id else fromMaybe nullacct . pruneAccounts (isZeroMixedAmount . balance)-            markboring  = if no_elide_ opts then id else markBoringParentAccounts+            prunezeros  = if empty_ then id else fromMaybe nullacct . pruneAccounts (isZeroMixedAmount . balance)+            markboring  = if no_elide_ then id else markBoringParentAccounts -      items = dbg1 "items" $ map (balanceReportItem opts q) accts'+      -- Make a report row for each account.+      items = dbg1 "items" $ map (balanceReportItem ropts q) displayaccts -      -- now sort items like MultiBalanceReport, except -      -- sorting a tree by amount was more easily done above-      sorteditems -        | sort_amount_ opts && tree_ opts = items-        | sort_amount_ opts               = sortFlatBRByAmount items-        | otherwise                       = sortBRByAccountDeclaration items-      -        where    -          -- Sort the report rows, representing a flat account list, by row total. +      -- Sort report rows (except sorting by amount in tree mode, which was done above).+      sorteditems+        | sort_amount_ && tree_ ropts = items+        | sort_amount_                = sortFlatBRByAmount items+        | otherwise                   = sortBRByAccountDeclaration items+        where+          -- Sort the report rows, representing a flat account list, by row total.           sortFlatBRByAmount :: [BalanceReportItem] -> [BalanceReportItem]           sortFlatBRByAmount = sortBy (maybeflip $ comparing (normaliseMixedAmountSquashPricesForDisplay . fourth4))             where-              maybeflip = if normalbalance_ opts == Just NormallyNegative then id else flip-    -          -- Sort the report rows by account declaration order then account name. +              maybeflip = if normalbalance_ == Just NormallyNegative then id else flip+          -- Sort the report rows by account declaration order then account name.           sortBRByAccountDeclaration :: [BalanceReportItem] -> [BalanceReportItem]           sortBRByAccountDeclaration rows = sortedrows-            where +            where               anamesandrows = [(first4 r, r) | r <- rows]               anames = map fst anamesandrows-              sortedanames = sortAccountNamesByDeclaration j (tree_ opts) anames-              sortedrows = sortAccountItemsLike sortedanames anamesandrows +              sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames+              sortedrows = sortAccountItemsLike sortedanames anamesandrows -      total | not (flat_ opts) = dbg1 "total" $ sum [amt | (_,_,indent,amt) <- items, indent == 0]-            | otherwise        = dbg1 "total" $-                                 if flatShowsExclusiveBalance-                                 then sum $ map fourth4 items-                                 else sum $ map aebalance $ clipAccountsAndAggregate 1 accts'+      -- Calculate the grand total.+      total | not (flat_ ropts) = dbg1 "total" $ sum [amt | (_,_,indent,amt) <- items, indent == 0]+            | otherwise         = dbg1 "total" $+                                  if flatShowsExclusiveBalance+                                  then sum $ map fourth4 items+                                  else sum $ map aebalance $ clipAccountsAndAggregate 1 displayaccts  -- | A sorting helper: sort a list of things (eg report rows) keyed by account name -- to match the provided ordering of those same account names.-sortAccountItemsLike :: [AccountName] -> [(AccountName, b)] -> [b] +sortAccountItemsLike :: [AccountName] -> [(AccountName, b)] -> [b] sortAccountItemsLike sortedas items =   concatMap (\a -> maybe [] (:[]) $ lookup a items) sortedas @@ -176,10 +182,13 @@  -- | Flip the sign of all amounts in a BalanceReport. brNegate :: BalanceReport -> BalanceReport-brNegate (is, tot) = (map brItemNegate is, -tot) +brNegate (is, tot) = (map brItemNegate is, -tot)   where     brItemNegate (a, a', d, amt) = (a, a', d, -amt) ++-- tests+ Right samplejournal2 =   journalBalanceTransactions False     nulljournal{@@ -203,8 +212,6 @@       ]     } --- tests- tests_BalanceReport = tests "BalanceReport" [   tests "balanceReport" $     let@@ -216,10 +223,10 @@         (showMixedAmountDebug etotal) `is` (showMixedAmountDebug atotal)       usd0 = usd 0     in [-  +      test "balanceReport with no args on null journal" $      (defreportopts, nulljournal) `gives` ([], Mixed [nullamt])-  +     ,test "balanceReport with no args on sample journal" $      (defreportopts, samplejournal) `gives`       ([@@ -236,7 +243,7 @@        ,("income:salary","salary",1, mamountp' "$-1.00")        ],        Mixed [usd0])-  +     ,test "balanceReport with --depth=N" $      (defreportopts{depth_=Just 1}, samplejournal) `gives`       ([@@ -244,7 +251,7 @@        ,("income",      "income",      0, mamountp' "$-2.00")        ],        Mixed [usd0])-  +     ,test "balanceReport with depth:N" $      (defreportopts{query_="depth:1"}, samplejournal) `gives`       ([@@ -252,7 +259,7 @@        ,("income",      "income",      0, mamountp' "$-2.00")        ],        Mixed [usd0])-  +     ,tests "balanceReport with a date or secondary date span" [      (defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives`       ([],@@ -272,7 +279,7 @@        ,("income:salary","income:salary",0, mamountp' "$-1.00")        ],        Mixed [usd0])-  +     ,test "balanceReport with not:desc:" $      (defreportopts{query_="not:desc:income"}, samplejournal) `gives`       ([@@ -285,7 +292,7 @@        ,("income:gifts","income:gifts",0, mamountp' "$-1.00")        ],        Mixed [usd0])-  +     ,test "balanceReport with period on a populated period" $       (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2)}, samplejournal) `gives`        (@@ -294,13 +301,13 @@         ,("income:salary","income:salary",0, mamountp' "$-1.00")         ],         Mixed [usd0])-  +      ,test "balanceReport with period on an unpopulated period" $       (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}, samplejournal) `gives`        ([],Mixed [nullamt])-  -  -  +++   {-       ,test "accounts report with account pattern o" ~:        defreportopts{patterns_=["o"]} `gives`@@ -311,7 +318,7 @@        ,"--------------------"        ,"                 $-1"        ]-  +       ,test "accounts report with account pattern o and --depth 1" ~:        defreportopts{patterns_=["o"],depth_=Just 1} `gives`        ["                  $1  expenses"@@ -319,7 +326,7 @@        ,"--------------------"        ,"                 $-1"        ]-  +       ,test "accounts report with account pattern a" ~:        defreportopts{patterns_=["a"]} `gives`        ["                 $-1  assets"@@ -330,7 +337,7 @@        ,"--------------------"        ,"                 $-1"        ]-  +       ,test "accounts report with account pattern e" ~:        defreportopts{patterns_=["e"]} `gives`        ["                 $-1  assets"@@ -346,7 +353,7 @@        ,"--------------------"        ,"                   0"        ]-  +       ,test "accounts report with unmatched parent of two matched subaccounts" ~:        defreportopts{patterns_=["cash","saving"]} `gives`        ["                 $-1  assets"@@ -355,14 +362,14 @@        ,"--------------------"        ,"                 $-1"        ]-  +       ,test "accounts report with multi-part account name" ~:        defreportopts{patterns_=["expenses:food"]} `gives`        ["                  $1  expenses:food"        ,"--------------------"        ,"                  $1"        ]-  +       ,test "accounts report with negative account pattern" ~:        defreportopts{patterns_=["not:assets"]} `gives`        ["                  $2  expenses"@@ -375,20 +382,20 @@        ,"--------------------"        ,"                  $1"        ]-  +       ,test "accounts report negative account pattern always matches full name" ~:        defreportopts{patterns_=["not:e"]} `gives`        ["--------------------"        ,"                   0"        ]-  +       ,test "accounts report negative patterns affect totals" ~:        defreportopts{patterns_=["expenses","not:food"]} `gives`        ["                  $1  expenses:supplies"        ,"--------------------"        ,"                  $1"        ]-  +       ,test "accounts report with -E shows zero-balance accounts" ~:        defreportopts{patterns_=["assets"],empty_=True} `gives`        ["                 $-1  assets"@@ -399,7 +406,7 @@        ,"--------------------"        ,"                 $-1"        ]-  +       ,test "accounts report with cost basis" $          j <- (readJournal def Nothing $ unlines                 [""

@@ -3,6 +3,7 @@  {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}  module Hledger.Reports.BudgetReport@@ -36,7 +37,7 @@ import Hledger.Reports.ReportOptions import Hledger.Reports.ReportTypes import Hledger.Reports.BalanceReport (sortAccountItemsLike)-import Hledger.Reports.MultiBalanceReports+import Hledger.Reports.MultiBalanceReport   -- for reference:@@ -71,14 +72,14 @@     -- and that reports with and without --empty make sense when compared side by side     ropts = ropts' { accountlistmode_ = ALTree }     showunbudgeted = empty_ ropts-    q = queryFromOpts d ropts -    budgetedaccts = +    q = queryFromOpts d ropts+    budgetedaccts =       dbg2 "budgetedacctsinperiod" $-      nub $ +      nub $       concatMap expandAccountName $-      accountNamesFromPostings $ -      concatMap tpostings $ -      concatMap (flip runPeriodicTransaction reportspan) $ +      accountNamesFromPostings $+      concatMap tpostings $+      concatMap (flip runPeriodicTransaction reportspan) $       jperiodictxns j     actualj = dbg1 "actualj" $ budgetRollUp budgetedaccts showunbudgeted j     budgetj = dbg1 "budgetj" $ budgetJournal assrt ropts reportspan j@@ -86,10 +87,10 @@     budgetgoalreport@(MultiBalanceReport (_, budgetgoalitems, budgetgoaltotals)) = dbg1 "budgetgoalreport" $ multiBalanceReport (ropts{empty_=True}) q budgetj     budgetgoalreport'       -- If no interval is specified:-      -- budgetgoalreport's span might be shorter actualreport's due to periodic txns; -      -- it should be safe to replace it with the latter, so they combine well. +      -- budgetgoalreport's span might be shorter actualreport's due to periodic txns;+      -- it should be safe to replace it with the latter, so they combine well.       | interval_ ropts == NoInterval = MultiBalanceReport (actualspans, budgetgoalitems, budgetgoaltotals)-      | otherwise = budgetgoalreport +      | otherwise = budgetgoalreport     budgetreport = combineBudgetAndActual budgetgoalreport' actualreport     sortedbudgetreport = sortBudgetReport ropts j budgetreport   in@@ -99,13 +100,13 @@ sortBudgetReport :: ReportOpts -> Journal -> BudgetReport -> BudgetReport sortBudgetReport ropts j (PeriodicReport (ps, rows, trow)) = PeriodicReport (ps, sortedrows, trow)   where-    sortedrows +    sortedrows       | sort_amount_ ropts && tree_ ropts = sortTreeBURByActualAmount rows       | sort_amount_ ropts                = sortFlatBURByActualAmount rows       | otherwise                         = sortByAccountDeclaration rows      -- Sort a tree-mode budget report's rows by total actual amount at each level.-    sortTreeBURByActualAmount :: [BudgetReportRow] -> [BudgetReportRow] +    sortTreeBURByActualAmount :: [BudgetReportRow] -> [BudgetReportRow]     sortTreeBURByActualAmount rows = sortedrows       where         anamesandrows = [(first6 r, r) | r <- rows]@@ -115,21 +116,21 @@         accounttreewithbals = mapAccounts setibalance accounttree           where             setibalance a = a{aibalance=-              fromMaybe 0 $ -- when there's no actual amount, assume 0; will mess up with negative amounts ? TODO -              fromMaybe (error "sortTreeByAmount 1") $ -- should not happen, but it's ugly; TODO +              fromMaybe 0 $ -- when there's no actual amount, assume 0; will mess up with negative amounts ? TODO+              fromMaybe (error "sortTreeByAmount 1") $ -- should not happen, but it's ugly; TODO               lookup (aname a) atotals               }         sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ ropts) accounttreewithbals         sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree-        sortedrows = sortAccountItemsLike sortedanames anamesandrows +        sortedrows = sortAccountItemsLike sortedanames anamesandrows      -- Sort a flat-mode budget report's rows by total actual amount.-    sortFlatBURByActualAmount :: [BudgetReportRow] -> [BudgetReportRow] +    sortFlatBURByActualAmount :: [BudgetReportRow] -> [BudgetReportRow]     sortFlatBURByActualAmount = sortBy (maybeflip $ comparing (fst . fifth6))       where         maybeflip = if normalbalance_ ropts == Just NormallyNegative then id else flip -    -- Sort the report rows by account declaration order then account name. +    -- Sort the report rows by account declaration order then account name.     -- <unbudgeted> remains at the top.     sortByAccountDeclaration rows = sortedrows       where@@ -137,9 +138,9 @@         anamesandrows = [(first6 r, r) | r <- rows']         anames = map fst anamesandrows         sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames-        sortedrows = unbudgetedrow ++ sortAccountItemsLike sortedanames anamesandrows +        sortedrows = unbudgetedrow ++ sortAccountItemsLike sortedanames anamesandrows --- | Use all periodic transactions in the journal to generate +-- | Use all periodic transactions in the journal to generate -- budget transactions in the specified report period. -- Budget transactions are similar to forecast transactions except -- their purpose is to set goal amounts (of change) per account and period.@@ -158,11 +159,11 @@  -- | Adjust a journal's account names for budget reporting, in two ways: ----- 1. accounts with no budget goal anywhere in their ancestry are moved +-- 1. accounts with no budget goal anywhere in their ancestry are moved --    under the "unbudgeted" top level account. -- -- 2. subaccounts with no budget goal are merged with their closest parent account---    with a budget goal, so that only budgeted accounts are shown. +--    with a budget goal, so that only budgeted accounts are shown. --    This can be disabled by --empty. -- budgetRollUp :: [AccountName] -> Bool -> Journal -> Journal@@ -175,7 +176,7 @@           where             remapAccount a               | hasbudget         = a-              | hasbudgetedparent = if showunbudgeted then a else budgetedparent +              | hasbudgetedparent = if showunbudgeted then a else budgetedparent               | otherwise         = if showunbudgeted then u <> acctsep <> a else u               where                 hasbudget = a `elem` budgetedaccts@@ -268,11 +269,22 @@  -- | Render a budget report as plain text suitable for console output. budgetReportAsText :: ReportOpts -> BudgetReport -> String-budgetReportAsText ropts budgetr@(PeriodicReport ( _, rows, _)) =-  printf "Budget performance in %s:\n\n" (showDateSpan $ budgetReportSpan budgetr)-  ++ +budgetReportAsText ropts@ReportOpts{..} budgetr@(PeriodicReport ( _, rows, _)) =+  title ++ "\n\n" ++   tableAsText ropts showcell (maybetranspose $ budgetReportAsTable ropts budgetr)   where+    multiperiod = interval_ /= NoInterval+    title = printf "Budget performance in %s%s:"+      (showDateSpan $ budgetReportSpan budgetr)+      (case value_ of+        Just (AtCost _mc)   -> ", valued at cost"+        Just (AtEnd _mc)    -> ", valued at period ends"+        Just (AtNow _mc)    -> ", current value"+        -- XXX duplicates the above+        Just (AtDefault _mc) | multiperiod -> ", valued at period ends"+        Just (AtDefault _mc)  -> ", current value"+        Just (AtDate d _mc) -> ", valued at "++showDate d+        Nothing             -> "")     actualwidth =       maximum [ maybe 0 (length . showMixedAmountOneLineWithoutPrice) amt       | (_, _, _, amtandgoals, _, _) <- rows@@ -300,39 +312,39 @@                        (showbudgetamt budget)      -- | Calculate the percentage of actual change to budget goal to show, if any.-    -- Both amounts are converted to cost, if possible, before comparing.+    -- If valuing at cost, both amounts are converted to cost before comparing.     -- A percentage will not be shown if:     -- - actual or goal are not the same, single, commodity     -- - the goal is zero     percentage :: Change -> BudgetGoal -> Maybe Percentage     percentage actual budget =-      case (toCost actual, toCost budget) of-        (Mixed [a], Mixed [b]) | (acommodity a == acommodity b || isZeroAmount a) && not (isZeroAmount b) +      case (maybecost $ normaliseMixedAmount actual, maybecost $ normaliseMixedAmount budget) of+        (Mixed [a], Mixed [b]) | (acommodity a == acommodity b || isZeroAmount a) && not (isZeroAmount b)             -> Just $ 100 * aquantity a / aquantity b-        _   -> Nothing+        _   -> -- trace (pshow $ (maybecost actual, maybecost budget))  -- debug missing percentage+               Nothing       where-        toCost = normaliseMixedAmount . costOfMixedAmount -+        maybecost = if valuationTypeIsCost ropts then costOfMixedAmount else id     showamt :: MixedAmount -> String-    showamt | color_ ropts  = cshowMixedAmountOneLineWithoutPrice-            | otherwise     = showMixedAmountOneLineWithoutPrice+    showamt | color_    = cshowMixedAmountOneLineWithoutPrice+            | otherwise = showMixedAmountOneLineWithoutPrice      -- don't show the budget amount in color, it messes up alignment     showbudgetamt = showMixedAmountOneLineWithoutPrice -    maybetranspose | transpose_ ropts = \(Table rh ch vals) -> Table ch rh (transpose vals)-                   | otherwise       = id+    maybetranspose | transpose_ = \(Table rh ch vals) -> Table ch rh (transpose vals)+                   | otherwise  = id  -- | Build a 'Table' from a multi-column balance report. budgetReportAsTable :: ReportOpts -> BudgetReport -> Table String String (Maybe MixedAmount, Maybe MixedAmount)-budgetReportAsTable -  ropts +budgetReportAsTable+  ropts   (PeriodicReport     ( periods     , rows     , (_, _, _, coltots, grandtot, grandavg)     )) =-    addtotalrow $ +    addtotalrow $     Table       (T.Group NoLine $ map Header accts)       (T.Group NoLine $ map Header colheadings)@@ -356,7 +368,7 @@                                      ))  -- XXX here for now--- TODO: does not work for flat-by-default reports with --flat not specified explicitly  +-- TODO: does not work for flat-by-default reports with --flat not specified explicitly -- | Drop leading components of accounts names as specified by --drop, but only in --flat mode. maybeAccountNameDrop :: ReportOpts -> AccountName -> AccountName maybeAccountNameDrop opts a | flat_ opts = accountNameDrop (drop_ opts) a

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable, FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable, FlexibleInstances, ScopedTypeVariables #-} {-|  Journal entries report, used by the print command.@@ -14,13 +14,16 @@ ) where +import Control.Applicative ((<|>)) import Data.List+import Data.Maybe import Data.Ord+import Data.Time.Calendar (Day, addDays)  import Hledger.Data import Hledger.Query import Hledger.Reports.ReportOptions-import Hledger.Utils +import Hledger.Utils   -- | A journal entries report is a list of whole transactions as@@ -31,11 +34,29 @@  -- | Select transactions for an entries report. entriesReport :: ReportOpts -> Query -> Journal -> EntriesReport-entriesReport opts q j =-  sortBy (comparing date) $ filter (q `matchesTransaction`) ts-    where-      date = transactionDateFn opts-      ts = jtxns $ journalSelectingAmountFromOpts opts j+entriesReport ropts@ReportOpts{..} q j@Journal{..} =+  sortBy (comparing datefn) $ filter (q `matchesTransaction`) $ map tvalue jtxns+  where+    datefn = transactionDateFn ropts+    styles = journalCommodityStyles j+    tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings}+    priceoracle = journalPriceOracle j+    pvalue p = maybe p (postingApplyValuation priceoracle styles end today False p) value_+      where+        today  = fromMaybe (error' "erValue: ReportOpts today_ is unset so could not satisfy --value=now") today_+        end    = fromMaybe (postingDate p) mperiodorjournallastday+          where+            mperiodorjournallastday = mperiodlastday <|> journalEndDate False j+              where+                -- The last day of the report period.+                -- Will be Nothing if no report period is specified, or also+                -- if ReportOpts does not have today_ set, since we need that+                -- to get the report period robustly.+                mperiodlastday :: Maybe Day = do+                  t <- today_+                  let q = queryFromOpts t ropts+                  qend <- queryEndDate False q+                  return $ addDays (-1) qend  tests_EntriesReport = tests "EntriesReport" [   tests "entriesReport" [

@@ -0,0 +1,462 @@+{-# LANGUAGE FlexibleInstances, RecordWildCards, ScopedTypeVariables, OverloadedStrings, DeriveGeneric #-}+{-|++Multi-column balance reports, used by the balance command.++-}++module Hledger.Reports.MultiBalanceReport (+  MultiBalanceReport(..),+  MultiBalanceReportRow,+  multiBalanceReport,+  multiBalanceReportWith,+  balanceReportFromMultiBalanceReport,+  mbrNegate,+  mbrNormaliseSign,+  multiBalanceReportSpan,+  tableAsText,++  -- -- * Tests+  tests_MultiBalanceReport+)+where++import GHC.Generics (Generic)+import Control.DeepSeq (NFData)+import Data.List+import Data.Maybe+import Data.Ord+import Data.Time.Calendar+import Safe+import Text.Tabular as T+import Text.Tabular.AsciiWide++import Hledger.Data+import Hledger.Query+import Hledger.Utils+import Hledger.Read (mamountp')+import Hledger.Reports.ReportOptions+import Hledger.Reports.BalanceReport+++-- | A multi balance report is a balance report with multiple columns,+-- corresponding to consecutive subperiods within the overall report+-- period. It has:+--+-- 1. a list of each column's period (date span)+--+-- 2. a list of rows, each containing:+--+--   * the full account name+--+--   * the leaf account name+--+--   * the account's depth+--+--   * A list of amounts, one for each column. The meaning of the+--     amounts depends on the type of multi balance report, of which+--     there are three: periodic, cumulative and historical (see+--     'BalanceType' and "Hledger.Cli.Commands.Balance").+--+--   * the total of the row's amounts for a periodic report,+--     or zero for cumulative/historical reports (since summing+--     end balances generally doesn't make sense).+--+--   * the average of the row's amounts+--+-- 3. the column totals, and the overall grand total (or zero for+-- cumulative/historical reports) and grand average.+--+newtype MultiBalanceReport =+  MultiBalanceReport ([DateSpan]+                     ,[MultiBalanceReportRow]+                     ,MultiBalanceReportTotals+                     )+  deriving (Generic)++type MultiBalanceReportRow    = (AccountName, AccountName, Int, [MixedAmount], MixedAmount, MixedAmount)+type MultiBalanceReportTotals = ([MixedAmount], MixedAmount, MixedAmount) -- (Totals list, sum of totals, average of totals)++instance NFData MultiBalanceReport++instance Show MultiBalanceReport where+    -- use pshow (pretty-show's ppShow) to break long lists onto multiple lines+    -- we add some bogus extra shows here to help it parse the output+    -- and wrap tuples and lists properly+    show (MultiBalanceReport (spans, items, totals)) =+        "MultiBalanceReport (ignore extra quotes):\n" ++ pshow (show spans, map show items, totals)++-- type alias just to remind us which AccountNames might be depth-clipped, below.+type ClippedAccountName = AccountName++-- | Generate a multicolumn balance report for the matched accounts,+-- showing the change of balance, accumulated balance, or historical balance+-- in each of the specified periods. Does not support tree-mode boring parent eliding.+-- If the normalbalance_ option is set, it adjusts the sorting and sign of amounts+-- (see ReportOpts and CompoundBalanceCommand).+-- hledger's most powerful and useful report, used by the balance+-- command (in multiperiod mode) and (via multiBalanceReport') by the bs/cf/is commands.+multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport+multiBalanceReport ropts q j = multiBalanceReportWith ropts q j (journalPriceOracle j)++-- | A helper for multiBalanceReport. This one takes an extra argument, a+-- PriceOracle to be used for looking up market prices. Commands which+-- run multiple reports (bs etc.) can generate the price oracle just once+-- for efficiency, passing it to each report by calling this function directly.+multiBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle -> MultiBalanceReport+multiBalanceReportWith ropts@ReportOpts{..} q j@Journal{..} priceoracle =+  (if invert_ then mbrNegate else id) $+  MultiBalanceReport (colspans, sortedrows, totalsrow)+    where+      dbg1 s = let p = "multiBalanceReport" in Hledger.Utils.dbg1 (p++" "++s)  -- add prefix in this function's debug output+      -- dbg1 = const id  -- exclude this function from debug output++      ----------------------------------------------------------------------+      -- 1. Queries, report/column dates.++      symq       = dbg1 "symq"   $ filterQuery queryIsSym $ dbg1 "requested q" q+      depthq     = dbg1 "depthq" $ filterQuery queryIsDepth q+      depth      = queryDepth depthq+      depthless  = dbg1 "depthless" . filterQuery (not . queryIsDepth)+      datelessq  = dbg1 "datelessq"  $ filterQuery (not . queryIsDateOrDate2) q+      dateqcons  = if date2_ then Date2 else Date+      -- The date span specified by -b/-e/-p options and query args if any.+      requestedspan  = dbg1 "requestedspan"  $ queryDateSpan date2_ q+      -- If the requested span is open-ended, close it using the journal's end dates.+      -- This can still be the null (open) span if the journal is empty.+      requestedspan' = dbg1 "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan date2_ j+      -- The list of interval spans enclosing the requested span.+      -- This list can be empty if the journal was empty,+      -- or if hledger-ui has added its special date:-tomorrow to the query+      -- and all txns are in the future.+      intervalspans  = dbg1 "intervalspans"  $ splitSpan interval_ requestedspan'+      -- The requested span enlarged to enclose a whole number of intervals.+      -- This can be the null span if there were no intervals.+      reportspan     = dbg1 "reportspan"     $ DateSpan (maybe Nothing spanStart $ headMay intervalspans)+                                                        (maybe Nothing spanEnd   $ lastMay intervalspans)+      mreportstart = spanStart reportspan+      -- The user's query with no depth limit, and expanded to the report span+      -- if there is one (otherwise any date queries are left as-is, which+      -- handles the hledger-ui+future txns case above).+      reportq   = dbg1 "reportq" $ depthless $+        if reportspan == nulldatespan+        then q+        else And [datelessq, reportspandatesq]+          where+            reportspandatesq = dbg1 "reportspandatesq" $ dateqcons reportspan+      -- The date spans to be included as report columns.+      colspans :: [DateSpan] = dbg1 "colspans" $ splitSpan interval_ displayspan+        where+          displayspan+            | empty_    = dbg1 "displayspan (-E)" reportspan                              -- all the requested intervals+            | otherwise = dbg1 "displayspan" $ requestedspan `spanIntersect` matchedspan  -- exclude leading/trailing empty intervals+          matchedspan = dbg1 "matchedspan" $ postingsDateSpan' (whichDateFromOpts ropts) ps++      -- If doing cost valuation, convert amounts to cost.+      j' = journalSelectingAmountFromOpts ropts j++      ----------------------------------------------------------------------+      -- 2. Calculate starting balances, if needed for -H++      -- Balances at report start date, from all earlier postings which otherwise match the query.+      -- These balances are unvalued except maybe converted to cost.+      startbals :: [(AccountName, MixedAmount)] = dbg1 "startbals" $ map (\(a,_,_,b) -> (a,b)) startbalanceitems+        where+          (startbalanceitems,_) = dbg1 "starting balance report" $ balanceReport ropts''{value_=Nothing} startbalq j'+            where+              ropts' | tree_ ropts = ropts{no_elide_=True}+                     | otherwise   = ropts{accountlistmode_=ALFlat}+              ropts'' = ropts'{period_ = precedingperiod}+                where+                  precedingperiod = dateSpanAsPeriod $ spanIntersect (DateSpan Nothing mreportstart) $ periodAsDateSpan period_+              -- q projected back before the report start date.+              -- When there's no report start date, in case there are future txns (the hledger-ui case above),+              -- we use emptydatespan to make sure they aren't counted as starting balance.+              startbalq = dbg1 "startbalq" $ And [datelessq, dateqcons precedingspan]+                where+                  precedingspan = case mreportstart of+                                  Just d  -> DateSpan Nothing (Just d)+                                  Nothing -> emptydatespan+      -- 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.+      startaccts = dbg1 "startaccts" $ map fst startbals+      -- Helpers to look up an account's starting balance.+      startingBalanceFor a = fromMaybe nullmixedamt $ lookup a startbals++      ----------------------------------------------------------------------+      -- 3. Gather postings for each column.++      -- Postings matching the query within the report period.+      ps :: [Posting] =+          dbg1 "ps" $+          journalPostings $+          filterJournalAmounts symq $      -- remove amount parts excluded by cur:+          filterJournalPostings reportq $  -- remove postings not matched by (adjusted) query+          j'++      -- Group postings into their columns, with the column end dates.+      colps :: [([Posting], Maybe Day)] =+          dbg1 "colps"+          [(filter (isPostingInDateSpan' (whichDateFromOpts ropts) s) ps, spanEnd s) | s <- colspans]++      ----------------------------------------------------------------------+      -- 4. Calculate account balance changes in each column.++      -- In each column, gather the accounts that have postings and their change amount.+      acctChangesFromPostings :: [Posting] -> [(ClippedAccountName, MixedAmount)]+      acctChangesFromPostings ps = [(aname a, (if tree_ ropts then aibalance else aebalance) a) | a <- as]+          where+            as = depthLimit $+                 (if tree_ ropts then id else filter ((>0).anumpostings)) $+                 drop 1 $ accountsFromPostings ps+            depthLimit+                | tree_ ropts = filter ((depthq `matchesAccount`).aname) -- exclude deeper balances+                | otherwise   = clipAccountsAndAggregate depth -- aggregate deeper balances at the depth limit+      colacctchanges :: [[(ClippedAccountName, MixedAmount)]] =+          dbg1 "colacctchanges" $ map (acctChangesFromPostings . fst) colps++      ----------------------------------------------------------------------+      -- 5. Gather the account balance changes into a regular matrix including the accounts+      -- from all columns (and with -H, accounts with starting balances), adding zeroes where needed.++      -- All account names that will be displayed, possibly depth-clipped.+      displayaccts :: [ClippedAccountName] =+          dbg1 "displayaccts" $+          (if tree_ ropts then expandAccountNames else id) $+          nub $ map (clipOrEllipsifyAccountName depth) $+          if empty_ || balancetype_ == HistoricalBalance+          then nub $ sort $ startaccts ++ allpostedaccts+          else allpostedaccts+        where+          allpostedaccts :: [AccountName] = dbg1 "allpostedaccts" $ sort $ accountNamesFromPostings ps+      -- Each column's balance changes for each account, adding zeroes where needed.+      colallacctchanges :: [[(ClippedAccountName, MixedAmount)]] =+          dbg1 "colallacctchanges"+          [sortBy (comparing fst) $+           unionBy (\(a,_) (a',_) -> a == a') postedacctchanges zeroes+           | postedacctchanges <- colacctchanges]+          where zeroes = [(a, nullmixedamt) | a <- displayaccts]+      -- Transpose to get each account's balance changes across all columns.+      acctchanges :: [(ClippedAccountName, [MixedAmount])] =+          dbg1 "acctchanges"+          [(a, map snd abs) | abs@((a,_):_) <- transpose colallacctchanges] -- never null, or used when null...++      ----------------------------------------------------------------------+      -- 6. Build the report rows.++      -- One row per account, with account name info, row amounts, row total and row average.+      -- Row amounts are converted to value if that has been requested.+      -- Row total/average are always simply the sum/average of the row amounts.+      multiperiod = interval_ /= NoInterval+      rows :: [MultiBalanceReportRow] =+          dbg1 "rows" $+          [(a, accountLeafName a, accountNameLevel a, valuedrowbals, rowtot, rowavg)+           | (a,changes) <- dbg1 "acctchanges" acctchanges+             -- The row amounts to be displayed: per-period changes,+             -- zero-based cumulative totals, or+             -- starting-balance-based historical balances.+           , let rowbals = dbg1 "rowbals" $ case balancetype_ of+                   PeriodChange      -> changes+                   CumulativeChange  -> drop 1 $ scanl (+) 0                      changes+                   HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes+             -- The row amounts valued according to --value if needed.+           , let val end = maybe id (mixedAmountApplyValuation priceoracle styles end today multiperiod) value_+           , let valuedrowbals = dbg1 "valuedrowbals" $ [val periodlastday amt | (amt,periodlastday) <- zip rowbals lastdays]+             -- The total and average for the row, and their values.+             -- Total for a cumulative/historical report is always zero.+           , let rowtot = if balancetype_==PeriodChange then sum valuedrowbals else 0+           , let rowavg = averageMixedAmounts valuedrowbals+           , empty_ || depth == 0 || any (not . isZeroMixedAmount) valuedrowbals+           ]+        where+          -- Some things needed if doing valuation.+          -- Here's the current intended effect of --value on each part of the report:+          --  -H/--historical starting balances:+          --   cost: summed cost of previous postings+          --   end:  historical starting balances valued at day before report start+          --   date: historical starting balances valued at date+          --  table cells:+          --   cost: summed costs of postings+          --   end:  summed postings, valued at subperiod end+          --   date: summed postings, valued at date+          --  column totals:+          --   cost: summed column amounts+          --   end:  summed column amounts+          --   date: summed column amounts+          --  row totals & averages, grand total & average:+          --   cost: summed/averaged row amounts+          --   end:  summed/averaged row amounts+          --   date: summed/averaged row amounts+          today = fromMaybe (error' "multiBalanceReport: ReportOpts today_ is unset so could not satisfy --value=now") today_  -- XXX shouldn't error if not needed, eg valuation type is AtDate+          -- Market prices, commodity display styles.+          styles = journalCommodityStyles j+          -- The last day of each column subperiod.+          lastdays =+            map ((maybe+                  (error' "multiBalanceReport: expected all spans to have an end date")  -- XXX should not happen+                  (addDays (-1)))+                . spanEnd) colspans++      ----------------------------------------------------------------------+      -- 7. Sort the report rows.++      -- Sort the rows by amount or by account declaration order. This is a bit tricky.+      -- TODO: is it always ok to sort report rows after report has been generated, as a separate step ?+      sortedrows :: [MultiBalanceReportRow] =+        dbg1 "sortedrows" $+        sortrows rows+        where+          sortrows+            | sort_amount_ && accountlistmode_ == ALTree = sortTreeMBRByAmount+            | sort_amount_                               = sortFlatMBRByAmount+            | otherwise                                  = sortMBRByAccountDeclaration+            where+              -- Sort the report rows, representing a tree of accounts, by row total at each level.+              -- Similar to sortMBRByAccountDeclaration/sortAccountNamesByDeclaration.+              sortTreeMBRByAmount rows = sortedrows+                where+                  anamesandrows = [(first6 r, r) | r <- rows]+                  anames = map fst anamesandrows+                  atotals = [(a,tot) | (a,_,_,_,tot,_) <- rows]+                  accounttree = accountTree "root" anames+                  accounttreewithbals = mapAccounts setibalance accounttree+                    where+                      -- should not happen, but it's dangerous; TODO+                      setibalance a = a{aibalance=fromMaybe (error "sortTreeMBRByAmount 1") $ lookup (aname a) atotals}+                  sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive normalbalance_) accounttreewithbals+                  sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree+                  sortedrows = sortAccountItemsLike sortedanames anamesandrows++              -- Sort the report rows, representing a flat account list, by row total.+              sortFlatMBRByAmount = sortBy (maybeflip $ comparing (normaliseMixedAmountSquashPricesForDisplay . fifth6))+                where+                  maybeflip = if normalbalance_ == Just NormallyNegative then id else flip++              -- Sort the report rows by account declaration order then account name.+              sortMBRByAccountDeclaration rows = sortedrows+                where+                  anamesandrows = [(first6 r, r) | r <- rows]+                  anames = map fst anamesandrows+                  sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames+                  sortedrows = sortAccountItemsLike sortedanames anamesandrows++      ----------------------------------------------------------------------+      -- 8. Build the report totals row.++      -- Calculate the column totals. These are always the sum of column amounts.+      highestlevelaccts = [a | a <- displayaccts, not $ any (`elem` displayaccts) $ init $ expandAccountName a]+      colamts           = transpose [bs | (a,_,_,bs,_,_) <- rows, not (tree_ ropts) || a `elem` highestlevelaccts]+      coltotals :: [MixedAmount] =+        dbg1 "coltotals" $ map sum colamts+      -- Calculate the grand total and average. These are always the sum/average+      -- of the column totals.+      [grandtotal,grandaverage] =+        let amts = map ($ map sum colamts)+              [if balancetype_==PeriodChange then sum else const 0+              ,averageMixedAmounts+              ]+        in amts+      -- Totals row.+      totalsrow :: MultiBalanceReportTotals =+        dbg1 "totalsrow" (coltotals, grandtotal, grandaverage)++-- | Given a MultiBalanceReport and its normal balance sign,+-- if it is known to be normally negative, convert it to normally positive.+mbrNormaliseSign :: NormalSign -> MultiBalanceReport -> MultiBalanceReport+mbrNormaliseSign NormallyNegative = mbrNegate+mbrNormaliseSign _ = id++-- | Flip the sign of all amounts in a MultiBalanceReport.+mbrNegate (MultiBalanceReport (colspans, rows, totalsrow)) =+  MultiBalanceReport (colspans, map mbrRowNegate rows, mbrTotalsRowNegate totalsrow)+  where+    mbrRowNegate (acct,shortacct,indent,amts,tot,avg) = (acct,shortacct,indent,map negate amts,-tot,-avg)+    mbrTotalsRowNegate (amts,tot,avg) = (map negate amts,-tot,-avg)++-- | Figure out the overall date span of a multicolumn balance report.+multiBalanceReportSpan :: MultiBalanceReport -> DateSpan+multiBalanceReportSpan (MultiBalanceReport ([], _, _))       = DateSpan Nothing Nothing+multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans)++-- | Generates a simple non-columnar BalanceReport, but using multiBalanceReport,+-- in order to support --historical. Does not support tree-mode boring parent eliding.+-- If the normalbalance_ option is set, it adjusts the sorting and sign of amounts+-- (see ReportOpts and CompoundBalanceCommand).+balanceReportFromMultiBalanceReport :: ReportOpts -> Query -> Journal -> BalanceReport+balanceReportFromMultiBalanceReport opts q j = (rows', total)+  where+    MultiBalanceReport (_, rows, (totals, _, _)) = multiBalanceReport opts q j+    rows' = [(a+             ,if flat_ opts then a else a'   -- BalanceReport expects full account name here with --flat+             ,if tree_ opts then d-1 else 0  -- BalanceReport uses 0-based account depths+             , headDef nullmixedamt amts     -- 0 columns is illegal, should not happen, return zeroes if it does+             ) | (a,a',d, amts, _, _) <- rows]+    total = headDef nullmixedamt totals+++-- common rendering helper, XXX here for now++tableAsText :: ReportOpts -> (a -> String) -> Table String String a -> String+tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell =+  unlines+  . trimborder+  . lines+  . render pretty id id showcell+  . align+  where+    trimborder = drop 1 . init . map (drop 1 . init)+    align (Table l t d) = Table l' t d+      where+        acctswidth = maximum' $ map strWidth (headerContents l)+        l'         = padRightWide acctswidth <$> l++-- tests++tests_MultiBalanceReport = tests "MultiBalanceReport" [+  let+    (opts,journal) `gives` r = do+      let (eitems, etotal) = r+          (MultiBalanceReport (_, aitems, atotal)) = multiBalanceReport opts (queryFromOpts nulldate opts) journal+          showw (acct,acct',indent,lAmt,amt,amt') = (acct, acct', indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt')+      (map showw aitems) `is` (map showw eitems)+      ((\(_, b, _) -> showMixedAmountDebug b) atotal) `is` (showMixedAmountDebug etotal) -- we only check the sum of the totals+    usd0 = usd 0+    amount0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False}+  in+   tests "multiBalanceReport" [+      test "null journal"  $+      (defreportopts, nulljournal) `gives` ([], Mixed [nullamt])++     ,test "with -H on a populated period"  $+      (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives`+       (+        [+         ("assets:bank:checking", "checking", 3, [mamountp' "$1.00"] , Mixed [nullamt], Mixed [amount0 {aquantity=1}])+        ,("income:salary"       ,"salary"   , 2, [mamountp' "$-1.00"], Mixed [nullamt], Mixed [amount0 {aquantity=(-1)}])+        ],+        Mixed [nullamt])++     ,_test "a valid history on an empty period"  $+      (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 [amount0 {aquantity=1}])+        ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])+        ],+        Mixed [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 [amount0 {aquantity=1}])+        ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])+        ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",Mixed [amount0 {aquantity=(-2)}])+        ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}])+        ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}])+        ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])+        ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])+        ],+        Mixed [usd0])+    ]+ ]

@@ -1,355 +0,0 @@-{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, OverloadedStrings #-}-{-|--Multi-column balance reports, used by the balance command.---}--module Hledger.Reports.MultiBalanceReports (-  MultiBalanceReport(..),-  MultiBalanceReportRow,-  multiBalanceReport,-  balanceReportFromMultiBalanceReport,-  mbrNegate,-  mbrNormaliseSign,-  multiBalanceReportSpan,-  tableAsText,--  -- -- * Tests-  tests_MultiBalanceReports-)-where--import Data.List-import Data.Maybe-import Data.Ord-import Data.Time.Calendar-import Safe-import Text.Tabular as T-import Text.Tabular.AsciiWide--import Hledger.Data-import Hledger.Query-import Hledger.Utils -import Hledger.Read (mamountp')-import Hledger.Reports.ReportOptions-import Hledger.Reports.BalanceReport----- | A multi balance report is a balance report with one or more columns. It has:------ 1. a list of each column's period (date span)------ 2. a list of rows, each containing:------   * the full account name------   * the leaf account name------   * the account's depth------   * a list of amounts, one for each column------   * the total of the row's amounts------   * the average of the row's amounts------ 3. the column totals and the overall total and average------ The meaning of the amounts depends on the type of multi balance--- report, of which there are three: periodic, cumulative and historical--- (see 'BalanceType' and "Hledger.Cli.Commands.Balance").-newtype MultiBalanceReport =-  MultiBalanceReport ([DateSpan]-                     ,[MultiBalanceReportRow]-                     ,MultiBalanceReportTotals-                     )-type MultiBalanceReportRow    = (AccountName, AccountName, Int, [MixedAmount], MixedAmount, MixedAmount)-type MultiBalanceReportTotals = ([MixedAmount], MixedAmount, MixedAmount) -- (Totals list, sum of totals, average of totals)--instance Show MultiBalanceReport where-    -- use pshow (pretty-show's ppShow) to break long lists onto multiple lines-    -- we add some bogus extra shows here to help it parse the output-    -- and wrap tuples and lists properly-    show (MultiBalanceReport (spans, items, totals)) =-        "MultiBalanceReport (ignore extra quotes):\n" ++ pshow (show spans, map show items, totals)---- type alias just to remind us which AccountNames might be depth-clipped, below.-type ClippedAccountName = AccountName---- | Generate a multicolumn balance report for the matched accounts,--- showing the change of balance, accumulated balance, or historical balance--- in each of the specified periods. Does not support tree-mode boring parent eliding.--- If the normalbalance_ option is set, it adjusts the sorting and sign of amounts --- (see ReportOpts and CompoundBalanceCommand).-multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport-multiBalanceReport opts q j =-  (if invert_ opts then mbrNegate else id) $ -  MultiBalanceReport (displayspans, sorteditems, totalsrow)-    where-      symq       = dbg1 "symq"   $ filterQuery queryIsSym $ dbg1 "requested q" q-      depthq     = dbg1 "depthq" $ filterQuery queryIsDepth q-      depth      = queryDepth depthq-      depthless  = dbg1 "depthless" . filterQuery (not . queryIsDepth)-      datelessq  = dbg1 "datelessq"  $ filterQuery (not . queryIsDateOrDate2) q-      dateqcons  = if date2_ opts then Date2 else Date-      -- The date span specified by -b/-e/-p options and query args if any.-      requestedspan  = dbg1 "requestedspan"  $ queryDateSpan (date2_ opts) q-      -- If the requested span is open-ended, close it using the journal's end dates.-      -- This can still be the null (open) span if the journal is empty.-      requestedspan' = dbg1 "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan (date2_ opts) j-      -- The list of interval spans enclosing the requested span.-      -- This list can be empty if the journal was empty,-      -- or if hledger-ui has added its special date:-tomorrow to the query-      -- and all txns are in the future.-      intervalspans  = dbg1 "intervalspans"  $ splitSpan (interval_ opts) requestedspan'           -      -- The requested span enlarged to enclose a whole number of intervals.-      -- This can be the null span if there were no intervals. -      reportspan     = dbg1 "reportspan"     $ DateSpan (maybe Nothing spanStart $ headMay intervalspans)-                                                        (maybe Nothing spanEnd   $ lastMay intervalspans)-      -- The user's query with no depth limit, and expanded to the report span-      -- if there is one (otherwise any date queries are left as-is, which-      -- handles the hledger-ui+future txns case above).-      reportq   = dbg1 "reportq" $ depthless $ -        if reportspan == nulldatespan -        then q -        else And [datelessq, reportspandatesq]-          where-            reportspandatesq = dbg1 "reportspandatesq" $ dateqcons reportspan-      -- q projected back before the report start date, to calculate starting balances.-      -- When there's no report start date, in case there are future txns (the hledger-ui case above),-      -- we use emptydatespan to make sure they aren't counted as starting balance.  -      startbalq = dbg1 "startbalq" $ And [datelessq, dateqcons precedingspan]-        where-          precedingspan = case spanStart reportspan of-                            Just d  -> DateSpan Nothing (Just d)-                            Nothing -> emptydatespan -      ps :: [Posting] =-          dbg1 "ps" $-          journalPostings $-          filterJournalAmounts symq $     -- remove amount parts excluded by cur:-          filterJournalPostings reportq $        -- remove postings not matched by (adjusted) query-          journalSelectingAmountFromOpts opts j--      displayspans = dbg1 "displayspans" $ splitSpan (interval_ opts) displayspan-        where-          displayspan-            | empty_ opts = dbg1 "displayspan (-E)" reportspan                                -- all the requested intervals-            | otherwise   = dbg1 "displayspan"      $ requestedspan `spanIntersect` matchedspan -- exclude leading/trailing empty intervals-          matchedspan = dbg1 "matchedspan" $ postingsDateSpan' (whichDateFromOpts opts) ps--      psPerSpan :: [[Posting]] =-          dbg1 "psPerSpan"-          [filter (isPostingInDateSpan' (whichDateFromOpts opts) s) ps | s <- displayspans]--      postedAcctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] =-          dbg1 "postedAcctBalChangesPerSpan" $-          map postingAcctBals psPerSpan-          where-            postingAcctBals :: [Posting] -> [(ClippedAccountName, MixedAmount)]-            postingAcctBals ps = [(aname a, (if tree_ opts then aibalance else aebalance) a) | a <- as]-                where-                  as = depthLimit $-                       (if tree_ opts then id else filter ((>0).anumpostings)) $-                       drop 1 $ accountsFromPostings ps-                  depthLimit-                      | tree_ opts = filter ((depthq `matchesAccount`).aname) -- exclude deeper balances-                      | otherwise  = clipAccountsAndAggregate depth -- aggregate deeper balances at the depth limit--      postedAccts :: [AccountName] = dbg1 "postedAccts" $ sort $ accountNamesFromPostings ps--      -- starting balances and accounts from transactions before the report start date-      startacctbals = dbg1 "startacctbals" $ map (\(a,_,_,b) -> (a,b)) startbalanceitems-          where-            (startbalanceitems,_) = dbg1 "starting balance report" $ balanceReport opts' startbalq j-                                    where-                                      opts' | tree_ opts = opts{no_elide_=True}-                                            | otherwise  = opts{accountlistmode_=ALFlat}-      startingBalanceFor a = fromMaybe nullmixedamt $ lookup a startacctbals-      startAccts = dbg1 "startAccts" $ map fst startacctbals--      displayedAccts :: [ClippedAccountName] =-          dbg1 "displayedAccts" $-          (if tree_ opts then expandAccountNames else id) $-          nub $ map (clipOrEllipsifyAccountName depth) $-          if empty_ opts || (balancetype_ opts) == HistoricalBalance then nub $ sort $ startAccts ++ postedAccts else postedAccts--      acctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] =-          dbg1 "acctBalChangesPerSpan"-          [sortBy (comparing fst) $ unionBy (\(a,_) (a',_) -> a == a') postedacctbals zeroes-           | postedacctbals <- postedAcctBalChangesPerSpan]-          where zeroes = [(a, nullmixedamt) | a <- displayedAccts]--      acctBalChanges :: [(ClippedAccountName, [MixedAmount])] =-          dbg1 "acctBalChanges"-          [(a, map snd abs) | abs@((a,_):_) <- transpose acctBalChangesPerSpan] -- never null, or used when null...--      items :: [MultiBalanceReportRow] =-          dbg1 "items" $-          [(a, accountLeafName a, accountNameLevel a, displayedBals, rowtot, rowavg)-           | (a,changes) <- acctBalChanges-           , let displayedBals = case balancetype_ opts of-                                  HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes-                                  CumulativeChange -> drop 1 $ scanl (+) nullmixedamt changes-                                  _                 -> changes-           , let rowtot = sum displayedBals-           , let rowavg = averageMixedAmounts displayedBals-           , empty_ opts || depth == 0 || any (not . isZeroMixedAmount) displayedBals-           ]--      -- TODO TBD: is it always ok to sort report rows after report has been generated ?-      -- Or does sorting sometimes need to be done as part of the report generation ?  -      sorteditems :: [MultiBalanceReportRow] =-        dbg1 "sorteditems" $-        sortitems items-        where-          sortitems-            | sort_amount_ opts && accountlistmode_ opts == ALTree       = sortTreeMBRByAmount-            | sort_amount_ opts                                          = sortFlatMBRByAmount-            | otherwise                                                  = sortMBRByAccountDeclaration-            where-              -- Sort the report rows, representing a tree of accounts, by row total at each level.-              -- Similar to sortMBRByAccountDeclaration/sortAccountNamesByDeclaration.-              sortTreeMBRByAmount rows = sortedrows-                where-                  anamesandrows = [(first6 r, r) | r <- rows]-                  anames = map fst anamesandrows-                  atotals = [(a,tot) | (a,_,_,_,tot,_) <- rows]-                  accounttree = accountTree "root" anames-                  accounttreewithbals = mapAccounts setibalance accounttree-                    where-                      -- should not happen, but it's dangerous; TODO -                      setibalance a = a{aibalance=fromMaybe (error "sortTreeMBRByAmount 1") $ lookup (aname a) atotals}-                  sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ opts) accounttreewithbals-                  sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree-                  sortedrows = sortAccountItemsLike sortedanames anamesandrows --              -- Sort the report rows, representing a flat account list, by row total. -              sortFlatMBRByAmount = sortBy (maybeflip $ comparing (normaliseMixedAmountSquashPricesForDisplay . fifth6))-                where-                  maybeflip = if normalbalance_ opts == Just NormallyNegative then id else flip--              -- Sort the report rows by account declaration order then account name. -              sortMBRByAccountDeclaration rows = sortedrows-                where -                  anamesandrows = [(first6 r, r) | r <- rows]-                  anames = map fst anamesandrows-                  sortedanames = sortAccountNamesByDeclaration j (tree_ opts) anames-                  sortedrows = sortAccountItemsLike sortedanames anamesandrows --      totals :: [MixedAmount] =-          -- dbg1 "totals" $-          map sum balsbycol-          where-            balsbycol = transpose [bs | (a,_,_,bs,_,_) <- sorteditems, not (tree_ opts) || a `elem` highestlevelaccts]-            highestlevelaccts     =-                dbg1 "highestlevelaccts"-                [a | a <- displayedAccts, not $ any (`elem` displayedAccts) $ init $ expandAccountName a]--      totalsrow :: MultiBalanceReportTotals =-          dbg1 "totalsrow"-          (totals, sum totals, averageMixedAmounts totals)--      dbg1 s = let p = "multiBalanceReport" in Hledger.Utils.dbg1 (p++" "++s)  -- add prefix in this function's debug output-      -- dbg1 = const id  -- exclude this function from debug output---- | Given a MultiBalanceReport and its normal balance sign,--- if it is known to be normally negative, convert it to normally positive.-mbrNormaliseSign :: NormalSign -> MultiBalanceReport -> MultiBalanceReport-mbrNormaliseSign NormallyNegative = mbrNegate-mbrNormaliseSign _ = id---- | Flip the sign of all amounts in a MultiBalanceReport.-mbrNegate (MultiBalanceReport (colspans, rows, totalsrow)) =-  MultiBalanceReport (colspans, map mbrRowNegate rows, mbrTotalsRowNegate totalsrow)-  where-    mbrRowNegate (acct,shortacct,indent,amts,tot,avg) = (acct,shortacct,indent,map negate amts,-tot,-avg)-    mbrTotalsRowNegate (amts,tot,avg) = (map negate amts,-tot,-avg)---- | Figure out the overall date span of a multicolumn balance report.-multiBalanceReportSpan :: MultiBalanceReport -> DateSpan-multiBalanceReportSpan (MultiBalanceReport ([], _, _))       = DateSpan Nothing Nothing-multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans)---- | Generates a simple non-columnar BalanceReport, but using multiBalanceReport, --- in order to support --historical. Does not support tree-mode boring parent eliding. --- If the normalbalance_ option is set, it adjusts the sorting and sign of amounts --- (see ReportOpts and CompoundBalanceCommand).-balanceReportFromMultiBalanceReport :: ReportOpts -> Query -> Journal -> BalanceReport-balanceReportFromMultiBalanceReport opts q j = (rows', total)-  where-    MultiBalanceReport (_, rows, (totals, _, _)) = multiBalanceReport opts q j-    rows' = [(a-             ,if flat_ opts then a else a'   -- BalanceReport expects full account name here with --flat-             ,if tree_ opts then d-1 else 0  -- BalanceReport uses 0-based account depths-             , headDef nullmixedamt amts     -- 0 columns is illegal, should not happen, return zeroes if it does-             ) | (a,a',d, amts, _, _) <- rows]-    total = headDef nullmixedamt totals----- common rendering helper, XXX here for now--tableAsText :: ReportOpts -> (a -> String) -> Table String String a -> String-tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell =-  unlines-  . trimborder-  . lines-  . render pretty id id showcell-  . align-  where-    trimborder = drop 1 . init . map (drop 1 . init)-    align (Table l t d) = Table l' t d-      where-        acctswidth = maximum' $ map strWidth (headerContents l)-        l'         = padRightWide acctswidth <$> l---- tests--tests_MultiBalanceReports = tests "MultiBalanceReports" [-  let-    (opts,journal) `gives` r = do-      let (eitems, etotal) = r-          (MultiBalanceReport (_, aitems, atotal)) = multiBalanceReport opts (queryFromOpts nulldate opts) journal-          showw (acct,acct',indent,lAmt,amt,amt') = (acct, acct', indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt')-      (map showw aitems) `is` (map showw eitems)-      ((\(_, b, _) -> showMixedAmountDebug b) atotal) `is` (showMixedAmountDebug etotal) -- we only check the sum of the totals-    usd0 = usd 0-    amount0 = Amount {acommodity="$", aquantity=0, aprice=NoPrice, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False}-  in -   tests "multiBalanceReport" [-      test "null journal"  $-      (defreportopts, nulljournal) `gives` ([], Mixed [nullamt])-  -     ,test "with -H on a populated period"  $-      (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives`-       (-        [-         ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])-        ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])-        ],-        Mixed [usd0])-  -     ,test "a valid history on an empty period"  $-      (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 [amount0 {aquantity=1}])-        ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])-        ],-        Mixed [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 [amount0 {aquantity=1}])-        ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])-        ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",Mixed [amount0 {aquantity=(-2)}])-        ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}])-        ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}])-        ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])-        ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])-        ],-        Mixed [usd0])-    ]- ]

@@ -1,10 +1,16 @@-{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances, TupleSections, OverloadedStrings #-} {-|  Postings report, used by the register command.  -} +{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+ module Hledger.Reports.PostingsReport (   PostingsReport,   PostingsReportItem,@@ -26,7 +32,7 @@  import Hledger.Data import Hledger.Query-import Hledger.Utils +import Hledger.Utils import Hledger.Reports.ReportOptions  @@ -52,38 +58,89 @@                                         -- the running total/average.                           ) +-- | A summary posting summarises the activity in one account within a report+-- interval. It is kludgily represented by a regular Posting with no description,+-- the interval's start date stored as the posting date, and the interval's end+-- date attached with a tuple.+type SummaryPosting = (Posting, Day)+ -- | Select postings from the journal and add running balance and other -- information to make a postings report. Used by eg hledger's register command. postingsReport :: ReportOpts -> Query -> Journal -> PostingsReport-postingsReport opts q j = (totallabel, items)+postingsReport ropts@ReportOpts{..} q j@Journal{..} =+  (totallabel, items)     where-      reportspan = adjustReportDates opts q j-      whichdate = whichDateFromOpts opts+      reportspan = adjustReportDates ropts q j+      whichdate = whichDateFromOpts ropts       depth = queryDepth q+      styles = journalCommodityStyles j        -- postings to be included in the report, and similarly-matched postings before the report start date-      (precedingps, reportps) = matchedPostingsBeforeAndDuring opts q j reportspan+      (precedingps, reportps) = matchedPostingsBeforeAndDuring ropts q j reportspan -      -- postings or pseudo postings to be displayed-      displayps | interval == NoInterval = map (,Nothing) reportps-                | otherwise              = summarisePostingsByInterval interval whichdate depth showempty reportspan reportps-        where-          interval = interval_ opts -- XXX-          showempty = empty_ opts || average_ opts+      -- We may be converting amounts to value.+      -- Currently this is done as follows (keep synced with hledger_options.m4.md):+      --  register -M --value+      --   cost: value each posting at cost, then summarise ; value -H starting balance at cost+      --   end:  value each summary posting at period end   ; value -H starting balance at day before report start+      --   date: value each summary posting at date         ; value -H starting balance at date+      --  register --value+      --   cost: value each posting at cost                 ; value -H starting balance at cost+      --   end:  value each posting at report end           ; value -H starting balance at day before report start+      --   date: value each posting at date                 ; value -H starting balance at date+      --+      --  In all cases, the running total/average is calculated from the above numbers.+      --  "Day before report start" is a bit arbitrary.+      today =+        fromMaybe (error' "postingsReport: ReportOpts today_ is unset so could not satisfy --value=now")+        today_+      reportperiodlastday =+        fromMaybe (error' "postingsReport: expected a non-empty journal") $ -- XXX shouldn't happen+        reportPeriodOrJournalLastDay ropts j+      multiperiod = interval_ /= NoInterval+      showempty = empty_ || average_+      priceoracle = journalPriceOracle j+      pvalue p end = maybe p (postingApplyValuation priceoracle styles end today multiperiod p) value_ +      -- Postings, or summary postings with their subperiod's end date, to be displayed.+      displayps :: [(Posting, Maybe Day)]+        | multiperiod =+            let summaryps = summarisePostingsByInterval interval_ whichdate depth showempty reportspan reportps+            in [(pvalue p lastday, Just periodend) | (p, periodend) <- summaryps, let lastday = addDays (-1) periodend]+        | otherwise =+            [(pvalue p reportperiodlastday, Nothing) | p <- reportps]+       -- posting report items ready for display-      items = dbg1 "postingsReport items" $ postingsReportItems displayps (nullposting,Nothing) whichdate depth startbal runningcalc startnum+      items = dbg1 "postingsReport items" $ postingsReportItems displayps (nullposting,Nothing) whichdate depth startbalvalued runningcalc startnum         where-          historical = balancetype_ opts == HistoricalBalance+          historical = balancetype_ == HistoricalBalance           precedingsum = sumPostings precedingps           precedingavg | null precedingps = 0                        | otherwise        = divideMixedAmount (fromIntegral $ length precedingps) precedingsum-          startbal | average_ opts = if historical then precedingavg else 0-                   | otherwise     = if historical then precedingsum else 0+          startbal | average_  = if historical then precedingavg else 0+                   | otherwise = if historical then precedingsum else 0+          -- For --value=end/now/DATE, convert the initial running total/average to value.+          startbalvalued = val startbal+            where+              val = maybe id (mixedAmountApplyValuation priceoracle styles daybeforereportstart today multiperiod) value_+                where+                  daybeforereportstart = maybe+                                         (error' "postingsReport: expected a non-empty journal") -- XXX shouldn't happen+                                         (addDays (-1))+                                         $ reportPeriodOrJournalStart ropts j+           startnum = if historical then length precedingps + 1 else 1-          runningcalc | average_ opts = \i avg amt -> divideMixedAmount (fromIntegral i) avg + amt - avg  -- running average-                      | otherwise     = \_ bal amt -> bal + amt                                           -- running total+          runningcalc = registerRunningCalculationFn ropts +-- | Based on the given report options, return a function that does the appropriate+-- running calculation for the register report, ie a running average or running total.+-- This function will take the item number, previous average/total, and new posting amount,+-- 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+ totallabel = "Total"  -- | Adjust report start/end dates to more useful ones based on@@ -121,7 +178,8 @@       dbg1 "ps3" $ map (filterPostingAmount symq) $                            -- remove amount parts which the query's cur: terms would exclude       dbg1 "ps2" $ (if related_ opts then concatMap relatedPostings else id) $ -- with -r, replace each with its sibling postings       dbg1 "ps1" $ filter (beforeandduringq `matchesPosting`) $                -- filter postings by the query, with no start date or depth limit-                  journalPostings $ journalSelectingAmountFromOpts opts j+                  journalPostings $+                  journalSelectingAmountFromOpts opts j    -- maybe convert to cost early, will be seen by amt:. XXX what about converting to value ?       where         beforeandduringq = dbg1 "beforeandduringq" $ And [depthless $ dateless q, beforeendq]           where@@ -136,9 +194,6 @@       where         dateq = dbg1 "dateq" $ filterQuery queryIsDateOrDate2 $ dbg1 "q" q  -- XXX confused by multiple date:/date2: ? -negatePostingAmount :: Posting -> Posting-negatePostingAmount p = p { pamount = negate $ pamount p }- -- | Generate postings report line items from a list of postings or (with -- non-Nothing dates attached) summary postings. postingsReportItems :: [(Posting,Maybe Day)] -> (Posting,Maybe Day) -> WhichDate -> Int -> MixedAmount -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) -> Int -> [PostingsReportItem]@@ -172,21 +227,16 @@  -- | Convert a list of postings into summary postings, one per interval, -- aggregated to the specified depth if any.+-- Each summary posting will have a non-Nothing interval end date. summarisePostingsByInterval :: Interval -> WhichDate -> Int -> Bool -> DateSpan -> [Posting] -> [SummaryPosting] summarisePostingsByInterval interval wd depth showempty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan     where       summarisespan s = summarisePostingsInDateSpan s wd depth showempty (postingsinspan s)       postingsinspan s = filter (isPostingInDateSpan' wd s) ps --- | A summary posting summarises the activity in one account within a report--- interval. It is currently kludgily represented by a regular Posting with no--- description, the interval's start date stored as the posting date, and the--- interval's end date attached with a tuple.-type SummaryPosting = (Posting, Maybe Day)- -- | Given a date span (representing a report interval) and a list of -- postings within it, aggregate the postings into one summary posting per--- account.+-- account. Each summary posting will have a non-Nothing interval end date. -- -- When a depth argument is present, postings to accounts of greater -- depth are also aggregated where possible. If the depth is 0, all@@ -199,7 +249,7 @@ summarisePostingsInDateSpan :: DateSpan -> WhichDate -> Int -> Bool -> [Posting] -> [SummaryPosting] summarisePostingsInDateSpan (DateSpan b e) wd depth showempty ps     | null ps && (isNothing b || isNothing e) = []-    | null ps && showempty = [(summaryp, Just e')]+    | null ps && showempty = [(summaryp, e')]     | otherwise = summarypes     where       postingdate = if wd == PrimaryDate then postingDate else postingDate2@@ -210,7 +260,7 @@                     | otherwise = ["..."]       summaryps | depth > 0 = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames]                 | otherwise = [summaryp{paccount="...",pamount=sum $ map pamount ps}]-      summarypes = map (, Just e') $ (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps+      summarypes = map (, e') $ (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps       anames = sort $ nub $ map paccount ps       -- aggregate balances by account, like ledgerFromJournal, then do depth-clipping       accts = accountsFromPostings ps@@ -219,6 +269,10 @@           bal = if isclipped a then aibalance else aebalance           isclipped a = accountNameLevel a >= depth +negatePostingAmount :: Posting -> Posting+negatePostingAmount p = p { pamount = negate $ pamount p }++ -- tests  tests_PostingsReport = tests "PostingsReport" [@@ -233,13 +287,13 @@      ,(Depth 2, samplejournal) `gives` 13      ,(And [Depth 1, StatusQ Cleared, Acct "expenses"], samplejournal) `gives` 2      ,(And [And [Depth 1, StatusQ Cleared], Acct "expenses"], samplejournal) `gives` 2-  +      -- with query and/or command-line options      ,(length $ snd $ postingsReport defreportopts Any samplejournal) `is` 13      ,(length $ snd $ postingsReport defreportopts{interval_=Months 1} Any samplejournal) `is` 11      ,(length $ snd $ postingsReport defreportopts{interval_=Months 1, empty_=True} Any samplejournal) `is` 20      ,(length $ snd $ postingsReport defreportopts (Acct "assets:bank:checking") samplejournal) `is` 5-  +      -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0      -- [(Just (parsedate "2008-01-01","income"),assets:bank:checking             $1,$1)      -- ,(Nothing,income:salary                   $-1,0)@@ -251,7 +305,7 @@      -- ,(Nothing,expenses:supplies                $1,$2)      -- ,(Nothing,assets:cash                     $-2,0)      -- ,(Just (2008-12-31,"pay off"),liabilities:debts                $1,$1)-     -- ,(Nothing,assets:bank:checking            $-1,0)    +     -- ,(Nothing,assets:bank:checking            $-1,0)      {-         let opts = defreportopts@@ -268,7 +322,7 @@          ,"2008/12/31 pay off              liabilities:debts                $1           $1"          ,"                                assets:bank:checking            $-1            0"          ]-    +       ,"postings report with cleared option" ~:        do         let opts = defreportopts{cleared_=True}@@ -280,7 +334,7 @@          ,"2008/12/31 pay off              liabilities:debts                $1           $1"          ,"                                assets:bank:checking            $-1            0"          ]-    +       ,"postings report with uncleared option" ~:        do         let opts = defreportopts{uncleared_=True}@@ -293,7 +347,7 @@          ,"2008/06/02 save                 assets:bank:saving               $1           $1"          ,"                                assets:bank:checking            $-1            0"          ]-    +       ,"postings report sorts by date" ~:        do         j <- readJournal' $ unlines@@ -307,7 +361,7 @@             ]         let opts = defreportopts         registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/02/02"]-    +       ,"postings report with account pattern" ~:        do         j <- samplejournal@@ -315,7 +369,7 @@         (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines          ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"          ]-    +       ,"postings report with account pattern, case insensitive" ~:        do         j <- samplejournal@@ -323,7 +377,7 @@         (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines          ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"          ]-    +       ,"postings report with display expression" ~:        do         j <- samplejournal@@ -335,7 +389,7 @@         "d=[2008/6/2]"  `gives` ["2008/06/02"]         "d>=[2008/6/2]" `gives` ["2008/06/02","2008/06/03","2008/12/31"]         "d>[2008/6/2]"  `gives` ["2008/06/03","2008/12/31"]-    +       ,"postings report with period expression" ~:        do         j <- samplejournal@@ -363,9 +417,9 @@         registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/10/01"]         let opts = defreportopts{period_=maybePeriod date1 "quarterly",empty_=True}         registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]-    +       ]-    +       , "postings report with depth arg" ~:        do         j <- samplejournal@@ -383,7 +437,7 @@          ,"2008/12/31 pay off              liabilities:debts                $1           $1"          ,"                                assets:bank                     $-1            0"          ]-    +     -}     ] @@ -392,7 +446,7 @@       summarisePostingsByInterval (Quarters 1) PrimaryDate 99999 False (DateSpan Nothing Nothing) [] `is` []       ]    ]-  +   -- ,tests_summarisePostingsInDateSpan = [     --  "summarisePostingsInDateSpan" ~: do     --   let gives (b,e,depth,showempty,ps) =@@ -428,5 +482,5 @@     --    [     --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [usd 15]}     --    ]-  +  ]

@@ -10,6 +10,7 @@   ReportOpts(..),   BalanceType(..),   AccountListMode(..),+  ValuationType(..),   FormatStr,   defreportopts,   rawOptsToReportOpts,@@ -32,6 +33,11 @@   specifiedStartEndDates,   specifiedStartDate,   specifiedEndDate,+  reportPeriodStart,+  reportPeriodOrJournalStart,+  reportPeriodLastDay,+  reportPeriodOrJournalLastDay,+  valuationTypeIsCost,    tests_ReportOptions )@@ -75,22 +81,27 @@ -- | Standard options for customising report filtering and output. -- Most of these correspond to standard hledger command-line options -- or query arguments, but not all. Some are used only by certain--- commands, as noted below. +-- commands, as noted below. data ReportOpts = ReportOpts {-     period_         :: Period+     today_          :: Maybe Day  -- ^ The current date. A late addition to ReportOpts.+                                   -- Optional, but when set it may affect some reports:+                                   -- Reports use it when picking a -V valuation date.+                                   -- This is not great, adds indeterminacy.+    ,period_         :: Period     ,interval_       :: Interval     ,statuses_       :: [Status]  -- ^ Zero, one, or two statuses to be matched-    ,cost_           :: Bool+    ,value_          :: Maybe ValuationType  -- ^ What value should amounts be converted to ?     ,depth_          :: Maybe Int-    ,display_        :: Maybe DisplayExp+    ,display_        :: Maybe DisplayExp  -- XXX unused ?     ,date2_          :: Bool     ,empty_          :: Bool     ,no_elide_       :: Bool     ,real_           :: Bool     ,format_         :: Maybe FormatStr     ,query_          :: String -- all arguments, as a string-    -- register command only+    --     ,average_        :: Bool+    -- register command only     ,related_        :: Bool     -- balance-type commands only     ,balancetype_    :: BalanceType@@ -98,7 +109,6 @@     ,drop_           :: Int     ,row_total_      :: Bool     ,no_total_       :: Bool-    ,value_          :: Bool     ,pretty_tables_  :: Bool     ,sort_amount_    :: Bool     ,invert_         :: Bool  -- ^ if true, flip all amount signs in reports@@ -106,10 +116,10 @@       -- ^ This can be set when running balance reports on a set of accounts       --   with the same normal balance type (eg all assets, or all incomes).       -- - It helps --sort-amount know how to sort negative numbers-      --   (eg in the income section of an income statement) -      -- - It helps compound balance report commands (is, bs etc.) do  -      --   sign normalisation, converting normally negative subreports to -      --   normally positive for a more conventional display.   +      --   (eg in the income section of an income statement)+      -- - It helps compound balance report commands (is, bs etc.) do+      --   sign normalisation, converting normally negative subreports to+      --   normally positive for a more conventional display.     ,color_          :: Bool     ,forecast_       :: Bool     ,transpose_      :: Bool@@ -153,10 +163,11 @@   d <- getCurrentDay   color <- hSupportsANSI stdout   return defreportopts{-     period_      = periodFromRawOpts d rawopts'+     today_       = Just d+    ,period_      = periodFromRawOpts d rawopts'     ,interval_    = intervalFromRawOpts rawopts'     ,statuses_    = statusesFromRawOpts rawopts'-    ,cost_        = boolopt "cost" rawopts'+    ,value_       = valuationTypeFromRawOpts rawopts'     ,depth_       = maybeintopt "depth" rawopts'     ,display_     = maybedisplayopt d rawopts'     ,date2_       = boolopt "date2" rawopts'@@ -172,7 +183,6 @@     ,drop_        = intopt "drop" rawopts'     ,row_total_   = boolopt "row-total" rawopts'     ,no_total_    = boolopt "no-total" rawopts'-    ,value_       = boolopt "value" rawopts'     ,sort_amount_ = boolopt "sort-amount" rawopts'     ,invert_      = boolopt "invert" rawopts'     ,pretty_tables_ = boolopt "pretty-tables" rawopts'@@ -218,23 +228,26 @@     ("cumulative":_) -> CumulativeChange     _                -> PeriodChange --- Get the period specified by the intersection of -b/--begin, -e/--end and/or--- -p/--period options, using the given date to interpret relative date expressions.+-- Get the period specified by any -b/--begin, -e/--end and/or -p/--period+-- options appearing in the command line.+-- Its bounds are the rightmost begin date specified by a -b or -p, and+-- the rightmost end date specified by a -e or -p. Cf #1011.+-- Today's date is provided to help interpret any relative dates. periodFromRawOpts :: Day -> RawOpts -> Period periodFromRawOpts d rawopts =-  case (mearliestb, mlateste) of+  case (mlastb, mlaste) of     (Nothing, Nothing) -> PeriodAll     (Just b, Nothing)  -> PeriodFrom b     (Nothing, Just e)  -> PeriodTo e     (Just b, Just e)   -> simplifyPeriod $                           PeriodBetween b e   where-    mearliestb = case beginDatesFromRawOpts d rawopts of+    mlastb = case beginDatesFromRawOpts d rawopts of                    [] -> Nothing-                   bs -> Just $ minimum bs-    mlateste   = case endDatesFromRawOpts d rawopts of+                   bs -> Just $ last bs+    mlaste = case endDatesFromRawOpts d rawopts of                    [] -> Nothing-                   es -> Just $ maximum es+                   es -> Just $ last es  -- Get all begin dates specified by -b/--begin or -p/--period options, in order, -- using the given date to interpret relative date expressions.@@ -274,13 +287,18 @@  -- | Get the report interval, if any, specified by the last of -p/--period, -- -D/--daily, -W/--weekly, -M/--monthly etc. options.+-- An interval from --period counts only if it is explicitly defined. intervalFromRawOpts :: RawOpts -> Interval intervalFromRawOpts = lastDef NoInterval . catMaybes . map intervalfromrawopt   where     intervalfromrawopt (n,v)       | n == "period" =-          either (\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e) (Just . fst) $-          parsePeriodExpr nulldate (stripquotes $ T.pack v) -- reference date does not affect the interval+          either+            (\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e)+            extractIntervalOrNothing $+            parsePeriodExpr+              (error' "intervalFromRawOpts: did not expect to need today's date here") -- should not happen; we are just getting the interval, which does not use the reference date+              (stripquotes $ T.pack v)       | n == "daily"     = Just $ Days 1       | n == "weekly"    = Just $ Weeks 1       | n == "monthly"   = Just $ Months 1@@ -288,6 +306,12 @@       | n == "yearly"    = Just $ Years 1       | otherwise = Nothing +-- | Extract the interval from the parsed -p/--period expression.+-- Return Nothing if an interval is not explicitly defined.+extractIntervalOrNothing :: (Interval, DateSpan) -> Maybe Interval+extractIntervalOrNothing (NoInterval, _) = Nothing+extractIntervalOrNothing (interval, _) = Just interval+ -- | Get any statuses to be matched, as specified by -U/--unmarked, -- -P/--pending, -C/--cleared flags. -UPC is equivalent to no flags, -- so this returns a list of 0-2 unique statuses.@@ -306,7 +330,7 @@   | length l' >= numstatuses = []   | otherwise                = l'   where-    l' = nub $ sort l +    l' = nub $ sort l     numstatuses = length [minBound .. maxBound :: Status]  -- | Add/remove this status from the status list. Used by hledger-ui.@@ -314,6 +338,39 @@   | s `elem` ss = ropts{statuses_=filter (/= s) ss}   | otherwise   = ropts{statuses_=simplifyStatuses (s:ss)} +-- | Parse the type of valuation to be performed, if any, specified by+-- -B/--cost, -V, -X/--exchange, or --value flags. If there's more+-- than one of these, the rightmost flag wins.+valuationTypeFromRawOpts :: RawOpts -> Maybe ValuationType+valuationTypeFromRawOpts = lastDef Nothing . filter isJust . map valuationfromrawopt+  where+    valuationfromrawopt (n,v)  -- option name, value+      | n == "B"     = Just $ AtCost Nothing+      | n == "V"     = Just $ AtDefault Nothing+      | n == "X"     = Just $ AtDefault (Just $ T.pack v)+      | n == "value" = Just $ valuation v+      | otherwise    = Nothing+    valuation v+      | t `elem` ["cost","c"] = AtCost mc+      | t `elem` ["end" ,"e"] = AtEnd  mc+      | t `elem` ["now" ,"n"] = AtNow  mc+      | otherwise =+          case parsedateM t of+            Just d  -> AtDate d mc+            Nothing -> usageError $ "could not parse \""++t++"\" as valuation type, should be: cost|end|now|c|e|n|YYYY-MM-DD"+      where+        -- parse --value's value: TYPE[,COMM]+        (t,c') = break (==',') v+        mc     = case drop 1 c' of+                   "" -> Nothing+                   c  -> Just $ T.pack c++valuationTypeIsCost :: ReportOpts -> Bool+valuationTypeIsCost ropts =+  case value_ ropts of+    Just (AtCost _) -> True+    _               -> False+ type DisplayExp = String  maybedisplayopt :: Day -> RawOpts -> Maybe DisplayExp@@ -345,12 +402,14 @@ -- depthFromOpts :: ReportOpts -> Int -- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts) --- | Convert this journal's postings' amounts to the cost basis amounts if--- specified by options.+-- | Convert this journal's postings' amounts to cost using their+-- transaction prices, if specified by options (-B/--value=cost).+-- Maybe soon superseded by newer valuation code. journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal-journalSelectingAmountFromOpts opts-    | cost_ opts = journalConvertAmountsToCost-    | otherwise = id+journalSelectingAmountFromOpts opts =+  case value_ opts of+    Just (AtCost _) -> journalConvertAmountsToCost+    _               -> id  -- | Convert report options and arguments to a query. queryFromOpts :: Day -> ReportOpts -> Query@@ -382,8 +441,10 @@     flagsqopts = []     argsqopts = snd $ parseQuery d (T.pack query_) +-- Report dates.+ -- | The effective report span is the start and end dates specified by--- options or queries, or otherwise the earliest and latest transaction or +-- 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. -- Needs IO to parse smart dates in options/queries.@@ -421,6 +482,47 @@ specifiedEndDate :: ReportOpts -> IO (Maybe Day) specifiedEndDate ropts = snd <$> specifiedStartEndDates ropts +-- Some pure alternatives to the above. XXX review/clean up++-- Get the report's start date.+-- If no report period is specified, will be Nothing.+-- Will also be Nothing if ReportOpts does not have today_ set,+-- since we need that to get the report period robustly+-- (unlike reportStartDate, which looks up the date with IO.)+reportPeriodStart :: ReportOpts -> Maybe Day+reportPeriodStart ropts@ReportOpts{..} = do+  t <- today_+  queryStartDate False $ queryFromOpts t ropts++-- Get the report's start date, or if no report period is specified,+-- the journal's start date (the earliest posting date). If there's no+-- report period and nothing in the journal, will be Nothing.+reportPeriodOrJournalStart :: ReportOpts -> Journal -> Maybe Day+reportPeriodOrJournalStart ropts@ReportOpts{..} j =+  reportPeriodStart ropts <|> journalStartDate False j++-- Get the last day of the overall report period.+-- This the inclusive end date (one day before the+-- more commonly used, exclusive, report end date).+-- If no report period is specified, will be Nothing.+-- Will also be Nothing if ReportOpts does not have today_ set,+-- since we need that to get the report period robustly+-- (unlike reportEndDate, which looks up the date with IO.)+reportPeriodLastDay :: ReportOpts -> Maybe Day+reportPeriodLastDay ropts@ReportOpts{..} = do+  t <- today_+  let q = queryFromOpts t ropts+  qend <- queryEndDate False q+  return $ addDays (-1) qend++-- Get the last day of the overall report period, or if no report+-- period is specified, the last day of the journal (ie the latest+-- posting date). If there's no report period and nothing in the+-- journal, will be Nothing.+reportPeriodOrJournalLastDay :: ReportOpts -> Journal -> Maybe Day+reportPeriodOrJournalLastDay ropts@ReportOpts{..} j =+  reportPeriodLastDay ropts <|> journalEndDate False j+ -- tests  tests_ReportOptions = tests "ReportOptions" [@@ -428,7 +530,7 @@       (queryFromOpts nulldate defreportopts) `is` Any      ,(queryFromOpts nulldate defreportopts{query_="a"}) `is` (Acct "a")      ,(queryFromOpts nulldate defreportopts{query_="desc:'a a'"}) `is` (Desc "a a")-     ,(queryFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01"),query_="date:'to 2013'" }) +     ,(queryFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01"),query_="date:'to 2013'" })       `is` (Date $ mkdatespan "2012/01/01" "2013/01/01")      ,(queryFromOpts nulldate defreportopts{query_="date2:'in 2012'"}) `is` (Date2 $ mkdatespan "2012/01/01" "2013/01/01")      ,(queryFromOpts nulldate defreportopts{query_="'a a' 'b"}) `is` (Or [Acct "a a", Acct "'b"])

@@ -33,7 +33,7 @@ type PeriodicReportRow a =   ( AccountName  -- A full account name.   , AccountName  -- Shortened form of the account name to display in tree mode. Usually the leaf name, possibly with parent accounts prefixed.-  , Int          -- Indent level for displaying this account name in tree mode. 0, 1, 2... +  , Int          -- Indent level for displaying this account name in tree mode. 0, 1, 2...   , [a]          -- The data value for each subperiod.   , a            -- The total of this row's values.   , a            -- The average of this row's values.

@@ -0,0 +1,112 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable, FlexibleInstances #-}+{-|++A transactions report. Like an EntriesReport, but with more+information such as a running balance.++-}++module Hledger.Reports.TransactionsReport (+  TransactionsReport,+  TransactionsReportItem,+  transactionsReport,+  transactionsReportByCommodity,+  triOrigTransaction,+  triDate,+  triAmount,+  triBalance,+  triCommodityAmount,+  triCommodityBalance,+  tests_TransactionsReport+)+where++import Data.List+import Data.Ord++import Hledger.Data+import Hledger.Query+import Hledger.Reports.ReportOptions+import Hledger.Reports.AccountTransactionsReport+import Hledger.Utils+++-- | A transactions report includes a list of transactions touching multiple accounts+-- (posting-filtered and unfiltered variants), a running balance, and some+-- other information helpful for rendering a register view (a flag+-- indicating multiple other accounts and a display string describing+-- them) with or without a notion of current account(s).+-- Two kinds of report use this data structure, see transactionsReport+-- and accountTransactionsReport below for details.+type TransactionsReport = (String                   -- label for the balance column, eg "balance" or "total"+                          ,[TransactionsReportItem] -- line items, one per transaction+                          )+type TransactionsReportItem = (Transaction -- the original journal transaction, unmodified+                              ,Transaction -- the transaction as seen from a particular account, with postings maybe filtered+                              ,Bool        -- is this a split, ie more than one other account posting+                              ,String      -- a display string describing the other account(s), if any+                              ,MixedAmount -- the amount posted to the current account(s) by the filtered postings (or total amount posted)+                              ,MixedAmount -- the running total of item amounts, starting from zero;+                                           -- or with --historical, the running total including items+                                           -- (matched by the report query) preceding the report period+                              )++triOrigTransaction (torig,_,_,_,_,_) = torig+triDate (_,tacct,_,_,_,_) = tdate tacct+triAmount (_,_,_,_,a,_) = a+triBalance (_,_,_,_,_,a) = a+triCommodityAmount c = filterMixedAmountByCommodity c  . triAmount+triCommodityBalance c = filterMixedAmountByCommodity c  . triBalance++totallabel   = "Period Total"++-- | Select transactions from the whole journal. This is similar to a+-- "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 = (totallabel, 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++-- | Split a transactions report whose items may involve several commodities,+-- into one or more single-commodity transactions reports.+transactionsReportByCommodity :: TransactionsReport -> [(CommoditySymbol, TransactionsReport)]+transactionsReportByCommodity tr =+  [(c, filterTransactionsReportByCommodity c tr) | c <- transactionsReportCommodities tr]+  where+    transactionsReportCommodities (_,items) =+      nub $ sort $ map acommodity $ concatMap (amounts . triAmount) items++-- Remove transaction report items and item amount (and running+-- balance amount) components that don't involve the specified+-- commodity. Other item fields such as the transaction are left unchanged.+filterTransactionsReportByCommodity :: CommoditySymbol -> TransactionsReport -> TransactionsReport+filterTransactionsReportByCommodity c (label,items) =+  (label, fixTransactionsReportItemBalances $ concat [filterTransactionsReportItemByCommodity c i | i <- items])+  where+    filterTransactionsReportItemByCommodity c (t,t2,s,o,a,bal)+      | c `elem` cs = [item']+      | otherwise   = []+      where+        cs = map acommodity $ amounts a+        item' = (t,t2,s,o,a',bal)+        a' = filterMixedAmountByCommodity c a++    fixTransactionsReportItemBalances [] = []+    fixTransactionsReportItemBalances [i] = [i]+    fixTransactionsReportItemBalances items = reverse $ i:(go startbal is)+      where+        i:is = reverse items+        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++-- tests++tests_TransactionsReport = tests "TransactionsReport" [+ ]

@@ -1,282 +0,0 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable, FlexibleInstances #-}-{-|--Here are several variants of a transactions report.-Transactions reports are like a postings report, but more-transaction-oriented, and (in the account-centric variant) relative to-a some base account.  They are used by hledger-web.---}--module Hledger.Reports.TransactionsReports (-  TransactionsReport,-  TransactionsReportItem,-  AccountTransactionsReport,-  AccountTransactionsReportItem,-  triOrigTransaction,-  triDate,-  triAmount,-  triBalance,-  triCommodityAmount,-  triCommodityBalance,-  journalTransactionsReport,-  accountTransactionsReport,-  transactionsReportByCommodity,-  transactionRegisterDate,-  tests_TransactionsReports-)-where--import Data.List-import Data.Ord--- import Data.Text (Text)-import qualified Data.Text as T-import Data.Time.Calendar--import Hledger.Data-import Hledger.Query-import Hledger.Reports.ReportOptions-import Hledger.Utils----- | A transactions report includes a list of transactions--- (posting-filtered and unfiltered variants), a running balance, and some--- other information helpful for rendering a register view (a flag--- indicating multiple other accounts and a display string describing--- them) with or without a notion of current account(s).--- Two kinds of report use this data structure, see journalTransactionsReport--- and accountTransactionsReport below for details.-type TransactionsReport = (String                   -- label for the balance column, eg "balance" or "total"-                          ,[TransactionsReportItem] -- line items, one per transaction-                          )-type TransactionsReportItem = (Transaction -- the original journal transaction, unmodified-                              ,Transaction -- the transaction as seen from a particular account, with postings maybe filtered-                              ,Bool        -- is this a split, ie more than one other account posting-                              ,String      -- a display string describing the other account(s), if any-                              ,MixedAmount -- the amount posted to the current account(s) by the filtered postings (or total amount posted)-                              ,MixedAmount -- the running total of item amounts, starting from zero;-                                           -- or with --historical, the running total including items-                                           -- (matched by the report query) preceding the report period-                              )--triOrigTransaction (torig,_,_,_,_,_) = torig-triDate (_,tacct,_,_,_,_) = tdate tacct-triAmount (_,_,_,_,a,_) = a-triBalance (_,_,_,_,_,a) = a-triCommodityAmount c = filterMixedAmountByCommodity c  . triAmount-triCommodityBalance c = filterMixedAmountByCommodity c  . triBalance------------------------------------------------------------------------------------- | Select transactions from the whole journal. This is similar to a--- "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.-journalTransactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport-journalTransactionsReport opts j q = (totallabel, 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------------------------------------------------------------------------------------- | An account transactions report represents transactions affecting--- a particular account (or possibly several accounts, but we don't--- use that). It is used eg by hledger-ui's and hledger-web's account--- register view, where we want to show one row per transaction, in--- the context of the current account. Report items consist of:------ - the transaction, unmodified------ - the transaction as seen in the context of the current account and query,---   which means:------   - the transaction date is set to the "transaction context date",---     which can be different from the transaction's general date:---     if postings to the current account (and matched by the report query)---     have their own dates, it's the earliest of these dates.------   - the transaction's postings are filtered, excluding any which are not---     matched by the report query------ - a text description of the other account(s) posted to/from------ - a flag indicating whether there's more than one other account involved------ - the total increase/decrease to the current account------ - the report transactions' running total after this transaction;---   or if historical balance is requested (-H), the historical running total.---   The historical running total includes transactions from before the---   report start date if one is specified, filtered by the report query.---   The historical running total may or may not be the account's historical---   running balance, depending on the report query.------ Items are sorted by transaction register date (the earliest date the transaction--- posts to the current account), most recent first.--- Reporting intervals are currently ignored.----type AccountTransactionsReport =-  (String                          -- label for the balance column, eg "balance" or "total"-  ,[AccountTransactionsReportItem] -- line items, one per transaction-  )--type AccountTransactionsReportItem =-  (-   Transaction -- the transaction, unmodified-  ,Transaction -- the transaction, as seen from the current account-  ,Bool        -- is this a split (more than one posting to other accounts) ?-  ,String      -- a display string describing the other account(s), if any-  ,MixedAmount -- the amount posted to the current account(s) (or total amount posted)-  ,MixedAmount -- the register's running total or the current account(s)'s historical balance, after this transaction-  )--accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> AccountTransactionsReport-accountTransactionsReport opts j reportq thisacctq = (label, items)-  where-    -- a depth limit does not affect the account transactions report-    -- seems unnecessary for some reason XXX-    reportq' = -- filterQuery (not . queryIsDepth)-               reportq-    -- get all transactions, with amounts converted to cost basis if -B-    ts1 = jtxns $ journalSelectingAmountFromOpts opts j-    -- apply any cur:SYM filters in reportq'-    symq  = filterQuery queryIsSym reportq'-    ts2 = (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 = filter (matchesTransaction thisacctq . filterTransactionPostings (And [realq, statusq])) ts2-    -- sort by the transaction's register date, for accurate starting balance-    ts = sortBy (comparing (transactionRegisterDate reportq' thisacctq)) ts3--    (startbal,label)-      | balancetype_ opts == HistoricalBalance = (sumPostings priorps, balancelabel)-      | otherwise                              = (nullmixedamt,        totallabel)-      where-        priorps = dbg1 "priorps" $-                  filter (matchesPosting-                          (dbg1 "priorq" $-                           And [thisacctq, tostartdateq, datelessreportq]))-                         $ transactionsPostings ts-        tostartdateq =-          case mstartdate of-            Just _  -> Date (DateSpan Nothing mstartdate)-            Nothing -> None  -- no start date specified, there are no prior postings-        mstartdate = queryStartDate (date2_ opts) reportq'-        datelessreportq = filterQuery (not . queryIsDateOrDate2) reportq'--    items = reverse $ -- see also registerChartHtml-            accountTransactionsReportItems reportq' thisacctq startbal negate ts--totallabel = "Period Total"-balancelabel = "Historical Total"---- | Generate transactions report items from a list of transactions,--- using the provided user-specified report query, a query specifying--- which account to use as the focus, a starting balance, a sign-setting--- function and a balance-summing function. Or with a None current account--- query, this can also be used for the journalTransactionsReport.-accountTransactionsReportItems :: Query -> Query -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [TransactionsReportItem]-accountTransactionsReportItems _ _ _ _ [] = []-accountTransactionsReportItems reportq thisacctq bal signfn (torig:ts) =-    case i of Just i' -> i':is-              Nothing -> is-    -- 201403: This is used for both accountTransactionsReport and journalTransactionsReport, which makes it a bit overcomplicated-    -- 201407: I've lost my grip on this, let's just hope for the best-    -- 201606: we now calculate change and balance from filtered postings, check this still works well for all callers XXX-    where-      tfiltered@Transaction{tpostings=reportps} = filterTransactionPostings reportq torig-      tacct = tfiltered{tdate=transactionRegisterDate reportq thisacctq tfiltered}-      (i,bal') = case reportps of-           [] -> (Nothing,bal)  -- no matched postings in this transaction, skip it-           _  -> (Just (torig, tacct, numotheraccts > 1, otheracctstr, a, b), b)-                 where-                  (thisacctps, otheracctps) = partition (matchesPosting thisacctq) reportps-                  numotheraccts = length $ nub $ map paccount otheracctps-                  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-      is = accountTransactionsReportItems reportq thisacctq bal' signfn ts---- | 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 ?--- It's normally the transaction's general date, but if any posting(s)--- matched by the report query and affecting the matched account(s) have--- their own earlier dates, it's the earliest of these dates.--- Secondary transaction/posting dates are ignored.-transactionRegisterDate :: Query -> Query -> Transaction -> Day-transactionRegisterDate reportq thisacctq t-  | null thisacctps = tdate t-  | otherwise       = minimum $ map postingDate thisacctps-  where-    reportps   = tpostings $ filterTransactionPostings reportq t-    thisacctps = filter (matchesPosting thisacctq) reportps---- -- | Generate a short readable summary of some postings, like--- -- "from (negatives) to (positives)".--- summarisePostings :: [Posting] -> String--- summarisePostings ps =---     case (summarisePostingAccounts froms, summarisePostingAccounts tos) of---        ("",t) -> "to "++t---        (f,"") -> "from "++f---        (f,t)  -> "from "++f++" to "++t---     where---       (froms,tos) = partition (fromMaybe False . isNegativeMixedAmount . pamount) ps---- | Generate a simplified summary of some postings' accounts.--- To reduce noise, if there are both real and virtual postings, show only the real ones.-summarisePostingAccounts :: [Posting] -> String-summarisePostingAccounts ps =-  (intercalate ", " . map (T.unpack . accountSummarisedName) . nub . map paccount) displayps -- XXX pack-  where-    realps = filter isReal ps-    displayps | null realps = ps-              | otherwise   = realps------------------------------------------------------------------------------------- | Split a transactions report whose items may involve several commodities,--- into one or more single-commodity transactions reports.-transactionsReportByCommodity :: TransactionsReport -> [(CommoditySymbol, TransactionsReport)]-transactionsReportByCommodity tr =-  [(c, filterTransactionsReportByCommodity c tr) | c <- transactionsReportCommodities tr]-  where-    transactionsReportCommodities (_,items) =-      nub $ sort $ map acommodity $ concatMap (amounts . triAmount) items---- Remove transaction report items and item amount (and running--- balance amount) components that don't involve the specified--- commodity. Other item fields such as the transaction are left unchanged.-filterTransactionsReportByCommodity :: CommoditySymbol -> TransactionsReport -> TransactionsReport-filterTransactionsReportByCommodity c (label,items) =-  (label, fixTransactionsReportItemBalances $ concat [filterTransactionsReportItemByCommodity c i | i <- items])-  where-    filterTransactionsReportItemByCommodity c (t,t2,s,o,a,bal)-      | c `elem` cs = [item']-      | otherwise   = []-      where-        cs = map acommodity $ amounts a-        item' = (t,t2,s,o,a',bal)-        a' = filterMixedAmountByCommodity c a--    fixTransactionsReportItemBalances [] = []-    fixTransactionsReportItemBalances [i] = [i]-    fixTransactionsReportItemBalances items = reverse $ i:(go startbal is)-      where-        i:is = reverse items-        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------------------------------------------------------------------------------------- tests--tests_TransactionsReports = tests "TransactionsReports" [- ]

@@ -93,6 +93,27 @@ fifth6  (_,_,_,_,x,_) = x sixth6  (_,_,_,_,_,x) = x +-- currying+++curry2 :: ((a, b) -> c) -> a -> b -> c+curry2 f x y = f (x, y)++uncurry2 :: (a -> b -> c) -> (a, b) -> c+uncurry2 f (x, y) = f x y++curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d+curry3 f x y z = f (x, y, z)++uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d+uncurry3 f (x, y, z) = f x y z++curry4 :: ((a, b, c, d) -> e) -> a -> b -> c -> d -> e+curry4 f w x y z = f (w, x, y, z)++uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e+uncurry4 f (w, x, y, z) = f w x y z+ -- lists  splitAtElement :: Eq a => a -> [a] -> [[a]]@@ -161,14 +182,14 @@     [] -> Nothing     (md:_) -> md --- | Read text from a file, +-- | Read text from a file, -- handling any of the usual line ending conventions, -- using the system locale's text encoding,--- ignoring any utf8 BOM prefix (as seen in paypal's 2018 CSV, eg) if that encoding is utf8. +-- ignoring any utf8 BOM prefix (as seen in paypal's 2018 CSV, eg) if that encoding is utf8. readFilePortably :: FilePath -> IO Text readFilePortably f =  openFile f ReadMode >>= readHandlePortably --- | Like readFilePortably, but read from standard input if the path is "-". +-- | Like readFilePortably, but read from standard input if the path is "-". readFileOrStdinPortably :: String -> IO Text readFileOrStdinPortably f = openFileOrStdin f ReadMode >>= readHandlePortably   where@@ -236,7 +257,7 @@ -- hereFileRelative f = makeRelativeToProject f >>= hereFileExp --   where --     QuasiQuoter{quoteExp=hereFileExp} = hereFile-    + tests_Utils = tests "Utils" [   tests_Text   ]

@@ -2,7 +2,7 @@  {-# LANGUAGE OverloadedStrings #-} -module Hledger.Utils.Color +module Hledger.Utils.Color (   color,   bgColor,

@@ -14,8 +14,8 @@   ,traceWith   ,debugLevel   ,ptraceAt+  ,ptraceAtWith   ,dbg0-  ,dbgExit   ,dbg1   ,dbg2   ,dbg3@@ -25,6 +25,17 @@   ,dbg7   ,dbg8   ,dbg9+  ,dbg0With+  ,dbg1With+  ,dbg2With+  ,dbg3With+  ,dbg4With+  ,dbg5With+  ,dbg6With+  ,dbg7With+  ,dbg8With+  ,dbg9With+  ,dbgExit   ,ptraceAtIO   ,dbg0IO   ,dbg1IO@@ -83,7 +94,7 @@ -- touch and reload this module to see the effect of a new --debug option. -- After command-line processing, it is also available as the @debug_@ -- field of 'Hledger.Cli.CliOptions.CliOpts'.--- {-# OPTIONS_GHC -fno-cse #-} +-- {-# OPTIONS_GHC -fno-cse #-} -- {-# NOINLINE debugLevel #-} debugLevel :: Int debugLevel = case snd $ break (=="--debug") args of@@ -111,16 +122,25 @@                                   | otherwise     = ls                           in trace (s++":"++nlorspace++intercalate "\n" ls') a --- | Pretty-print a message and the showable value to the console, then return it.+-- | Like ptraceAt, but takes a custom show function instead of a label.+ptraceAtWith :: Show a => Int -> (a -> String) -> a -> a+ptraceAtWith level f+    | level > 0 && debugLevel < level = id+    | otherwise = \a -> let p = f a+                            -- ls = lines p+                            -- nlorspace | length ls > 1 = "\n"+                            --           | otherwise     = " " ++ take (10 - length s) (repeat ' ')+                            -- ls' | length ls > 1 = map (" "++) ls+                            --     | otherwise     = ls+                        -- in trace (s++":"++nlorspace++intercalate "\n" ls') a+                        in trace p a++-- "dbg" would clash with megaparsec.+-- | Pretty-print a label and the showable value to the console, then return it. dbg0 :: Show a => String -> a -> a dbg0 = ptraceAt 0--- "dbg" would clash with megaparsec --- | Like dbg0, but also exit the program. Uses unsafePerformIO.-dbgExit :: Show a => String -> a -> a-dbgExit msg = const (unsafePerformIO exitFailure) . dbg0 msg---- | Pretty-print a message and the showable value to the console when the global debug level is >= 1, then return it.+-- | Pretty-print a label and the showable value to the console when the global debug level is >= 1, then return it. -- Uses unsafePerformIO. dbg1 :: Show a => String -> a -> a dbg1 = ptraceAt 1@@ -149,6 +169,41 @@ dbg9 :: Show a => String -> a -> a dbg9 = ptraceAt 9 +-- | Like dbg0, but takes a custom show function instead of a label.+dbg0With :: Show a => (a -> String) -> a -> a+dbg0With = ptraceAtWith 0++dbg1With :: Show a => (a -> String) -> a -> a+dbg1With = ptraceAtWith 1++dbg2With :: Show a => (a -> String) -> a -> a+dbg2With = ptraceAtWith 2++dbg3With :: Show a => (a -> String) -> a -> a+dbg3With = ptraceAtWith 3++dbg4With :: Show a => (a -> String) -> a -> a+dbg4With = ptraceAtWith 4++dbg5With :: Show a => (a -> String) -> a -> a+dbg5With = ptraceAtWith 5++dbg6With :: Show a => (a -> String) -> a -> a+dbg6With = ptraceAtWith 6++dbg7With :: Show a => (a -> String) -> a -> a+dbg7With = ptraceAtWith 7++dbg8With :: Show a => (a -> String) -> a -> a+dbg8With = ptraceAtWith 8++dbg9With :: Show a => (a -> String) -> a -> a+dbg9With = ptraceAtWith 9++-- | Like dbg0, but also exit the program. Uses unsafePerformIO.+dbgExit :: Show a => String -> a -> a+dbgExit msg = const (unsafePerformIO exitFailure) . dbg0 msg+ -- | Like ptraceAt, but convenient to insert in an IO monad (plus -- convenience aliases). -- XXX These have a bug; they should use@@ -191,12 +246,12 @@ dbg9IO :: (MonadIO m, Show a) => String -> a -> m () dbg9IO = ptraceAtIO 9 --- | Log a message and a pretty-printed showable value to ./debug.log, then return it.+-- | 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 message and a pretty-printed showable value to ./debug.log, +-- | 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, at least when built with -threaded@@ -204,7 +259,7 @@ plogAt :: Show a => Int -> String -> a -> a plogAt lvl     | lvl > 0 && debugLevel < lvl = flip const-    | otherwise = \s a -> +    | otherwise = \s a ->         let p = ppShow a             ls = lines p             nlorspace | length ls > 1 = "\n"

@@ -322,9 +322,9 @@ -- see also http://unicode.org/reports/tr11/#Description  -- | Calculate the render width of a string, considering--- wide characters (counted as double width), ANSI escape codes +-- wide characters (counted as double width), ANSI escape codes -- (not counted), and line breaks (in a multi-line string, the longest--- line determines the width). +-- line determines the width). strWidth :: String -> Int strWidth "" = 0 strWidth s = maximum $ map (foldr (\a b -> charWidth a + b) 0) $ lines s'

@@ -24,7 +24,7 @@   ,expectParseEqOn   ,expectParseEqOnE   ,expectParseStateOn-) +) where  import Control.Exception@@ -36,7 +36,7 @@ import Data.CallStack import Data.List import qualified Data.Text as T-import Safe +import Safe import System.Exit import Text.Megaparsec import Text.Megaparsec.Custom@@ -50,38 +50,38 @@ -- * easytest helpers  -- | Name the given test(s). A readability synonym for easytest's "scope".-test :: T.Text -> E.Test a -> E.Test a +test :: T.Text -> E.Test a -> E.Test a test = E.scope  -- | Skip the given test(s), with the same type signature as "test". -- If called in a monadic sequence of tests, also skips following tests.-_test :: T.Text -> E.Test a -> E.Test a -_test _name = (E.skip >>) +_test :: T.Text -> E.Test a -> E.Test a+_test _name = (E.skip >>)  -- | Name the given test(s). A synonym for "test".-it :: T.Text -> E.Test a -> E.Test a +it :: T.Text -> E.Test a -> E.Test a it = test --- | Skip the given test(s), and any following tests in a monadic sequence. +-- | Skip the given test(s), and any following tests in a monadic sequence. -- A synonym for "_test".-_it :: T.Text -> E.Test a -> E.Test a +_it :: T.Text -> E.Test a -> E.Test a _it = _test  -- | Name and group a list of tests. Combines easytest's "scope" and "tests".-tests :: T.Text -> [E.Test ()] -> E.Test () +tests :: T.Text -> [E.Test ()] -> E.Test () tests name = E.scope name . E.tests  -- | Skip the given list of tests, and any following tests in a monadic sequence, -- with the same type signature as "group".-_tests :: T.Text -> [E.Test ()] -> E.Test () +_tests :: T.Text -> [E.Test ()] -> E.Test () _tests _name = (E.skip >>) . E.tests  -- | Run some easytest tests, catching easytest's ExitCode exception, -- returning True if there was a problem. -- With arguments, runs only the scope (or single test) named by the first argument--- (exact, case sensitive). +-- (exact, case sensitive). -- If there is a second argument, it should be an integer and will be used--- as the seed for randomness. +-- as the seed for randomness. runEasytests :: [String] -> E.Test () -> IO Bool runEasytests args tests = (do   case args of@@ -96,7 +96,7 @@   `catch` (\(_::ExitCode) -> return True)  -- | Like easytest's expectEq (asserts the second (actual) value equals the first (expected) value)--- but pretty-prints the values in the failure output. +-- but pretty-prints the values in the failure output. expectEqPP :: (Eq a, Show a, HasCallStack) => a -> a -> E.Test () expectEqPP expected actual = if expected == actual then E.ok else E.crash $   "\nexpected:\n" <> T.pack (pshow expected) <> "\nbut got:\n" <> T.pack (pshow actual) <> "\n"@@ -105,10 +105,10 @@ is :: (Eq a, Show a, HasCallStack) => a -> a -> Test () is = flip expectEqPP --- | Test that this stateful parser runnable in IO successfully parses --- all of the given input text, showing the parse error if it fails. +-- | Test that this stateful parser runnable in IO successfully parses+-- all of the given input text, showing the parse error if it fails. -- Suitable for hledger's JournalParser parsers.-expectParse :: (Monoid st, Eq a, Show a, HasCallStack) => +expectParse :: (Monoid st, Eq a, Show a, HasCallStack) =>   StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> E.Test () expectParse parser input = do   ep <- E.io (runParserT (evalStateT (parser <* eof) mempty) "" input)@@ -135,9 +135,9 @@              (const ok)              ep --- | Test that this stateful parser runnable in IO fails to parse --- the given input text, with a parse error containing the given string. -expectParseError :: (Monoid st, Eq a, Show a, HasCallStack) => +-- | Test that this stateful parser runnable in IO fails to parse+-- the given input text, with a parse error containing the given string.+expectParseError :: (Monoid st, Eq a, Show a, HasCallStack) =>   StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> String -> E.Test () expectParseError parser input errstr = do   ep <- E.io (runParserT (evalStateT parser mempty) "" input)@@ -173,8 +173,8 @@         else fail $ "\nparse error is not as expected:\n" ++ e' ++ "\n"  -- | Like expectParse, but also test the parse result is an expected value,--- pretty-printing both if it fails. -expectParseEq :: (Monoid st, Eq a, Show a, HasCallStack) => +-- pretty-printing both if it fails.+expectParseEq :: (Monoid st, Eq a, Show a, HasCallStack) =>   StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> E.Test () expectParseEq parser input expected = expectParseEqOn parser input id expected @@ -186,9 +186,9 @@   -> E.Test () expectParseEqE parser input expected = expectParseEqOnE parser input id expected --- | Like expectParseEq, but transform the parse result with the given function +-- | Like expectParseEq, but transform the parse result with the given function -- before comparing it.-expectParseEqOn :: (Monoid st, Eq b, Show b, HasCallStack) => +expectParseEqOn :: (Monoid st, Eq b, Show b, HasCallStack) =>   StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> E.Test () expectParseEqOn parser input f expected = do   ep <- E.io $ runParserT (evalStateT (parser <* eof) mempty) "" input

@@ -30,7 +30,7 @@   textstrip,   textlstrip,   textrstrip,- -- chomp,+  textchomp,  -- elideLeft,   textElideRight,  -- formatString,@@ -90,9 +90,9 @@ textrstrip = T.reverse . textlstrip . T.reverse textrstrip :: Text -> Text --- -- | Remove trailing newlines/carriage returns.--- chomp :: String -> String--- chomp = reverse . dropWhile (`elem` "\r\n") . reverse+-- | Remove trailing newlines/carriage returns (and other whitespace).+textchomp :: Text -> Text+textchomp = T.stripEnd  -- stripbrackets :: String -> String -- stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse :: String -> String@@ -423,11 +423,11 @@ tests_Text = tests "Text" [    tests "quoteIfSpaced" [      quoteIfSpaced "a'a" `is` "a'a"-    ,quoteIfSpaced "a\"a" `is` "a\"a"              -    ,quoteIfSpaced "a a" `is` "\"a a\""               -    ,quoteIfSpaced "mimi's cafe" `is` "\"mimi's cafe\""       -    ,quoteIfSpaced "\"alex\" cafe" `is` "\"\\\"alex\\\" cafe\""     -    ,quoteIfSpaced "le'shan's cafe" `is` "\"le'shan's cafe\""    -    ,quoteIfSpaced "\"be'any's\" cafe" `is` "\"\\\"be'any's\\\" cafe\"" -    ] +    ,quoteIfSpaced "a\"a" `is` "a\"a"+    ,quoteIfSpaced "a a" `is` "\"a a\""+    ,quoteIfSpaced "mimi's cafe" `is` "\"mimi's cafe\""+    ,quoteIfSpaced "\"alex\" cafe" `is` "\"\\\"alex\\\" cafe\""+    ,quoteIfSpaced "le'shan's cafe" `is` "\"le'shan's cafe\""+    ,quoteIfSpaced "\"be'any's\" cafe" `is` "\"\\\"be'any's\\\" cafe\""+    ]   ]

@@ -16,7 +16,7 @@ Not carefully tested.  -}--- TODO obsolete ? +-- TODO obsolete ?  module Hledger.Utils.UTF8IOCompat (   readFile,@@ -119,5 +119,5 @@  -- | A SystemString-aware version of error that adds a usage hint. usageError :: String -> a-usageError = error' . (++ " (use -h to see usage)")  +usageError = error' . (++ " (use -h to see usage)") 

@@ -230,7 +230,7 @@     -- (since only one custom error should be used at a time).     findCustomError :: ParseError Text CustomErr -> Maybe CustomErr     findCustomError err = case err of-      FancyError _ errSet -> +      FancyError _ errSet ->         finds (\case {ErrorCustom e -> Just e; _ -> Nothing}) errSet       _ -> Nothing 

@@ -98,7 +98,7 @@   coreLine        = concatMap helper $ flattenHeader $ zipHeader 0 is h   helper          = either vsep dashes   dashes (i,_)    = replicate i sep-  vsep NoLine     = replicate 2 sep  -- match the double space sep in renderColumns +  vsep NoLine     = replicate 2 sep  -- match the double space sep in renderColumns   vsep SingleLine = sep : cross pretty : [sep]   vsep DoubleLine = sep : cross' ++ [sep]   cross' = case prop of

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.1.+-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack ----- hash: 4d6b36fe7c3d7cbcff001ad72b5f9030c0fdf2caf573b30e46dddbc0045a7066+-- hash: 29b6dee7771d38c64240d2b8c53c8e41ed43c08e8fe2e93cbd6c531edc2a4ecd  name:           hledger-lib-version:        1.14.1+version:        1.15 synopsis:       Core data types, parsers and functionality for the hledger accounting tools description:    This is a reusable library containing hledger's core functionality.                 .@@ -25,7 +25,7 @@ maintainer:     Simon Michael <simon@joyful.com> license:        GPL-3 license-file:   LICENSE-tested-with:    GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.3+tested-with:    GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.5 build-type:     Simple extra-source-files:     CHANGES.md@@ -58,7 +58,6 @@       Hledger.Data.Dates       Hledger.Data.Journal       Hledger.Data.Ledger-      Hledger.Data.MarketPrice       Hledger.Data.Period       Hledger.Data.PeriodicTransaction       Hledger.Data.StringFormat@@ -68,6 +67,7 @@       Hledger.Data.Transaction       Hledger.Data.TransactionModifier       Hledger.Data.Types+      Hledger.Data.Valuation       Hledger.Query       Hledger.Read       Hledger.Read.Common@@ -78,13 +78,13 @@       Hledger.Reports       Hledger.Reports.ReportOptions       Hledger.Reports.ReportTypes-      Hledger.Reports.BalanceHistoryReport+      Hledger.Reports.AccountTransactionsReport       Hledger.Reports.BalanceReport       Hledger.Reports.BudgetReport       Hledger.Reports.EntriesReport-      Hledger.Reports.MultiBalanceReports+      Hledger.Reports.MultiBalanceReport       Hledger.Reports.PostingsReport-      Hledger.Reports.TransactionsReports+      Hledger.Reports.TransactionsReport       Hledger.Utils       Hledger.Utils.Color       Hledger.Utils.Debug@@ -120,7 +120,8 @@     , deepseq     , directory     , easytest >=0.2.1 && <0.3-    , extra+    , extra >=1.6.3+    , fgl >=5.5.4.0     , file-embed >=0.0.10     , filepath     , hashtables >=1.2.3.1@@ -138,6 +139,7 @@     , template-haskell     , text >=1.2     , time >=1.5+    , timeit     , transformers >=0.2     , uglymemo     , utf8-string >=0.3.5@@ -159,7 +161,6 @@       Hledger.Data.Dates       Hledger.Data.Journal       Hledger.Data.Ledger-      Hledger.Data.MarketPrice       Hledger.Data.Period       Hledger.Data.PeriodicTransaction       Hledger.Data.Posting@@ -169,6 +170,7 @@       Hledger.Data.Transaction       Hledger.Data.TransactionModifier       Hledger.Data.Types+      Hledger.Data.Valuation       Hledger.Query       Hledger.Read       Hledger.Read.Common@@ -177,15 +179,15 @@       Hledger.Read.TimeclockReader       Hledger.Read.TimedotReader       Hledger.Reports-      Hledger.Reports.BalanceHistoryReport+      Hledger.Reports.AccountTransactionsReport       Hledger.Reports.BalanceReport       Hledger.Reports.BudgetReport       Hledger.Reports.EntriesReport-      Hledger.Reports.MultiBalanceReports+      Hledger.Reports.MultiBalanceReport       Hledger.Reports.PostingsReport       Hledger.Reports.ReportOptions       Hledger.Reports.ReportTypes-      Hledger.Reports.TransactionsReports+      Hledger.Reports.TransactionsReport       Hledger.Utils       Hledger.Utils.Color       Hledger.Utils.Debug@@ -222,7 +224,8 @@     , directory     , doctest >=0.16     , easytest >=0.2.1 && <0.3-    , extra+    , extra >=1.6.3+    , fgl >=5.5.4.0     , file-embed >=0.0.10     , filepath     , hashtables >=1.2.3.1@@ -240,12 +243,15 @@     , template-haskell     , text >=1.2     , time >=1.5+    , timeit     , transformers >=0.2     , uglymemo     , utf8-string >=0.3.5   if (!impl(ghc >= 8.0))     build-depends:         semigroups ==0.18.*+  if (impl(ghc < 8.2))+    buildable: False   default-language: Haskell2010  test-suite easytests@@ -261,7 +267,6 @@       Hledger.Data.Dates       Hledger.Data.Journal       Hledger.Data.Ledger-      Hledger.Data.MarketPrice       Hledger.Data.Period       Hledger.Data.PeriodicTransaction       Hledger.Data.Posting@@ -271,6 +276,7 @@       Hledger.Data.Transaction       Hledger.Data.TransactionModifier       Hledger.Data.Types+      Hledger.Data.Valuation       Hledger.Query       Hledger.Read       Hledger.Read.Common@@ -279,15 +285,15 @@       Hledger.Read.TimeclockReader       Hledger.Read.TimedotReader       Hledger.Reports-      Hledger.Reports.BalanceHistoryReport+      Hledger.Reports.AccountTransactionsReport       Hledger.Reports.BalanceReport       Hledger.Reports.BudgetReport       Hledger.Reports.EntriesReport-      Hledger.Reports.MultiBalanceReports+      Hledger.Reports.MultiBalanceReport       Hledger.Reports.PostingsReport       Hledger.Reports.ReportOptions       Hledger.Reports.ReportTypes-      Hledger.Reports.TransactionsReports+      Hledger.Reports.TransactionsReport       Hledger.Utils       Hledger.Utils.Color       Hledger.Utils.Debug@@ -323,7 +329,8 @@     , deepseq     , directory     , easytest >=0.2.1 && <0.3-    , extra+    , extra >=1.6.3+    , fgl >=5.5.4.0     , file-embed >=0.0.10     , filepath     , hashtables >=1.2.3.1@@ -342,6 +349,7 @@     , template-haskell     , text >=1.2     , time >=1.5+    , timeit     , transformers >=0.2     , uglymemo     , utf8-string >=0.3.5

@@ -1,17 +1,17 @@ -.TH "hledger_csv" "5" "March 2019" "hledger 1.14" "hledger User Manuals"+.TH "hledger_csv" "5" "August 2019" "hledger 1.15" "hledger User Manuals"    .SH NAME .PP-CSV \- how hledger reads CSV data, and the CSV rules file format+CSV - how hledger reads CSV data, and the CSV rules file format .SH DESCRIPTION .PP-hledger can read CSV (comma\-separated value) files as if they were+hledger can read CSV (comma-separated value) files as if they were journal files, automatically converting each CSV record into a transaction.-(To learn about \f[I]writing\f[] CSV, see CSV output.)+(To learn about \f[I]writing\f[R] CSV, see CSV output.) .PP Converting CSV to transactions requires some special conversion rules. These do several things:@@ -24,58 +24,57 @@ they can add refinements based on patterns in the CSV data, eg categorizing transactions with more detailed account names. .PP-When reading a CSV file named \f[C]FILE.csv\f[], hledger looks for a-conversion rules file named \f[C]FILE.csv.rules\f[] in the same+When reading a CSV file named \f[C]FILE.csv\f[R], hledger looks for a+conversion rules file named \f[C]FILE.csv.rules\f[R] in the same directory.-You can override this with the \f[C]\-\-rules\-file\f[] option.-If the rules file does not exist, hledger will auto\-create one with-some example rules, which you\[aq]ll need to adjust.+You can override this with the \f[C]--rules-file\f[R] option.+If the rules file does not exist, hledger will auto-create one with some+example rules, which you\[aq]ll need to adjust. .PP-At minimum, the rules file must identify the \f[C]date\f[] and-\f[C]amount\f[] fields.-It may also be necessary to specify the date format, and the number of-header lines to skip.+At minimum, the rules file must identify the date and amount fields.+It\[aq]s often necessary to specify the date format, and the number of+header lines to skip, also. Eg: .IP .nf \f[C]-fields\ date,\ _,\ _,\ amount-date\-format\ \ %d/%m/%Y-skip\ 1-\f[]+fields date, _, _, amount+date-format  %d/%m/%Y+skip 1+\f[R] .fi .PP A more complete example: .IP .nf \f[C]-#\ hledger\ CSV\ rules\ for\ amazon.com\ order\ history+# hledger CSV rules for amazon.com order history -#\ sample:-#\ "Date","Type","To/From","Name","Status","Amount","Fees","Transaction\ ID"-#\ "Jul\ 29,\ 2012","Payment","To","Adapteva,\ Inc.","Completed","$25.00","$0.00","17LA58JSK6PRD4HDGLNJQPI1PB9N8DKPVHL"+# sample:+# \[dq]Date\[dq],\[dq]Type\[dq],\[dq]To/From\[dq],\[dq]Name\[dq],\[dq]Status\[dq],\[dq]Amount\[dq],\[dq]Fees\[dq],\[dq]Transaction ID\[dq]+# \[dq]Jul 29, 2012\[dq],\[dq]Payment\[dq],\[dq]To\[dq],\[dq]Adapteva, Inc.\[dq],\[dq]Completed\[dq],\[dq]$25.00\[dq],\[dq]$0.00\[dq],\[dq]17LA58JSK6PRD4HDGLNJQPI1PB9N8DKPVHL\[dq] -#\ skip\ one\ header\ line-skip\ 1+# skip one header line+skip 1 -#\ name\ the\ csv\ fields\ (and\ assign\ the\ transaction\[aq]s\ date,\ amount\ and\ code)-fields\ date,\ _,\ toorfrom,\ name,\ amzstatus,\ amount,\ fees,\ code+# name the csv fields (and assign the transaction\[aq]s date, amount and code)+fields date, _, toorfrom, name, amzstatus, amount, fees, code -#\ how\ to\ parse\ the\ date-date\-format\ %b\ %\-d,\ %Y+# how to parse the date+date-format %b %-d, %Y -#\ combine\ two\ fields\ to\ make\ the\ description-description\ %toorfrom\ %name+# combine two fields to make the description+description %toorfrom %name -#\ save\ these\ fields\ as\ tags-comment\ \ \ \ \ status:%amzstatus,\ fees:%fees+# save these fields as tags+comment     status:%amzstatus, fees:%fees -#\ set\ the\ base\ account\ for\ all\ transactions-account1\ \ \ \ assets:amazon+# set the base account for all transactions+account1    assets:amazon -#\ flip\ the\ sign\ on\ the\ amount-amount\ \ \ \ \ \ \-%amount-\f[]+# flip the sign on the amount+amount      -%amount+\f[R] .fi .PP For more examples, see Convert CSV files.@@ -83,11 +82,11 @@ .PP The following seven kinds of rule can appear in the rules file, in any order.-Blank lines and lines beginning with \f[C]#\f[] or \f[C];\f[] are+Blank lines and lines beginning with \f[C]#\f[R] or \f[C];\f[R] are ignored. .SS skip .PP-\f[C]skip\f[]\f[I]\f[CI]N\f[I]\f[]+\f[C]skip\f[R]\f[I]\f[CI]N\f[I]\f[R] .PP Skip this number of CSV records at the beginning. You\[aq]ll need this whenever your CSV data contains header lines.@@ -95,122 +94,126 @@ .IP .nf \f[C]-#\ ignore\ the\ first\ CSV\ line-skip\ 1-\f[]+# ignore the first CSV line+skip 1+\f[R] .fi-.SS date\-format+.SS date-format .PP-\f[C]date\-format\f[]\f[I]\f[CI]DATEFMT\f[I]\f[]+\f[C]date-format\f[R]\f[I]\f[CI]DATEFMT\f[I]\f[R] .PP-When your CSV date fields are not formatted like \f[C]YYYY/MM/DD\f[] (or-\f[C]YYYY\-MM\-DD\f[] or \f[C]YYYY.MM.DD\f[]), you\[aq]ll need to+When your CSV date fields are not formatted like \f[C]YYYY/MM/DD\f[R]+(or \f[C]YYYY-MM-DD\f[R] or \f[C]YYYY.MM.DD\f[R]), you\[aq]ll need to specify the format.-DATEFMT is a strptime\-like date parsing pattern, which must parse the+DATEFMT is a strptime-like date parsing pattern, which must parse the date field values completely. Examples: .IP .nf \f[C]-#\ for\ dates\ like\ "11/06/2013":-date\-format\ %m/%d/%Y-\f[]+# for dates like \[dq]11/06/2013\[dq]:+date-format %m/%d/%Y+\f[R] .fi .IP .nf \f[C]-#\ for\ dates\ like\ "6/11/2013"\ (note\ the\ \-\ to\ make\ leading\ zeros\ optional):-date\-format\ %\-d/%\-m/%Y-\f[]+# for dates like \[dq]6/11/2013\[dq] (note the - to make leading zeros optional):+date-format %-d/%-m/%Y+\f[R] .fi .IP .nf \f[C]-#\ for\ dates\ like\ "2013\-Nov\-06":-date\-format\ %Y\-%h\-%d-\f[]+# for dates like \[dq]2013-Nov-06\[dq]:+date-format %Y-%h-%d+\f[R] .fi .IP .nf \f[C]-#\ for\ dates\ like\ "11/6/2013\ 11:32\ PM":-date\-format\ %\-m/%\-d/%Y\ %l:%M\ %p-\f[]+# for dates like \[dq]11/6/2013 11:32 PM\[dq]:+date-format %-m/%-d/%Y %l:%M %p+\f[R] .fi .SS field list .PP-\f[C]fields\f[]\f[I]\f[CI]FIELDNAME1\f[I]\f[],-\f[I]\f[CI]FIELDNAME2\f[I]\f[]...+\f[C]fields\f[R]\f[I]\f[CI]FIELDNAME1\f[I]\f[R],+\f[I]\f[CI]FIELDNAME2\f[I]\f[R]... .PP This (a) names the CSV fields, in order (names may not contain whitespace; uninteresting names may be left blank), and (b) assigns them to journal entry fields if you use any of these standard field names:-\f[C]date\f[], \f[C]date2\f[], \f[C]status\f[], \f[C]code\f[],-\f[C]description\f[], \f[C]comment\f[], \f[C]account1\f[],-\f[C]account2\f[], \f[C]amount\f[], \f[C]amount\-in\f[],-\f[C]amount\-out\f[], \f[C]currency\f[], \f[C]balance\f[].+\f[C]date\f[R], \f[C]date2\f[R], \f[C]status\f[R], \f[C]code\f[R],+\f[C]description\f[R], \f[C]comment\f[R], \f[C]account1\f[R],+\f[C]account2\f[R], \f[C]amount\f[R], \f[C]amount-in\f[R],+\f[C]amount-out\f[R], \f[C]currency\f[R], \f[C]balance\f[R],+\f[C]balance1\f[R], \f[C]balance2\f[R]. Eg: .IP .nf \f[C]-#\ use\ the\ 1st,\ 2nd\ and\ 4th\ CSV\ fields\ as\ the\ entry\[aq]s\ date,\ description\ and\ amount,-#\ and\ give\ the\ 7th\ and\ 8th\ fields\ meaningful\ names\ for\ later\ reference:+# use the 1st, 2nd and 4th CSV fields as the entry\[aq]s date, description and amount,+# and give the 7th and 8th fields meaningful names for later reference: #-#\ CSV\ field:-#\ \ \ \ \ \ 1\ \ \ \ \ 2\ \ \ \ \ \ \ \ \ \ \ \ 3\ 4\ \ \ \ \ \ \ 5\ 6\ 7\ \ \ \ \ \ \ \ \ \ 8-#\ entry\ field:-fields\ date,\ description,\ ,\ amount,\ ,\ ,\ somefield,\ anotherfield-\f[]+# CSV field:+#      1     2            3 4       5 6 7          8+# entry field:+fields date, description, , amount, , , somefield, anotherfield+\f[R] .fi .SS field assignment .PP-\f[I]\f[CI]ENTRYFIELDNAME\f[I]\f[] \f[I]\f[CI]FIELDVALUE\f[I]\f[]+\f[I]\f[CI]ENTRYFIELDNAME\f[I]\f[R] \f[I]\f[CI]FIELDVALUE\f[I]\f[R] .PP This sets a journal entry field (one of the standard names above) to the given text value, which can include CSV field values interpolated by-name (\f[C]%CSVFIELDNAME\f[]) or 1\-based position (\f[C]%N\f[]).- Eg:+name (\f[C]%CSVFIELDNAME\f[R]) or 1-based position (\f[C]%N\f[R]).+Eg: .IP .nf \f[C]-#\ set\ the\ amount\ to\ the\ 4th\ CSV\ field\ with\ "USD\ "\ prepended-amount\ USD\ %4-\f[]+# set the amount to the 4th CSV field with \[dq]USD \[dq] prepended+amount USD %4+\f[R] .fi .IP .nf \f[C]-#\ combine\ three\ fields\ to\ make\ a\ comment\ (containing\ two\ tags)-comment\ note:\ %somefield\ \-\ %anotherfield,\ date:\ %1-\f[]+# combine three fields to make a comment (containing two tags)+comment note: %somefield - %anotherfield, date: %1+\f[R] .fi .PP Field assignments can be used instead of or in addition to a field list.+.PP+Note, interpolation strips any outer whitespace, so a CSV value like+\f[C]\[dq] 1 \[dq]\f[R] becomes \f[C]1\f[R] when interpolated (#1051). .SS conditional block .PP-\f[C]if\f[] \f[I]\f[CI]PATTERN\f[I]\f[]+\f[C]if\f[R] \f[I]\f[CI]PATTERN\f[I]\f[R] .PD 0 .P .PD-\ \ \ \ \f[I]\f[CI]FIELDASSIGNMENTS\f[I]\f[]...+\ \ \ \ \f[I]\f[CI]FIELDASSIGNMENTS\f[I]\f[R]... .PP-\f[C]if\f[]+\f[C]if\f[R] .PD 0 .P .PD-\f[I]\f[CI]PATTERN\f[I]\f[]+\f[I]\f[CI]PATTERN\f[I]\f[R] .PD 0 .P .PD-\f[I]\f[CI]PATTERN\f[I]\f[]...+\f[I]\f[CI]PATTERN\f[I]\f[R]... .PD 0 .P .PD-\ \ \ \ \f[I]\f[CI]FIELDASSIGNMENTS\f[I]\f[]...+\ \ \ \ \f[I]\f[CI]FIELDASSIGNMENTS\f[I]\f[R]... .PP This applies one or more field assignments, only to those CSV records matched by one of the PATTERNs.-The patterns are case\-insensitive regular expressions which match+The patterns are case-insensitive regular expressions which match anywhere within the whole CSV record (it\[aq]s not yet possible to match within a specific field). When there are multiple patterns they can be written on separate lines,@@ -221,46 +224,46 @@ .IP .nf \f[C]-#\ if\ the\ CSV\ record\ contains\ "groceries",\ set\ account2\ to\ "expenses:groceries"-if\ groceries-\ account2\ expenses:groceries-\f[]+# if the CSV record contains \[dq]groceries\[dq], set account2 to \[dq]expenses:groceries\[dq]+if groceries+ account2 expenses:groceries+\f[R] .fi .IP .nf \f[C]-#\ if\ the\ CSV\ record\ contains\ any\ of\ these\ patterns,\ set\ account2\ and\ comment\ as\ shown+# if the CSV record contains any of these patterns, set account2 and comment as shown if-monthly\ service\ fee-atm\ transaction\ fee-banking\ thru\ software-\ account2\ expenses:business:banking-\ comment\ \ XXX\ deductible\ ?\ check\ it-\f[]+monthly service fee+atm transaction fee+banking thru software+ account2 expenses:business:banking+ comment  XXX deductible ? check it+\f[R] .fi .SS include .PP-\f[C]include\f[]\f[I]\f[CI]RULESFILE\f[I]\f[]+\f[C]include\f[R]\f[I]\f[CI]RULESFILE\f[I]\f[R] .PP Include another rules file at this point.-\f[C]RULESFILE\f[] is either an absolute file path or a path relative to-the current file\[aq]s directory.+\f[C]RULESFILE\f[R] is either an absolute file path or a path relative+to the current file\[aq]s directory. Eg: .IP .nf \f[C]-#\ rules\ reused\ with\ several\ CSV\ files-include\ common.rules-\f[]+# rules reused with several CSV files+include common.rules+\f[R] .fi-.SS newest\-first+.SS newest-first .PP-\f[C]newest\-first\f[]+\f[C]newest-first\f[R] .PP Consider adding this rule if all of the following are true: you might be processing just one day of data, your CSV records are in reverse chronological order (newest first), and you care about preserving the-order of same\-day transactions.+order of same-day transactions. It usually isn\[aq]t needed, because hledger autodetects the CSV order, but when all CSV records have the same date it will assume they are oldest first.@@ -268,50 +271,82 @@ .SS CSV ordering .PP The generated journal entries will be sorted by date.-The order of same\-day entries will be preserved (except in the special-case where you might need \f[C]newest\-first\f[], see above).+The order of same-day entries will be preserved (except in the special+case where you might need \f[C]newest-first\f[R], see above). .SS CSV accounts .PP-Each journal entry will have two postings, to \f[C]account1\f[] and-\f[C]account2\f[] respectively.+Each journal entry will have two postings, to \f[C]account1\f[R] and+\f[C]account2\f[R] respectively. It\[aq]s not yet possible to generate entries with more than two postings.-It\[aq]s conventional and recommended to use \f[C]account1\f[] for the+It\[aq]s conventional and recommended to use \f[C]account1\f[R] for the account whose CSV we are reading. .SS CSV amounts .PP-The \f[C]amount\f[] field sets the amount of the \f[C]account1\f[]-posting.-.PP-If the CSV has debit/credit amounts in separate fields, assign to the-\f[C]amount\-in\f[] and \f[C]amount\-out\f[] pseudo fields instead.-(Whichever one has a value will be used, with appropriate sign.-If both contain a value, it may not work so well.)-.PP-If an amount value is parenthesised, it will be de\-parenthesised and-sign\-flipped.+A transaction amount must be set, in one of these ways:+.IP \[bu] 2+with an \f[C]amount\f[R] field assignment, which sets the first+posting\[aq]s amount+.IP \[bu] 2+(When the CSV has debit and credit amounts in separate fields:)+.PD 0+.P+.PD+with field assignments for the \f[C]amount-in\f[R] and+\f[C]amount-out\f[R] pseudo fields (both of them).+Whichever one has a value will be used, with appropriate sign.+If both contain a value, it might not work so well.+.IP \[bu] 2+or implicitly by means of a balance assignment (see below). .PP+There is some special handling for sign in amounts:+.IP \[bu] 2+If an amount value is parenthesised, it will be de-parenthesised and+sign-flipped.+.IP \[bu] 2 If an amount value begins with a double minus sign, those will cancel out and be removed. .PP-If the CSV has the currency symbol in a separate field, assign that to-the \f[C]currency\f[] pseudo field to have it prepended to the amount.-Or, you can use a field assignment to \f[C]amount\f[] that interpolates-both CSV fields (giving more control, eg to put the currency symbol on-the right).-.SS CSV balance assertions+If the currency/commodity symbol is provided as a separate CSV field,+assign it to the \f[C]currency\f[R] pseudo field; the symbol will be+prepended to the amount (TODO: when there is an amount).+Or, you can use an \f[C]amount\f[R] field assignment for more control,+eg:+.IP+.nf+\f[C]+fields date,description,currency,amount+amount %amount %currency+\f[R]+.fi+.SS CSV balance assertions/assignments .PP-If the CSV includes a running balance, you can assign that to the-\f[C]balance\f[] pseudo field; whenever the running balance value is-non\-empty, it will be asserted as the balance after the-\f[C]account1\f[] posting.+If the CSV includes a running balance, you can assign that to one of the+pseudo fields \f[C]balance\f[R] (or \f[C]balance1\f[R]) or+\f[C]balance2\f[R].+This will generate a balance assertion (or if the amount is left empty,+a balance assignment), on the first or second posting, whenever the+running balance field is non-empty.+(TODO: #1000) .SS Reading multiple CSV files .PP-You can read multiple CSV files at once using multiple \f[C]\-f\f[]+You can read multiple CSV files at once using multiple \f[C]-f\f[R] arguments on the command line, and hledger will look for a-correspondingly\-named rules file for each.-Note if you use the \f[C]\-\-rules\-file\f[] option, this one rules file+correspondingly-named rules file for each.+Note if you use the \f[C]--rules-file\f[R] option, this one rules file will be used for all the CSV files being read.+.SS Valid CSV+.PP+hledger follows RFC 4180, with the addition of a customisable separator+character.+.PP+Some things to note:+.PP+When quoting fields,+.IP \[bu] 2+you must use double quotes, not single quotes+.IP \[bu] 2+spaces outside the quotes are not allowed.   .SH "REPORTING BUGS"