ref: Return the interval split in reportSpan, to reduce the number

of different places we call splitSpan and ease refactoring.
This commit is contained in:
Stephen Morgan 2022-01-04 16:55:28 +01:00 committed by Simon Michael
parent e33de3585b
commit ba0eec9132
8 changed files with 38 additions and 52 deletions

View File

@ -116,11 +116,11 @@ multiBalanceReportWith :: ReportSpec -> Journal -> PriceOracle -> Set AccountNam
multiBalanceReportWith rspec' j priceoracle unelidableaccts = report multiBalanceReportWith rspec' j priceoracle unelidableaccts = report
where where
-- Queries, report/column dates. -- Queries, report/column dates.
reportspan = dbg3 "reportspan" $ reportSpan j rspec' (reportspan, colspans) = reportSpan j rspec'
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 priceoracle reportspan colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle colspans
-- 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.
@ -145,11 +145,11 @@ compoundBalanceReportWith :: ReportSpec -> Journal -> PriceOracle
compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
where where
-- Queries, report/column dates. -- Queries, report/column dates.
reportspan = dbg3 "reportspan" $ reportSpan j rspec' (reportspan, colspans) = reportSpan j rspec'
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 priceoracle reportspan colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle colspans
-- The matched postings with a starting balance. All of these should appear -- The matched postings 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.
@ -242,14 +242,13 @@ makeReportQuery rspec reportspan
dateqcons = if date2_ (_rsReportOpts rspec) then Date2 else Date dateqcons = if date2_ (_rsReportOpts rspec) then Date2 else Date
-- | Group postings, grouped by their column -- | Group postings, grouped by their column
getPostingsByColumn :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> [(DateSpan, [Posting])] getPostingsByColumn :: ReportSpec -> Journal -> PriceOracle -> [DateSpan] -> [(DateSpan, [Posting])]
getPostingsByColumn rspec j priceoracle reportspan = getPostingsByColumn rspec j priceoracle colspans =
groupByDateSpan True getDate colspans ps groupByDateSpan True getDate colspans ps
where where
-- Postings matching the query within the report period. -- Postings matching the query within the report period.
ps = dbg5 "getPostingsByColumn" $ getPostings rspec j priceoracle ps = 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_ $ _rsReportOpts rspec) reportspan
getDate = postingDateOrDate2 (whichDate (_rsReportOpts rspec)) getDate = postingDateOrDate2 (whichDate (_rsReportOpts rspec))
-- | Gather postings matching the query within the report period. -- | Gather postings matching the query within the report period.

View File

