slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

;lib: encapsulate Prices db

Browse Source
This commit is contained in:
Simon Michael 2019-05-25 05:27:55 -07:00
parent 4b004c2332
commit 34a0ad00b1
13 changed files with 105 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
hledger-lib/Hledger/Data.hs
View File

@ -16,7 +16,7 @@ module Hledger.Data (
module Hledger.Data.Dates,
module Hledger.Data.Journal,
module Hledger.Data.Ledger,
module Hledger.Data.MarketPrice,
module Hledger.Data.Prices,
module Hledger.Data.Period,
module Hledger.Data.PeriodicTransaction,
module Hledger.Data.Posting,
@ -37,7 +37,7 @@ import Hledger.Data.Commodity
import Hledger.Data.Dates
import Hledger.Data.Journal
import Hledger.Data.Ledger
import Hledger.Data.MarketPrice
import Hledger.Data.Prices
import Hledger.Data.Period
import Hledger.Data.PeriodicTransaction
import Hledger.Data.Posting
@ -55,6 +55,7 @@ tests_Data = tests "Data" [
,tests_Journal
,tests_Ledger
,tests_Posting
,tests_Prices
,tests_StringFormat
,tests_Timeclock
,tests_Transaction

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

@ -142,6 +142,7 @@ import qualified Data.Map as M
import Hledger.Data.Types
import Hledger.Data.Commodity
import Hledger.Data.Prices
import Hledger.Utils
@ -456,28 +457,12 @@ canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'}
-- The given market prices are expected to be in parse order.
-- If no default valuation commodity can be found, the amount is left
-- unchanged.
amountValue :: [MarketPrice] -> Day -> Amount -> Amount
amountValue ps d a@Amount{acommodity=c} =
case commodityValue ps d c of
amountValue :: Prices -> Day -> Amount -> Amount
amountValue prices d a@Amount{acommodity=c} =
case priceLookup prices d c of
Just v -> v{aquantity=aquantity v * aquantity a}
Nothing -> a
-- (This is here not in Commodity.hs to use the Amount Show instance above for debugging.)
--
-- | Find the market value of one unit of the given commodity
-- on the given valuation date in its default valuation commodity
-- (that of the latest applicable market price before the valuation date).
-- The given market prices are expected to be in parse order.
commodityValue :: [MarketPrice] -> Day -> CommoditySymbol -> Maybe Amount
commodityValue ps valuationdate c =
case ps' of
[] -> dbg Nothing
ps'' -> dbg $ Just $ mpamount $ head ps''
where
ps' = filter (\MarketPrice{..} -> mpcommodity==c && mpdate<=valuationdate) ps
dbg = dbg8 ("using market price for "++T.unpack c)
-------------------------------------------------------------------------------
-- MixedAmount
@ -739,8 +724,8 @@ canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styl
-- in its default valuation commodity, using the given market prices
-- which are expected to be in parse order. When no default valuation
-- commodity can be found, amounts are left unchanged.
mixedAmountValue :: [MarketPrice] -> Day -> MixedAmount -> MixedAmount
mixedAmountValue ps d (Mixed as) = Mixed $ map (amountValue ps d) as
mixedAmountValue :: Prices -> Day -> MixedAmount -> MixedAmount
mixedAmountValue prices d (Mixed as) = Mixed $ map (amountValue prices d) as
-- | Replace each component amount's TotalPrice, if it has one, with an equivalent UnitPrice.
-- Has no effect on amounts without one.

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

@ -61,6 +61,7 @@ module Hledger.Data.Journal (
journalNextTransaction,
journalPrevTransaction,
journalPostings,
journalPrices,
-- * Standard account types
journalBalanceSheetAccountQuery,
journalProfitAndLossAccountQuery,
@ -115,6 +116,7 @@ import Hledger.Data.Types
import Hledger.Data.AccountName
import Hledger.Data.Amount
import Hledger.Data.Dates
import Hledger.Data.Prices
import Hledger.Data.Transaction
import Hledger.Data.TransactionModifier
import Hledger.Data.Posting
@ -1094,6 +1096,19 @@ postingPivot fieldortagname p = p{paccount = pivotedacct, poriginal = Just $ ori
postingFindTag :: TagName -> Posting -> Maybe (TagName, TagValue)
postingFindTag tagname p = find ((tagname==) . fst) $ postingAllTags p
-- | Convert a journal's market price declarations
journalPrices :: Journal -> Prices
journalPrices = toPrices . jmarketprices
-- -- | Render a market price as a P directive.
-- showMarketPriceDirective :: MarketPrice -> String
-- showMarketPriceDirective mp = unwords
-- [ "P"
-- , showDate (mpdate mp)
-- , T.unpack (mpcommodity mp)
-- , (showAmount . setAmountPrecision maxprecision) (mpamount mp)
-- ]
-- Misc helpers
-- | Check if a set of hledger account/description filter patterns matches the

50
hledger-lib/Hledger/Data/MarketPrice.hs
View File

@ -1,50 +0,0 @@
{-|
A 'MarketPrice' represents a historical exchange rate between two
commodities. (Ledger calls them historical prices.) For example, prices
published by a stock exchange or the foreign exchange market. Some
commands (balance, currently) can use this information to show the market
value of things at a given date.
-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.Data.MarketPrice (
showMarketPrice
)
where
import qualified Data.Text as T
import Hledger.Data.Amount
import Hledger.Data.Dates
import Hledger.Data.Types
-- | Get the string representation of an market price, based on its
-- commodity's display settings.
showMarketPrice :: MarketPrice -> String
showMarketPrice mp = unwords
[ "P"
, showDate (mpdate mp)
, T.unpack (mpcommodity mp)
, (showAmount . setAmountPrecision maxprecision) (mpamount mp)
]
-- -- | Convert this posting's amount to its value on the given date in
-- -- its default valuation commodity, using market prices from the given journal.
-- postingValueAtDate :: Journal -> Day -> Posting -> Posting
-- postingValueAtDate j d p@Posting{..} = p{pamount=mixedAmountValue prices d pamount}
-- where
-- -- prices are in parse order - sort into date then parse order,
-- -- & reversed for quick lookup of the latest price.
-- prices = reverse $ sortOn mpdate $ jmarketprices j
-- -- | Find the best commodity to convert to when asked to show the
-- -- market value of this commodity on the given date. That is, the one
-- -- in which it has most recently been market-priced, ie the commodity
-- -- mentioned in the most recent applicable historical price directive
-- -- before this date.
-- -- defaultValuationCommodity :: Journal -> Day -> CommoditySymbol -> Maybe CommoditySymbol
-- -- defaultValuationCommodity j d c = mpamount <$> commodityValue j d c

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

@ -87,6 +87,7 @@ import Hledger.Data.Types
import Hledger.Data.Amount
import Hledger.Data.AccountName
import Hledger.Data.Dates (nulldate, spanContainsDate)
import Hledger.Data.Prices
@ -354,12 +355,8 @@ postingTransformAmount f p@Posting{pamount=a} = p{pamount=f a}
-- valuation commodity on the given date using the given market prices.
-- If no default valuation commodity can be found, amounts are left unchanged.
-- The prices are expected to be in parse order.
postingValue :: [MarketPrice] -> Day -> Posting -> Posting
postingValue prices d p = postingTransformAmount (mixedAmountValue prices' d) p
where
-- prices are in parse order - sort into date then parse order,
-- & reversed for quick lookup of the latest price.
prices' = reverse $ sortOn mpdate prices
postingValue :: Prices -> Day -> Posting -> Posting
postingValue prices d p = postingTransformAmount (mixedAmountValue prices d) p
-- | Convert this posting's amount to cost, and apply the appropriate amount styles.
postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting

53
hledger-lib/Hledger/Data/Prices.hs Normal file
View File

@ -0,0 +1,53 @@
{-|
Find historical exchange rates between two commodities.
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.Data.Prices (
Prices
,nullPrices
,toPrices
,priceLookup
,tests_Prices
)
where
import Data.List
import qualified Data.Text as T
import Data.Time.Calendar (Day)
import Hledger.Utils
import Hledger.Data.Types
-- | A database of historical market prices for multiple commodites,
-- allowing fast lookup of exchange rates between commodity pairs on a
-- given date.
data Prices = Prices {
prPrices :: [MarketPrice] -- ^ For now, just a list of price declarations sorted by date then parse order.
}
nullPrices = toPrices []
-- | Convert a list of market prices in declaration order to a 'Prices' db.
toPrices :: [MarketPrice] -> Prices
toPrices declaredprices = Prices{prPrices = reverse $ sortOn mpdate declaredprices}
-- | Find the market value of one unit of the given commodity on the
-- given date in its default valuation commodity (the commodity of the
-- latest applicable price before the valuation date).
-- Returns Nothing if there's no applicable price.
priceLookup :: Prices -> Day -> CommoditySymbol -> Maybe Amount
priceLookup Prices{..} valuationdate c =
case filter (\MarketPrice{..} -> mpcommodity==c && mpdate<=valuationdate) prPrices of
[] -> dbg Nothing
ps' -> dbg $ Just $ mpamount $ head ps'
where
dbg = dbg8 ("using market price for "++T.unpack c)
tests_Prices = tests "Prices" [
]

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

@ -420,11 +420,14 @@ data TimeclockEntry = TimeclockEntry {
instance NFData TimeclockEntry
-- | A historical exchange rate between two commodities, eg published
-- by a stock exchange or the foreign exchange market.
data MarketPrice = MarketPrice {
mpdate :: Day,
mpcommodity :: CommoditySymbol,
mpamount :: Amount
} deriving (Eq,Ord,Typeable,Data,Generic) -- , Show in Amount.hs
} deriving (Eq,Ord,Typeable,Data,Generic)
-- Show instance derived in Amount.hs
instance NFData MarketPrice
@ -452,8 +455,9 @@ data Journal = Journal {
,jdeclaredaccounttypes :: M.Map AccountType [AccountName] -- ^ Accounts whose type has been declared in account directives (usually 5 top-level accounts)
,jcommodities :: M.Map CommoditySymbol Commodity -- ^ commodities and formats declared by commodity directives
,jinferredcommodities :: M.Map CommoditySymbol AmountStyle -- ^ commodities and formats inferred from journal amounts TODO misnamed - jusedstyles
,jmarketprices :: [MarketPrice] -- ^ All market prices declared by P directives. After journal finalisation,
-- these will be in parse order (not yet date-sorted, to allow concatenating Journals).
,jmarketprices :: [MarketPrice] -- ^ 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]

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

@ -73,6 +73,7 @@ balanceReport ropts@ReportOpts{..} q j =
today = fromMaybe (error' "balanceReport: ReportOpts today_ is unset so could not satisfy --value=now") today_
multiperiod = interval_ /= NoInterval
prices = journalPrices j
-- Get all the summed accounts & balances, according to the query, as an account tree.
-- If doing cost valuation, amounts will be converted to cost first.
@ -92,9 +93,6 @@ balanceReport ropts@ReportOpts{..} q j =
Just (AtDefault _mc) -> mixedAmountValue prices today
Just (AtDate d _mc) -> mixedAmountValue prices d
where
-- prices are in parse order - sort into date then parse order,
-- & reversed for quick lookup of the latest price.
prices = reverse $ sortOn mpdate $ jmarketprices j
periodlastday =
fromMaybe (error' "balanceReport: expected a non-empty journal") $ -- XXX shouldn't happen
reportPeriodOrJournalLastDay ropts j

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

@ -38,20 +38,22 @@ entriesReport ropts@ReportOpts{..} q j@Journal{..} =
sortBy (comparing datefn) $ filter (q `matchesTransaction`) $ map tvalue jtxns
where
datefn = transactionDateFn ropts
prices = journalPrices j
styles = journalCommodityStyles j
tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings}
pvalue p@Posting{..} = case value_ of
Nothing -> p
Just (AtCost _mc) -> postingToCost (journalCommodityStyles j) p
Just (AtCost _mc) -> postingToCost styles p
Just (AtEnd _mc) -> valueend p
Just (AtNow _mc) -> valuenow p
Just (AtDefault _mc) -> valuenow p
Just (AtDate d _mc) -> postingValue jmarketprices d p
Just (AtDate d _mc) -> postingValue prices d p
where
valueend p = postingValue jmarketprices (
valueend p = postingValue prices (
fromMaybe (postingDate p) -- XXX shouldn't happen
mperiodorjournallastday
) p
valuenow p = postingValue jmarketprices (
valuenow p = postingValue prices (
case today_ of Just d -> d
Nothing -> error' "erValue: ReportOpts today_ is unset so could not satisfy --value=now"
) p

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

@ -157,9 +157,8 @@ multiBalanceReport ropts@ReportOpts{..} q j@Journal{..} =
-- end: summed/averaged row amounts
-- date: summed/averaged row amounts
today = fromMaybe (error' "postingsReport: ReportOpts today_ is unset so could not satisfy --value=now") today_
-- Market prices. Sort into date then parse order,
-- & reverse for quick lookup of the latest price.
prices = reverse $ sortOn mpdate jmarketprices
-- Market prices.
prices = journalPrices j
-- The last day of each column subperiod.
lastdays :: [Day] =
map ((maybe

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

@ -67,6 +67,7 @@ postingsReport ropts@ReportOpts{..} q j@Journal{..} =
reportspan = adjustReportDates ropts q j
whichdate = whichDateFromOpts ropts
depth = queryDepth q
prices = journalPrices j
-- postings to be included in the report, and similarly-matched postings before the report start date
(precedingps, reportps) = matchedPostingsBeforeAndDuring ropts q j reportspan
@ -95,13 +96,13 @@ postingsReport ropts@ReportOpts{..} q j@Journal{..} =
let
showempty = empty_ || average_
summaryps = summarisePostingsByInterval interval_ whichdate depth showempty reportspan reportps
summarypsendvalue = [(postingValue jmarketprices periodlastday p, periodend) | (p,periodend) <- summaryps
summarypsendvalue = [(postingValue prices periodlastday p, periodend) | (p,periodend) <- summaryps
,let periodlastday = maybe
(error' "postingsReport: expected a subperiod end date") -- XXX shouldn't happen
(addDays (-1))
periodend
]
summarypsdatevalue d = [(postingValue jmarketprices d p, periodend) | (p,periodend) <- summaryps]
summarypsdatevalue d = [(postingValue prices d p, periodend) | (p,periodend) <- summaryps]
in case value_ of
Nothing -> summaryps
Just (AtCost _mc) -> summaryps -- conversion to cost was done earlier
@ -115,7 +116,7 @@ postingsReport ropts@ReportOpts{..} q j@Journal{..} =
reportperiodlastday =
fromMaybe (error' "postingsReport: expected a non-empty journal") -- XXX shouldn't happen
$ reportPeriodOrJournalLastDay ropts j
reportpsdatevalue d = [(postingValue jmarketprices d p, Nothing) | p <- reportps]
reportpsdatevalue d = [(postingValue prices d p, Nothing) | p <- reportps]
reportpsnovalue = [(p, Nothing) | p <- reportps]
in case value_ of
Nothing -> reportpsnovalue
@ -137,10 +138,6 @@ postingsReport ropts@ReportOpts{..} q j@Journal{..} =
| otherwise = if historical then precedingsum else 0
-- For --value=end/now/DATE, convert the initial running total/average to value.
startbaldatevalue d = mixedAmountValue prices d startbal
where
-- prices are in parse order - sort into date then parse order,
-- & reversed for quick lookup of the latest price.
prices = reverse $ sortOn mpdate jmarketprices
valuedstartbal = case value_ of
Nothing -> startbal
Just (AtCost _mc) -> startbal -- conversion to cost was done earlier

8
hledger-lib/hledger-lib.cabal
View File

@ -4,7 +4,7 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
-- hash: ffd57f3b3365e927bfb79cb1bfe2ff6081fcd89b12d8a6fda4b6e254817b7ba7
-- hash: ac2028674178919d87ff7e06ea16e97e245e92deeb60beb9689c083547cd1a44
name: hledger-lib
version: 1.14.99
@ -58,7 +58,7 @@ library
Hledger.Data.Dates
Hledger.Data.Journal
Hledger.Data.Ledger
Hledger.Data.MarketPrice
Hledger.Data.Prices
Hledger.Data.Period
Hledger.Data.PeriodicTransaction
Hledger.Data.StringFormat
@ -159,10 +159,10 @@ test-suite doctests
Hledger.Data.Dates
Hledger.Data.Journal
Hledger.Data.Ledger
Hledger.Data.MarketPrice
Hledger.Data.Period
Hledger.Data.PeriodicTransaction
Hledger.Data.Posting
Hledger.Data.Prices
Hledger.Data.RawOptions
Hledger.Data.StringFormat
Hledger.Data.Timeclock
@ -261,10 +261,10 @@ test-suite easytests
Hledger.Data.Dates
Hledger.Data.Journal
Hledger.Data.Ledger
Hledger.Data.MarketPrice
Hledger.Data.Period
Hledger.Data.PeriodicTransaction
Hledger.Data.Posting
Hledger.Data.Prices
Hledger.Data.RawOptions
Hledger.Data.StringFormat
Hledger.Data.Timeclock

2
hledger-lib/package.yaml
View File

@ -110,7 +110,7 @@ library:
- Hledger.Data.Dates
- Hledger.Data.Journal
- Hledger.Data.Ledger
- Hledger.Data.MarketPrice
- Hledger.Data.Prices
- Hledger.Data.Period
- Hledger.Data.PeriodicTransaction
- Hledger.Data.StringFormat