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

lib: Remove special handling of now-inaccessible AtDefault valuation constructor.

Browse Source 
This simplifies all the *ApplyValuation functions, as they no longer
need mreportdate or multiperiod arguments.
This commit is contained in:
Stephen Morgan 2020-12-17 17:13:06 +11:00 committed by Simon Michael
parent 0c23619ae7
commit cdec0f9382
8 changed files with 32 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -334,17 +334,16 @@ aliasReplace (RegexAlias re repl) a =
-- provided price oracle, commodity styles, reference dates, and
-- whether this is for a multiperiod report or not. See
-- amountApplyValuation.
postingApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> Posting -> ValuationType -> Posting
postingApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod p v =
postingApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Posting -> ValuationType -> Posting
postingApplyValuation priceoracle styles periodlast today p v =
case v of
AtCost Nothing -> postingToCost styles p
AtCost mc -> postingValueAtDate priceoracle styles mc periodlast $ postingToCost styles p
AtThen mc -> postingValueAtDate priceoracle styles mc (postingDate p) p
AtEnd mc -> postingValueAtDate priceoracle styles mc periodlast p
AtNow mc -> postingValueAtDate priceoracle styles mc today p
AtDefault mc | ismultiperiod -> postingValueAtDate priceoracle styles mc periodlast p
AtDefault mc -> postingValueAtDate priceoracle styles mc (fromMaybe today mreportlast) p
AtDate d mc -> postingValueAtDate priceoracle styles mc d p
AtCost Nothing -> postingToCost styles p
AtCost mc -> postingValueAtDate priceoracle styles mc periodlast $ postingToCost styles p
AtThen mc -> postingValueAtDate priceoracle styles mc (postingDate p) p
AtEnd mc -> postingValueAtDate priceoracle styles mc periodlast p
AtNow mc -> postingValueAtDate priceoracle styles mc today p
AtDefault mc -> postingValueAtDate priceoracle styles mc periodlast p
AtDate d mc -> postingValueAtDate priceoracle styles mc d p
-- | Convert this posting's amount to cost, and apply the appropriate amount styles.
postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting

