From adb6ee40ebcbcbdf3d6c4cbc0f715f026c59b373 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 3 Jun 2019 17:26:27 -0700 Subject: [PATCH] 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 | 2 +- hledger-api/hledger-api.hs | 8 +- hledger-lib/Hledger/Data/Amount.hs | 20 +- hledger-lib/Hledger/Data/Journal.hs | 62 ++++--- hledger-lib/Hledger/Data/Posting.hs | 4 +- hledger-lib/Hledger/Data/Prices.hs | 171 ++++++++---------- hledger-lib/Hledger/Data/Types.hs | 51 ++++-- hledger-lib/Hledger/Query.hs | 20 +- hledger-lib/Hledger/Read/Common.hs | 2 +- hledger-lib/Hledger/Read/JournalReader.hs | 14 +- hledger-lib/Hledger/Reports/BalanceReport.hs | 5 +- hledger-lib/Hledger/Reports/EntriesReport.hs | 3 +- .../Hledger/Reports/MultiBalanceReports.hs | 3 +- hledger-lib/Hledger/Reports/PostingsReport.hs | 5 +- hledger-web/Hledger/Web/Handler/MiscR.hs | 2 +- hledger-web/Hledger/Web/Json.hs | 4 +- hledger/Hledger/Cli/Commands/Prices.hs | 24 +-- 17 files changed, 203 insertions(+), 197 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 7577de123..a0b9bb397 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -414,7 +414,7 @@ Posting -- MixedAmount MixedAmount *-- "*" Amount Amount -- CommoditySymbol Amount -- Quantity -Amount -- Price +Amount -- AmountPrice Amount -- AmountStyle --> diff --git a/hledger-api/hledger-api.hs b/hledger-api/hledger-api.hs index f2307943b..c9df03089 100644 --- a/hledger-api/hledger-api.hs +++ b/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 diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index a84c10465..c39eb9c0f 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/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 -showPrice NoPrice = "" -showPrice (UnitPrice pa) = " @ " ++ showAmount pa -showPrice (TotalPrice pa) = " @@ " ++ showAmount pa +showAmountPrice :: AmountPrice -> String +showAmountPrice NoPrice = "" +showAmountPrice (UnitPrice pa) = " @ " ++ showAmount pa +showAmountPrice (TotalPrice pa) = " @@ " ++ showAmount pa -showPriceDebug :: Price -> String -showPriceDebug NoPrice = "" -showPriceDebug (UnitPrice pa) = " @ " ++ showAmountDebug pa -showPriceDebug (TotalPrice pa) = " @@ " ++ showAmountDebug pa +showAmountPriceDebug :: AmountPrice -> String +showAmountPriceDebug NoPrice = "" +showAmountPriceDebug (UnitPrice 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 diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 168ec04b1..47ffa3404 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/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 -addMarketPrice h j = j { jmarketprices = h : jmarketprices j } -- XXX #999 keep sorted +addPriceDirective :: PriceDirective -> Journal -> Journal +addPriceDirective h j = j { jpricedirectives = h : jpricedirectives j } -- XXX #999 keep sorted -- | Get the transaction with this index (its 1-based position in the input stream), if any. journalTransactionAt :: Journal -> Integer -> Maybe Transaction @@ -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 --- journalApplyMarketPrices j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts} +-- journalApplyPriceDirectives :: Journal -> Journal +-- journalApplyPriceDirectives j@Journal{jtxns=ts} = j{jtxns=map fixtransaction ts} -- where -- fixtransaction t@Transaction{tdate=d, tpostings=ps} = t{tpostings=map fixposting ps} -- where @@ -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 --- journalMarketPriceFor j d CommoditySymbol{symbol=s} = do --- let ps = reverse $ filter ((<= d).mpdate) $ filter ((s==).hsymbol) $ sortBy (comparing mpdate) $ jmarketprices j --- case ps of (MarketPrice{mpamount=a}:_) -> Just a +-- journalPriceDirectiveFor :: Journal -> Day -> CommoditySymbol -> Maybe MixedAmount +-- journalPriceDirectiveFor j d CommoditySymbol{symbol=s} = do +-- let ps = reverse $ filter ((<= d).pddate) $ filter ((s==).hsymbol) $ sortBy (comparing pddate) $ jpricedirectives j +-- case ps of (PriceDirective{pdamount=a}:_) -> Just a -- _ -> Nothing -- | Convert all this journal's amounts to cost 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 -journalPrices :: Journal -> Prices -journalPrices = toPrices . jmarketprices +-- -- | Build a database of market prices in effect on the given date, +-- -- from the journal's price directives. +-- journalPrices :: Day -> Journal -> Prices +-- journalPrices d = toPrices d . jpricedirectives -- -- | Render a market price as a P directive. --- showMarketPriceDirective :: MarketPrice -> String --- showMarketPriceDirective mp = unwords +-- showPriceDirectiveDirective :: PriceDirective -> String +-- showPriceDirectiveDirective pd = unwords -- [ "P" --- , showDate (mpdate mp) --- , T.unpack (mpcommodity mp) --- , (showAmount . setAmountPrecision maxprecision) (mpamount mp) +-- , showDate (pddate pd) +-- , T.unpack (pdcommodity pd) +-- , (showAmount . setAmountPrecision maxprecision) (pdamount pd +-- ) -- ] -- Misc helpers diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 247b4c320..13ea984dc 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/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. diff --git a/hledger-lib/Hledger/Data/Prices.hs b/hledger-lib/Hledger/Data/Prices.hs index de638f5ff..8010a25e3 100644 --- a/hledger-lib/Hledger/Data/Prices.hs +++ b/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 --- market value of one unit of a given commodity, in a different --- specified valuation commodity, defaulting to the commodity of the --- most recent applicable price. +tests_Prices = tests "Prices" [ + tests_priceLookup + ] + +------------------------------------------------------------------------------ +-- 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 Prices{prPrices} d mto from +priceLookup :: [PriceDirective] -> Day -> Maybe CommoditySymbol -> CommoditySymbol -> Maybe Amount +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 - , let pto = acommodity mpamount - , mpdate <= d + headMay [pdamount | PriceDirective{pddate, pdcommodity=pfrom, pdamount} <- latestfirst + , let pto = acommodity pdamount + , pddate <= d , pfrom == from , maybe True (== pto) mto ] mreverseprice = dbgprice "reverse market price" $ headMay [ priceamt - | mp@MarketPrice{mpdate, mpcommodity=pfrom, mpamount} <- prPrices - , let pto = acommodity mpamount - , mpdate <= d + | PriceDirective{pddate, pdcommodity=pfrom, pdamount} <- latestfirst + , let pto = acommodity pdamount + , 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 - ] - --- 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 + priceLookup [] (d "2019-06-01") Nothing "" `is` Nothing ] +------------------------------------------------------------------------------ diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 71221d6d6..b05007b80 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/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. --- The price amount should always be positive. -data Price = NoPrice | UnitPrice Amount | TotalPrice Amount +-- | An amount's per-unit or total cost/selling price in another +-- commodity, as recorded in the journal entry eg with @ or @@. +-- Docs call this "transaction price". The amount is always positive. +data AmountPrice = 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 --- by a stock exchange or the foreign exchange market. +-- | A market price declaration made by the journal format's P directive. +-- It declares two things: a historical exchange rate between two commodities, +-- and an amount display style for the second commodity. +data PriceDirective = PriceDirective { + pddate :: Day + ,pdcommodity :: CommoditySymbol + ,pdamount :: Amount + } deriving (Eq,Ord,Typeable,Data,Generic,Show) + -- Show instance derived in Amount.hs (XXX why ?) + +instance NFData PriceDirective + +-- | A historical market price (exchange rate) from one commodity to another. +-- A more concise form of a PriceDirective, without the amount display info. data MarketPrice = MarketPrice { - mpdate :: Day, - mpcommodity :: CommoditySymbol, - mpamount :: Amount - } deriving (Eq,Ord,Typeable,Data,Generic) - -- Show instance derived in Amount.hs + mpdate :: Day -- ^ Date on which this price becomes effective. + ,mpfrom :: CommoditySymbol -- ^ The commodity being converted from. + ,mpto :: CommoditySymbol -- ^ The commodity being converted to. + ,mprate :: Quantity -- ^ One unit of the "from" commodity is worth this quantity of the "to" commodity. + } deriving (Eq,Ord,Typeable,Data,Generic) + -- Show instance derived in Amount.hs (XXX why ?) instance NFData MarketPrice +-- | 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] diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index d8cdbb985..32b4351ef 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/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 -matchesMarketPrice (None) _ = False -matchesMarketPrice (Not q) p = not $ matchesMarketPrice q p -matchesMarketPrice (Or qs) p = any (`matchesMarketPrice` p) qs -matchesMarketPrice (And qs) p = all (`matchesMarketPrice` p) qs -matchesMarketPrice q@(Amt _ _) p = matchesAmount q (mpamount p) -matchesMarketPrice q@(Sym _) p = matchesCommodity q (mpcommodity p) -matchesMarketPrice (Date span) p = spanContainsDate span (mpdate p) -matchesMarketPrice _ _ = True +matchesPriceDirective :: Query -> PriceDirective -> Bool +matchesPriceDirective (None) _ = False +matchesPriceDirective (Not q) p = not $ matchesPriceDirective q p +matchesPriceDirective (Or qs) p = any (`matchesPriceDirective` p) qs +matchesPriceDirective (And qs) p = all (`matchesPriceDirective` p) qs +matchesPriceDirective q@(Amt _ _) p = matchesAmount q (pdamount p) +matchesPriceDirective q@(Sym _) p = matchesCommodity q (pdcommodity p) +matchesPriceDirective (Date span) p = spanContainsDate span (pddate p) +matchesPriceDirective _ _ = True -- tests diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 14f9667a9..5f2414cb2 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/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 diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index b6bd7c3f4..95f10ccc3 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/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{ - mpdate = fromGregorian 2017 1 30, - mpcommodity = "BTC", - mpamount = usd 922.83 + PriceDirective{ + pddate = fromGregorian 2017 1 30, + pdcommodity = "BTC", + pdamount = usd 922.83 } ,test "tagdirectivep" $ do diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index 08f0b07e1..ca8a0ab3c 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/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 diff --git a/hledger-lib/Hledger/Reports/EntriesReport.hs b/hledger-lib/Hledger/Reports/EntriesReport.hs index ef34163fa..b3049ea16 100644 --- a/hledger-lib/Hledger/Reports/EntriesReport.hs +++ b/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 diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs index 223c18404..d5ba9589d 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs +++ b/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. diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 7f5501021..3149fd3a1 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/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 diff --git a/hledger-web/Hledger/Web/Handler/MiscR.hs b/hledger-web/Hledger/Web/Handler/MiscR.hs index 3ffecdd34..65a3131f9 100644 --- a/hledger-web/Hledger/Web/Handler/MiscR.hs +++ b/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 diff --git a/hledger-web/Hledger/Web/Json.hs b/hledger-web/Hledger/Web/Json.hs index ab9572d25..b5a2402ad 100644 --- a/hledger-web/Hledger/Web/Json.hs +++ b/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 diff --git a/hledger/Hledger/Cli/Commands/Prices.hs b/hledger/Hledger/Cli/Commands/Prices.hs index a51a1af07..2c0a83bfc 100755 --- a/hledger/Hledger/Cli/Commands/Prices.hs +++ b/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) $ - sortOn mpdate $ - filter (matchesMarketPrice q) $ + mapM_ (putStrLn . showPriceDirective) $ + sortOn pddate $ + filter (matchesPriceDirective q) $ allprices where ifBoolOpt opt | boolopt opt $ rawopts_ opts = id | otherwise = const [] -showPrice :: MarketPrice -> String -showPrice mp = unwords ["P", show $ mpdate mp, T.unpack . quoteCommoditySymbolIfNeeded $ mpcommodity mp, showAmountWithZeroCommodity $ mpamount mp] +showPriceDirective :: PriceDirective -> String +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