Merge pull request #1560 from Xitian9/rationalisevaluation

Clean up valuation functions, and make clear which to use where.
This commit is contained in:
Simon Michael 2021-06-07 19:02:44 -10:00 committed by GitHub
commit 665fec83cd
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
16 changed files with 145 additions and 174 deletions

View File

@ -34,7 +34,7 @@ main = do
d <- getCurrentDay d <- getCurrentDay
let let
q = rsQuery rspec q = rsQuery rspec
ts = filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts (rsOpts rspec) j ts = filter (q `matchesTransaction`) $ jtxns $ journalApplyValuationFromOpts rspec j
ts' = map transactionSwapDates ts ts' = map transactionSwapDates ts
mapM_ (T.putStrLn . showTransaction) ts' mapM_ (T.putStrLn . showTransaction) ts'

View File

@ -63,7 +63,6 @@ module Hledger.Data.Posting (
-- * misc. -- * misc.
showComment, showComment,
postingTransformAmount, postingTransformAmount,
postingApplyCostValuation,
postingApplyValuation, postingApplyValuation,
postingToCost, postingToCost,
tests_Posting tests_Posting
@ -328,14 +327,6 @@ aliasReplace (BasicAlias old new) a
aliasReplace (RegexAlias re repl) a = aliasReplace (RegexAlias re repl) a =
fmap T.pack . regexReplace re repl $ T.unpack a -- XXX fmap T.pack . regexReplace re repl $ T.unpack a -- XXX
-- | Apply a specified costing and valuation to this posting's amount,
-- using the provided price oracle, commodity styles, and reference dates.
-- Costing is done first if requested, and after that any valuation.
-- See amountApplyValuation and amountCost.
postingApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Costing -> Maybe ValuationType -> Posting -> Posting
postingApplyCostValuation priceoracle styles periodlast today cost v p =
postingTransformAmount (mixedAmountApplyCostValuation priceoracle styles periodlast today (postingDate p) cost v) p
-- | Apply a specified valuation to this posting's amount, using the -- | Apply a specified valuation to this posting's amount, using the
-- provided price oracle, commodity styles, and reference dates. -- provided price oracle, commodity styles, and reference dates.
-- See amountApplyValuation. -- See amountApplyValuation.

View File

@ -34,7 +34,6 @@ module Hledger.Data.Transaction (
balanceTransaction, balanceTransaction,
balanceTransactionHelper, balanceTransactionHelper,
transactionTransformPostings, transactionTransformPostings,
transactionApplyCostValuation,
transactionApplyValuation, transactionApplyValuation,
transactionToCost, transactionToCost,
transactionApplyAliases, transactionApplyAliases,
@ -628,13 +627,6 @@ postingSetTransaction t p = p{ptransaction=Just t}
transactionTransformPostings :: (Posting -> Posting) -> Transaction -> Transaction transactionTransformPostings :: (Posting -> Posting) -> Transaction -> Transaction
transactionTransformPostings f t@Transaction{tpostings=ps} = t{tpostings=map f ps} transactionTransformPostings f t@Transaction{tpostings=ps} = t{tpostings=map f ps}
-- | Apply a specified costing and valuation to this transaction's amounts,
-- using the provided price oracle, commodity styles, and reference dates.
-- See amountApplyValuation and amountCost.
transactionApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Costing -> Maybe ValuationType -> Transaction -> Transaction
transactionApplyCostValuation priceoracle styles periodlast today cost v =
transactionTransformPostings (postingApplyCostValuation priceoracle styles periodlast today cost v)
-- | Apply a specified valuation to this transaction's amounts, using -- | Apply a specified valuation to this transaction's amounts, using
-- the provided price oracle, commodity styles, and reference dates. -- the provided price oracle, commodity styles, and reference dates.
-- See amountApplyValuation. -- See amountApplyValuation.
@ -644,7 +636,7 @@ transactionApplyValuation priceoracle styles periodlast today v =
-- | Convert this transaction's amounts to cost, and apply the appropriate amount styles. -- | Convert this transaction's amounts to cost, and apply the appropriate amount styles.
transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction
transactionToCost styles t@Transaction{tpostings=ps} = t{tpostings=map (postingToCost styles) ps} transactionToCost styles = transactionTransformPostings (postingToCost styles)
-- | Apply some account aliases to all posting account names in the transaction, as described by accountNameApplyAliases. -- | Apply some account aliases to all posting account names in the transaction, as described by accountNameApplyAliases.
-- This can fail due to a bad replacement pattern in a regular expression alias. -- This can fail due to a bad replacement pattern in a regular expression alias.

View File

@ -17,10 +17,7 @@ module Hledger.Data.Valuation (
,ValuationType(..) ,ValuationType(..)
,PriceOracle ,PriceOracle
,journalPriceOracle ,journalPriceOracle
,amountApplyCostValuation ,mixedAmountToCost
,amountApplyValuation
,amountValueAtDate
,mixedAmountApplyCostValuation
,mixedAmountApplyValuation ,mixedAmountApplyValuation
,mixedAmountValueAtDate ,mixedAmountValueAtDate
,marketPriceReverse ,marketPriceReverse
@ -100,13 +97,9 @@ priceDirectiveToMarketPrice PriceDirective{..} =
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- Converting things to value -- Converting things to value
-- | Apply a specified costing and valuation to this mixed amount, -- | Convert all component amounts to cost/selling price if requested, and style them.
-- using the provided price oracle, commodity styles, and reference dates. mixedAmountToCost :: Costing -> M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
-- Costing is done first if requested, and after that any valuation. mixedAmountToCost cost styles = mapMixedAmount (amountToCost cost styles)
-- See amountApplyValuation and amountCost.
mixedAmountApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> Costing -> Maybe ValuationType -> MixedAmount -> MixedAmount
mixedAmountApplyCostValuation priceoracle styles periodlast today postingdate cost v =
mapMixedAmount (amountApplyCostValuation priceoracle styles periodlast today postingdate cost v)
-- | Apply a specified valuation to this mixed amount, using the -- | Apply a specified valuation to this mixed amount, using the
-- provided price oracle, commodity styles, and reference dates. -- provided price oracle, commodity styles, and reference dates.
@ -115,18 +108,10 @@ mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle ->
mixedAmountApplyValuation priceoracle styles periodlast today postingdate v = mixedAmountApplyValuation priceoracle styles periodlast today postingdate v =
mapMixedAmount (amountApplyValuation priceoracle styles periodlast today postingdate v) mapMixedAmount (amountApplyValuation priceoracle styles periodlast today postingdate v)
-- | Apply a specified costing and valuation to this Amount, -- | Convert an Amount to its cost if requested, and style it appropriately.
-- using the provided price oracle, commodity styles, and reference dates. amountToCost :: Costing -> M.Map CommoditySymbol AmountStyle -> Amount -> Amount
-- Costing is done first if requested, and after that any valuation. amountToCost NoCost _ = id
-- See amountApplyValuation and amountCost. amountToCost Cost styles = styleAmount styles . amountCost
amountApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> Costing -> Maybe ValuationType -> Amount -> Amount
amountApplyCostValuation priceoracle styles periodlast today postingdate cost v =
valuation . costing
where
valuation = maybe id (amountApplyValuation priceoracle styles periodlast today postingdate) v
costing = case cost of
Cost -> styleAmount styles . amountCost
NoCost -> id
-- | Apply a specified valuation to this amount, using the provided -- | Apply a specified valuation to this amount, using the provided
-- price oracle, reference dates, and whether this is for a -- price oracle, reference dates, and whether this is for a

View File

@ -18,7 +18,7 @@ where
import Data.List (mapAccumL, nub, partition, sortBy) import Data.List (mapAccumL, nub, partition, sortBy)
import Data.Ord (comparing) import Data.Ord (comparing)
import Data.Maybe (catMaybes, fromMaybe) import Data.Maybe (catMaybes)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
@ -83,45 +83,28 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i
where where
-- a depth limit should not affect the account transactions report -- a depth limit should not affect the account transactions report
-- seems unnecessary for some reason XXX -- seems unnecessary for some reason XXX
reportq' = -- filterQuery (not . queryIsDepth) reportq' = reportq -- filterQuery (not . queryIsDepth)
reportq
-- get all transactions
ts1 =
-- ptraceAtWith 5 (("ts1:\n"++).pshowTransactions) $
jtxns j
-- apply any cur:SYM filters in reportq'
symq = filterQuery queryIsSym reportq' symq = filterQuery queryIsSym reportq'
ts2 =
ptraceAtWith 5 (("ts2:\n"++).pshowTransactions) $
(if queryIsNull symq then id else map (filterTransactionAmounts symq)) ts1
-- keep just the transactions affecting this account (via possibly realness or status-filtered postings)
realq = filterQuery queryIsReal reportq' realq = filterQuery queryIsReal reportq'
statusq = filterQuery queryIsStatus reportq' statusq = filterQuery queryIsStatus reportq'
ts3 =
traceAt 3 ("thisacctq: "++show thisacctq) $
ptraceAtWith 5 (("ts3:\n"++).pshowTransactions) $
filter (matchesTransaction thisacctq . filterTransactionPostings (And [realq, statusq])) ts2
-- maybe convert these transactions to cost or value
-- PARTIAL:
prices = journalPriceOracle (infer_value_ ropts) j
styles = journalCommodityStyles j
periodlast =
fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen
reportPeriodOrJournalLastDay rspec j
tval = transactionApplyCostValuation prices styles periodlast (rsToday rspec) (cost_ ropts) $ value_ ropts
ts4 =
ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $
map tval ts3
-- sort by the transaction's register date, for accurate starting balance -- sort by the transaction's register date, for accurate starting balance
-- these are not yet filtered by tdate, we want to search them all for priorps -- these are not yet filtered by tdate, we want to search them all for priorps
ts5 = transactions =
ptraceAtWith 5 (("ts5:\n"++).pshowTransactions) $ ptraceAtWith 5 (("ts5:\n"++).pshowTransactions)
sortBy (comparing (transactionRegisterDate reportq' thisacctq)) ts4 . sortBy (comparing (transactionRegisterDate reportq' thisacctq))
. jtxns
. ptraceAtWith 5 (("ts4:\n"++).pshowTransactions.jtxns)
-- keep just the transactions affecting this account (via possibly realness or status-filtered postings)
. traceAt 3 ("thisacctq: "++show thisacctq)
. ptraceAtWith 5 (("ts3:\n"++).pshowTransactions.jtxns)
. filterJournalTransactions thisacctq
. filterJournalPostings (And [realq, statusq])
-- apply any cur:SYM filters in reportq'
. ptraceAtWith 5 (("ts2:\n"++).pshowTransactions.jtxns)
. (if queryIsNull symq then id else filterJournalAmounts symq)
-- maybe convert these transactions to cost or value
$ journalApplyValuationFromOpts rspec j
startbal startbal
| balancetype_ ropts == HistoricalBalance = sumPostings priorps | balancetype_ ropts == HistoricalBalance = sumPostings priorps
@ -131,7 +114,7 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i
filter (matchesPosting filter (matchesPosting
(dbg5 "priorq" $ (dbg5 "priorq" $
And [thisacctq, tostartdateq, datelessreportq])) And [thisacctq, tostartdateq, datelessreportq]))
$ transactionsPostings ts5 $ transactionsPostings transactions
tostartdateq = tostartdateq =
case mstartdate of case mstartdate of
Just _ -> Date (DateSpan Nothing mstartdate) Just _ -> Date (DateSpan Nothing mstartdate)
@ -148,7 +131,7 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i
items = reverse $ items = reverse $
accountTransactionsReportItems reportq' thisacctq startbal maNegate $ accountTransactionsReportItems reportq' thisacctq startbal maNegate $
(if filtertxns then filter (reportq' `matchesTransaction`) else id) $ (if filtertxns then filter (reportq' `matchesTransaction`) else id) $
ts5 transactions
pshowTransactions :: [Transaction] -> String pshowTransactions :: [Transaction] -> String
pshowTransactions = pshow . map (\t -> unwords [show $ tdate t, T.unpack $ tdescription t]) pshowTransactions = pshow . map (\t -> unwords [show $ tdate t, T.unpack $ tdescription t])

View File

@ -1,4 +1,6 @@
{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances, ScopedTypeVariables #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-| {-|
Journal entries report, used by the print command. Journal entries report, used by the print command.
@ -15,12 +17,11 @@ module Hledger.Reports.EntriesReport (
where where
import Data.List (sortBy) import Data.List (sortBy)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing) import Data.Ord (comparing)
import Data.Time (fromGregorian) import Data.Time (fromGregorian)
import Hledger.Data import Hledger.Data
import Hledger.Query import Hledger.Query (Query(..))
import Hledger.Reports.ReportOptions import Hledger.Reports.ReportOptions
import Hledger.Utils import Hledger.Utils
@ -33,15 +34,9 @@ type EntriesReportItem = Transaction
-- | Select transactions for an entries report. -- | Select transactions for an entries report.
entriesReport :: ReportSpec -> Journal -> EntriesReport entriesReport :: ReportSpec -> Journal -> EntriesReport
entriesReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j@Journal{..} = entriesReport rspec@ReportSpec{rsOpts=ropts} =
sortBy (comparing getdate) $ filter (rsQuery rspec `matchesTransaction`) $ map tvalue jtxns sortBy (comparing $ transactionDateFn ropts) . jtxns . filterJournalTransactions (rsQuery rspec)
where . journalApplyValuationFromOpts rspec{rsOpts=ropts{show_costs_=True}}
getdate = transactionDateFn ropts
-- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings}
where
pvalue = postingApplyCostValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) cost_ value_
where periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j
tests_EntriesReport = tests "EntriesReport" [ tests_EntriesReport = tests "EntriesReport" [
tests "entriesReport" [ tests "entriesReport" [

View File

@ -41,10 +41,10 @@ import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (fromMaybe, mapMaybe) import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Ord (Down(..)) import Data.Ord (Down(..))
import Data.Semigroup (sconcat) import Data.Semigroup (sconcat)
import Data.Time.Calendar (Day, addDays, fromGregorian) import Data.Time.Calendar (Day, fromGregorian)
import Safe (lastDef, minimumMay) import Safe (lastDef, minimumMay)
import Hledger.Data import Hledger.Data
@ -111,7 +111,7 @@ multiBalanceReportWith rspec' j priceoracle = report
rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan
-- Group postings into their columns. -- Group postings into their columns.
colps = dbg5 "colps" $ getPostingsByColumn rspec j reportspan colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle reportspan
-- The matched accounts with a starting balance. All of these should appear -- The matched accounts with a starting balance. All of these should appear
-- in the report, even if they have no postings during the report period. -- in the report, even if they have no postings during the report period.
@ -139,7 +139,7 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan
-- Group postings into their columns. -- Group postings into their columns.
colps = dbg5 "colps" $ getPostingsByColumn rspec j reportspan colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle reportspan
-- The matched accounts with a starting balance. All of these should appear -- The matched accounts with a starting balance. All of these should appear
-- in the report, even if they have no postings during the report period. -- in the report, even if they have no postings during the report period.
@ -187,7 +187,7 @@ startingBalances rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j priceoracle repo
fmap (M.findWithDefault nullacct precedingspan) acctmap fmap (M.findWithDefault nullacct precedingspan) acctmap
where where
acctmap = calculateReportMatrix rspec' j priceoracle mempty acctmap = calculateReportMatrix rspec' j priceoracle mempty
. M.singleton precedingspan . map fst $ getPostings rspec' j . M.singleton precedingspan . map fst $ getPostings rspec' j priceoracle
rspec' = rspec{rsQuery=startbalq,rsOpts=ropts'} rspec' = rspec{rsQuery=startbalq,rsOpts=ropts'}
-- If we're re-valuing every period, we need to have the unvalued start -- If we're re-valuing every period, we need to have the unvalued start
@ -225,11 +225,11 @@ makeReportQuery rspec reportspan
dateqcons = if date2_ (rsOpts rspec) then Date2 else Date dateqcons = if date2_ (rsOpts rspec) then Date2 else Date
-- | Group postings, grouped by their column -- | Group postings, grouped by their column
getPostingsByColumn :: ReportSpec -> Journal -> DateSpan -> Map DateSpan [Posting] getPostingsByColumn :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> Map DateSpan [Posting]
getPostingsByColumn rspec j reportspan = columns getPostingsByColumn rspec j priceoracle reportspan = columns
where where
-- Postings matching the query within the report period. -- Postings matching the query within the report period.
ps :: [(Posting, Day)] = dbg5 "getPostingsByColumn" $ getPostings rspec j ps :: [(Posting, Day)] = dbg5 "getPostingsByColumn" $ getPostings rspec j priceoracle
-- The date spans to be included as report columns. -- The date spans to be included as report columns.
colspans = dbg3 "colspans" $ splitSpan (interval_ $ rsOpts rspec) reportspan colspans = dbg3 "colspans" $ splitSpan (interval_ $ rsOpts rspec) reportspan
@ -240,12 +240,13 @@ getPostingsByColumn rspec j reportspan = columns
columns = foldr addPosting emptyMap ps columns = foldr addPosting emptyMap ps
-- | Gather postings matching the query within the report period. -- | Gather postings matching the query within the report period.
getPostings :: ReportSpec -> Journal -> [(Posting, Day)] getPostings :: ReportSpec -> Journal -> PriceOracle -> [(Posting, Day)]
getPostings ReportSpec{rsQuery=query,rsOpts=ropts} = getPostings rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j priceoracle =
map (\p -> (p, date p)) . map (\p -> (p, date p)) .
journalPostings . journalPostings .
filterJournalAmounts symq . -- remove amount parts excluded by cur: filterJournalAmounts symq . -- remove amount parts excluded by cur:
filterJournalPostings reportq -- remove postings not matched by (adjusted) query filterJournalPostings reportq $ -- remove postings not matched by (adjusted) query
valuedJournal
where where
symq = dbg3 "symq" . filterQuery queryIsSym $ dbg3 "requested q" query symq = dbg3 "symq" . filterQuery queryIsSym $ dbg3 "requested q" query
-- The user's query with no depth limit, and expanded to the report span -- The user's query with no depth limit, and expanded to the report span
@ -253,6 +254,8 @@ getPostings ReportSpec{rsQuery=query,rsOpts=ropts} =
-- handles the hledger-ui+future txns case above). -- handles the hledger-ui+future txns case above).
reportq = dbg3 "reportq" $ depthless query reportq = dbg3 "reportq" $ depthless query
depthless = dbg3 "depthless" . filterQuery (not . queryIsDepth) depthless = dbg3 "depthless" . filterQuery (not . queryIsDepth)
valuedJournal | isJust (valuationAfterSum ropts) = j
| otherwise = journalApplyValuationFromOptsWith rspec j priceoracle
date = case whichDateFromOpts ropts of date = case whichDateFromOpts ropts of
PrimaryDate -> postingDate PrimaryDate -> postingDate
@ -291,7 +294,7 @@ calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals col
-- starting-balance-based historical balances. -- starting-balance-based historical balances.
rowbals name changes = dbg5 "rowbals" $ case balancetype_ ropts of rowbals name changes = dbg5 "rowbals" $ case balancetype_ ropts of
PeriodChange -> changeamts PeriodChange -> changeamts
CumulativeChange -> cumulativeSum avalue nullacct changeamts CumulativeChange -> cumulative
HistoricalBalance -> historical HistoricalBalance -> historical
where where
-- changes to report on: usually just the changes itself, but use the -- changes to report on: usually just the changes itself, but use the
@ -300,6 +303,7 @@ calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals col
ChangeReport -> M.mapWithKey avalue changes ChangeReport -> M.mapWithKey avalue changes
BudgetReport -> M.mapWithKey avalue changes BudgetReport -> M.mapWithKey avalue changes
ValueChangeReport -> periodChanges valuedStart historical ValueChangeReport -> periodChanges valuedStart historical
cumulative = cumulativeSum avalue nullacct changeamts
historical = cumulativeSum avalue startingBalance changes historical = cumulativeSum avalue startingBalance changes
startingBalance = HM.lookupDefault nullacct name startbals startingBalance = HM.lookupDefault nullacct name startbals
valuedStart = avalue (DateSpan Nothing historicalDate) startingBalance valuedStart = avalue (DateSpan Nothing historicalDate) startingBalance
@ -308,10 +312,10 @@ calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals col
-- pad with zeros -- pad with zeros
allchanges = ((<>zeros) <$> acctchanges) <> (zeros <$ startbals) allchanges = ((<>zeros) <$> acctchanges) <> (zeros <$ startbals)
acctchanges = dbg5 "acctchanges" . addElided $ transposeMap colacctchanges acctchanges = dbg5 "acctchanges" . addElided $ transposeMap colacctchanges
colacctchanges = dbg5 "colacctchanges" $ fmap (acctChangesFromPostings rspec) valuedps colacctchanges = dbg5 "colacctchanges" $ fmap (acctChangesFromPostings rspec) colps
valuedps = M.mapWithKey (\colspan -> map (pvalue colspan)) colps
(pvalue, avalue) = postingAndAccountValuations rspec j priceoracle avalue = acctApplyBoth . mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle
acctApplyBoth f a = a{aibalance = f $ aibalance a, aebalance = f $ aebalance a}
addElided = if queryDepth (rsQuery rspec) == Just 0 then HM.insert "..." zeros else id addElided = if queryDepth (rsQuery rspec) == Just 0 then HM.insert "..." zeros else id
historicalDate = minimumMay $ mapMaybe spanStart colspans historicalDate = minimumMay $ mapMaybe spanStart colspans
zeros = M.fromList [(span, nullacct) | span <- colspans] zeros = M.fromList [(span, nullacct) | span <- colspans]
@ -549,29 +553,6 @@ cumulativeSum :: (DateSpan -> Account -> Account) -> Account -> Map DateSpan Acc
cumulativeSum value start = snd . M.mapAccumWithKey accumValued start cumulativeSum value start = snd . M.mapAccumWithKey accumValued start
where accumValued startAmt date newAmt = let s = sumAcct startAmt newAmt in (s, value date s) where accumValued startAmt date newAmt = let s = sumAcct startAmt newAmt in (s, value date s)
-- | Calculate the Posting and Account valuation functions required by this
-- MultiBalanceReport.
postingAndAccountValuations :: ReportSpec -> Journal -> PriceOracle
-> (DateSpan -> Posting -> Posting, DateSpan -> Account -> Account)
postingAndAccountValuations ReportSpec{rsToday=today, rsOpts=ropts} j priceoracle = case value_ ropts of
-- If we're doing AtEnd valuation, we may need to value the same posting at different dates
-- (for example, when preparing a ValueChange report). So we should only convert to cost and
-- maybe strip prices from the Posting, and should do valuation on the Accounts.
Just v@(AtEnd _) -> (pvalue Nothing, avalue v)
-- Otherwise, all costing and valuation should be done on the Postings.
_ -> (pvalue (value_ ropts), const id)
where
-- For a Posting: convert to cost, apply valuation, then strip prices if we don't need them (See issue #1507).
pvalue v span = maybeStripPrices . postingApplyCostValuation priceoracle styles (end span) today (cost_ ropts) v
-- For an Account: Apply valuation to both the inclusive and exclusive balances.
avalue v span a = a{aibalance = value (aibalance a), aebalance = value (aebalance a)}
where value = mixedAmountApplyValuation priceoracle styles (end span) today (error "multiBalanceReport: did not expect amount valuation to be called ") v -- PARTIAL: should not happen
maybeStripPrices = if show_costs_ ropts then id else postingStripPrices
end = maybe (error "multiBalanceReport: expected all spans to have an end date") -- PARTIAL: should not happen
(addDays (-1)) . spanEnd
styles = journalCommodityStyles j
-- tests -- tests
tests_MultiBalanceReport = tests "MultiBalanceReport" [ tests_MultiBalanceReport = tests "MultiBalanceReport" [

View File

@ -68,30 +68,18 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items
reportspan = reportSpanBothDates j rspec reportspan = reportSpanBothDates j rspec
whichdate = whichDateFromOpts ropts whichdate = whichDateFromOpts ropts
mdepth = queryDepth $ rsQuery rspec mdepth = queryDepth $ rsQuery rspec
styles = journalCommodityStyles j
priceoracle = journalPriceOracle infer_value_ j
multiperiod = interval_ /= NoInterval multiperiod = interval_ /= NoInterval
-- postings to be included in the report, and similarly-matched postings before the report start date -- postings to be included in the report, and similarly-matched postings before the report start date
(precedingps, reportps) = matchedPostingsBeforeAndDuring rspec j reportspan (precedingps, reportps) = matchedPostingsBeforeAndDuring rspec j reportspan
-- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
-- Strip prices from postings if we won't need them.
pvalue periodlast = maybeStripPrices . postingApplyCostValuation priceoracle styles periodlast (rsToday rspec) cost_ value_
where maybeStripPrices = if show_costs_ then id else postingStripPrices
-- Postings, or summary postings with their subperiod's end date, to be displayed. -- Postings, or summary postings with their subperiod's end date, to be displayed.
displayps :: [(Posting, Maybe Day)] displayps :: [(Posting, Maybe Day)]
| multiperiod, Just (AtEnd _) <- value_ = [(pvalue lastday p, Just periodend) | (p, periodend) <- summariseps reportps, let lastday = addDays (-1) periodend] | multiperiod = [(p, Just periodend) | (p, periodend) <- summariseps reportps]
| multiperiod = [(p, Just periodend) | (p, periodend) <- summariseps valuedps] | otherwise = [(p, Nothing) | p <- reportps]
| otherwise = [(p, Nothing) | p <- valuedps]
where where
summariseps = summarisePostingsByInterval interval_ whichdate mdepth showempty reportspan summariseps = summarisePostingsByInterval interval_ whichdate mdepth showempty reportspan
valuedps = map (pvalue reportorjournallast) reportps
showempty = empty_ || average_ showempty = empty_ || average_
reportorjournallast =
fromMaybe (error' "postingsReport: expected a non-empty journal") $ -- PARTIAL: shouldn't happen
reportPeriodOrJournalLastDay rspec j
-- Posting report items ready for display. -- Posting report items ready for display.
items = items =
@ -106,12 +94,8 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items
startbal | average_ = if historical then precedingavg else nullmixedamt startbal | average_ = if historical then precedingavg else nullmixedamt
| otherwise = if historical then precedingsum else nullmixedamt | otherwise = if historical then precedingsum else nullmixedamt
where where
precedingsum = sumPostings $ map (pvalue daybeforereportstart) precedingps precedingsum = sumPostings precedingps
precedingavg = divideMixedAmount (fromIntegral $ length precedingps) precedingsum precedingavg = divideMixedAmount (fromIntegral $ length precedingps) precedingsum
daybeforereportstart =
maybe (error' "postingsReport: expected a non-empty journal") -- PARTIAL: shouldn't happen
(addDays (-1))
$ reportPeriodOrJournalStart rspec j
runningcalc = registerRunningCalculationFn ropts runningcalc = registerRunningCalculationFn ropts
startnum = if historical then length precedingps + 1 else 1 startnum = if historical then length precedingps + 1 else 1
@ -130,10 +114,10 @@ registerRunningCalculationFn ropts
-- Date restrictions and depth restrictions in the query are ignored. -- Date restrictions and depth restrictions in the query are ignored.
-- A helper for the postings report. -- A helper for the postings report.
matchedPostingsBeforeAndDuring :: ReportSpec -> Journal -> DateSpan -> ([Posting],[Posting]) matchedPostingsBeforeAndDuring :: ReportSpec -> Journal -> DateSpan -> ([Posting],[Posting])
matchedPostingsBeforeAndDuring ReportSpec{rsOpts=ropts,rsQuery=q} j (DateSpan mstart mend) = matchedPostingsBeforeAndDuring rspec@ReportSpec{rsOpts=ropts,rsQuery=q} j reportspan =
dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps
where where
beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing mstart beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing $ spanStart reportspan
beforeandduringps = beforeandduringps =
dbg5 "ps5" $ sortOn sortdate $ -- sort postings by date or date2 dbg5 "ps5" $ sortOn sortdate $ -- sort postings by date or date2
dbg5 "ps4" $ (if invert_ ropts then map negatePostingAmount else id) $ -- with --invert, invert amounts dbg5 "ps4" $ (if invert_ ropts then map negatePostingAmount else id) $ -- with --invert, invert amounts
@ -141,13 +125,13 @@ matchedPostingsBeforeAndDuring ReportSpec{rsOpts=ropts,rsQuery=q} j (DateSpan ms
dbg5 "ps2" $ (if related_ ropts then concatMap relatedPostings else id) $ -- with -r, replace each with its sibling postings dbg5 "ps2" $ (if related_ ropts then concatMap relatedPostings else id) $ -- with -r, replace each with its sibling postings
dbg5 "ps1" $ filter (beforeandduringq `matchesPosting`) $ -- filter postings by the query, with no start date or depth limit dbg5 "ps1" $ filter (beforeandduringq `matchesPosting`) $ -- filter postings by the query, with no start date or depth limit
journalPostings $ journalPostings $
journalSelectingAmountFromOpts ropts j -- maybe convert to cost early, will be seen by amt:. XXX what about converting to value ? journalApplyValuationFromOpts rspec j -- convert to cost and apply valuation
where where
beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq] beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq]
where where
depthless = filterQuery (not . queryIsDepth) depthless = filterQuery (not . queryIsDepth)
dateless = filterQuery (not . queryIsDateOrDate2) dateless = filterQuery (not . queryIsDateOrDate2)
beforeendq = dateqtype $ DateSpan Nothing mend beforeendq = dateqtype $ DateSpan Nothing $ spanEnd reportspan
sortdate = if date2_ ropts then postingDate2 else postingDate sortdate = if date2_ ropts then postingDate2 else postingDate
symq = dbg4 "symq" $ filterQuery queryIsSym q symq = dbg4 "symq" $ filterQuery queryIsSym q
dateqtype dateqtype

View File

@ -28,7 +28,10 @@ module Hledger.Reports.ReportOptions (
reportOptsToggleStatus, reportOptsToggleStatus,
simplifyStatuses, simplifyStatuses,
whichDateFromOpts, whichDateFromOpts,
journalSelectingAmountFromOpts, journalApplyValuationFromOpts,
journalApplyValuationFromOptsWith,
mixedAmountApplyValuationAfterSumFromOptsWith,
valuationAfterSum,
intervalFromRawOpts, intervalFromRawOpts,
forecastPeriodFromRawOpts, forecastPeriodFromRawOpts,
queryFromFlags, queryFromFlags,
@ -47,6 +50,7 @@ module Hledger.Reports.ReportOptions (
where where
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Control.Monad ((<=<))
import Data.List.Extra (nubSort) import Data.List.Extra (nubSort)
import Data.Maybe (fromMaybe, mapMaybe) import Data.Maybe (fromMaybe, mapMaybe)
import qualified Data.Text as T import qualified Data.Text as T
@ -488,14 +492,64 @@ flat_ = not . tree_
-- depthFromOpts :: ReportOpts -> Int -- depthFromOpts :: ReportOpts -> Int
-- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts) -- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts)
-- | Convert this journal's postings' amounts to cost using their -- | Convert this journal's postings' amounts to cost and/or to value, if specified
-- transaction prices, if specified by options (-B/--cost). -- by options (-B/--cost/-V/-X/--value etc.). Strip prices if not needed. This
-- Maybe soon superseded by newer valuation code. -- should be the main stop for performing costing and valuation. The exception is
journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal -- whenever you need to perform valuation _after_ summing up amounts, as in a
journalSelectingAmountFromOpts opts = case cost_ opts of -- historical balance report with --value=end. valuationAfterSum will check for this
-- condition.
journalApplyValuationFromOpts :: ReportSpec -> Journal -> Journal
journalApplyValuationFromOpts rspec j =
journalApplyValuationFromOptsWith rspec j priceoracle
where priceoracle = journalPriceOracle (infer_value_ $ rsOpts rspec) j
-- | Like journalApplyValuationFromOpts, but takes PriceOracle as an argument.
journalApplyValuationFromOptsWith :: ReportSpec -> Journal -> PriceOracle -> Journal
journalApplyValuationFromOptsWith rspec@ReportSpec{rsOpts=ropts} j priceoracle =
journalMapPostings (valuation . maybeStripPrices) $ costing j
where
valuation p = maybe id (postingApplyValuation priceoracle styles (periodEnd p) (rsToday rspec)) (value_ ropts) p
maybeStripPrices = if show_costs_ ropts then id else postingStripPrices
costing = case cost_ ropts of
Cost -> journalToCost Cost -> journalToCost
NoCost -> id NoCost -> id
-- Find the end of the period containing this posting
periodEnd = addDays (-1) . fromMaybe err . mPeriodEnd . postingDate
mPeriodEnd = spanEnd <=< latestSpanContaining (historical : spans)
historical = DateSpan Nothing $ spanStart =<< headMay spans
spans = splitSpan (interval_ ropts) $ reportSpanBothDates j rspec
styles = journalCommodityStyles j
err = error "journalApplyValuationFromOpts: expected all spans to have an end date"
-- | Select the Account valuation functions required for performing valuation after summing
-- amounts. Used in MultiBalanceReport to value historical and similar reports.
mixedAmountApplyValuationAfterSumFromOptsWith :: ReportOpts -> Journal -> PriceOracle
-> (DateSpan -> MixedAmount -> MixedAmount)
mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle =
case valuationAfterSum ropts of
Just mc -> \span -> valuation mc span . maybeStripPrices . costing
Nothing -> const id
where
valuation mc span = mixedAmountValueAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd span)
where err = error "mixedAmountApplyValuationAfterSumFromOptsWith: expected all spans to have an end date"
maybeStripPrices = if show_costs_ ropts then id else mixedAmountStripPrices
costing = case cost_ ropts of
Cost -> styleMixedAmount styles . mixedAmountCost
NoCost -> id
styles = journalCommodityStyles j
-- | If the ReportOpts specify that we are performing valuation after summing amounts,
-- return Just the commodity symbol we're converting to, otherwise return Nothing.
-- Used for example with historical reports with --value=end.
valuationAfterSum :: ReportOpts -> Maybe (Maybe CommoditySymbol)
valuationAfterSum ropts = case value_ ropts of
Just (AtEnd mc) | valueAfterSum -> Just mc
_ -> Nothing
where valueAfterSum = reporttype_ ropts == ValueChangeReport
|| balancetype_ ropts /= PeriodChange
-- | Convert report options to a query, ignoring any non-flag command line arguments. -- | Convert report options to a query, ignoring any non-flag command line arguments.
queryFromFlags :: ReportOpts -> Query queryFromFlags :: ReportOpts -> Query
queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq

View File

@ -61,13 +61,13 @@ triCommodityBalance c = filterMixedAmountByCommodity c . triBalance
-- "postingsReport" except with transaction-based report items which -- "postingsReport" except with transaction-based report items which
-- are ordered most recent first. XXX Or an EntriesReport - use that instead ? -- are ordered most recent first. XXX Or an EntriesReport - use that instead ?
-- This is used by hledger-web's journal view. -- This is used by hledger-web's journal view.
transactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport transactionsReport :: ReportSpec -> Journal -> Query -> TransactionsReport
transactionsReport opts j q = items transactionsReport rspec j q = items
where where
-- XXX items' first element should be the full transaction with all postings -- XXX items' first element should be the full transaction with all postings
items = reverse $ accountTransactionsReportItems q None nullmixedamt id ts items = reverse $ accountTransactionsReportItems q None nullmixedamt id ts
ts = sortBy (comparing date) $ filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts opts j ts = sortBy (comparing date) $ filter (q `matchesTransaction`) $ jtxns $ journalApplyValuationFromOpts rspec j
date = transactionDateFn opts date = transactionDateFn $ rsOpts rspec
-- | Split a transactions report whose items may involve several commodities, -- | Split a transactions report whose items may involve several commodities,
-- into one or more single-commodity transactions reports. -- into one or more single-commodity transactions reports.

View File

@ -81,7 +81,10 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{
render . defaultLayout toplabel bottomlabel . str render . defaultLayout toplabel bottomlabel . str
. T.unpack . showTransactionOneLineAmounts . T.unpack . showTransactionOneLineAmounts
$ transactionApplyCostValuation prices styles periodlast (rsToday rspec) (cost_ ropts) (value_ ropts) t . maybe id (transactionApplyValuation prices styles periodlast (rsToday rspec)) (value_ ropts)
$ case cost_ ropts of
Cost -> transactionToCost styles t
NoCost -> t
-- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real
where where
toplabel = toplabel =

View File

@ -27,7 +27,7 @@ getJournalR = do
Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)" Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)"
title' = title <> if m /= Any then ", filtered" else "" title' = title <> if m /= Any then ", filtered" else ""
acctlink a = (RegisterR, [("q", replaceInacct q $ accountQuery a)]) acctlink a = (RegisterR, [("q", replaceInacct q $ accountQuery a)])
items = transactionsReport (rsOpts . reportspec_ $ cliopts_ opts) j m items = transactionsReport (reportspec_ $ cliopts_ opts) j m
transactionFrag = transactionFragment j transactionFrag = transactionFragment j
defaultLayout $ do defaultLayout $ do

View File

@ -17,7 +17,7 @@ journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do
filets = filets =
groupBy (\t1 t2 -> transactionFile t1 == transactionFile t2) $ groupBy (\t1 t2 -> transactionFile t1 == transactionFile t2) $
filter (rsQuery rspec `matchesTransaction`) $ filter (rsQuery rspec `matchesTransaction`) $
jtxns $ journalSelectingAmountFromOpts ropts j jtxns $ journalApplyValuationFromOpts rspec j
checkunique = False -- boolopt "unique" rawopts XXX was supported by checkdates command checkunique = False -- boolopt "unique" rawopts XXX was supported by checkdates command
compare a b = if checkunique then getdate a < getdate b else getdate a <= getdate b compare a b = if checkunique then getdate a < getdate b else getdate a <= getdate b
where getdate = transactionDateFn ropts where getdate = transactionDateFn ropts

View File

@ -25,7 +25,7 @@ checkdates :: CliOpts -> Journal -> IO ()
checkdates CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do checkdates CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
let ropts = (rsOpts rspec){accountlistmode_=ALFlat} let ropts = (rsOpts rspec){accountlistmode_=ALFlat}
let ts = filter (rsQuery rspec `matchesTransaction`) $ let ts = filter (rsQuery rspec `matchesTransaction`) $
jtxns $ journalSelectingAmountFromOpts ropts j jtxns $ journalApplyValuationFromOpts rspec{rsOpts=ropts} j
-- pprint rawopts -- pprint rawopts
let unique = boolopt "--unique" rawopts -- TEMP: it's this for hledger check dates let unique = boolopt "--unique" rawopts -- TEMP: it's this for hledger check dates
|| boolopt "unique" rawopts -- and this for hledger check-dates (for some reason) || boolopt "unique" rawopts -- and this for hledger check-dates (for some reason)

View File

@ -62,7 +62,10 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{rsOpts=ReportOpts{..}
priceOracle = journalPriceOracle infer_value_ j priceOracle = journalPriceOracle infer_value_ j
styles = journalCommodityStyles j styles = journalCommodityStyles j
today = rsToday rspec today = rsToday rspec
mixedAmountValue periodlast date = mixedAmountApplyCostValuation priceOracle styles periodlast today date cost_ value_ mixedAmountValue periodlast date =
maybe id (mixedAmountApplyValuation priceOracle styles periodlast today date) value_
. mixedAmountToCost cost_ styles
let let
ropts = rsOpts rspec ropts = rsOpts rspec
showCashFlow = boolopt "cashflow" rawopts showCashFlow = boolopt "cashflow" rawopts

View File

@ -39,7 +39,7 @@ tags CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
argsquery <- either usageError (return . fst) $ parseQueryList d querystring argsquery <- either usageError (return . fst) $ parseQueryList d querystring
let let
q = simplifyQuery $ And [queryFromFlags $ rsOpts rspec, argsquery] q = simplifyQuery $ And [queryFromFlags $ rsOpts rspec, argsquery]
txns = filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts (rsOpts rspec) j txns = filter (q `matchesTransaction`) $ jtxns $ journalApplyValuationFromOpts rspec j
tagsorvalues = tagsorvalues =
(if parsed then id else nubSort) (if parsed then id else nubSort)
[ r [ r