diff --git a/hledger-lib/Hledger/Data.hs b/hledger-lib/Hledger/Data.hs index 990ed753d..b742a467f 100644 --- a/hledger-lib/Hledger/Data.hs +++ b/hledger-lib/Hledger/Data.hs @@ -16,7 +16,7 @@ module Hledger.Data ( module Hledger.Data.Dates, module Hledger.Data.Journal, module Hledger.Data.Ledger, - module Hledger.Data.MarketPrice, + module Hledger.Data.Prices, module Hledger.Data.Period, module Hledger.Data.PeriodicTransaction, module Hledger.Data.Posting, @@ -37,7 +37,7 @@ import Hledger.Data.Commodity import Hledger.Data.Dates import Hledger.Data.Journal import Hledger.Data.Ledger -import Hledger.Data.MarketPrice +import Hledger.Data.Prices import Hledger.Data.Period import Hledger.Data.PeriodicTransaction import Hledger.Data.Posting @@ -55,6 +55,7 @@ tests_Data = tests "Data" [ ,tests_Journal ,tests_Ledger ,tests_Posting + ,tests_Prices ,tests_StringFormat ,tests_Timeclock ,tests_Transaction diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index c83cbb69a..e6149020c 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -142,6 +142,7 @@ import qualified Data.Map as M import Hledger.Data.Types import Hledger.Data.Commodity +import Hledger.Data.Prices import Hledger.Utils @@ -456,28 +457,12 @@ canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'} -- The given market prices are expected to be in parse order. -- If no default valuation commodity can be found, the amount is left -- unchanged. -amountValue :: [MarketPrice] -> Day -> Amount -> Amount -amountValue ps d a@Amount{acommodity=c} = - case commodityValue ps d c of +amountValue :: Prices -> Day -> Amount -> Amount +amountValue prices d a@Amount{acommodity=c} = + case priceLookup prices d c 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 of one unit of the given commodity --- on the given valuation date in its default valuation commodity --- (that of the latest applicable market price before the valuation date). --- The given market prices are expected to be in parse order. -commodityValue :: [MarketPrice] -> Day -> CommoditySymbol -> Maybe Amount -commodityValue ps valuationdate c = - case ps' of - [] -> dbg Nothing - ps'' -> dbg $ Just $ mpamount $ head ps'' - where - ps' = filter (\MarketPrice{..} -> mpcommodity==c && mpdate<=valuationdate) ps - dbg = dbg8 ("using market price for "++T.unpack c) - - ------------------------------------------------------------------------------- -- MixedAmount @@ -739,8 +724,8 @@ canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styl -- in its default valuation commodity, using the given market prices -- which are expected to be in parse order. When no default valuation -- commodity can be found, amounts are left unchanged. -mixedAmountValue :: [MarketPrice] -> Day -> MixedAmount -> MixedAmount -mixedAmountValue ps d (Mixed as) = Mixed $ map (amountValue ps d) as +mixedAmountValue :: Prices -> Day -> MixedAmount -> MixedAmount +mixedAmountValue prices d (Mixed as) = Mixed $ map (amountValue prices d) as -- | Replace each component amount's TotalPrice, if it has one, with an equivalent UnitPrice. -- Has no effect on amounts without one. diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 43f608314..bca59a40f 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -61,6 +61,7 @@ module Hledger.Data.Journal ( journalNextTransaction, journalPrevTransaction, journalPostings, + journalPrices, -- * Standard account types journalBalanceSheetAccountQuery, journalProfitAndLossAccountQuery, @@ -115,6 +116,7 @@ import Hledger.Data.Types import Hledger.Data.AccountName import Hledger.Data.Amount import Hledger.Data.Dates +import Hledger.Data.Prices import Hledger.Data.Transaction import Hledger.Data.TransactionModifier import Hledger.Data.Posting @@ -1094,6 +1096,19 @@ postingPivot fieldortagname p = p{paccount = pivotedacct, poriginal = Just $ ori postingFindTag :: TagName -> Posting -> Maybe (TagName, TagValue) postingFindTag tagname p = find ((tagname==) . fst) $ postingAllTags p +-- | Convert a journal's market price declarations +journalPrices :: Journal -> Prices +journalPrices = toPrices . jmarketprices + +-- -- | Render a market price as a P directive. +-- showMarketPriceDirective :: MarketPrice -> String +-- showMarketPriceDirective mp = unwords +-- [ "P" +-- , showDate (mpdate mp) +-- , T.unpack (mpcommodity mp) +-- , (showAmount . setAmountPrecision maxprecision) (mpamount mp) +-- ] + -- Misc helpers -- | Check if a set of hledger account/description filter patterns matches the diff --git a/hledger-lib/Hledger/Data/MarketPrice.hs b/hledger-lib/Hledger/Data/MarketPrice.hs deleted file mode 100644 index 5593008a8..000000000 --- a/hledger-lib/Hledger/Data/MarketPrice.hs +++ /dev/null @@ -1,50 +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. - --} - -{-# LANGUAGE RecordWildCards #-} - -module Hledger.Data.MarketPrice ( - showMarketPrice -) -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) - ] - --- -- | Convert this posting's amount to its value on the given date in --- -- its default valuation commodity, using market prices from the given journal. --- postingValueAtDate :: Journal -> Day -> Posting -> Posting --- postingValueAtDate j d p@Posting{..} = p{pamount=mixedAmountValue prices d pamount} --- where --- -- prices are in parse order - sort into date then parse order, --- -- & reversed for quick lookup of the latest price. --- prices = reverse $ sortOn mpdate $ jmarketprices j - --- -- | Find the best commodity to convert to when asked to show the --- -- market value of this commodity on the given date. That is, the one --- -- in which it has most recently been market-priced, ie the commodity --- -- mentioned in the most recent applicable historical price directive --- -- before this date. --- -- defaultValuationCommodity :: Journal -> Day -> CommoditySymbol -> Maybe CommoditySymbol --- -- defaultValuationCommodity j d c = mpamount <$> commodityValue j d c - diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 21aabdb55..a4b7e2f03 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -87,6 +87,7 @@ import Hledger.Data.Types import Hledger.Data.Amount import Hledger.Data.AccountName import Hledger.Data.Dates (nulldate, spanContainsDate) +import Hledger.Data.Prices @@ -354,12 +355,8 @@ postingTransformAmount f p@Posting{pamount=a} = p{pamount=f a} -- valuation commodity on the given date using the given market prices. -- If no default valuation commodity can be found, amounts are left unchanged. -- The prices are expected to be in parse order. -postingValue :: [MarketPrice] -> Day -> Posting -> Posting -postingValue prices d p = postingTransformAmount (mixedAmountValue prices' d) p - where - -- prices are in parse order - sort into date then parse order, - -- & reversed for quick lookup of the latest price. - prices' = reverse $ sortOn mpdate prices +postingValue :: Prices -> Day -> Posting -> Posting +postingValue prices d p = postingTransformAmount (mixedAmountValue prices d) p -- | Convert this posting's amount to cost, and apply the appropriate amount styles. postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting diff --git a/hledger-lib/Hledger/Data/Prices.hs b/hledger-lib/Hledger/Data/Prices.hs new file mode 100644 index 000000000..cd028fd64 --- /dev/null +++ b/hledger-lib/Hledger/Data/Prices.hs @@ -0,0 +1,53 @@ +{-| + +Find historical exchange rates between two commodities. + +-} + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Hledger.Data.Prices ( + Prices + ,nullPrices + ,toPrices + ,priceLookup + ,tests_Prices +) +where + +import Data.List +import qualified Data.Text as T +import Data.Time.Calendar (Day) + +import Hledger.Utils +import Hledger.Data.Types + +-- | A database of historical market prices for multiple commodites, +-- allowing fast lookup of exchange rates between commodity pairs on a +-- given date. +data Prices = Prices { + prPrices :: [MarketPrice] -- ^ For now, just a list of price declarations sorted by date then parse order. + } + +nullPrices = toPrices [] + +-- | Convert a list of market prices in declaration order to a 'Prices' db. +toPrices :: [MarketPrice] -> Prices +toPrices declaredprices = Prices{prPrices = reverse $ sortOn mpdate declaredprices} + +-- | Find the market value of one unit of the given commodity on the +-- given date in its default valuation commodity (the commodity of the +-- latest applicable price before the valuation date). +-- Returns Nothing if there's no applicable price. +priceLookup :: Prices -> Day -> CommoditySymbol -> Maybe Amount +priceLookup Prices{..} valuationdate c = + case filter (\MarketPrice{..} -> mpcommodity==c && mpdate<=valuationdate) prPrices of + [] -> dbg Nothing + ps' -> dbg $ Just $ mpamount $ head ps' + where + dbg = dbg8 ("using market price for "++T.unpack c) + +tests_Prices = tests "Prices" [ + ] + diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 5db00083a..167139475 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -420,11 +420,14 @@ data TimeclockEntry = TimeclockEntry { instance NFData TimeclockEntry +-- | A historical exchange rate between two commodities, eg published +-- by a stock exchange or the foreign exchange market. data MarketPrice = MarketPrice { mpdate :: Day, mpcommodity :: CommoditySymbol, mpamount :: Amount - } deriving (Eq,Ord,Typeable,Data,Generic) -- , Show in Amount.hs + } deriving (Eq,Ord,Typeable,Data,Generic) + -- Show instance derived in Amount.hs instance NFData MarketPrice @@ -452,8 +455,9 @@ data Journal = Journal { ,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] -- ^ All market prices declared by P directives. After journal finalisation, - -- these will be in parse order (not yet date-sorted, to allow concatenating Journals). + ,jmarketprices :: [MarketPrice] -- ^ 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. + -- (This field is not date-sorted, to allow monoidally combining finalised journals.) ,jtxnmodifiers :: [TransactionModifier] ,jperiodictxns :: [PeriodicTransaction] ,jtxns :: [Transaction] diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index 5aa6e90a0..e28a9ab1c 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -73,6 +73,7 @@ balanceReport ropts@ReportOpts{..} q j = today = fromMaybe (error' "balanceReport: ReportOpts today_ is unset so could not satisfy --value=now") today_ multiperiod = interval_ /= NoInterval + prices = journalPrices 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. @@ -92,9 +93,6 @@ balanceReport ropts@ReportOpts{..} q j = Just (AtDefault _mc) -> mixedAmountValue prices today Just (AtDate d _mc) -> mixedAmountValue prices d where - -- prices are in parse order - sort into date then parse order, - -- & reversed for quick lookup of the latest price. - prices = reverse $ sortOn mpdate $ jmarketprices j periodlastday = fromMaybe (error' "balanceReport: expected a non-empty journal") $ -- XXX shouldn't happen reportPeriodOrJournalLastDay ropts j diff --git a/hledger-lib/Hledger/Reports/EntriesReport.hs b/hledger-lib/Hledger/Reports/EntriesReport.hs index bb0a9002e..9ff2e63a4 100644 --- a/hledger-lib/Hledger/Reports/EntriesReport.hs +++ b/hledger-lib/Hledger/Reports/EntriesReport.hs @@ -38,20 +38,22 @@ entriesReport ropts@ReportOpts{..} q j@Journal{..} = sortBy (comparing datefn) $ filter (q `matchesTransaction`) $ map tvalue jtxns where datefn = transactionDateFn ropts + prices = journalPrices j + styles = journalCommodityStyles j tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings} pvalue p@Posting{..} = case value_ of Nothing -> p - Just (AtCost _mc) -> postingToCost (journalCommodityStyles j) p + Just (AtCost _mc) -> postingToCost styles p Just (AtEnd _mc) -> valueend p Just (AtNow _mc) -> valuenow p Just (AtDefault _mc) -> valuenow p - Just (AtDate d _mc) -> postingValue jmarketprices d p + Just (AtDate d _mc) -> postingValue prices d p where - valueend p = postingValue jmarketprices ( + valueend p = postingValue prices ( fromMaybe (postingDate p) -- XXX shouldn't happen mperiodorjournallastday ) p - valuenow p = postingValue jmarketprices ( + valuenow p = postingValue prices ( case today_ of Just d -> d Nothing -> error' "erValue: ReportOpts today_ is unset so could not satisfy --value=now" ) p diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs index 8225236b6..74cd02821 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs @@ -157,9 +157,8 @@ multiBalanceReport ropts@ReportOpts{..} q j@Journal{..} = -- end: summed/averaged row amounts -- date: summed/averaged row amounts today = fromMaybe (error' "postingsReport: ReportOpts today_ is unset so could not satisfy --value=now") today_ - -- Market prices. Sort into date then parse order, - -- & reverse for quick lookup of the latest price. - prices = reverse $ sortOn mpdate jmarketprices + -- Market prices. + prices = journalPrices j -- The last day of each column subperiod. lastdays :: [Day] = map ((maybe diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 1ad46bb83..48234c4b3 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -67,6 +67,7 @@ postingsReport ropts@ReportOpts{..} q j@Journal{..} = reportspan = adjustReportDates ropts q j whichdate = whichDateFromOpts ropts depth = queryDepth q + prices = journalPrices j -- postings to be included in the report, and similarly-matched postings before the report start date (precedingps, reportps) = matchedPostingsBeforeAndDuring ropts q j reportspan @@ -95,13 +96,13 @@ postingsReport ropts@ReportOpts{..} q j@Journal{..} = let showempty = empty_ || average_ summaryps = summarisePostingsByInterval interval_ whichdate depth showempty reportspan reportps - summarypsendvalue = [(postingValue jmarketprices periodlastday p, periodend) | (p,periodend) <- summaryps + summarypsendvalue = [(postingValue prices periodlastday p, periodend) | (p,periodend) <- summaryps ,let periodlastday = maybe (error' "postingsReport: expected a subperiod end date") -- XXX shouldn't happen (addDays (-1)) periodend ] - summarypsdatevalue d = [(postingValue jmarketprices d p, periodend) | (p,periodend) <- summaryps] + summarypsdatevalue d = [(postingValue prices d p, periodend) | (p,periodend) <- summaryps] in case value_ of Nothing -> summaryps Just (AtCost _mc) -> summaryps -- conversion to cost was done earlier @@ -115,7 +116,7 @@ postingsReport ropts@ReportOpts{..} q j@Journal{..} = reportperiodlastday = fromMaybe (error' "postingsReport: expected a non-empty journal") -- XXX shouldn't happen $ reportPeriodOrJournalLastDay ropts j - reportpsdatevalue d = [(postingValue jmarketprices d p, Nothing) | p <- reportps] + reportpsdatevalue d = [(postingValue prices d p, Nothing) | p <- reportps] reportpsnovalue = [(p, Nothing) | p <- reportps] in case value_ of Nothing -> reportpsnovalue @@ -137,10 +138,6 @@ postingsReport ropts@ReportOpts{..} q j@Journal{..} = | otherwise = if historical then precedingsum else 0 -- For --value=end/now/DATE, convert the initial running total/average to value. startbaldatevalue d = mixedAmountValue prices d startbal - where - -- prices are in parse order - sort into date then parse order, - -- & reversed for quick lookup of the latest price. - prices = reverse $ sortOn mpdate jmarketprices valuedstartbal = case value_ of Nothing -> startbal Just (AtCost _mc) -> startbal -- conversion to cost was done earlier diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 8bee216d2..d0317172e 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: ffd57f3b3365e927bfb79cb1bfe2ff6081fcd89b12d8a6fda4b6e254817b7ba7 +-- hash: ac2028674178919d87ff7e06ea16e97e245e92deeb60beb9689c083547cd1a44 name: hledger-lib version: 1.14.99 @@ -58,7 +58,7 @@ library Hledger.Data.Dates Hledger.Data.Journal Hledger.Data.Ledger - Hledger.Data.MarketPrice + Hledger.Data.Prices Hledger.Data.Period Hledger.Data.PeriodicTransaction Hledger.Data.StringFormat @@ -159,10 +159,10 @@ test-suite doctests Hledger.Data.Dates Hledger.Data.Journal Hledger.Data.Ledger - Hledger.Data.MarketPrice Hledger.Data.Period Hledger.Data.PeriodicTransaction Hledger.Data.Posting + Hledger.Data.Prices Hledger.Data.RawOptions Hledger.Data.StringFormat Hledger.Data.Timeclock @@ -261,10 +261,10 @@ test-suite easytests Hledger.Data.Dates Hledger.Data.Journal Hledger.Data.Ledger - Hledger.Data.MarketPrice Hledger.Data.Period Hledger.Data.PeriodicTransaction Hledger.Data.Posting + Hledger.Data.Prices Hledger.Data.RawOptions Hledger.Data.StringFormat Hledger.Data.Timeclock diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index 29861e9b0..d2b32058e 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -110,7 +110,7 @@ library: - Hledger.Data.Dates - Hledger.Data.Journal - Hledger.Data.Ledger - - Hledger.Data.MarketPrice + - Hledger.Data.Prices - Hledger.Data.Period - Hledger.Data.PeriodicTransaction - Hledger.Data.StringFormat