diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 19f6864d3..2f66e46de 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -186,7 +186,7 @@ instance Semigroup Journal where ,jcommodities = jcommodities j1 <> jcommodities j2 ,jinferredcommodities = jinferredcommodities j1 <> jinferredcommodities j2 ,jpricedirectives = jpricedirectives j1 <> jpricedirectives j2 - ,jimpliedmarketprices = jimpliedmarketprices j1 <> jimpliedmarketprices j2 + ,jinferredmarketprices = jinferredmarketprices j1 <> jinferredmarketprices j2 ,jtxnmodifiers = jtxnmodifiers j1 <> jtxnmodifiers j2 ,jperiodictxns = jperiodictxns j1 <> jperiodictxns j2 ,jtxns = jtxns j1 <> jtxns j2 @@ -212,7 +212,7 @@ nulljournal = Journal { ,jcommodities = M.empty ,jinferredcommodities = M.empty ,jpricedirectives = [] - ,jimpliedmarketprices = [] + ,jinferredmarketprices = [] ,jtxnmodifiers = [] ,jperiodictxns = [] ,jtxns = [] @@ -1044,16 +1044,16 @@ canonicalStyleFrom ss@(s:_) = -- been balanced and posting amounts have appropriate prices attached. journalInferMarketPricesFromTransactions :: Journal -> Journal journalInferMarketPricesFromTransactions j = - j{jimpliedmarketprices = - dbg4 "jimpliedmarketprices" $ - mapMaybe postingImpliedMarketPrice $ journalPostings j + j{jinferredmarketprices = + dbg4 "jinferredmarketprices" $ + mapMaybe postingInferredmarketPrice $ journalPostings j } -- | Make a market price equivalent to this posting's amount's unit -- price, if any. If the posting amount is multicommodity, only the -- first commodity amount is considered. -postingImpliedMarketPrice :: Posting -> Maybe MarketPrice -postingImpliedMarketPrice p@Posting{pamount} = +postingInferredmarketPrice :: Posting -> Maybe MarketPrice +postingInferredmarketPrice p@Posting{pamount} = -- convert any total prices to unit prices case mixedAmountTotalPriceToUnitPrice pamount of Mixed ( Amount{acommodity=fromcomm, aprice = Just (UnitPrice Amount{acommodity=tocomm, aquantity=rate})} : _) -> diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index bfc07347a..4f3d78dae 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -470,9 +470,9 @@ data Journal = Journal { ,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 + ,jinferredcommodities :: M.Map CommoditySymbol AmountStyle -- ^ commodities and formats inferred from journal amounts TODO misnamed, should be eg jusedstyles ,jpricedirectives :: [PriceDirective] -- ^ Declarations of market prices by P directives, in parse order (after journal finalisation) - ,jimpliedmarketprices :: [MarketPrice] -- ^ Market prices implied by transactions, in parse order (after journal finalisation) + ,jinferredmarketprices :: [MarketPrice] -- ^ Market prices implied by transactions, in parse order (after journal finalisation) ,jtxnmodifiers :: [TransactionModifier] ,jperiodictxns :: [PeriodicTransaction] ,jtxns :: [Transaction] diff --git a/hledger-lib/Hledger/Data/Valuation.hs b/hledger-lib/Hledger/Data/Valuation.hs index 02865a912..2fd2f4641 100644 --- a/hledger-lib/Hledger/Data/Valuation.hs +++ b/hledger-lib/Hledger/Data/Valuation.hs @@ -52,38 +52,6 @@ import Hledger.Data.Dates (parsedate) ------------------------------------------------------------------------------ -- 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, - -- which were either: - -- declared by P directives, - -- implied by transaction prices, - -- inferred by reversing a declared rate, - -- or inferred by reversing a transaction-implied 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. - ,prDefaultValuationCommodities :: M.Map CommoditySymbol CommoditySymbol - -- ^ The default valuation commodity for each source commodity. - -- These are used when a valuation commodity is not specified - -- (-V). They are the destination commodity of the latest - -- (declared or transaction-implied, but not reverse) each - -- source commodity's latest market price (on the date of this - -- graph). - } - 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 ? -- CLI: --value=cost|then|end|now|DATE[,COMM] data ValuationType = @@ -95,9 +63,62 @@ data ValuationType = | AtDefault (Maybe CommoditySymbol) -- ^ works like AtNow in single period reports, like AtEnd in multiperiod reports deriving (Show,Data,Eq) -- Typeable +-- | 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, + -- which were either: + -- declared by P directives, + -- inferred from transaction prices, + -- inferred by reversing a declared rate, + -- or inferred by reversing a transaction-inferred 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. + ,prDefaultValuationCommodities :: M.Map CommoditySymbol CommoditySymbol + -- ^ The default valuation commodity for each source commodity. + -- These are used when a valuation commodity is not specified + -- (-V). They are the destination commodity of the latest + -- (declared or inferred, but not reverse) each + -- source commodity's latest market price (on the date of this + -- graph). + } + deriving (Show,Generic) + +instance NFData PriceGraph + +-- | A price oracle is a magic memoising function that efficiently +-- looks up market prices (exchange rates) from one commodity to +-- another (or if unspecified, to a default valuation commodity) on a +-- given date. +type PriceOracle = (Day, CommoditySymbol, Maybe CommoditySymbol) -> Maybe (CommoditySymbol, Quantity) + +-- | Generate a price oracle (memoising price lookup function) from a +-- journal's directive-declared and transaction-inferred market +-- prices. For best performance, generate this only once per journal, +-- reusing it across reports if there are more than one, as +-- compoundBalanceCommand does. +journalPriceOracle :: Journal -> PriceOracle +journalPriceOracle Journal{jpricedirectives, jinferredmarketprices} = + let + declaredprices = map priceDirectiveToMarketPrice jpricedirectives + makepricegraph = memo $ makePriceGraph declaredprices jinferredmarketprices + in + memo $ uncurry3 $ priceLookup makepricegraph + +priceDirectiveToMarketPrice :: PriceDirective -> MarketPrice +priceDirectiveToMarketPrice PriceDirective{..} = + MarketPrice{ mpdate = pddate + , mpfrom = pdcommodity + , mpto = acommodity pdamount + , mprate = aquantity pdamount + } ------------------------------------------------------------------------------ --- Valuation +-- Converting things to value -- | Apply a specified valuation to this mixed amount, using the -- provided price oracle, commodity styles, reference dates, and @@ -189,72 +210,28 @@ amountValueAtDate priceoracle styles mto d a = ------------------------------------------------------------------------------ -- Market price lookup --- From a journal's directive-declared and transaction-implied market --- prices, generate a memoising function that efficiently looks up --- exchange rates between commodities on any date. For best performance, --- 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, jimpliedmarketprices} = - -- traceStack "journalPriceOracle" $ - let - pricesatdate = - memo $ - pricesAtDate jpricedirectives jimpliedmarketprices - 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. +-- | Given a memoising price graph generator, a valuation date, a +-- source commodity and an optional valuation commodity, find the +-- value on that date of one unit of the source commodity in the +-- valuation commodity, or in a default valuation commodity. Returns +-- the valuation commodity that was specified or chosen, and the +-- quantity of it that one unit of the source commodity is worth. Or +-- if no applicable market price can be found or calculated, or if the +-- source commodity and the valuation commodity are the same, returns +-- Nothing. -- --- When the valuation commodity is specified, this looks for an --- exchange rate (market price) calculated in any of the following --- ways, in order of preference: --- --- 1. a declared market price (DMP) - a P directive giving the --- exchange rate from source commodity to valuation commodity --- --- 2. a transaction-implied market price (TMP) - a market price --- equivalent to the transaction price used in the latest --- transaction from source commodity to valuation commodity --- (on or before the valuation date) --- --- 3. a reverse declared market price (RDMP) - calculated by inverting --- a DMP --- --- 4. a reverse transaction-implied market price (RTMP) - calculated --- by inverting a TMP --- --- 5. an indirect market price (IMP) - calculated by combining the --- shortest chain of market prices (any of the above types) leading --- from source commodity to valuation commodity. --- --- When the valuation commodity is not specified, this looks for the --- latest applicable declared or transaction-implied 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. +-- See makePriceGraph for how prices are determined. +-- Note that both market prices and default valuation commodities can +-- vary with valuation date, since that determines which market prices +-- are visible. -- priceLookup :: (Day -> PriceGraph) -> Day -> CommoditySymbol -> Maybe CommoditySymbol -> Maybe (CommoditySymbol, Quantity) -priceLookup pricesatdate d from mto = +priceLookup makepricegraph 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, prDefaultValuationCommodities=defaultdests} = pricesatdate d + PriceGraph{prGraph=g, prNodemap=m, prDefaultValuationCommodities=defaultdests} = makepricegraph d fromnode = node m from mto' = mto <|> mdefaultto where @@ -286,8 +263,7 @@ priceLookup pricesatdate d from mto = 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} + p date from q to = MarketPrice{mpdate=d date, mpfrom=from, mpto=to, mprate=q} ps1 = [ p "2000/01/01" "A" 10 "B" ,p "2000/01/01" "B" 10 "C" @@ -295,32 +271,62 @@ tests_priceLookup = ,p "2000/01/01" "E" 2 "D" ,p "2001/01/01" "A" 11 "B" ] - pricesatdate = pricesAtDate ps1 [] + makepricegraph = makePriceGraph ps1 [] in test "priceLookup" $ do - priceLookup pricesatdate (d "1999/01/01") "A" Nothing @?= Nothing - priceLookup pricesatdate (d "2000/01/01") "A" Nothing @?= Just ("B",10) - priceLookup pricesatdate (d "2000/01/01") "B" (Just "A") @?= Just ("A",0.1) - priceLookup pricesatdate (d "2000/01/01") "A" (Just "E") @?= Just ("E",500) + priceLookup makepricegraph (d "1999/01/01") "A" Nothing @?= Nothing + priceLookup makepricegraph (d "2000/01/01") "A" Nothing @?= Just ("B",10) + priceLookup makepricegraph (d "2000/01/01") "B" (Just "A") @?= Just ("A",0.1) + priceLookup makepricegraph (d "2000/01/01") "A" (Just "E") @?= 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, and a --- list of transaction-implied market prices in parse order, to a --- graph of the effective exchange rates between commodity pairs on --- the given day. -pricesAtDate :: [PriceDirective] -> [MarketPrice] -> Day -> PriceGraph -pricesAtDate pricedirectives impliedmarketprices d = - dbg9 ("pricesAtDate "++show d) $ +-- | Build the graph of commodity conversion prices for a given day. +-- Converts a list of declared market prices in parse order, and a +-- list of transaction-inferred market prices in parse order, to a +-- graph of all known exchange rates between commodity pairs in effect +-- on that day. Cf hledger.m4.md -> Valuation: +-- +-- hledger looks for a market price (exchange rate) from commodity A +-- to commodity B in one or more of these ways, in this order of +-- preference: +-- +-- 1. A *declared market price* or *inferred market price*: +-- A's latest market price in B on or before the valuation date +-- as declared by a P directive, or (with the `--value-infer` flag) +-- inferred from transaction prices. +-- +-- 2. A *reverse market price*: +-- the inverse of a declared or inferred market price from B to A. +-- +-- 3. A *chained market price*: +-- a synthetic price formed by combining the shortest chain of market +-- prices (any of the above types) leading from A to B. +-- +-- 1 and 2 form the edges of the price graph, and we can query it for +-- 3 (which is the reason we use a graph). +-- +-- We also identify each commodity's default valuation commodity, if +-- any. For each commodity A, hledger picks a default valuation +-- commodity as follows: +-- +-- 1. The price commodity from the latest (on or before valuation +-- date) declared market price for A. +-- +-- 2. If there are no P directives at all (any commodity, any date), +-- and the `--value-infer` flag is used, then the price commodity +-- from the latest (on or before valuation date) transaction price +-- for A. +-- +makePriceGraph :: [MarketPrice] -> [MarketPrice] -> Day -> PriceGraph +makePriceGraph alldeclaredprices allinferredprices d = + dbg9 ("makePriceGraph "++show d) $ PriceGraph{prGraph=g, prNodemap=m, prDefaultValuationCommodities=defaultdests} where - -- prices in effect on date d, either declared or implied - currentdeclaredandimpliedprices = dbg2 "currentdeclaredandimpliedprices" $ - latestPriceForEachPairOn pricedirectives impliedmarketprices d + -- prices in effect on date d, either declared or inferred + declaredandinferredprices = dbg2 "declaredandinferredprices" $ + declaredOrInferredPricesOn alldeclaredprices allinferredprices d - -- infer any additional reverse prices not already declared or implied + -- infer any additional reverse prices not already declared or inferred reverseprices = dbg2 "reverseprices" $ - map marketPriceReverse currentdeclaredandimpliedprices \\ currentdeclaredandimpliedprices + map marketPriceReverse declaredandinferredprices \\ declaredandinferredprices -- build the graph and associated node map (g, m) = @@ -329,47 +335,38 @@ pricesAtDate pricedirectives impliedmarketprices d = (dbg9 "price graph edges" $ [(mpfrom, mpto, mprate) | MarketPrice{..} <- prices]) :: (Gr CommoditySymbol Quantity, NodeMap CommoditySymbol) where - prices = currentdeclaredandimpliedprices ++ reverseprices + prices = declaredandinferredprices ++ reverseprices allcomms = map mpfrom prices -- determine a default valuation commodity D for each source commodity S: -- the price commodity in the latest declared market price for S (on any date) defaultdests = M.fromList [(mpfrom,mpto) | MarketPrice{..} <- alldeclaredprices] - where - alldeclaredprices = dbg2 "alldeclaredprices" $ map priceDirectiveToMarketPrice pricedirectives --- From a list of price directives in parse order, and a list of --- transaction-implied market prices in parse order, get the effective --- price on the given date for each commodity pair. That is, the --- latest declared or transaction-implied price dated on or before --- that day, with declared prices taking precedence. -latestPriceForEachPairOn :: [PriceDirective] -> [MarketPrice] -> Day -> [MarketPrice] -latestPriceForEachPairOn pricedirectives impliedmarketprices d = +-- | From a list of directive-declared market prices in parse order, +-- and a list of transaction-inferred market prices in parse order, +-- get the effective price on the given date for each commodity pair. +-- That is, the latest (by date then parse order) declared price or +-- inferred price, on or before that date, If there is both a declared +-- and inferred price on the same day, declared takes precedence. +declaredOrInferredPricesOn :: [MarketPrice] -> [MarketPrice] -> Day -> [MarketPrice] +declaredOrInferredPricesOn declaredprices inferredprices d = let - -- consider only declarations/transactions before the valuation date - declaredprices = map priceDirectiveToMarketPrice $ filter ((<=d).pddate) pricedirectives - impliedmarketprices' = filter ((<=d).mpdate) impliedmarketprices - -- label the items with their precedence and then their parse order - declaredprices' = [(1, i, p) | (i,p) <- zip [1..] declaredprices] - impliedmarketprices'' = [(0, i, p) | (i,p) <- zip [1..] impliedmarketprices'] + -- keeping only prices on or before the valuation date, label each + -- item with its same-day precedence (declared above inferred) and + -- then parse order + declaredprices' = [(1, i, p) | (i,p@MarketPrice{mpdate}) <- zip [1..] declaredprices, mpdate<=d] + inferredprices' = [(0, i, p) | (i,p@MarketPrice{mpdate}) <- zip [1..] inferredprices, mpdate<=d] in -- combine - declaredprices' ++ impliedmarketprices'' + declaredprices' ++ inferredprices' -- sort by newest date then highest precedence then latest parse order & sortBy (flip compare `on` (\(precedence,parseorder,mp)->(mpdate mp,precedence,parseorder))) -- discard the sorting labels & map third3 - -- keep only the first (ie the newest, highest precedence and latest parsed) price for each pair + -- keep only the first (ie the newest, highest precedence, latest parsed) price for each pair + -- XXX or use a Map ? & nubSortBy (compare `on` (\(MarketPrice{..})->(mpfrom,mpto))) -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}