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.
This commit is contained in:
Simon Michael
parent
e24c6292d0
commit
adb6ee40eb
@ -414,7 +414,7 @@ Posting -- MixedAmount
|
||||
MixedAmount *-- "*" Amount
|
||||
Amount -- CommoditySymbol
|
||||
Amount -- Quantity
|
||||
Amount -- Price
|
||||
Amount -- AmountPrice
|
||||
Amount -- AmountStyle
|
||||
</uml>
|
||||
-->
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
]
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
@ -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]
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user