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
GitHub
commit
665fec83cd
@ -34,7 +34,7 @@ main = do
|
||||
d <- getCurrentDay
|
||||
let
|
||||
q = rsQuery rspec
|
||||
ts = filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts (rsOpts rspec) j
|
||||
ts = filter (q `matchesTransaction`) $ jtxns $ journalApplyValuationFromOpts rspec j
|
||||
ts' = map transactionSwapDates ts
|
||||
mapM_ (T.putStrLn . showTransaction) ts'
|
||||
|
||||
|
||||
@ -63,7 +63,6 @@ module Hledger.Data.Posting (
|
||||
-- * misc.
|
||||
showComment,
|
||||
postingTransformAmount,
|
||||
postingApplyCostValuation,
|
||||
postingApplyValuation,
|
||||
postingToCost,
|
||||
tests_Posting
|
||||
@ -328,14 +327,6 @@ aliasReplace (BasicAlias old new) a
|
||||
aliasReplace (RegexAlias re repl) a =
|
||||
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
|
||||
-- provided price oracle, commodity styles, and reference dates.
|
||||
-- See amountApplyValuation.
|
||||
|
||||
@ -34,7 +34,6 @@ module Hledger.Data.Transaction (
|
||||
balanceTransaction,
|
||||
balanceTransactionHelper,
|
||||
transactionTransformPostings,
|
||||
transactionApplyCostValuation,
|
||||
transactionApplyValuation,
|
||||
transactionToCost,
|
||||
transactionApplyAliases,
|
||||
@ -628,13 +627,6 @@ postingSetTransaction t p = p{ptransaction=Just t}
|
||||
transactionTransformPostings :: (Posting -> Posting) -> Transaction -> Transaction
|
||||
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
|
||||
-- the provided price oracle, commodity styles, and reference dates.
|
||||
-- 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.
|
||||
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.
|
||||
-- This can fail due to a bad replacement pattern in a regular expression alias.
|
||||
|
||||
@ -17,10 +17,7 @@ module Hledger.Data.Valuation (
|
||||
,ValuationType(..)
|
||||
,PriceOracle
|
||||
,journalPriceOracle
|
||||
,amountApplyCostValuation
|
||||
,amountApplyValuation
|
||||
,amountValueAtDate
|
||||
,mixedAmountApplyCostValuation
|
||||
,mixedAmountToCost
|
||||
,mixedAmountApplyValuation
|
||||
,mixedAmountValueAtDate
|
||||
,marketPriceReverse
|
||||
@ -100,13 +97,9 @@ priceDirectiveToMarketPrice PriceDirective{..} =
|
||||
------------------------------------------------------------------------------
|
||||
-- Converting things to value
|
||||
|
||||
-- | Apply a specified costing and valuation to this mixed 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.
|
||||
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)
|
||||
-- | Convert all component amounts to cost/selling price if requested, and style them.
|
||||
mixedAmountToCost :: Costing -> M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
|
||||
mixedAmountToCost cost styles = mapMixedAmount (amountToCost cost styles)
|
||||
|
||||
-- | Apply a specified valuation to this mixed amount, using the
|
||||
-- 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 =
|
||||
mapMixedAmount (amountApplyValuation priceoracle styles periodlast today postingdate v)
|
||||
|
||||
-- | Apply a specified costing and valuation to this 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.
|
||||
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
|
||||
-- | Convert an Amount to its cost if requested, and style it appropriately.
|
||||
amountToCost :: Costing -> M.Map CommoditySymbol AmountStyle -> Amount -> Amount
|
||||
amountToCost NoCost _ = id
|
||||
amountToCost Cost styles = styleAmount styles . amountCost
|
||||
|
||||
-- | Apply a specified valuation to this amount, using the provided
|
||||
-- price oracle, reference dates, and whether this is for a
|
||||
@ -151,7 +136,7 @@ amountApplyCostValuation priceoracle styles periodlast today postingdate cost v
|
||||
--
|
||||
-- - the provided "today" date - (--value=now, or -V/X with no report
|
||||
-- end date).
|
||||
--
|
||||
--
|
||||
-- This is all a bit complicated. See the reference doc at
|
||||
-- https://hledger.org/hledger.html#effect-of-valuation-on-reports
|
||||
-- (hledger_options.m4.md "Effect of valuation on reports"), and #1083.
|
||||
|
||||
@ -18,7 +18,7 @@ where
|
||||
|
||||
import Data.List (mapAccumL, nub, partition, sortBy)
|
||||
import Data.Ord (comparing)
|
||||
import Data.Maybe (catMaybes, fromMaybe)
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar (Day)
|
||||
@ -83,45 +83,28 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i
|
||||
where
|
||||
-- a depth limit should not affect the account transactions report
|
||||
-- seems unnecessary for some reason XXX
|
||||
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'
|
||||
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'
|
||||
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
|
||||
reportq' = reportq -- filterQuery (not . queryIsDepth)
|
||||
symq = filterQuery queryIsSym reportq'
|
||||
realq = filterQuery queryIsReal reportq'
|
||||
statusq = filterQuery queryIsStatus reportq'
|
||||
|
||||
-- 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
|
||||
ts5 =
|
||||
ptraceAtWith 5 (("ts5:\n"++).pshowTransactions) $
|
||||
sortBy (comparing (transactionRegisterDate reportq' thisacctq)) ts4
|
||||
transactions =
|
||||
ptraceAtWith 5 (("ts5:\n"++).pshowTransactions)
|
||||
. 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
|
||||
| balancetype_ ropts == HistoricalBalance = sumPostings priorps
|
||||
@ -131,7 +114,7 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i
|
||||
filter (matchesPosting
|
||||
(dbg5 "priorq" $
|
||||
And [thisacctq, tostartdateq, datelessreportq]))
|
||||
$ transactionsPostings ts5
|
||||
$ transactionsPostings transactions
|
||||
tostartdateq =
|
||||
case mstartdate of
|
||||
Just _ -> Date (DateSpan Nothing mstartdate)
|
||||
@ -148,7 +131,7 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i
|
||||
items = reverse $
|
||||
accountTransactionsReportItems reportq' thisacctq startbal maNegate $
|
||||
(if filtertxns then filter (reportq' `matchesTransaction`) else id) $
|
||||
ts5
|
||||
transactions
|
||||
|
||||
pshowTransactions :: [Transaction] -> String
|
||||
pshowTransactions = pshow . map (\t -> unwords [show $ tdate t, T.unpack $ tdescription t])
|
||||
|
||||
@ -1,4 +1,6 @@
|
||||
{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances, ScopedTypeVariables #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-|
|
||||
|
||||
Journal entries report, used by the print command.
|
||||
@ -15,12 +17,11 @@ module Hledger.Reports.EntriesReport (
|
||||
where
|
||||
|
||||
import Data.List (sortBy)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Ord (comparing)
|
||||
import Data.Time (fromGregorian)
|
||||
|
||||
import Hledger.Data
|
||||
import Hledger.Query
|
||||
import Hledger.Query (Query(..))
|
||||
import Hledger.Reports.ReportOptions
|
||||
import Hledger.Utils
|
||||
|
||||
@ -33,15 +34,9 @@ type EntriesReportItem = Transaction
|
||||
|
||||
-- | Select transactions for an entries report.
|
||||
entriesReport :: ReportSpec -> Journal -> EntriesReport
|
||||
entriesReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j@Journal{..} =
|
||||
sortBy (comparing getdate) $ filter (rsQuery rspec `matchesTransaction`) $ map tvalue jtxns
|
||||
where
|
||||
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
|
||||
entriesReport rspec@ReportSpec{rsOpts=ropts} =
|
||||
sortBy (comparing $ transactionDateFn ropts) . jtxns . filterJournalTransactions (rsQuery rspec)
|
||||
. journalApplyValuationFromOpts rspec{rsOpts=ropts{show_costs_=True}}
|
||||
|
||||
tests_EntriesReport = tests "EntriesReport" [
|
||||
tests "entriesReport" [
|
||||
|
||||
@ -41,10 +41,10 @@ import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import Data.Maybe (fromMaybe, isJust, mapMaybe)
|
||||
import Data.Ord (Down(..))
|
||||
import Data.Semigroup (sconcat)
|
||||
import Data.Time.Calendar (Day, addDays, fromGregorian)
|
||||
import Data.Time.Calendar (Day, fromGregorian)
|
||||
import Safe (lastDef, minimumMay)
|
||||
|
||||
import Hledger.Data
|
||||
@ -111,7 +111,7 @@ multiBalanceReportWith rspec' j priceoracle = report
|
||||
rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan
|
||||
|
||||
-- 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
|
||||
-- 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
|
||||
|
||||
-- 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
|
||||
-- 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
|
||||
where
|
||||
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'}
|
||||
-- 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
|
||||
|
||||
-- | Group postings, grouped by their column
|
||||
getPostingsByColumn :: ReportSpec -> Journal -> DateSpan -> Map DateSpan [Posting]
|
||||
getPostingsByColumn rspec j reportspan = columns
|
||||
getPostingsByColumn :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> Map DateSpan [Posting]
|
||||
getPostingsByColumn rspec j priceoracle reportspan = columns
|
||||
where
|
||||
-- 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.
|
||||
colspans = dbg3 "colspans" $ splitSpan (interval_ $ rsOpts rspec) reportspan
|
||||
@ -240,12 +240,13 @@ getPostingsByColumn rspec j reportspan = columns
|
||||
columns = foldr addPosting emptyMap ps
|
||||
|
||||
-- | Gather postings matching the query within the report period.
|
||||
getPostings :: ReportSpec -> Journal -> [(Posting, Day)]
|
||||
getPostings ReportSpec{rsQuery=query,rsOpts=ropts} =
|
||||
getPostings :: ReportSpec -> Journal -> PriceOracle -> [(Posting, Day)]
|
||||
getPostings rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j priceoracle =
|
||||
map (\p -> (p, date p)) .
|
||||
journalPostings .
|
||||
filterJournalAmounts symq . -- remove amount parts excluded by cur:
|
||||
filterJournalPostings reportq -- remove postings not matched by (adjusted) query
|
||||
filterJournalAmounts symq . -- remove amount parts excluded by cur:
|
||||
filterJournalPostings reportq $ -- remove postings not matched by (adjusted) query
|
||||
valuedJournal
|
||||
where
|
||||
symq = dbg3 "symq" . filterQuery queryIsSym $ dbg3 "requested q" query
|
||||
-- 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).
|
||||
reportq = dbg3 "reportq" $ depthless query
|
||||
depthless = dbg3 "depthless" . filterQuery (not . queryIsDepth)
|
||||
valuedJournal | isJust (valuationAfterSum ropts) = j
|
||||
| otherwise = journalApplyValuationFromOptsWith rspec j priceoracle
|
||||
|
||||
date = case whichDateFromOpts ropts of
|
||||
PrimaryDate -> postingDate
|
||||
@ -291,7 +294,7 @@ calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals col
|
||||
-- starting-balance-based historical balances.
|
||||
rowbals name changes = dbg5 "rowbals" $ case balancetype_ ropts of
|
||||
PeriodChange -> changeamts
|
||||
CumulativeChange -> cumulativeSum avalue nullacct changeamts
|
||||
CumulativeChange -> cumulative
|
||||
HistoricalBalance -> historical
|
||||
where
|
||||
-- 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
|
||||
BudgetReport -> M.mapWithKey avalue changes
|
||||
ValueChangeReport -> periodChanges valuedStart historical
|
||||
cumulative = cumulativeSum avalue nullacct changeamts
|
||||
historical = cumulativeSum avalue startingBalance changes
|
||||
startingBalance = HM.lookupDefault nullacct name startbals
|
||||
valuedStart = avalue (DateSpan Nothing historicalDate) startingBalance
|
||||
@ -308,10 +312,10 @@ calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals col
|
||||
-- pad with zeros
|
||||
allchanges = ((<>zeros) <$> acctchanges) <> (zeros <$ startbals)
|
||||
acctchanges = dbg5 "acctchanges" . addElided $ transposeMap colacctchanges
|
||||
colacctchanges = dbg5 "colacctchanges" $ fmap (acctChangesFromPostings rspec) valuedps
|
||||
valuedps = M.mapWithKey (\colspan -> map (pvalue colspan)) colps
|
||||
colacctchanges = dbg5 "colacctchanges" $ fmap (acctChangesFromPostings rspec) 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
|
||||
historicalDate = minimumMay $ mapMaybe spanStart 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
|
||||
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_MultiBalanceReport = tests "MultiBalanceReport" [
|
||||
|
||||
@ -68,30 +68,18 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items
|
||||
reportspan = reportSpanBothDates j rspec
|
||||
whichdate = whichDateFromOpts ropts
|
||||
mdepth = queryDepth $ rsQuery rspec
|
||||
styles = journalCommodityStyles j
|
||||
priceoracle = journalPriceOracle infer_value_ j
|
||||
multiperiod = interval_ /= NoInterval
|
||||
|
||||
-- postings to be included in the report, and similarly-matched postings before the report start date
|
||||
(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.
|
||||
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 valuedps]
|
||||
| otherwise = [(p, Nothing) | p <- valuedps]
|
||||
| multiperiod = [(p, Just periodend) | (p, periodend) <- summariseps reportps]
|
||||
| otherwise = [(p, Nothing) | p <- reportps]
|
||||
where
|
||||
summariseps = summarisePostingsByInterval interval_ whichdate mdepth showempty reportspan
|
||||
valuedps = map (pvalue reportorjournallast) reportps
|
||||
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.
|
||||
items =
|
||||
@ -106,12 +94,8 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items
|
||||
startbal | average_ = if historical then precedingavg else nullmixedamt
|
||||
| otherwise = if historical then precedingsum else nullmixedamt
|
||||
where
|
||||
precedingsum = sumPostings $ map (pvalue daybeforereportstart) precedingps
|
||||
precedingsum = sumPostings precedingps
|
||||
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
|
||||
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.
|
||||
-- A helper for the postings report.
|
||||
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
|
||||
where
|
||||
beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing mstart
|
||||
beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing $ spanStart reportspan
|
||||
beforeandduringps =
|
||||
dbg5 "ps5" $ sortOn sortdate $ -- sort postings by date or date2
|
||||
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 "ps1" $ filter (beforeandduringq `matchesPosting`) $ -- filter postings by the query, with no start date or depth limit
|
||||
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
|
||||
beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq]
|
||||
where
|
||||
depthless = filterQuery (not . queryIsDepth)
|
||||
dateless = filterQuery (not . queryIsDateOrDate2)
|
||||
beforeendq = dateqtype $ DateSpan Nothing mend
|
||||
beforeendq = dateqtype $ DateSpan Nothing $ spanEnd reportspan
|
||||
sortdate = if date2_ ropts then postingDate2 else postingDate
|
||||
symq = dbg4 "symq" $ filterQuery queryIsSym q
|
||||
dateqtype
|
||||
|
||||
@ -28,7 +28,10 @@ module Hledger.Reports.ReportOptions (
|
||||
reportOptsToggleStatus,
|
||||
simplifyStatuses,
|
||||
whichDateFromOpts,
|
||||
journalSelectingAmountFromOpts,
|
||||
journalApplyValuationFromOpts,
|
||||
journalApplyValuationFromOptsWith,
|
||||
mixedAmountApplyValuationAfterSumFromOptsWith,
|
||||
valuationAfterSum,
|
||||
intervalFromRawOpts,
|
||||
forecastPeriodFromRawOpts,
|
||||
queryFromFlags,
|
||||
@ -47,6 +50,7 @@ module Hledger.Reports.ReportOptions (
|
||||
where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Control.Monad ((<=<))
|
||||
import Data.List.Extra (nubSort)
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import qualified Data.Text as T
|
||||
@ -488,13 +492,63 @@ flat_ = not . tree_
|
||||
-- depthFromOpts :: ReportOpts -> Int
|
||||
-- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts)
|
||||
|
||||
-- | Convert this journal's postings' amounts to cost using their
|
||||
-- transaction prices, if specified by options (-B/--cost).
|
||||
-- Maybe soon superseded by newer valuation code.
|
||||
journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
|
||||
journalSelectingAmountFromOpts opts = case cost_ opts of
|
||||
Cost -> journalToCost
|
||||
NoCost -> id
|
||||
-- | Convert this journal's postings' amounts to cost and/or to value, if specified
|
||||
-- by options (-B/--cost/-V/-X/--value etc.). Strip prices if not needed. This
|
||||
-- should be the main stop for performing costing and valuation. The exception is
|
||||
-- whenever you need to perform valuation _after_ summing up amounts, as in a
|
||||
-- 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
|
||||
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.
|
||||
queryFromFlags :: ReportOpts -> Query
|
||||
|
||||
@ -61,13 +61,13 @@ triCommodityBalance c = filterMixedAmountByCommodity c . triBalance
|
||||
-- "postingsReport" except with transaction-based report items which
|
||||
-- are ordered most recent first. XXX Or an EntriesReport - use that instead ?
|
||||
-- This is used by hledger-web's journal view.
|
||||
transactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport
|
||||
transactionsReport opts j q = items
|
||||
transactionsReport :: ReportSpec -> Journal -> Query -> TransactionsReport
|
||||
transactionsReport rspec j q = items
|
||||
where
|
||||
-- XXX items' first element should be the full transaction with all postings
|
||||
items = reverse $ accountTransactionsReportItems q None nullmixedamt id ts
|
||||
ts = sortBy (comparing date) $ filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts opts j
|
||||
date = transactionDateFn opts
|
||||
ts = sortBy (comparing date) $ filter (q `matchesTransaction`) $ jtxns $ journalApplyValuationFromOpts rspec j
|
||||
date = transactionDateFn $ rsOpts rspec
|
||||
|
||||
-- | Split a transactions report whose items may involve several commodities,
|
||||
-- into one or more single-commodity transactions reports.
|
||||
|
||||
@ -81,7 +81,10 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{
|
||||
|
||||
render . defaultLayout toplabel bottomlabel . str
|
||||
. 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
|
||||
where
|
||||
toplabel =
|
||||
|
||||
@ -27,7 +27,7 @@ getJournalR = do
|
||||
Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)"
|
||||
title' = title <> if m /= Any then ", filtered" else ""
|
||||
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
|
||||
|
||||
defaultLayout $ do
|
||||
|
||||
@ -17,7 +17,7 @@ journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do
|
||||
filets =
|
||||
groupBy (\t1 t2 -> transactionFile t1 == transactionFile t2) $
|
||||
filter (rsQuery rspec `matchesTransaction`) $
|
||||
jtxns $ journalSelectingAmountFromOpts ropts j
|
||||
jtxns $ journalApplyValuationFromOpts rspec j
|
||||
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
|
||||
where getdate = transactionDateFn ropts
|
||||
|
||||
@ -25,7 +25,7 @@ checkdates :: CliOpts -> Journal -> IO ()
|
||||
checkdates CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
|
||||
let ropts = (rsOpts rspec){accountlistmode_=ALFlat}
|
||||
let ts = filter (rsQuery rspec `matchesTransaction`) $
|
||||
jtxns $ journalSelectingAmountFromOpts ropts j
|
||||
jtxns $ journalApplyValuationFromOpts rspec{rsOpts=ropts} j
|
||||
-- pprint rawopts
|
||||
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)
|
||||
|
||||
@ -62,7 +62,10 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{rsOpts=ReportOpts{..}
|
||||
priceOracle = journalPriceOracle infer_value_ j
|
||||
styles = journalCommodityStyles j
|
||||
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
|
||||
ropts = rsOpts rspec
|
||||
showCashFlow = boolopt "cashflow" rawopts
|
||||
|
||||
@ -39,7 +39,7 @@ tags CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
|
||||
argsquery <- either usageError (return . fst) $ parseQueryList d querystring
|
||||
let
|
||||
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 =
|
||||
(if parsed then id else nubSort)
|
||||
[ r
|
||||
|
||||
Loading…
Reference in New Issue
Block a user