;lib: encapsulate Prices db

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

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 :: Prices -> Day -> Amount -> Amount
-amountValue ps d a@Amount{acommodity=c} =
+amountValue prices d a@Amount{acommodity=c} =
-  case commodityValue ps d c of
+  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 :: Prices -> Day -> MixedAmount -> MixedAmount
-mixedAmountValue ps d (Mixed as) = Mixed $ map (amountValue ps d) as
+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. 

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

hledger-lib/Hledger/Data/MarketPrice.hs

@@ -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
-

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 -> Day -> Posting -> Posting
-postingValue prices d p = postingTransformAmount (mixedAmountValue prices' d) p
+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
 
 -- | Convert this posting's amount to cost, and apply the appropriate amount styles.
 postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting

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" [
+  ]
+

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,
+  ,jmarketprices          :: [MarketPrice]                          -- ^ All market price declarations (P directives), in parse order (after journal finalisation).
-                                                                    --   these will be in parse order (not yet date-sorted, to allow concatenating Journals).
+                                                                    --   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]

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

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

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,
+      -- Market prices.
-      -- & reverse for quick lookup of the latest price.
+      prices = journalPrices j
-      prices = reverse $ sortOn mpdate jmarketprices
       -- The last day of each column subperiod.
       lastdays :: [Day] =
         map ((maybe

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

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

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