6
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -584,9 +584,9 @@ transactionTransformPostings f t@Transaction{tpostings=ps} = t{tpostings=map f p
-- the provided price oracle, commodity styles, reference dates, and
-- whether this is for a multiperiod report or not. See
-- amountApplyValuation.
transactionApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> Transaction -> ValuationType -> Transaction
transactionApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod t v =
transactionTransformPostings (\p -> postingApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod p v) t
transactionApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Transaction -> ValuationType -> Transaction
transactionApplyValuation priceoracle styles periodlast today t v =
transactionTransformPostings (\p -> postingApplyValuation priceoracle styles periodlast today p v) t
-- | Convert this transaction's amounts to cost, and apply the appropriate amount styles.
transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction

28
hledger-lib/Hledger/Data/Valuation.hs
View File

@ -34,7 +34,6 @@ import Data.List ( (\\), sortBy )
import Data.List.Extra (nubSortBy)
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Maybe ( fromMaybe )
import qualified Data.Text as T
import Data.Time.Calendar (Day, fromGregorian)
import Data.MemoUgly (memo)
@ -98,9 +97,9 @@ priceDirectiveToMarketPrice PriceDirective{..} =
-- provided price oracle, commodity styles, reference dates, and
-- whether this is for a multiperiod report or not.
-- See amountApplyValuation.
mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> ValuationType -> MixedAmount -> MixedAmount
mixedAmountApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod v (Mixed as) =
Mixed $ map (amountApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod v) as
mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> MixedAmount -> MixedAmount
mixedAmountApplyValuation priceoracle styles periodlast today v (Mixed as) =
Mixed $ map (amountApplyValuation priceoracle styles periodlast today v) as
-- | Apply a specified valuation to this amount, using the provided
-- price oracle, reference dates, and whether this is for a
@ -133,18 +132,17 @@ mixedAmountApplyValuation priceoracle styles periodlast mreportlast today ismult
-- https://hledger.org/hledger.html#effect-of-valuation-on-reports
-- (hledger_options.m4.md "Effect of valuation on reports"), and #1083.
--
amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> ValuationType -> Amount -> Amount
amountApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod v a =
amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Amount -> Amount
amountApplyValuation priceoracle styles periodlast today v a =
case v of
AtCost Nothing -> styleAmount styles $ amountCost a
AtCost mc -> amountValueAtDate priceoracle styles mc periodlast $ styleAmount styles $ amountCost a
AtThen _mc -> error' unsupportedValueThenError -- PARTIAL:
-- amountValueAtDate priceoracle styles mc periodlast a -- posting date unknown, handle like AtEnd
AtEnd mc -> amountValueAtDate priceoracle styles mc periodlast a
AtNow mc -> amountValueAtDate priceoracle styles mc today a
AtDefault mc | ismultiperiod -> amountValueAtDate priceoracle styles mc periodlast a
AtDefault mc -> amountValueAtDate priceoracle styles mc (fromMaybe today mreportlast) a
AtDate d mc -> amountValueAtDate priceoracle styles mc d a
AtCost Nothing -> styleAmount styles $ amountCost a
AtCost mc -> amountValueAtDate priceoracle styles mc periodlast $ styleAmount styles $ amountCost a
AtThen _mc -> error' unsupportedValueThenError -- PARTIAL:
-- amountValueAtDate priceoracle styles mc periodlast a -- posting date unknown, handle like AtEnd
AtEnd mc -> amountValueAtDate priceoracle styles mc periodlast a
AtNow mc -> amountValueAtDate priceoracle styles mc today a
AtDefault mc -> amountValueAtDate priceoracle styles mc periodlast a
AtDate d mc -> amountValueAtDate priceoracle styles mc d a
-- | Standard error message for a report not supporting --value=then.
unsupportedValueThenError :: String

6
hledger-lib/Hledger/Reports/AccountTransactionsReport.hs
View File

@ -116,14 +116,12 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = (
periodlast =
fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen
reportPeriodOrJournalLastDay rspec j
mreportlast = reportPeriodLastDay rspec
multiperiod = interval_ ropts /= NoInterval
tval = case value_ ropts of
Just v -> \t -> transactionApplyValuation prices styles periodlast mreportlast (rsToday rspec) multiperiod t v
Just v -> \t -> transactionApplyValuation prices styles periodlast (rsToday rspec) t v
Nothing -> id
ts4 =
ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $
map tval ts3
map tval ts3
-- 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

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

@ -41,11 +41,10 @@ entriesReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j@Journal{..} =
tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings}
where
pvalue p = maybe p
(postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast mreportlast (rsToday rspec) False p)
(postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) p)
value_
where
periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j
mreportlast = reportPeriodLastDay rspec
tests_EntriesReport = tests "EntriesReport" [
tests "entriesReport" [

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

@ -253,12 +253,9 @@ makeReportQuery rspec reportspan
makeValuation :: ReportSpec -> Journal -> PriceOracle -> (Day -> MixedAmount -> MixedAmount)
makeValuation rspec j priceoracle day = case value_ (rsOpts rspec) of
Nothing -> id
Just v -> mixedAmountApplyValuation priceoracle styles day mreportlast (rsToday rspec) multiperiod v
Just v -> mixedAmountApplyValuation priceoracle styles day (rsToday rspec) v
where
-- Some things needed if doing valuation.
styles = journalCommodityStyles j
mreportlast = reportPeriodOrJournalLastDay rspec j
multiperiod = interval_ (rsOpts rspec) /= NoInterval
-- | Group postings, grouped by their column
getPostingsByColumn :: ReportSpec -> Journal -> DateSpan -> Map DateSpan [Posting]

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

@ -89,9 +89,7 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j =
where
showempty = empty_ || average_
-- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
pvalue p periodlast = maybe p (postingApplyValuation priceoracle styles periodlast mreportlast (rsToday rspec) multiperiod p) value_
where
mreportlast = reportPeriodLastDay rspec
pvalue p periodlast = maybe p (postingApplyValuation priceoracle styles periodlast (rsToday rspec) p) value_
reportorjournallast =
fromMaybe (error' "postingsReport: expected a non-empty journal") $ -- PARTIAL: shouldn't happen
reportPeriodOrJournalLastDay rspec j
@ -112,7 +110,7 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j =
precedingsum = sumPostings precedingps
precedingavg | null precedingps = 0
| otherwise = divideMixedAmount (fromIntegral $ length precedingps) precedingsum
bvalue = maybe id (mixedAmountApplyValuation priceoracle styles daybeforereportstart Nothing (rsToday rspec) multiperiod) value_
bvalue = maybe id (mixedAmountApplyValuation priceoracle styles daybeforereportstart $ rsToday rspec) value_
-- XXX constrain valuation type to AtDate daybeforereportstart here ?
where
daybeforereportstart =

4
hledger-ui/Hledger/UI/TransactionScreen.hs
View File

@ -78,13 +78,11 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{
periodlast =
fromMaybe (error' "TransactionScreen: expected a non-empty journal") $ -- PARTIAL: shouldn't happen
reportPeriodOrJournalLastDay rspec j
mreportlast = reportPeriodLastDay rspec
multiperiod = interval_ ropts /= NoInterval
render $ defaultLayout toplabel bottomlabel $ str $
showTransactionOneLineAmounts $
(if valuationTypeIsCost ropts then transactionToCost (journalCommodityStyles j) else id) $
(if valuationTypeIsDefaultValue ropts then (\t -> transactionApplyValuation prices styles periodlast mreportlast (rsToday rspec) multiperiod t (AtDefault Nothing)) else id) $
(if valuationTypeIsDefaultValue ropts then (\t -> transactionApplyValuation prices styles periodlast (rsToday rspec) t (AtDefault Nothing)) else id) $
-- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real
t
where