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

reg: support --value-at=period with periodic reports (#329)

Browse Source
This commit is contained in:
Simon Michael 2019-05-04 12:00:57 -07:00
parent dd8c403c81
commit ec1b98434c
5 changed files with 78 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -22,7 +22,6 @@ module Hledger.Reports.PostingsReport (
)
where
import Control.Applicative ((<|>))
import Data.List
import Data.Maybe
import Data.Ord (comparing)
@ -62,35 +61,70 @@ type PostingsReportItem = (Maybe Day -- The posting date, if this is the firs
-- | Select postings from the journal and add running balance and other
-- information to make a postings report. Used by eg hledger's register command.
postingsReport :: ReportOpts -> Query -> Journal -> PostingsReport
postingsReport opts q j =
(if value_ opts then prValue opts j else id) $
postingsReport ropts@ReportOpts{..} q j =
(totallabel, items)
where
reportspan = adjustReportDates opts q j
whichdate = whichDateFromOpts opts
reportspan = adjustReportDates ropts q j
whichdate = whichDateFromOpts ropts
depth = queryDepth q
-- postings to be included in the report, and similarly-matched postings before the report start date
(precedingps, reportps) = matchedPostingsBeforeAndDuring opts q j reportspan
(precedingps, reportps) = matchedPostingsBeforeAndDuring ropts q j reportspan
-- postings or pseudo postings to be displayed
displayps | interval == NoInterval = map (,Nothing) reportps
| otherwise = summarisePostingsByInterval interval whichdate depth showempty reportspan reportps
-- Postings or summary pseudo postings to be displayed.
-- If --value-at is present, we'll need to convert them to value in various ways.
displayps
| multiperiod = case mvalueat of
Just AtTransaction
-> [(postingValueAtDate (postingDate p) p, end) | (p,end) <- summarisePostingsByInterval interval_ whichdate depth showempty reportspan reportps]
Just AtPeriod
-> [(postingValueAtDate (
maybe (error' "postingsReport: expected a subperiod end date") -- XXX shouldn't happen
(addDays (-1)) end) p
, end)
| (p,end) <- summarisePostingsByInterval interval_ whichdate depth showempty reportspan reportps]
Just (AtDate d)
-> [(postingValueAtDate d p, end) | (p,end) <- summarisePostingsByInterval interval_ whichdate depth showempty reportspan reportps]
Just AtNow
-> [(postingValueAtDate today p, end) | (p,end) <- summarisePostingsByInterval interval_ whichdate depth showempty reportspan reportps]
Nothing
-> [(p, end) | (p,end) <- summarisePostingsByInterval interval_ whichdate depth showempty reportspan reportps]
| otherwise = case mvalueat of
Just AtTransaction
-> [(postingValueAtDate (postingDate p) p, Nothing) | p <- reportps]
Just AtPeriod
-> [(postingValueAtDate reportperiodlastday p, Nothing) | p <- reportps]
Just (AtDate d)
-> [(postingValueAtDate d p, Nothing) | p <- reportps]
Just AtNow
-> [(postingValueAtDate today p, Nothing) | p <- reportps]
Nothing
-> [(p, Nothing) | p <- reportps]
where
interval = interval_ opts -- XXX
showempty = empty_ opts || average_ opts
mvalueat = if value_ then Just value_at_ else Nothing
multiperiod = interval_ /= NoInterval
showempty = empty_ || average_
reportperiodlastday =
fromMaybe (error' "postingsReport: expected a non-empty journal") -- XXX shouldn't happen
$ reportPeriodOrJournalLastDay ropts j
today = fromMaybe (error' "postingsReport: ReportOpts today_ is unset so could not satisfy --value-at=now") today_
postingValueAtDate d p@Posting{..} = p{pamount=mixedAmountValue prices d pamount}
where
-- prices are in parse order - sort into date then parse order,
-- & reversed for quick lookup of the latest price.
prices = reverse $ sortOn mpdate $ jmarketprices j
-- posting report items ready for display
items = dbg1 "postingsReport items" $ postingsReportItems displayps (nullposting,Nothing) whichdate depth startbal runningcalc startnum
where
historical = balancetype_ opts == HistoricalBalance
historical = balancetype_ == HistoricalBalance
precedingsum = sumPostings precedingps
precedingavg | null precedingps = 0
| otherwise = divideMixedAmount (fromIntegral $ length precedingps) precedingsum
startbal | average_ opts = if historical then precedingavg else 0
| otherwise = if historical then precedingsum else 0
startbal | average_ = if historical then precedingavg else 0
| otherwise = if historical then precedingsum else 0
startnum = if historical then length precedingps + 1 else 1
runningcalc = registerRunningCalculationFn opts
runningcalc = registerRunningCalculationFn ropts
-- | Based on the given report options, return a function that does the appropriate
-- running calculation for the register report, ie a running average or running total.
@ -186,6 +220,7 @@ mkpostingsReportItem showdate showdesc wd menddate p b =
-- | Convert a list of postings into summary postings, one per interval,
-- aggregated to the specified depth if any.
-- Each summary posting will have a non-Nothing interval end date.
summarisePostingsByInterval :: Interval -> WhichDate -> Int -> Bool -> DateSpan -> [Posting] -> [SummaryPosting]
summarisePostingsByInterval interval wd depth showempty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan
where
@ -200,7 +235,7 @@ type SummaryPosting = (Posting, Maybe Day)
-- | Given a date span (representing a report interval) and a list of
-- postings within it, aggregate the postings into one summary posting per
-- account.
-- account. Each summary posting will have a non-Nothing interval end date.
--
-- When a depth argument is present, postings to accounts of greater
-- depth are also aggregated where possible. If the depth is 0, all
@ -236,72 +271,6 @@ summarisePostingsInDateSpan (DateSpan b e) wd depth showempty ps
negatePostingAmount :: Posting -> Posting
negatePostingAmount p = p { pamount = negate $ pamount p }
-- -- | Flip the sign of all amounts in a PostingsReport.
-- prNegate :: PostingsReport -> PostingsReport
-- | Convert all the posting amounts in a PostingsReport to their
-- default valuation commodities. This means using the Journal's most
-- recent applicable market prices before the valuation date.
-- The valuation date is set with --value-at and can be:
-- each posting's date,
-- the last day in the report period (or in the journal if no period,
-- or the posting dates if journal is empty - shouldn't happen),
-- or today's date (gives an error if today_ is not set in ReportOpts),
-- or a specified date.
--
-- Special case: when --value-at=transaction is combined with a report interval,
-- assume amounts were converted to value earlier and do nothing here.
--
prValue :: ReportOpts -> Journal -> PostingsReport -> PostingsReport
prValue ropts@ReportOpts{..} j@Journal{..} (totallabel, items) = (totallabel, items')
where
-- convert postings amounts to value
items' = [ (md, md2, desc, p', t') | (md, md2, desc, p, t) <- items
, let pdate = postingDate p
, let pamt' = val pdate (pamount p)
, let p' = p{pamount = pamt'}
, let t' = val pdate t -- In some cases, revaluing the totals/averages is fine.
-- With --value-at=t, we revalue postings early instead.
-- XXX --value=at=m -M is still a problem
]
val pdate amt =
let val' d = mixedAmountValue prices d amt in
case (value_at_, interval_) of
(AtTransaction, _) -> amt -- in this case we revalued postings early (Register.hs)
(AtPeriod, NoInterval) -> val' $ fromMaybe pdate mperiodorjournallastday
(AtPeriod, _) ->
error' "sorry, --value-at=period with periodic register reports is not yet supported"
-- XXX need to calculate total from period-valued postings
-- -- Get the last day of this subperiod. We can't always get it from the report item
-- -- (only the first items in each period have the period start/end dates).
-- -- The following kludge seems to work.. XXX
-- let subperiodlastday =
-- addDays (-1) $
-- fromMaybe (error' "prValue: expected a date here") $ -- should not happen
-- spanEnd $
-- headDef (error' "prValue: expected at least one span here") $ -- should not happen, splitting a well-formed span
-- splitSpan i (DateSpan (Just pdate) Nothing)
-- in val' subperiodlastday
(AtNow, _) -> case today_ of
Just d -> val' d
Nothing -> error' "prValue: ReportOpts today_ is unset so could not satisfy --value-at=now"
(AtDate d, _) -> val' d
where
mperiodorjournallastday = mperiodlastday <|> journalEndDate False j
-- Get the last day of the report period.
-- Will be Nothing if no report period is specified, or also
-- if ReportOpts does not have today_ set, since we need that
-- to get the report period robustly.
mperiodlastday :: Maybe Day = do
t <- today_
let q = queryFromOpts t ropts
qend <- queryEndDate False q
return $ addDays (-1) qend
-- prices are in parse order - sort into date then parse order,
-- & reversed for quick lookup of the latest price.
prices = reverse $ sortOn mpdate jmarketprices
-- tests

21
hledger-lib/Hledger/Reports/ReportOptions.hs
View File

@ -33,6 +33,8 @@ module Hledger.Reports.ReportOptions (
specifiedStartEndDates,
specifiedStartDate,
specifiedEndDate,
reportPeriodLastDay,
reportPeriodOrJournalLastDay,
tests_ReportOptions
)
@ -468,6 +470,25 @@ specifiedStartDate ropts = fst <$> specifiedStartEndDates ropts
specifiedEndDate :: ReportOpts -> IO (Maybe Day)
specifiedEndDate ropts = snd <$> specifiedStartEndDates ropts
-- Get the last day of the overall report period.
-- If no report period is specified, will be Nothing.
-- Will also be Nothing if ReportOpts does not have today_ set,
-- since we need that to get the report period robustly.
reportPeriodLastDay :: ReportOpts -> Maybe Day
reportPeriodLastDay ropts@ReportOpts{..} = do
t <- today_
let q = queryFromOpts t ropts
qend <- queryEndDate False q
return $ addDays (-1) qend
-- Get the last day of the overall report period,
-- or if no report period is specified, the last day of the journal
-- (ie the latest posting date).
-- If there's no report period and nothing in the journal, will be Nothing.
reportPeriodOrJournalLastDay :: ReportOpts -> Journal -> Maybe Day
reportPeriodOrJournalLastDay ropts@ReportOpts{..} j =
reportPeriodLastDay ropts <|> journalEndDate False j
-- tests
tests_ReportOptions = tests "ReportOptions" [

8
hledger/Hledger/Cli/Commands/Register.hs
View File

@ -61,13 +61,7 @@ register opts@CliOpts{reportopts_=ropts@ReportOpts{..}} j = do
render | fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv)
| fmt=="html" = const $ error' "Sorry, HTML output is not yet implemented for this kind of report." -- TODO
| otherwise = postingsReportAsText
-- For register reports with --value-at=transaction,
-- convert all amounts to value before summing them.
j' | value_at_ == AtTransaction = journalValueAtTransactionDate ropts j
| otherwise = j
writeOutput opts $ render opts $ postingsReport ropts (queryFromOpts d ropts) j'
writeOutput opts $ render opts $ postingsReport ropts (queryFromOpts d ropts) j
postingsReportAsCsv :: PostingsReport -> CSV
postingsReportAsCsv (_,is) =

2
hledger/hledger_options.m4.md
View File

@ -610,7 +610,7 @@ Here are the ones currently supported
|---------------------------------------------------------|:---------------------------------:|:----------------------------:|:--------------------------------:|
| print | Y | Y | Y |
| register | Y | Y | Y |
| register,&nbsp;multiperiod | Y | - | Y |
| register,&nbsp;multiperiod | Y | Y | Y |
| balance | Y | Y | Y |
| balance,&nbsp;multiperiod | - | Y | Y |
| balance,&nbsp;multiperiod,&nbsp;-T/-A | - | - | Y |

11
tests/journal/market-prices.test
View File

@ -117,7 +117,7 @@ $ hledger -f- print -V
<
P 2000/01/01 A 1 B
P 2000-01-15 A 5 B
P 2000/01/15 A 5 B
P 2000/02/01 A 2 B
P 2000/03/01 A 3 B
P 2000/04/01 A 4 B
@ -241,12 +241,9 @@ $ hledger -f- reg --value-at=transaction -M
# 20. periodic register report valued at period end
$ hledger -f- reg --value-at=period -M
>2 /not yet supported/
>=1
# XXX
# 2000/01 a 5 B 5 B
# 2000/02 a 2 B 7 B
# 2000/03 a 3 B 10 B
2000/01 a 5 B 5 B
2000/02 a 2 B 7 B
2000/03 a 3 B 10 B
# 21. periodic register report valued at specified date
$ hledger -f- reg --value-at=2000-01-15 -M