lib: clarify price types (#131)

dropped journalPrices

renamed Price to AmountPrice,  AKA "transaction price"

renamed MarketPrice to PriceDirective.

added new MarketPrice (more pure form of PriceDirective without the amount style information)

Prices is now a more efficient data structure, but not used yet.

CONTRIBUTING.md

@@ -414,7 +414,7 @@ Posting -- MixedAmount
 MixedAmount *-- "*" Amount
 Amount -- CommoditySymbol
 Amount -- Quantity
-Amount -- Price
+Amount -- AmountPrice
 Amount -- AmountStyle
 </uml>
 -->

hledger-api/hledger-api.hs

@@ -152,7 +152,7 @@ hledgerApiApp staticdir j = Servant.serve api server
       where
         accountnamesH = return $ journalAccountNames j
         transactionsH = return $ jtxns j
-        pricesH       = return $ jmarketprices j
+        pricesH       = return $ jpricedirectives j
         commoditiesH  = return $ (M.keys . jinferredcommodities) j
         accountsH     = return $ ledgerTopAccounts $ ledgerFromJournal Hledger.Query.Any j
         accounttransactionsH (a::AccountName) = do
@@ -176,7 +176,7 @@ hledgerApiApp staticdir j = Servant.serve api server
 --instance ToJSON DigitGroupStyle where toJSON = genericToJSON defaultOptions
 --instance ToJSON MixedAmount where toJSON = genericToJSON defaultOptions
 --instance ToJSON BalanceAssertion where toJSON = genericToJSON defaultOptions
---instance ToJSON Price where toJSON = genericToJSON defaultOptions
+--instance ToJSON AmountPrice where toJSON = genericToJSON defaultOptions
 --instance ToJSON MarketPrice where toJSON = genericToJSON defaultOptions
 --instance ToJSON PostingType where toJSON = genericToJSON defaultOptions
 --instance ToJSON Posting where
@@ -216,7 +216,7 @@ instance ToJSON Side
 instance ToJSON DigitGroupStyle
 instance ToJSON MixedAmount
 instance ToJSON BalanceAssertion
-instance ToJSON Price
+instance ToJSON AmountPrice
 instance ToJSON MarketPrice
 instance ToJSON PostingType
 instance ToJSON Posting where
@@ -262,7 +262,7 @@ instance ToSchema Side
 instance ToSchema DigitGroupStyle
 instance ToSchema MixedAmount
 instance ToSchema BalanceAssertion
-instance ToSchema Price
+instance ToSchema AmountPrice
 #if MIN_VERSION_swagger2(2,1,5)
   where declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
 #endif

hledger-lib/Hledger/Data/Amount.hs

@@ -302,7 +302,7 @@ setMinimalPrecision a = setAmountPrecision normalprecision a
 -- 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
@@ -341,15 +341,15 @@ cshowAmountWithoutPrice a = cshowAmount a{aprice=NoPrice}
 showAmountWithoutPriceOrCommodity :: Amount -> String
 showAmountWithoutPriceOrCommodity a = showAmount a{acommodity="", aprice=NoPrice}
 
-showPrice :: Price -> String
+showAmountPrice :: AmountPrice -> String
-showPrice NoPrice         = ""
+showAmountPrice NoPrice         = ""
-showPrice (UnitPrice pa)  = " @ "  ++ showAmount pa
+showAmountPrice (UnitPrice pa)  = " @ "  ++ showAmount pa
-showPrice (TotalPrice pa) = " @@ " ++ showAmount pa
+showAmountPrice (TotalPrice pa) = " @@ " ++ showAmount pa
 
-showPriceDebug :: Price -> String
+showAmountPriceDebug :: AmountPrice -> String
-showPriceDebug NoPrice         = ""
+showAmountPriceDebug NoPrice         = ""
-showPriceDebug (UnitPrice pa)  = " @ "  ++ showAmountDebug pa
+showAmountPriceDebug (UnitPrice pa)  = " @ "  ++ showAmountDebug pa
-showPriceDebug (TotalPrice pa) = " @@ " ++ showAmountDebug pa
+showAmountPriceDebug (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.
@@ -385,7 +385,7 @@ showAmountHelper showzerocommodity a@Amount{acommodity=c, aprice=p, astyle=Amoun
       (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 p
 
 -- | Like showAmount, but show a zero amount's commodity if it has one.
 showAmountWithZeroCommodity :: Amount -> String

hledger-lib/Hledger/Data/Journal.hs

@@ -16,7 +16,7 @@ other data format (see "Hledger.Read").
 
 module Hledger.Data.Journal (
   -- * Parsing helpers
-  addMarketPrice,
+  addPriceDirective,
   addTransactionModifier,
   addPeriodicTransaction,
   addTransaction,
@@ -61,7 +61,7 @@ module Hledger.Data.Journal (
   journalNextTransaction,
   journalPrevTransaction,
   journalPostings,
-  journalPrices,
+  -- journalPrices,
   -- * Standard account types
   journalBalanceSheetAccountQuery,
   journalProfitAndLossAccountQuery,
@@ -116,7 +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.Prices
 import Hledger.Data.Transaction
 import Hledger.Data.TransactionModifier
 import Hledger.Data.Posting
@@ -154,7 +154,7 @@ instance Show Journal where
 --                      ,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
@@ -184,7 +184,7 @@ instance Sem.Semigroup Journal where
     ,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
@@ -213,7 +213,7 @@ nulljournal = Journal {
   ,jdeclaredaccounttypes      = M.empty
   ,jcommodities               = M.empty
   ,jinferredcommodities       = M.empty
-  ,jmarketprices              = []
+  ,jpricedirectives              = []
   ,jtxnmodifiers              = []
   ,jperiodictxns              = []
   ,jtxns                      = []
@@ -240,8 +240,8 @@ addTransactionModifier mt j = j { jtxnmodifiers = mt : jtxnmodifiers j }
 addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal
 addPeriodicTransaction pt j = j { jperiodictxns = pt : jperiodictxns j }
 
-addMarketPrice :: MarketPrice -> Journal -> Journal
+addPriceDirective :: PriceDirective -> Journal -> Journal
-addMarketPrice h j = j { jmarketprices = h : jmarketprices j }  -- XXX #999 keep sorted
+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
@@ -556,7 +556,7 @@ journalReverse j =
     ,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.
@@ -908,16 +908,16 @@ checkBalanceAssignmentUnassignableAccountB p = do
 -- 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 = p{pamount=styleMixedAmount styles $ pamount p
                       ,pbalanceassertion=fixbalanceassertion <$> pbalanceassertion p}
       fixbalanceassertion ba = ba{baamount=styleAmount styles $ baamount ba}
-      fixmarketprice mp@MarketPrice{mpamount=a} = mp{mpamount=styleAmount styles a}
+      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. 
@@ -963,8 +963,8 @@ canonicalStyleFrom ss@(first:_) = first {asprecision = prec, asdecimalpoint = md
     --   []    -> (Just '.', 0)
 
 -- -- | Apply this journal's historical price records to unpriced amounts where possible.
--- journalApplyMarketPrices :: Journal -> Journal
+-- journalApplyPriceDirectives :: Journal -> Journal
--- journalApplyMarketPrices j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
+-- journalApplyPriceDirectives j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts}
 --     where
 --       fixtransaction t@Transaction{tdate=d, tpostings=ps} = t{tpostings=map fixposting ps}
 --        where
@@ -972,14 +972,14 @@ canonicalStyleFrom ss@(first:_) = first {asprecision = prec, asdecimalpoint = md
 --         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
+-- journalPriceDirectiveFor :: Journal -> Day -> CommoditySymbol -> Maybe MixedAmount
--- journalMarketPriceFor j d CommoditySymbol{symbol=s} = do
+-- journalPriceDirectiveFor j d CommoditySymbol{symbol=s} = do
---   let ps = reverse $ filter ((<= d).mpdate) $ filter ((s==).hsymbol) $ sortBy (comparing mpdate) $ jmarketprices j
+--   let ps = reverse $ filter ((<= d).pddate) $ filter ((s==).hsymbol) $ sortBy (comparing pddate) $ jpricedirectives j
---   case ps of (MarketPrice{mpamount=a}:_) -> Just a
+--   case ps of (PriceDirective{pdamount=a}:_) -> Just a
 --              _ -> Nothing
 
 -- | Convert all this journal's amounts to cost using the transaction prices, if any.
@@ -1037,12 +1037,12 @@ traverseJournalAmounts
     => (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
@@ -1098,17 +1098,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
+-- -- | Build a database of market prices in effect on the given date,
-journalPrices :: Journal -> Prices
+-- -- from the journal's price directives.
-journalPrices = toPrices . jmarketprices
+-- journalPrices :: Day -> Journal -> Prices
+-- journalPrices d = toPrices d . jpricedirectives
 
 -- -- | Render a market price as a P directive.
--- showMarketPriceDirective :: MarketPrice -> String
+-- showPriceDirectiveDirective :: PriceDirective -> String
--- showMarketPriceDirective mp = unwords
+-- showPriceDirectiveDirective pd = unwords
 --     [ "P"
---     , showDate (mpdate mp)
+--     , showDate (pddate pd)
---     , T.unpack (mpcommodity mp)
+--     , T.unpack (pdcommodity pd)
---     , (showAmount . setAmountPrecision maxprecision) (mpamount mp)
+--     , (showAmount . setAmountPrecision maxprecision) (pdamount pd
+--     )
 --     ]
 
 -- Misc helpers

hledger-lib/Hledger/Data/Posting.hs

@@ -350,7 +350,7 @@ aliasReplace (RegexAlias re repl) a = T.pack $ regexReplaceCIMemo re repl $ T.un
 -- Apply a specified valuation to this posting's amount, using the provided
 -- prices db, commodity styles, period-end/current dates, and whether
 -- this is for a multiperiod report or not.
-postingApplyValuation :: Prices -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> Posting -> ValuationType -> Posting
+postingApplyValuation :: [PriceDirective] -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> Posting -> ValuationType -> Posting
 postingApplyValuation prices styles periodend today ismultiperiod p v =
   case v of
     AtCost    Nothing            -> postingToCost styles p
@@ -370,7 +370,7 @@ postingToCost styles p@Posting{pamount=a} = p{pamount=mixedAmountToCost styles a
 -- using the given market prices.
 -- When market prices available on that date are not sufficient to
 -- calculate the value, amounts are left unchanged.
-postingValueAtDate :: Prices -> Maybe CommoditySymbol -> Day -> Posting -> Posting
+postingValueAtDate :: [PriceDirective] -> Maybe CommoditySymbol -> Day -> Posting -> Posting
 postingValueAtDate prices mc d p = postingTransformAmount (mixedAmountValueAtDate prices mc d) p
 
 -- | Apply a transform function to this posting's amount.

hledger-lib/Hledger/Data/Prices.hs

@@ -5,19 +5,18 @@ convert amounts to value in various ways.
 
 -}
 
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Hledger.Data.Prices (
    Prices
-  ,nullPrices
-  ,toPrices
-  ,priceLookup
   ,amountValueAtDate
   ,amountApplyValuation
   ,mixedAmountValueAtDate
   ,mixedAmountApplyValuation
+  ,priceLookup
   ,tests_Prices
 )
 where
@@ -34,39 +33,69 @@ import Hledger.Data.Types
 import Hledger.Data.Amount
 import Hledger.Data.Dates (parsedate)
 
--- | 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, then reversed.
-  }
-
-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}
-
--- | Reverse a market price from A to B, so that it becomes an equivalent price from B to A.
-marketPriceInvert :: MarketPrice -> MarketPrice
-marketPriceInvert p@MarketPrice{mpcommodity, mpamount} =  
-  p{ mpcommodity = acommodity mpamount
-   , mpamount    = setMinimalPrecision mpamount{acommodity=mpcommodity, aquantity=1 / aquantity mpamount}
-   }
-
-tests_marketPriceInvert = tests "marketPriceInvert" [
-  marketPriceInvert (MarketPrice{mpdate=d "2019-06-01", mpcommodity="A", mpamount=amt "B" 2})
-    `is`            (MarketPrice{mpdate=d "2019-06-01", mpcommodity="B", mpamount=amt "A" 0.5 `withPrecision` 1})
-  ]
 
 d = parsedate
-amt c q = nullamt{acommodity=c, aquantity=q}
+-- amt c q = nullamt{acommodity=c, aquantity=q}
 
--- | Using the market prices in effect at the given date, find the
+tests_Prices = tests "Prices" [
--- market value of one unit of a given commodity, in a different
+   tests_priceLookup
--- specified valuation commodity, defaulting to the commodity of the
+  ]
--- most recent applicable price.
+
+------------------------------------------------------------------------------
+-- Valuation
+                     
+-- Apply a specified valuation to this mixed amount, using the provided
+-- prices db, commodity styles, period-end/current dates, 
+-- and whether this is for a multiperiod report or not.
+-- Currently ignores the specified valuation commodity and always uses
+-- the default valuation commodity.
+mixedAmountApplyValuation :: [PriceDirective] -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> ValuationType -> MixedAmount -> MixedAmount
+mixedAmountApplyValuation prices styles periodend today ismultiperiod v (Mixed as) =
+  Mixed $ map (amountApplyValuation prices styles periodend today ismultiperiod v) as
+
+-- | 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 prices.
+-- When market prices available on that date are not sufficient to
+-- calculate the value, amounts are left unchanged.
+mixedAmountValueAtDate :: [PriceDirective] -> Maybe CommoditySymbol -> Day -> MixedAmount -> MixedAmount
+mixedAmountValueAtDate prices mc d (Mixed as) = Mixed $ map (amountValueAtDate prices mc d) as
+
+-- | Apply a specified valuation to this amount, using the provided
+-- prices db, commodity styles, period-end/current dates, 
+-- and whether this is for a multiperiod report or not.
+amountApplyValuation :: [PriceDirective] -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> ValuationType -> Amount -> Amount
+amountApplyValuation prices styles periodend today ismultiperiod v a =
+  case v of
+    AtCost    Nothing            -> amountToCost styles a
+    AtCost    mc                 -> amountValueAtDate prices mc periodend $ amountToCost styles a
+    AtEnd     mc                 -> amountValueAtDate prices mc periodend a
+    AtNow     mc                 -> amountValueAtDate prices mc today     a
+    AtDefault mc | ismultiperiod -> amountValueAtDate prices mc periodend a
+    AtDefault mc                 -> amountValueAtDate prices mc today     a
+    AtDate d  mc                 -> amountValueAtDate prices mc d         a
+
+-- | 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.)
+-- If the market prices available on that date are not sufficient to
+-- calculate this value, the amount is left unchanged.
+amountValueAtDate :: [PriceDirective] -> Maybe CommoditySymbol -> Day -> Amount -> Amount
+amountValueAtDate pricedirectives mc d a =
+  case priceLookup pricedirectives d mc (acommodity a) of
+    Just v  -> v{aquantity=aquantity v * aquantity a}
+    Nothing -> a
+
+------------------------------------------------------------------------------
+-- Market price lookup, naive version
+                     
+-- | Given a list of price directives in parse order, find the market
+-- value at the given date of one unit of a given commodity, in a
+-- different specified valuation commodity, defaulting to the
+-- commodity of the most recent applicable price.
+-- This might be slow if there are many price declarations.
 --
 -- When the valuation commodity is specified, this looks for, in order:
 --
@@ -91,8 +120,8 @@ amt c q = nullamt{acommodity=c, aquantity=q}
 -- if the source commodity and the valuation commodity are the same,
 -- this returns Nothing.
 --
-priceLookup :: Prices -> Day -> Maybe CommoditySymbol -> CommoditySymbol -> Maybe Amount
+priceLookup :: [PriceDirective] -> Day -> Maybe CommoditySymbol -> CommoditySymbol -> Maybe Amount
-priceLookup Prices{prPrices} d mto from
+priceLookup pricedirectives d mto from
   | mto == Just from = Nothing
   | otherwise        = mdirectprice <|> mreverseprice
   where
@@ -100,84 +129,38 @@ priceLookup Prices{prPrices} d mto from
       dbg4With ( ((lbl++" for "++T.unpack from++" at "++show d++": ") ++)
                  . maybe "none" showAmount )
 
+    latestfirst = reverse $ sortOn pddate pricedirectives  -- sortOn will preserve parse order within the same date I think
+
     -- Key to commodity symbols:
     -- from  - commodity we are converting from (looking up a price for)
     -- mto   - commodity we want to convert to, or Nothing meaning use default
     -- pfrom - commodity that this market price converts from
     -- pto   - commodity that this market price converts to
 
-    -- prPrices is sorted by date then parse order, reversed. So the
+    -- prPriceDirectives is sorted by date then parse order, reversed. So the
     -- first price on or before the valuation date is the effective one.
 
     mdirectprice =
       dbgprice "direct  market price" $
-      headMay [mpamount | MarketPrice{mpdate, mpcommodity=pfrom, mpamount} <- prPrices
+      headMay [pdamount | PriceDirective{pddate, pdcommodity=pfrom, pdamount} <- latestfirst
-                        , let pto = acommodity mpamount
+                        , let pto = acommodity pdamount
-                        , mpdate <= d
+                        , pddate <= d
                         , pfrom == from
                         , maybe True (== pto) mto
                         ]
     mreverseprice =
       dbgprice "reverse market price" $
       headMay [ priceamt
-              | mp@MarketPrice{mpdate, mpcommodity=pfrom, mpamount} <- prPrices
+              | PriceDirective{pddate, pdcommodity=pfrom, pdamount} <- latestfirst
-              , let pto = acommodity mpamount
+              , let pto = acommodity pdamount
-              , mpdate <= d
+              , pddate <= d
               , pto == from
               , maybe False (== pfrom) mto  -- use reverse prices only when target commodity is explicitly specified
-              , let MarketPrice{mpamount=priceamt} = marketPriceInvert mp
+              , let PriceDirective{pdamount=priceamt} = undefined -- marketPriceInvert mp
               ]
 
 tests_priceLookup = tests "priceLookup" [
-   priceLookup (Prices []) (d "2019-06-01") Nothing "" `is` Nothing
+   priceLookup [] (d "2019-06-01") Nothing "" `is` Nothing
-  ]
-   
--- Apply a specified valuation to this mixed amount, using the provided
--- prices db, commodity styles, period-end/current dates, 
--- and whether this is for a multiperiod report or not.
--- Currently ignores the specified valuation commodity and always uses
--- the default valuation commodity.
-mixedAmountApplyValuation :: Prices -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> ValuationType -> MixedAmount -> MixedAmount
-mixedAmountApplyValuation prices styles periodend today ismultiperiod v (Mixed as) =
-  Mixed $ map (amountApplyValuation prices styles periodend today ismultiperiod v) as
-
--- | 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 prices.
--- When market prices available on that date are not sufficient to
--- calculate the value, amounts are left unchanged.
-mixedAmountValueAtDate :: Prices -> Maybe CommoditySymbol -> Day -> MixedAmount -> MixedAmount
-mixedAmountValueAtDate prices mc d (Mixed as) = Mixed $ map (amountValueAtDate prices mc d) as
-
--- | Apply a specified valuation to this amount, using the provided
--- prices db, commodity styles, period-end/current dates, 
--- and whether this is for a multiperiod report or not.
-amountApplyValuation :: Prices -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> ValuationType -> Amount -> Amount
-amountApplyValuation prices styles periodend today ismultiperiod v a =
-  case v of
-    AtCost    Nothing            -> amountToCost styles a
-    AtCost    mc                 -> amountValueAtDate prices mc periodend $ amountToCost styles a
-    AtEnd     mc                 -> amountValueAtDate prices mc periodend a
-    AtNow     mc                 -> amountValueAtDate prices mc today     a
-    AtDefault mc | ismultiperiod -> amountValueAtDate prices mc periodend a
-    AtDefault mc                 -> amountValueAtDate prices mc today     a
-    AtDate d  mc                 -> amountValueAtDate prices mc d         a
-
--- | 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.)
--- If the market prices available on that date are not sufficient to
--- calculate this value, the amount is left unchanged.
-amountValueAtDate :: Prices -> Maybe CommoditySymbol -> Day -> Amount -> Amount
-amountValueAtDate prices mc d a =
-  case priceLookup prices d mc (acommodity a) of
-    Just v  -> v{aquantity=aquantity v * aquantity a}
-    Nothing -> a
-
-tests_Prices = tests "Prices" [
-   tests_marketPriceInvert
-  ,tests_priceLookup
   ]
 
+------------------------------------------------------------------------------

hledger-lib/Hledger/Data/Types.hs

@@ -154,12 +154,13 @@ instance ToMarkup Quantity
  where
    toMarkup = toMarkup . show
 
--- | An amount's price (none, per unit, or total) in another commodity.
+-- | An amount's per-unit or total cost/selling price in another
--- The price amount should always be positive.
+-- commodity, as recorded in the journal entry eg with @ or @@.
-data Price = NoPrice | UnitPrice Amount | TotalPrice Amount 
+-- Docs call this "transaction price". The amount is always positive.
+data AmountPrice = NoPrice | 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 @@ data Amount = Amount {
       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      :: AmountPrice            -- ^ the (fixed, transaction-specific) price for this amount, if any
     } deriving (Eq,Ord,Typeable,Data,Generic,Show)
 
 instance NFData Amount
@@ -420,17 +421,40 @@ data TimeclockEntry = TimeclockEntry {
 
 instance NFData TimeclockEntry
 
--- | A historical exchange rate between two commodities, eg published
+-- | A market price declaration made by the journal format's P directive.
--- by a stock exchange or the foreign exchange market.
+-- 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,
+   mpdate :: Day                -- ^ Date on which this price becomes effective.
-      mpcommodity :: CommoditySymbol,
+  ,mpfrom :: CommoditySymbol    -- ^ The commodity being converted from.
-      mpamount    :: Amount
+  ,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
+        -- Show instance derived in Amount.hs (XXX why ?)
 
 instance NFData MarketPrice
 
+-- | A database of the exchange rates between commodity pairs at a given date,
+-- organised as maps for efficient lookup.
+data Prices = Prices {
+   prDeclaredPrices ::
+      M.Map CommoditySymbol         -- from commodity A
+            (M.Map CommoditySymbol  -- to commodity B
+                   Quantity)        -- exchange rate from A to B (one A is worth this many B)
+            -- ^ Explicitly declared market prices, as { FROMCOMM : { TOCOMM : RATE } }.
+  }
+
 -- | What kind of value conversion should be done on amounts ?
 -- UI: --value=cost|end|now|DATE[,COMM]
 data ValuationType =
@@ -465,9 +489,8 @@ 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 price declarations (P directives), in parse order (after journal finalisation).
+  ,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.
-                                                                    --   (This field is not date-sorted, to allow monoidally combining finalised journals.)
   ,jtxnmodifiers          :: [TransactionModifier]
   ,jperiodictxns          :: [PeriodicTransaction]
   ,jtxns                  :: [Transaction]

hledger-lib/Hledger/Query.hs

@@ -43,7 +43,7 @@ module Hledger.Query (
   matchesMixedAmount,
   matchesAmount,
   matchesCommodity,
-  matchesMarketPrice,
+  matchesPriceDirective,
   words'',
   -- * tests
   tests_Query
@@ -639,15 +639,15 @@ matchesTags namepat valuepat = not . null . filter (match namepat valuepat)
     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
+matchesPriceDirective :: Query -> PriceDirective -> Bool
-matchesMarketPrice (None) _      = False
+matchesPriceDirective (None) _      = False
-matchesMarketPrice (Not q) p     = not $ matchesMarketPrice q p
+matchesPriceDirective (Not q) p     = not $ matchesPriceDirective q p
-matchesMarketPrice (Or qs) p     = any (`matchesMarketPrice` p) qs
+matchesPriceDirective (Or qs) p     = any (`matchesPriceDirective` p) qs
-matchesMarketPrice (And qs) p    = all (`matchesMarketPrice` p) qs
+matchesPriceDirective (And qs) p    = all (`matchesPriceDirective` p) qs
-matchesMarketPrice q@(Amt _ _) p = matchesAmount q (mpamount p)
+matchesPriceDirective q@(Amt _ _) p = matchesAmount q (pdamount p)
-matchesMarketPrice q@(Sym _) p   = matchesCommodity q (mpcommodity p)
+matchesPriceDirective q@(Sym _) p   = matchesCommodity q (pdcommodity p)
-matchesMarketPrice (Date span) p = spanContainsDate span (mpdate p)
+matchesPriceDirective (Date span) p = spanContainsDate span (pddate p)
-matchesMarketPrice _ _           = True
+matchesPriceDirective _ _           = True
 
 
 -- tests

hledger-lib/Hledger/Read/Common.hs

@@ -714,7 +714,7 @@ quotedcommoditysymbolp =
 simplecommoditysymbolp :: TextParser m CommoditySymbol
 simplecommoditysymbolp = takeWhile1P Nothing (not . isNonsimpleCommodityChar)
 
-priceamountp :: JournalParser m Price
+priceamountp :: JournalParser m AmountPrice
 priceamountp = option NoPrice $ do
   char '@'
   priceConstructor <- char '@' *> pure TotalPrice <|> pure UnitPrice

hledger-lib/Hledger/Read/JournalReader.hs

@@ -143,7 +143,7 @@ addJournalItemP =
     , transactionp          >>= modify' . addTransaction
     , transactionmodifierp  >>= modify' . addTransactionModifier
     , periodictransactionp  >>= modify' . addPeriodicTransaction
-    , marketpricedirectivep >>= modify' . addMarketPrice
+    , marketpricedirectivep >>= modify' . addPriceDirective
     , void (lift emptyorcommentlinep)
     , void (lift multilinecommentp)
     ] <?> "transaction or directive"
@@ -486,7 +486,7 @@ defaultcommoditydirectivep = do
   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 +496,7 @@ marketpricedirectivep = do
   lift (skipMany spacenonewline)
   price <- amountp
   lift restofline
-  return $ MarketPrice date symbol price
+  return $ PriceDirective date symbol price
 
 ignoredpricecommoditydirectivep :: JournalParser m ()
 ignoredpricecommoditydirectivep = do
@@ -917,10 +917,10 @@ tests_JournalReader = tests "JournalReader" [
 
   ,test "marketpricedirectivep" $ expectParseEq marketpricedirectivep
     "P 2017/01/30 BTC $922.83\n"
-    MarketPrice{
+    PriceDirective{
-      mpdate      = fromGregorian 2017 1 30,
+      pddate      = fromGregorian 2017 1 30,
-      mpcommodity = "BTC",
+      pdcommodity = "BTC",
-      mpamount    = usd 922.83
+      pdamount    = usd 922.83
       }
 
   ,test "tagdirectivep" $ do

hledger-lib/Hledger/Reports/BalanceReport.hs

@@ -64,7 +64,7 @@ flatShowsExclusiveBalance    = True
 -- This is like PeriodChangeReport with a single column (but more mature,
 -- eg this can do hierarchical display).
 balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport
-balanceReport ropts@ReportOpts{..} q j = 
+balanceReport ropts@ReportOpts{..} q j@Journal{..} = 
   (if invert_ then brNegate  else id) $ 
   (sorteditems, total)
     where
@@ -73,7 +73,6 @@ 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
       styles = journalCommodityStyles j
 
       -- Get all the summed accounts & balances, according to the query, as an account tree.
@@ -85,7 +84,7 @@ balanceReport ropts@ReportOpts{..} q j =
         where
           valueaccount a@Account{..} = a{aebalance=val aebalance, aibalance=val aibalance}
             where
-              val = maybe id (mixedAmountApplyValuation prices styles periodlastday today multiperiod) value_
+              val = maybe id (mixedAmountApplyValuation jpricedirectives styles periodlastday today multiperiod) value_
                 where
                   periodlastday =
                     fromMaybe (error' "balanceReport: expected a non-empty journal") $ -- XXX shouldn't happen

hledger-lib/Hledger/Reports/EntriesReport.hs

@@ -38,10 +38,9 @@ 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 = maybe p (postingApplyValuation prices styles end today False p) value_
+    pvalue p = maybe p (postingApplyValuation jpricedirectives 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

hledger-lib/Hledger/Reports/MultiBalanceReports.hs

@@ -158,7 +158,6 @@ multiBalanceReport ropts@ReportOpts{..} q j@Journal{..} =
       --   date: summed/averaged row amounts
       today = fromMaybe (error' "postingsReport: ReportOpts today_ is unset so could not satisfy --value=now") today_
       -- Market prices, commodity display styles.
-      prices = journalPrices j
       styles = journalCommodityStyles j
       -- The last day of each column subperiod.
       lastdays :: [Day] =
@@ -274,7 +273,7 @@ multiBalanceReport ropts@ReportOpts{..} q j@Journal{..} =
                    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 prices styles end today multiperiod) value_
+           , let val end = maybe id (mixedAmountApplyValuation jpricedirectives 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.

hledger-lib/Hledger/Reports/PostingsReport.hs

@@ -73,7 +73,6 @@ postingsReport ropts@ReportOpts{..} q j@Journal{..} =
       reportspan = adjustReportDates ropts q j
       whichdate = whichDateFromOpts ropts
       depth = queryDepth q
-      prices = journalPrices j
       styles = journalCommodityStyles j
 
       -- postings to be included in the report, and similarly-matched postings before the report start date
@@ -100,7 +99,7 @@ postingsReport ropts@ReportOpts{..} q j@Journal{..} =
         reportPeriodOrJournalLastDay ropts j
       multiperiod = interval_ /= NoInterval
       showempty = empty_ || average_
-      pvalue p end = maybe p (postingApplyValuation prices styles end today multiperiod p) value_
+      pvalue p end = maybe p (postingApplyValuation jpricedirectives styles end today multiperiod p) value_
 
       -- Postings, or summary postings with their subperiod's end date, to be displayed.
       displayps :: [(Posting, Maybe Day)]
@@ -122,7 +121,7 @@ postingsReport ropts@ReportOpts{..} q j@Journal{..} =
           -- For --value=end/now/DATE, convert the initial running total/average to value.
           startbalvalued = val startbal
             where
-              val = maybe id (mixedAmountApplyValuation prices styles daybeforereportstart today multiperiod) value_
+              val = maybe id (mixedAmountApplyValuation jpricedirectives styles daybeforereportstart today multiperiod) value_
                 where
                   daybeforereportstart = maybe
                                          (error' "postingsReport: expected a non-empty journal") -- XXX shouldn't happen

hledger-web/Hledger/Web/Handler/MiscR.hs

@@ -69,7 +69,7 @@ getPricesR = do
   VD{caps, j} <- getViewData
   when (CapView `notElem` caps) (permissionDenied "Missing the 'view' capability")
   selectRep $ do
-    provideJson $ jmarketprices j
+    provideJson $ jpricedirectives j
 
 getCommoditiesR :: Handler TypedContent
 getCommoditiesR = do

hledger-web/Hledger/Web/Json.hs

@@ -51,7 +51,7 @@ instance ToJSON Side
 instance ToJSON DigitGroupStyle
 instance ToJSON MixedAmount
 instance ToJSON BalanceAssertion
-instance ToJSON Price
+instance ToJSON AmountPrice
 instance ToJSON MarketPrice
 instance ToJSON PostingType
 
@@ -103,7 +103,7 @@ instance FromJSON Side
 instance FromJSON DigitGroupStyle
 instance FromJSON MixedAmount
 instance FromJSON BalanceAssertion
-instance FromJSON Price
+instance FromJSON AmountPrice
 instance FromJSON MarketPrice
 instance FromJSON PostingType
 instance FromJSON Posting

hledger/Hledger/Cli/Commands/Prices.hs

@@ -28,20 +28,20 @@ prices opts j = do
   let
     q          = queryFromOpts d (reportopts_ opts)
     ps         = filter (matchesPosting q) $ allPostings j
-    mprices    = jmarketprices j
+    mprices    = jpricedirectives j
     cprices    = concatMap postingCosts ps
     icprices   = concatMap postingCosts . mapAmount invertPrice $ ps
     allprices  = mprices ++ ifBoolOpt "costs" cprices ++ ifBoolOpt "inverted-costs" icprices
-  mapM_ (putStrLn . showPrice) $
+  mapM_ (putStrLn . showPriceDirective) $
-    sortOn mpdate $
+    sortOn pddate $
-    filter (matchesMarketPrice q) $
+    filter (matchesPriceDirective q) $
     allprices
   where
     ifBoolOpt opt | boolopt opt $ rawopts_ opts = id
                   | otherwise = const []
 
-showPrice :: MarketPrice -> String
+showPriceDirective :: PriceDirective -> String
-showPrice mp = unwords ["P", show $ mpdate mp, T.unpack . quoteCommoditySymbolIfNeeded $ mpcommodity mp, showAmountWithZeroCommodity $ mpamount mp]
+showPriceDirective mp = unwords ["P", show $ pddate mp, T.unpack . quoteCommoditySymbolIfNeeded $ pdcommodity mp, showAmountWithZeroCommodity $ pdamount mp]
 
 divideAmount' :: Quantity -> Amount -> Amount
 divideAmount' n a = a' where
@@ -50,7 +50,9 @@ divideAmount' n a = a' where
     extPrecision = (1+) . floor . logBase 10 $ (realToFrac n :: Double)
     precision' = extPrecision + asprecision (astyle a)
 
--- | Invert an amount's price for --invert-cost, somehow (? unclear XXX)
+-- XXX
+
+-- | Invert an amount's price for --invert-cost, somehow ? Unclear.
 invertPrice :: Amount -> Amount
 invertPrice a =
     case aprice a of
@@ -63,16 +65,16 @@ invertPrice a =
             a { aquantity = aquantity pa * signum (aquantity a), acommodity = acommodity pa, aprice = TotalPrice pa' } where
                 pa' = pa { aquantity = abs $ aquantity a, acommodity = acommodity a, aprice = NoPrice, astyle = astyle a }
 
-amountCost :: Day -> Amount -> Maybe MarketPrice
+amountCost :: Day -> Amount -> Maybe PriceDirective
 amountCost d a =
     case aprice a of
         NoPrice -> Nothing
         UnitPrice pa -> Just
-            MarketPrice { mpdate = d, mpcommodity = acommodity a, mpamount = pa }
+            PriceDirective { pddate = d, pdcommodity = acommodity a, pdamount = pa }
         TotalPrice pa -> Just
-            MarketPrice { mpdate = d, mpcommodity = acommodity a, mpamount = abs (aquantity a) `divideAmount'` pa }
+            PriceDirective { pddate = d, pdcommodity = acommodity a, pdamount = abs (aquantity a) `divideAmount'` pa }
 
-postingCosts :: Posting -> [MarketPrice]
+postingCosts :: Posting -> [PriceDirective]
 postingCosts p = mapMaybe (amountCost date) . amounts $ pamount p  where
    date = fromMaybe (tdate . fromJust $ ptransaction p) $ pdate p