;lib: multiBalanceReport cleanup

This commit is contained in:
Simon Michael 2019-05-04 12:34:59 -07:00
parent 3a79e300c9
commit cc05f48697

View File

@ -83,9 +83,9 @@ type ClippedAccountName = AccountName
-- If the normalbalance_ option is set, it adjusts the sorting and sign of amounts -- If the normalbalance_ option is set, it adjusts the sorting and sign of amounts
-- (see ReportOpts and CompoundBalanceCommand). -- (see ReportOpts and CompoundBalanceCommand).
multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport
multiBalanceReport opts q j = multiBalanceReport ropts@ReportOpts{..} q j =
(if invert_ opts then mbrNegate else id) $ (if invert_ then mbrNegate else id) $
(if value_ opts then mbrValue opts j else id) $ (if value_ then mbrValue ropts j else id) $
MultiBalanceReport (displayspans, sorteditems, totalsrow) MultiBalanceReport (displayspans, sorteditems, totalsrow)
where where
symq = dbg1 "symq" $ filterQuery queryIsSym $ dbg1 "requested q" q symq = dbg1 "symq" $ filterQuery queryIsSym $ dbg1 "requested q" q
@ -93,17 +93,17 @@ multiBalanceReport opts q j =
depth = queryDepth depthq depth = queryDepth depthq
depthless = dbg1 "depthless" . filterQuery (not . queryIsDepth) depthless = dbg1 "depthless" . filterQuery (not . queryIsDepth)
datelessq = dbg1 "datelessq" $ filterQuery (not . queryIsDateOrDate2) q datelessq = dbg1 "datelessq" $ filterQuery (not . queryIsDateOrDate2) q
dateqcons = if date2_ opts then Date2 else Date dateqcons = if date2_ then Date2 else Date
-- 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 = dbg1 "requestedspan" $ queryDateSpan (date2_ opts) q requestedspan = dbg1 "requestedspan" $ queryDateSpan date2_ q
-- If the requested span is open-ended, close it using the journal's end dates. -- If the requested span is open-ended, close it using the journal's end dates.
-- This can still be the null (open) span if the journal is empty. -- This can still be the null (open) span if the journal is empty.
requestedspan' = dbg1 "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan (date2_ opts) j requestedspan' = dbg1 "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan date2_ j
-- The list of interval spans enclosing the requested span. -- The list of interval spans enclosing the requested span.
-- This list can be empty if the journal was empty, -- This list can be empty if the journal was empty,
-- or if hledger-ui has added its special date:-tomorrow to the query -- or if hledger-ui has added its special date:-tomorrow to the query
-- and all txns are in the future. -- and all txns are in the future.
intervalspans = dbg1 "intervalspans" $ splitSpan (interval_ opts) requestedspan' intervalspans = dbg1 "intervalspans" $ splitSpan interval_ requestedspan'
-- The requested span enlarged to enclose a whole number of intervals. -- The requested span enlarged to enclose a whole number of intervals.
-- This can be the null span if there were no intervals. -- This can be the null span if there were no intervals.
reportspan = dbg1 "reportspan" $ DateSpan (maybe Nothing spanStart $ headMay intervalspans) reportspan = dbg1 "reportspan" $ DateSpan (maybe Nothing spanStart $ headMay intervalspans)
@ -130,31 +130,31 @@ multiBalanceReport opts q j =
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
journalSelectingAmountFromOpts opts j journalSelectingAmountFromOpts ropts j
displayspans = dbg1 "displayspans" $ splitSpan (interval_ opts) displayspan displayspans = dbg1 "displayspans" $ splitSpan interval_ displayspan
where where
displayspan displayspan
| empty_ opts = dbg1 "displayspan (-E)" reportspan -- all the requested intervals | empty_ = dbg1 "displayspan (-E)" reportspan -- all the requested intervals
| otherwise = dbg1 "displayspan" $ requestedspan `spanIntersect` matchedspan -- exclude leading/trailing empty intervals | otherwise = dbg1 "displayspan" $ requestedspan `spanIntersect` matchedspan -- exclude leading/trailing empty intervals
matchedspan = dbg1 "matchedspan" $ postingsDateSpan' (whichDateFromOpts opts) ps matchedspan = dbg1 "matchedspan" $ postingsDateSpan' (whichDateFromOpts ropts) ps
psPerSpan :: [[Posting]] = psPerSpan :: [[Posting]] =
dbg1 "psPerSpan" dbg1 "psPerSpan"
[filter (isPostingInDateSpan' (whichDateFromOpts opts) s) ps | s <- displayspans] [filter (isPostingInDateSpan' (whichDateFromOpts ropts) s) ps | s <- displayspans]
postedAcctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] = postedAcctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] =
dbg1 "postedAcctBalChangesPerSpan" $ dbg1 "postedAcctBalChangesPerSpan" $
map postingAcctBals psPerSpan map postingAcctBals psPerSpan
where where
postingAcctBals :: [Posting] -> [(ClippedAccountName, MixedAmount)] postingAcctBals :: [Posting] -> [(ClippedAccountName, MixedAmount)]
postingAcctBals ps = [(aname a, (if tree_ opts then aibalance else aebalance) a) | a <- as] postingAcctBals ps = [(aname a, (if tree_ ropts then aibalance else aebalance) a) | a <- as]
where where
as = depthLimit $ as = depthLimit $
(if tree_ opts then id else filter ((>0).anumpostings)) $ (if tree_ ropts then id else filter ((>0).anumpostings)) $
drop 1 $ accountsFromPostings ps drop 1 $ accountsFromPostings ps
depthLimit depthLimit
| tree_ opts = filter ((depthq `matchesAccount`).aname) -- exclude deeper balances | tree_ ropts = filter ((depthq `matchesAccount`).aname) -- exclude deeper balances
| otherwise = clipAccountsAndAggregate depth -- aggregate deeper balances at the depth limit | otherwise = clipAccountsAndAggregate depth -- aggregate deeper balances at the depth limit
postedAccts :: [AccountName] = dbg1 "postedAccts" $ sort $ accountNamesFromPostings ps postedAccts :: [AccountName] = dbg1 "postedAccts" $ sort $ accountNamesFromPostings ps
@ -162,18 +162,18 @@ multiBalanceReport opts q j =
-- starting balances and accounts from transactions before the report start date -- starting balances and accounts from transactions before the report start date
startacctbals = dbg1 "startacctbals" $ map (\(a,_,_,b) -> (a,b)) startbalanceitems startacctbals = dbg1 "startacctbals" $ map (\(a,_,_,b) -> (a,b)) startbalanceitems
where where
(startbalanceitems,_) = dbg1 "starting balance report" $ balanceReport opts' startbalq j (startbalanceitems,_) = dbg1 "starting balance report" $ balanceReport ropts' startbalq j
where where
opts' | tree_ opts = opts{no_elide_=True} ropts' | tree_ ropts = ropts{no_elide_=True}
| otherwise = opts{accountlistmode_=ALFlat} | otherwise = ropts{accountlistmode_=ALFlat}
startingBalanceFor a = fromMaybe nullmixedamt $ lookup a startacctbals startingBalanceFor a = fromMaybe nullmixedamt $ lookup a startacctbals
startAccts = dbg1 "startAccts" $ map fst startacctbals startAccts = dbg1 "startAccts" $ map fst startacctbals
displayedAccts :: [ClippedAccountName] = displayedAccts :: [ClippedAccountName] =
dbg1 "displayedAccts" $ dbg1 "displayedAccts" $
(if tree_ opts then expandAccountNames else id) $ (if tree_ ropts then expandAccountNames else id) $
nub $ map (clipOrEllipsifyAccountName depth) $ nub $ map (clipOrEllipsifyAccountName depth) $
if empty_ opts || (balancetype_ opts) == HistoricalBalance then nub $ sort $ startAccts ++ postedAccts else postedAccts if empty_ || balancetype_ == HistoricalBalance then nub $ sort $ startAccts ++ postedAccts else postedAccts
acctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] = acctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] =
dbg1 "acctBalChangesPerSpan" dbg1 "acctBalChangesPerSpan"
@ -189,13 +189,13 @@ multiBalanceReport opts q j =
dbg1 "items" $ dbg1 "items" $
[(a, accountLeafName a, accountNameLevel a, displayedBals, rowtot, rowavg) [(a, accountLeafName a, accountNameLevel a, displayedBals, rowtot, rowavg)
| (a,changes) <- acctBalChanges | (a,changes) <- acctBalChanges
, let displayedBals = case balancetype_ opts of , let displayedBals = case balancetype_ of
HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes
CumulativeChange -> drop 1 $ scanl (+) nullmixedamt changes CumulativeChange -> drop 1 $ scanl (+) nullmixedamt changes
_ -> changes _ -> changes
, let rowtot = sum displayedBals , let rowtot = sum displayedBals
, let rowavg = averageMixedAmounts displayedBals , let rowavg = averageMixedAmounts displayedBals
, empty_ opts || depth == 0 || any (not . isZeroMixedAmount) displayedBals , empty_ || depth == 0 || any (not . isZeroMixedAmount) displayedBals
] ]
-- TODO TBD: is it always ok to sort report rows after report has been generated ? -- TODO TBD: is it always ok to sort report rows after report has been generated ?
@ -205,8 +205,8 @@ multiBalanceReport opts q j =
sortitems items sortitems items
where where
sortitems sortitems
| sort_amount_ opts && accountlistmode_ opts == ALTree = sortTreeMBRByAmount | sort_amount_ && accountlistmode_ == ALTree = sortTreeMBRByAmount
| sort_amount_ opts = sortFlatMBRByAmount | sort_amount_ = sortFlatMBRByAmount
| otherwise = sortMBRByAccountDeclaration | otherwise = sortMBRByAccountDeclaration
where where
-- Sort the report rows, representing a tree of accounts, by row total at each level. -- Sort the report rows, representing a tree of accounts, by row total at each level.
@ -221,28 +221,28 @@ multiBalanceReport opts q j =
where where
-- should not happen, but it's dangerous; TODO -- should not happen, but it's dangerous; TODO
setibalance a = a{aibalance=fromMaybe (error "sortTreeMBRByAmount 1") $ lookup (aname a) atotals} setibalance a = a{aibalance=fromMaybe (error "sortTreeMBRByAmount 1") $ lookup (aname a) atotals}
sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ opts) accounttreewithbals sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive normalbalance_) accounttreewithbals
sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree
sortedrows = sortAccountItemsLike sortedanames anamesandrows sortedrows = sortAccountItemsLike sortedanames anamesandrows
-- Sort the report rows, representing a flat account list, by row total. -- Sort the report rows, representing a flat account list, by row total.
sortFlatMBRByAmount = sortBy (maybeflip $ comparing (normaliseMixedAmountSquashPricesForDisplay . fifth6)) sortFlatMBRByAmount = sortBy (maybeflip $ comparing (normaliseMixedAmountSquashPricesForDisplay . fifth6))
where where
maybeflip = if normalbalance_ opts == Just NormallyNegative then id else flip maybeflip = if normalbalance_ == Just NormallyNegative then id else flip
-- Sort the report rows by account declaration order then account name. -- Sort the report rows by account declaration order then account name.
sortMBRByAccountDeclaration rows = sortedrows sortMBRByAccountDeclaration rows = sortedrows
where where
anamesandrows = [(first6 r, r) | r <- rows] anamesandrows = [(first6 r, r) | r <- rows]
anames = map fst anamesandrows anames = map fst anamesandrows
sortedanames = sortAccountNamesByDeclaration j (tree_ opts) anames sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames
sortedrows = sortAccountItemsLike sortedanames anamesandrows sortedrows = sortAccountItemsLike sortedanames anamesandrows
totals :: [MixedAmount] = totals :: [MixedAmount] =
-- dbg1 "totals" $ -- dbg1 "totals" $
map sum balsbycol map sum balsbycol
where where
balsbycol = transpose [bs | (a,_,_,bs,_,_) <- sorteditems, not (tree_ opts) || a `elem` highestlevelaccts] balsbycol = transpose [bs | (a,_,_,bs,_,_) <- sorteditems, not (tree_ ropts) || a `elem` highestlevelaccts]
highestlevelaccts = highestlevelaccts =
dbg1 "highestlevelaccts" dbg1 "highestlevelaccts"
[a | a <- displayedAccts, not $ any (`elem` displayedAccts) $ init $ expandAccountName a] [a | a <- displayedAccts, not $ any (`elem` displayedAccts) $ init $ expandAccountName a]