Merge pull request #1560 from Xitian9/rationalisevaluation
Clean up valuation functions, and make clear which to use where.
This commit is contained in:
		
						commit
						665fec83cd
					
				| @ -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' | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -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. | ||||||
|  | |||||||
| @ -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. | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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]) | ||||||
|  | |||||||
| @ -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" [ | ||||||
|  | |||||||
| @ -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" [ | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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. | ||||||
|  | |||||||
| @ -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 = | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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) | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user