slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ref: balance: Refactor getPostingsByColumn to use groupByDateSpan.

Browse Source 
This reduces code duplication, makes the code more idiomatic, and hides
optimisation magic within groupByDateSpan.
This commit is contained in:
Stephen Morgan 2021-09-17 16:20:53 +10:00 committed by Simon Michael
parent 35c33f342b
commit a2d7ac5318
1 changed files with 23 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -36,6 +36,7 @@ module Hledger.Reports.MultiBalanceReport (
where where
import Control.Monad (guard) import Control.Monad (guard)
import Data.Bifunctor (second)
import Data.Foldable (toList) import Data.Foldable (toList)
import Data.List (sortOn, transpose) import Data.List (sortOn, transpose)
import Data.List.NonEmpty (NonEmpty(..)) import Data.List.NonEmpty (NonEmpty(..))
@ -46,7 +47,7 @@ import qualified Data.Map as M
import Data.Maybe (fromMaybe, isJust, 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, fromGregorian) import Data.Time.Calendar (fromGregorian)
import Safe (lastDef, minimumMay) import Safe (lastDef, minimumMay)
import Data.Default (def) import Data.Default (def)
@ -164,7 +165,7 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
) )
where where
-- Filter the column postings according to each subreport -- Filter the column postings according to each subreport
colps' = filter (matchesPosting q) <$> colps colps' = map (second $ filter (matchesPosting q)) colps
-- We need to filter historical postings directly, rather than their accumulated balances. (#1698) -- We need to filter historical postings directly, rather than their accumulated balances. (#1698)
startbals' = startingBalancesFromPostings rspec j priceoracle $ filter (matchesPosting q) startps startbals' = startingBalancesFromPostings rspec j priceoracle $ filter (matchesPosting q) startps
ropts = cbcsubreportoptions $ _rsReportOpts rspec ropts = cbcsubreportoptions $ _rsReportOpts rspec
@ -181,15 +182,14 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
subreportTotal (_, sr, increasestotal) = subreportTotal (_, sr, increasestotal) =
(if increasestotal then id else fmap maNegate) $ prTotals sr (if increasestotal then id else fmap maNegate) $ prTotals sr
cbr = CompoundPeriodicReport "" (M.keys colps) subreports overalltotals cbr = CompoundPeriodicReport "" (map fst colps) subreports overalltotals
-- | Calculate starting balances from postings, if needed for -H. -- | Calculate starting balances from postings, if needed for -H.
startingBalancesFromPostings :: ReportSpec -> Journal -> PriceOracle -> [Posting] startingBalancesFromPostings :: ReportSpec -> Journal -> PriceOracle -> [Posting]
-> HashMap AccountName Account -> HashMap AccountName Account
startingBalancesFromPostings rspec j priceoracle = startingBalancesFromPostings rspec j priceoracle ps =
fmap (M.findWithDefault nullacct emptydatespan) M.findWithDefault nullacct emptydatespan
. calculateReportMatrix rspec j priceoracle mempty <$> calculateReportMatrix rspec j priceoracle mempty [(emptydatespan, ps)]
. M.singleton emptydatespan
-- | Postings needed to calculate starting balances. -- | Postings needed to calculate starting balances.
-- --
@ -200,7 +200,7 @@ startingBalancesFromPostings rspec j priceoracle =
-- failure with some totals which are supposed to be 0 being blank. -- failure with some totals which are supposed to be 0 being blank.
startingPostings :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> [Posting] startingPostings :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> [Posting]
startingPostings rspec@ReportSpec{_rsQuery=query,_rsReportOpts=ropts} j priceoracle reportspan = startingPostings rspec@ReportSpec{_rsQuery=query,_rsReportOpts=ropts} j priceoracle reportspan =
map fst $ getPostings rspec' j priceoracle getPostings rspec' j priceoracle
where where
rspec' = rspec{_rsQuery=startbalq,_rsReportOpts=ropts'} rspec' = rspec{_rsQuery=startbalq,_rsReportOpts=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
@ -237,24 +237,21 @@ 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 -> Map DateSpan [Posting] getPostingsByColumn :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> [(DateSpan, [Posting])]
getPostingsByColumn rspec j priceoracle reportspan = columns getPostingsByColumn rspec j priceoracle reportspan =
groupByDateSpan True getDate colspans ps
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 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 colspans = dbg3 "colspans" $ splitSpan (interval_ $ _rsReportOpts rspec) reportspan
addPosting (p, d) = maybe id (M.adjust (p:)) $ latestSpanContaining colspans d getDate = case whichDateFromOpts (_rsReportOpts rspec) of
emptyMap = M.fromList . zip colspans $ repeat [] PrimaryDate -> postingDate
SecondaryDate -> postingDate2
-- Group postings into their columns
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 -> PriceOracle -> [(Posting, Day)] getPostings :: ReportSpec -> Journal -> PriceOracle -> [Posting]
getPostings rspec@ReportSpec{_rsQuery=query,_rsReportOpts=ropts} j priceoracle = getPostings rspec@ReportSpec{_rsQuery=query,_rsReportOpts=ropts} j priceoracle =
map (\p -> (p, date p)) .
journalPostings . journalPostings .
valueJournal . valueJournal .
filterJournalAmounts symq $ -- remove amount parts excluded by cur: filterJournalAmounts symq $ -- remove amount parts excluded by cur:
@ -269,10 +266,6 @@ getPostings rspec@ReportSpec{_rsQuery=query,_rsReportOpts=ropts} j priceoracle =
valueJournal j' | isJust (valuationAfterSum ropts) = j' valueJournal j' | isJust (valuationAfterSum ropts) = j'
| otherwise = journalApplyValuationFromOptsWith rspec j' priceoracle | otherwise = journalApplyValuationFromOptsWith rspec j' priceoracle
date = case whichDateFromOpts ropts of
PrimaryDate -> postingDate
SecondaryDate -> postingDate2
-- | Given a set of postings, eg for a single report column, gather -- | Given a set of postings, eg for a single report column, gather
-- the accounts that have postings and calculate the change amount for -- the accounts that have postings and calculate the change amount for
@ -295,7 +288,7 @@ acctChangesFromPostings ReportSpec{_rsQuery=query,_rsReportOpts=ropts} ps =
-- Makes sure all report columns have an entry. -- Makes sure all report columns have an entry.
calculateReportMatrix :: ReportSpec -> Journal -> PriceOracle calculateReportMatrix :: ReportSpec -> Journal -> PriceOracle
-> HashMap ClippedAccountName Account -> HashMap ClippedAccountName Account
-> Map DateSpan [Posting] -> [(DateSpan, [Posting])]
-> HashMap ClippedAccountName (Map DateSpan Account) -> HashMap ClippedAccountName (Map DateSpan Account)
calculateReportMatrix rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle startbals colps = -- PARTIAL: calculateReportMatrix rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle startbals colps = -- PARTIAL:
-- Ensure all columns have entries, including those with starting balances -- Ensure all columns have entries, including those with starting balances
@ -325,21 +318,21 @@ calculateReportMatrix rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle startb
-- 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) colps colacctchanges = dbg5 "colacctchanges" $ map (second $ acctChangesFromPostings rspec) colps
avalue = acctApplyBoth . mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle avalue = acctApplyBoth . mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle
acctApplyBoth f a = a{aibalance = f $ aibalance a, aebalance = f $ aebalance a} 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]
colspans = M.keys colps colspans = map fst colps
-- | Lay out a set of postings grouped by date span into a regular matrix with rows -- | Lay out a set of postings grouped by date span into a regular matrix with rows
-- given by AccountName and columns by DateSpan, then generate a MultiBalanceReport -- given by AccountName and columns by DateSpan, then generate a MultiBalanceReport
-- from the columns. -- from the columns.
generateMultiBalanceReport :: ReportSpec -> Journal -> PriceOracle generateMultiBalanceReport :: ReportSpec -> Journal -> PriceOracle
-> Map DateSpan [Posting] -> HashMap AccountName Account -> [(DateSpan, [Posting])] -> HashMap AccountName Account
-> MultiBalanceReport -> MultiBalanceReport
generateMultiBalanceReport rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle colps startbals = generateMultiBalanceReport rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle colps startbals =
report report
@ -361,7 +354,7 @@ generateMultiBalanceReport rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle c
sortedrows = dbg5 "sortedrows" $ sortRows ropts j rows sortedrows = dbg5 "sortedrows" $ sortRows ropts j rows
-- Take percentages if needed -- Take percentages if needed
report = reportPercent ropts $ PeriodicReport (M.keys colps) sortedrows totalsrow report = reportPercent ropts $ PeriodicReport (map fst colps) sortedrows totalsrow
-- | Build the report rows. -- | Build the report rows.
-- One row per account, with account name info, row amounts, row total and row average. -- One row per account, with account name info, row amounts, row total and row average.
@ -515,9 +508,9 @@ reportPercent ropts report@(PeriodicReport spans rows totalrow)
-- | Transpose a Map of HashMaps to a HashMap of Maps. -- | Transpose a Map of HashMaps to a HashMap of Maps.
-- --
-- Makes sure that all DateSpans are present in all rows. -- Makes sure that all DateSpans are present in all rows.
transposeMap :: Map DateSpan (HashMap AccountName a) transposeMap :: [(DateSpan, HashMap AccountName a)]
-> HashMap AccountName (Map DateSpan a) -> HashMap AccountName (Map DateSpan a)
transposeMap = M.foldrWithKey addSpan mempty transposeMap = foldr (uncurry addSpan) mempty
where where
addSpan span acctmap seen = HM.foldrWithKey (addAcctSpan span) seen acctmap addSpan span acctmap seen = HM.foldrWithKey (addAcctSpan span) seen acctmap