@ -63,7 +63,7 @@ type SummaryPosting = (Posting, Period)
postingsReport :: ReportSpec -> Journal -> PostingsReport postingsReport :: ReportSpec -> Journal -> PostingsReport
postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} j = items postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} j = items
where where
reportspan = reportSpanBothDates j rspec (reportspan, colspans) = reportSpanBothDates j rspec
whichdate = whichDate ropts whichdate = whichDate ropts
mdepth = queryDepth $ _rsQuery rspec mdepth = queryDepth $ _rsQuery rspec
multiperiod = interval_ /= NoInterval multiperiod = interval_ /= NoInterval
@ -76,7 +76,7 @@ postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} j = items
| multiperiod = [(p, Just period) | (p, period) <- summariseps reportps] | multiperiod = [(p, Just period) | (p, period) <- summariseps reportps]
| otherwise = [(p, Nothing) | p <- reportps] | otherwise = [(p, Nothing) | p <- reportps]
where where
summariseps = summarisePostingsByInterval interval_ whichdate mdepth showempty reportspan summariseps = summarisePostingsByInterval whichdate mdepth showempty colspans
showempty = empty_ || average_ showempty = empty_ || average_
-- Posting report items ready for display. -- Posting report items ready for display.
@ -164,15 +164,12 @@ mkpostingsReportItem showdate showdesc wd mperiod p b =
-- | Convert a list of postings into summary postings, one per interval, -- | Convert a list of postings into summary postings, one per interval,
-- aggregated to the specified depth if any. -- aggregated to the specified depth if any.
-- Each summary posting will have a non-Nothing interval end date. -- Each summary posting will have a non-Nothing interval end date.
summarisePostingsByInterval :: Interval -> WhichDate -> Maybe Int -> Bool -> DateSpan -> [Posting] -> [SummaryPosting] summarisePostingsByInterval :: WhichDate -> Maybe Int -> Bool -> [DateSpan] -> [Posting] -> [SummaryPosting]
summarisePostingsByInterval interval wd mdepth showempty reportspan = summarisePostingsByInterval wd mdepth showempty colspans =
concatMap (\(s,ps) -> summarisePostingsInDateSpan s wd mdepth showempty ps) concatMap (\(s,ps) -> summarisePostingsInDateSpan s wd mdepth showempty ps)
-- Group postings into their columns. We try to be efficient, since -- Group postings into their columns. We try to be efficient, since
-- there can possibly be a very large number of intervals (cf #1683) -- there can possibly be a very large number of intervals (cf #1683)
. groupByDateSpan showempty (postingDateOrDate2 wd) colspans . groupByDateSpan showempty (postingDateOrDate2 wd) colspans
where
-- The date spans to be included as report columns.
colspans = splitSpan interval reportspan
-- | Given a date span (representing a report interval) and a list of -- | Given a date span (representing a report interval) and a list of
-- postings within it, aggregate the postings into one summary posting per -- postings within it, aggregate the postings into one summary posting per
@ -377,7 +374,7 @@ tests_PostingsReport = testGroup "PostingsReport" [
-} -}
,testCase "summarisePostingsByInterval" $ ,testCase "summarisePostingsByInterval" $
summarisePostingsByInterval (Quarters 1) PrimaryDate Nothing False (DateSpan Nothing Nothing) [] @?= [] summarisePostingsByInterval PrimaryDate Nothing False [DateSpan Nothing Nothing] [] @?= []
-- ,tests_summarisePostingsInDateSpan = [ -- ,tests_summarisePostingsInDateSpan = [
-- "summarisePostingsInDateSpan" ~: do -- "summarisePostingsInDateSpan" ~: do

View File

@ -596,10 +596,10 @@ journalApplyValuationFromOptsWith rspec@ReportSpec{_rsReportOpts=ropts} j priceo
-- Find the end of the period containing this posting -- Find the end of the period containing this posting
periodEnd = addDays (-1) . fromMaybe err . mPeriodEnd . postingDate periodEnd = addDays (-1) . fromMaybe err . mPeriodEnd . postingDate
mPeriodEnd = case interval_ ropts of mPeriodEnd = case interval_ ropts of
NoInterval -> const . spanEnd $ reportSpan j rspec NoInterval -> const . spanEnd . fst $ reportSpan j rspec
_ -> spanEnd <=< latestSpanContaining (historical : spans) _ -> spanEnd <=< latestSpanContaining (historical : spans)
historical = DateSpan Nothing $ spanStart =<< headMay spans historical = DateSpan Nothing $ spanStart =<< headMay spans
spans = splitSpan (interval_ ropts) $ reportSpanBothDates j rspec spans = snd $ reportSpanBothDates j rspec
styles = journalCommodityStyles j styles = journalCommodityStyles j
err = error "journalApplyValuationFromOpts: expected all spans to have an end date" err = error "journalApplyValuationFromOpts: expected all spans to have an end date"
@ -653,18 +653,20 @@ queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq
-- options or queries, or otherwise the earliest and latest transaction or -- options or queries, or otherwise the earliest and latest transaction or
-- posting dates in the journal. If no dates are specified by options/queries -- posting dates in the journal. If no dates are specified by options/queries
-- and the journal is empty, returns the null date span. -- and the journal is empty, returns the null date span.
reportSpan :: Journal -> ReportSpec -> DateSpan -- Also return the intervals if they are requested.
reportSpan :: Journal -> ReportSpec -> (DateSpan, [DateSpan])
reportSpan = reportSpanHelper False reportSpan = reportSpanHelper False
-- | Like reportSpan, but uses both primary and secondary dates when calculating -- | Like reportSpan, but uses both primary and secondary dates when calculating
-- the span. -- the span.
reportSpanBothDates :: Journal -> ReportSpec -> DateSpan reportSpanBothDates :: Journal -> ReportSpec -> (DateSpan, [DateSpan])
reportSpanBothDates = reportSpanHelper True reportSpanBothDates = reportSpanHelper True
-- | A helper for reportSpan, which takes a Bool indicating whether to use both -- | A helper for reportSpan, which takes a Bool indicating whether to use both
-- primary and secondary dates. -- primary and secondary dates.
reportSpanHelper :: Bool -> Journal -> ReportSpec -> DateSpan reportSpanHelper :: Bool -> Journal -> ReportSpec -> (DateSpan, [DateSpan])
reportSpanHelper bothdates j ReportSpec{_rsQuery=query, _rsReportOpts=ropts} = reportspan reportSpanHelper bothdates j ReportSpec{_rsQuery=query, _rsReportOpts=ropts} =
(reportspan, intervalspans)
where where
-- The date span specified by -b/-e/-p options and query args if any. -- The date span specified by -b/-e/-p options and query args if any.
requestedspan = dbg3 "requestedspan" $ if bothdates then queryDateSpan' query else queryDateSpan (date2_ ropts) query requestedspan = dbg3 "requestedspan" $ if bothdates then queryDateSpan' query else queryDateSpan (date2_ ropts) query
@ -688,10 +690,10 @@ reportSpanHelper bothdates j ReportSpec{_rsQuery=query, _rsReportOpts=ropts} = r
(spanEnd =<< lastMay intervalspans) (spanEnd =<< lastMay intervalspans)
reportStartDate :: Journal -> ReportSpec -> Maybe Day reportStartDate :: Journal -> ReportSpec -> Maybe Day
reportStartDate j = spanStart . reportSpan j reportStartDate j = spanStart . fst . reportSpan j
reportEndDate :: Journal -> ReportSpec -> Maybe Day reportEndDate :: Journal -> ReportSpec -> Maybe Day
reportEndDate j = spanEnd . reportSpan j reportEndDate j = spanEnd . fst . reportSpan j
-- Some pure alternatives to the above. XXX review/clean up -- Some pure alternatives to the above. XXX review/clean up

View File

@ -9,9 +9,9 @@ Print a bar chart of posting activity per day, or other report interval.
module Hledger.Cli.Commands.Activity module Hledger.Cli.Commands.Activity
where where
import Data.List import Data.List (sortOn)
import Data.Maybe import Text.Printf (printf)
import Text.Printf import Lens.Micro ((^.), set)
import Hledger import Hledger
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
@ -31,19 +31,19 @@ activity :: CliOpts -> Journal -> IO ()
activity CliOpts{reportspec_=rspec} j = putStr $ showHistogram rspec j activity CliOpts{reportspec_=rspec} j = putStr $ showHistogram rspec j
showHistogram :: ReportSpec -> Journal -> String showHistogram :: ReportSpec -> Journal -> String
showHistogram ReportSpec{_rsQuery=q,_rsReportOpts=ReportOpts{interval_=i,date2_=date2}} j = showHistogram rspec@ReportSpec{_rsQuery=q} j =
concatMap (printDayWith countBar) spanps concatMap (printDayWith countBar) spanps
where where
interval | i == NoInterval = Days 1 spans = filter (DateSpan Nothing Nothing /=) . snd . reportSpan j $ case rspec ^. interval of
| otherwise = i NoInterval -> set interval (Days 1) rspec
span' = queryDateSpan date2 q `spanDefaultsFrom` journalDateSpan date2 j _ -> rspec
spans = filter (DateSpan Nothing Nothing /=) $ splitSpan interval span'
spanps = [(s, filter (isPostingInDateSpan s) ps) | s <- spans] spanps = [(s, filter (isPostingInDateSpan s) ps) | s <- spans]
-- same as Register -- same as Register
-- should count transactions, not postings ? -- should count transactions, not postings ?
-- ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j -- ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j
ps = sortOn postingDate $ filter (q `matchesPosting`) $ journalPostings j ps = sortOn postingDate $ filter (q `matchesPosting`) $ journalPostings j
printDayWith f (DateSpan b _, ps) = printf "%s %s\n" (show $ fromJust b) (f ps) printDayWith f (DateSpan (Just b) _, ps) = printf "%s %s\n" (show b) (f ps)
printDayWith _ _ = error "Expected start date for DateSpan" -- PARTIAL:
countBar ps = replicate (length ps) barchar countBar ps = replicate (length ps) barchar

View File

@ -340,7 +340,7 @@ balancemode = hledgerCommandMode
balance :: CliOpts -> Journal -> IO () balance :: CliOpts -> Journal -> IO ()
balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of
CalcBudget -> do -- single or multi period budget report CalcBudget -> do -- single or multi period budget report
let reportspan = reportSpan j rspec let reportspan = fst $ reportSpan j rspec
budgetreport = budgetReport rspec (balancingopts_ $ inputopts_ opts) reportspan j budgetreport = budgetReport rspec (balancingopts_ $ inputopts_ opts) reportspan j
render = case fmt of render = case fmt of
"txt" -> budgetReportAsText ropts "txt" -> budgetReportAsText ropts

View File

@ -81,25 +81,14 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{_rsReportOpts=ReportO
pnlQuery <- makeQuery "pnl" pnlQuery <- makeQuery "pnl"
let let
trans = dbg3 "investments" $ jtxns $ filterJournalTransactions investmentsQuery j filteredj = filterJournalTransactions investmentsQuery j
trans = dbg3 "investments" $ jtxns filteredj
journalSpan =
let dates = map (transactionDateOrDate2 wd) trans in
DateSpan (Just $ minimum dates) (Just $ addDays 1 $ maximum dates)
requestedSpan = periodAsDateSpan period_
requestedInterval = interval_
wholeSpan = dbg3 "wholeSpan" $ spanDefaultsFrom requestedSpan journalSpan
when (null trans) $ do when (null trans) $ do
putStrLn "No relevant transactions found. Check your investments query" putStrLn "No relevant transactions found. Check your investments query"
exitFailure exitFailure
let spans = case requestedInterval of let spans = snd $ reportSpan filteredj rspec
NoInterval -> [wholeSpan]
interval ->
splitSpan interval wholeSpan
let priceDirectiveDates = dbg3 "priceDirectiveDates" $ map pddate $ jpricedirectives j let priceDirectiveDates = dbg3 "priceDirectiveDates" $ map pddate $ jpricedirectives j

View File

@ -48,8 +48,7 @@ stats opts@CliOpts{reportspec_=rspec, progstarttime_} j = do
let today = _rsDay rspec let today = _rsDay rspec
q = _rsQuery rspec q = _rsQuery rspec
l = ledgerFromJournal q j l = ledgerFromJournal q j
reportspan = ledgerDateSpan l `spanDefaultsFrom` queryDateSpan False q intervalspans = snd $ reportSpanBothDates j rspec
intervalspans = splitSpan (interval_ $ _rsReportOpts rspec) reportspan
showstats = showLedgerStats l today showstats = showLedgerStats l today
(ls, txncounts) = unzip $ map showstats intervalspans (ls, txncounts) = unzip $ map showstats intervalspans
numtxns = sum txncounts numtxns = sum txncounts

View File

@ -136,7 +136,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=r
_ -> showDateSpan requestedspan _ -> showDateSpan requestedspan
where where
enddates = map (addDays (-1)) . mapMaybe spanEnd $ cbrDates cbr -- these spans will always have a definite end date enddates = map (addDays (-1)) . mapMaybe spanEnd $ cbrDates cbr -- these spans will always have a definite end date
requestedspan = reportSpan j rspec requestedspan = fst $ reportSpan j rspec
-- when user overrides, add an indication to the report title -- when user overrides, add an indication to the report title
-- Do we need to deal with overridden BalanceCalculation? -- Do we need to deal with overridden BalanceCalculation?