module Hledger.Reports.MultiBalanceReports (
MultiBalanceReport(..),
MultiBalanceReportRow,
multiBalanceReport
)
where
import Data.List
import Data.Maybe
import Data.Ord
import Safe
import Hledger.Data
import Hledger.Query
import Hledger.Utils
import Hledger.Reports.ReportOptions
import Hledger.Reports.BalanceReport
newtype MultiBalanceReport = MultiBalanceReport ([DateSpan]
,[MultiBalanceReportRow]
,MultiBalanceTotalsRow
)
type MultiBalanceReportRow = (RenderableAccountName, [MixedAmount], MixedAmount, MixedAmount)
type MultiBalanceTotalsRow = ([MixedAmount], MixedAmount, MixedAmount)
instance Show MultiBalanceReport where
show (MultiBalanceReport (spans, items, totals)) =
"MultiBalanceReport (ignore extra quotes):\n" ++ ppShow (show spans, map show items, totals)
type ClippedAccountName = AccountName
multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport
multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totalsrow)
where
symq = dbg "symq" $ filterQuery queryIsSym $ dbg "requested q" q
depthq = dbg "depthq" $ filterQuery queryIsDepth q
depth = queryDepth depthq
depthless = dbg "depthless" . filterQuery (not . queryIsDepth)
datelessq = dbg "datelessq" $ filterQuery (not . queryIsDateOrDate2) q
dateqcons = if date2_ opts then Date2 else Date
precedingq = dbg "precedingq" $ And [datelessq, dateqcons $ DateSpan Nothing (spanStart reportspan)]
requestedspan = dbg "requestedspan" $ queryDateSpan (date2_ opts) q
requestedspan' = dbg "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan (date2_ opts) j
intervalspans = dbg "intervalspans" $ splitSpan (intervalFromOpts opts) requestedspan'
reportspan = dbg "reportspan" $ DateSpan (maybe Nothing spanStart $ headMay intervalspans)
(maybe Nothing spanEnd $ lastMay intervalspans)
newdatesq = dbg "newdateq" $ dateqcons reportspan
reportq = dbg "reportq" $ depthless $ And [datelessq, newdatesq]
ps :: [Posting] =
dbg "ps" $
journalPostings $
filterJournalAmounts symq $
filterJournalPostings reportq $
journalSelectingAmountFromOpts opts j
displayspans = dbg "displayspans" $ splitSpan (intervalFromOpts opts) displayspan
where
displayspan
| empty_ opts = dbg "displayspan (-E)" $ reportspan
| otherwise = dbg "displayspan" $ requestedspan `spanIntersect` matchedspan
matchedspan = dbg "matchedspan" $ postingsDateSpan' (whichDateFromOpts opts) ps
psPerSpan :: [[Posting]] =
dbg "psPerSpan" $
[filter (isPostingInDateSpan' (whichDateFromOpts opts) s) ps | s <- displayspans]
postedAcctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] =
dbg "postedAcctBalChangesPerSpan" $
map postingAcctBals psPerSpan
where
postingAcctBals :: [Posting] -> [(ClippedAccountName, MixedAmount)]
postingAcctBals ps = [(aname a, (if tree_ opts then aibalance else aebalance) a) | a <- as]
where
as = depthLimit $
(if tree_ opts then id else filter ((>0).anumpostings)) $
drop 1 $ accountsFromPostings ps
depthLimit
| tree_ opts = filter ((depthq `matchesAccount`).aname)
| otherwise = clipAccountsAndAggregate depth
postedAccts :: [AccountName] = dbg "postedAccts" $ sort $ accountNamesFromPostings ps
startacctbals = dbg "startacctbals" $ map (\((a,_,_),b) -> (a,b)) startbalanceitems
where
(startbalanceitems,_) = dbg "starting balance report" $ balanceReport opts' precedingq j
where
opts' | tree_ opts = opts{no_elide_=True}
| otherwise = opts{accountlistmode_=ALFlat}
startingBalanceFor a = fromMaybe nullmixedamt $ lookup a startacctbals
startAccts = dbg "startAccts" $ map fst startacctbals
displayedAccts :: [ClippedAccountName] =
dbg "displayedAccts" $
(if tree_ opts then expandAccountNames else id) $
nub $ map (clipOrEllipsifyAccountName depth) $
if empty_ opts then nub $ sort $ startAccts ++ postedAccts else postedAccts
acctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] =
dbg "acctBalChangesPerSpan" $
[sortBy (comparing fst) $ unionBy (\(a,_) (a',_) -> a == a') postedacctbals zeroes
| postedacctbals <- postedAcctBalChangesPerSpan]
where zeroes = [(a, nullmixedamt) | a <- displayedAccts]
acctBalChanges :: [(ClippedAccountName, [MixedAmount])] =
dbg "acctBalChanges" $
[(a, map snd abs) | abs@((a,_):_) <- transpose acctBalChangesPerSpan]
items :: [MultiBalanceReportRow] =
dbg "items" $
[((a, accountLeafName a, accountNameLevel a), displayedBals, rowtot, rowavg)
| (a,changes) <- acctBalChanges
, let displayedBals = case balancetype_ opts of
HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes
CumulativeBalance -> drop 1 $ scanl (+) nullmixedamt changes
_ -> changes
, let rowtot = sum displayedBals
, let rowavg = averageMixedAmounts displayedBals
, empty_ opts || depth == 0 || any (not . isZeroMixedAmount) displayedBals
]
totals :: [MixedAmount] =
map sum balsbycol
where
balsbycol = transpose [bs | ((a,_,_),bs,_,_) <- items, not (tree_ opts) || a `elem` highestlevelaccts]
highestlevelaccts =
dbg "highestlevelaccts" $
[a | a <- displayedAccts, not $ any (`elem` displayedAccts) $ init $ expandAccountName a]
totalsrow :: MultiBalanceTotalsRow =
dbg "totalsrow" $
(totals, sum totals, averageMixedAmounts totals)
dbg s = let p = "multiBalanceReport" in Hledger.Utils.dbg (p++" "++s)