simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-11-09 10:17:34 +03:00
Code Issues Projects Releases Wiki Activity

lib: clarify price types (#131)

Browse Source 
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.
This commit is contained in:
Simon Michael 2019-06-03 17:26:27 -07:00
parent e24c6292d0
commit adb6ee40eb
17 changed files with 203 additions and 197 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CONTRIBUTING.md
View File

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

8
hledger-api/hledger-api.hs
View File

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

20
hledger-lib/Hledger/Data/Amount.hs
View File

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

62
hledger-lib/Hledger/Data/Journal.hs
View File

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

4
hledger-lib/Hledger/Data/Posting.hs
View File

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

171
hledger-lib/Hledger/Data/Prices.hs
View File

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

51
hledger-lib/Hledger/Data/Types.hs
View File

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

20
hledger-lib/Hledger/Query.hs
View File

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

2
hledger-lib/Hledger/Read/Common.hs
View File

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

14
hledger-lib/Hledger/Read/JournalReader.hs
View File

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

5
hledger-lib/Hledger/Reports/BalanceReport.hs
View File

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

3
hledger-lib/Hledger/Reports/EntriesReport.hs
View File

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

3
hledger-lib/Hledger/Reports/MultiBalanceReports.hs
View File

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

5
hledger-lib/Hledger/Reports/PostingsReport.hs
View File

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

2
hledger-web/Hledger/Web/Handler/MiscR.hs
View File

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

4
hledger-web/Hledger/Web/Json.hs
View File

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

24
hledger/Hledger/Cli/Commands/Prices.hs
View File

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