hledger/hledger-lib/Hledger/Reports/MultiBalanceReport.hs

{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE NamedFieldPuns   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|

Multi-column balance reports, used by the balance command.

-}

module Hledger.Reports.MultiBalanceReport (
  MultiBalanceReport,
  MultiBalanceReportRow,

  multiBalanceReport,
  multiBalanceReportWith,

  compoundBalanceReport,
  compoundBalanceReportWith,

  sortRows,
  sortRowsLike,

  -- * Helper functions
  makeReportQuery,
  getPostingsByColumn,
  getPostings,
  startingPostings,
  generateMultiBalanceReport,
  balanceReportTableAsText,

  -- -- * Tests
  tests_MultiBalanceReport
)
where

import Control.Monad (guard)
import Data.Bifunctor (second)
import Data.Foldable (toList)
import Data.List (sortOn, transpose)
import Data.List.NonEmpty (NonEmpty(..))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Ord (Down(..))
import Data.Semigroup (sconcat)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Time.Calendar (fromGregorian)
import Safe (lastDef, minimumMay)

import Data.Default (def)
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as TB
import qualified Text.Tabular.AsciiWide as Tab

import Hledger.Data
import Hledger.Query
import Hledger.Utils hiding (dbg3,dbg4,dbg5)
import qualified Hledger.Utils
import Hledger.Reports.ReportOptions
import Hledger.Reports.ReportTypes


-- add a prefix to this function's debug output
dbg3 s = let p = "multiBalanceReport" in Hledger.Utils.dbg3 (p++" "++s)
dbg4 s = let p = "multiBalanceReport" in Hledger.Utils.dbg4 (p++" "++s)
dbg5 s = let p = "multiBalanceReport" in Hledger.Utils.dbg5 (p++" "++s)


-- | A multi balance report is a kind of periodic report, where the amounts
-- correspond to balance changes or ending balances in a given period. It has:
--
-- 1. a list of each column's period (date span)
--
-- 2. a list of rows, each containing:
--
--   * the full account name, display name, and display depth
--
--   * A list of amounts, one for each column.
--
--   * the total of the row's amounts for a periodic report
--
--   * the average of the row's amounts
--
-- 3. the column totals, and the overall grand total (or zero for
-- cumulative/historical reports) and grand average.

type MultiBalanceReport    = PeriodicReport    DisplayName MixedAmount
type MultiBalanceReportRow = PeriodicReportRow DisplayName MixedAmount

-- type alias just to remind us which AccountNames might be depth-clipped, below.
type ClippedAccountName = AccountName


-- | Generate a multicolumn balance report for the matched accounts,
-- showing the change of balance, accumulated balance, or historical balance
-- in each of the specified periods. If the normalbalance_ option is set, it
-- adjusts the sorting and sign of amounts (see ReportOpts and
-- CompoundBalanceCommand). hledger's most powerful and useful report, used
-- by the balance command (in multiperiod mode) and (via compoundBalanceReport)
-- by the bs/cf/is commands.
multiBalanceReport :: ReportSpec -> Journal -> MultiBalanceReport
multiBalanceReport rspec j = multiBalanceReportWith rspec j (journalPriceOracle infer j) mempty
  where infer = infer_prices_ $ _rsReportOpts rspec

-- | A helper for multiBalanceReport. This one takes some extra arguments,
-- a 'PriceOracle' to be used for looking up market prices, and a set of
-- 'AccountName's which should not be elided. Commands which run multiple
-- reports (bs etc.) can generate the price oracle just once for efficiency,
-- passing it to each report by calling this function directly.
multiBalanceReportWith :: ReportSpec -> Journal -> PriceOracle -> Set AccountName -> MultiBalanceReport
multiBalanceReportWith rspec' j priceoracle unelidableaccts = report
  where
    -- Queries, report/column dates.
    (reportspan, colspans) = reportSpan j rspec'
    rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan

    -- Group postings into their columns.
    colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle colspans

    -- 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.
    startbals = dbg5 "startbals" $
      startingBalances rspec j priceoracle $ startingPostings rspec j priceoracle reportspan

    -- Generate and postprocess the report, negating balances and taking percentages if needed
    report = dbg4 "multiBalanceReportWith" $
      generateMultiBalanceReport rspec j priceoracle unelidableaccts colps startbals

-- | Generate a compound balance report from a list of CBCSubreportSpec. This
-- shares postings between the subreports.
compoundBalanceReport :: ReportSpec -> Journal -> [CBCSubreportSpec a]
                      -> CompoundPeriodicReport a MixedAmount
compoundBalanceReport rspec j = compoundBalanceReportWith rspec j (journalPriceOracle infer j)
  where infer = infer_prices_ $ _rsReportOpts rspec

-- | A helper for compoundBalanceReport, similar to multiBalanceReportWith.
compoundBalanceReportWith :: ReportSpec -> Journal -> PriceOracle
                          -> [CBCSubreportSpec a]
                          -> CompoundPeriodicReport a MixedAmount
compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
  where
    -- Queries, report/column dates.
    (reportspan, colspans) = reportSpan j rspec'
    rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan

    -- Group postings into their columns.
    colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle colspans

    -- 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.
    startps = dbg5 "startps" $ startingPostings rspec j priceoracle reportspan

    subreports = map generateSubreport subreportspecs
      where
        generateSubreport CBCSubreportSpec{..} =
            ( cbcsubreporttitle
            -- Postprocess the report, negating balances and taking percentages if needed
            , cbcsubreporttransform $
                generateMultiBalanceReport rspecsub j priceoracle mempty colps' startbals'
            , cbcsubreportincreasestotal
            )
          where
            -- Add a restriction to this subreport to the report query.
            -- XXX in non-thorough way, consider updateReportSpec ?
            q = cbcsubreportquery j
            ropts = cbcsubreportoptions $ _rsReportOpts rspec
            rspecsub = rspec{_rsReportOpts=ropts, _rsQuery=And [q, _rsQuery rspec]}
            -- Starting balances and column postings specific to this subreport.
            startbals' = startingBalances rspecsub j priceoracle $
              filter (matchesPostingExtra (journalAccountType j) q) startps
            colps' = map (second $ filter (matchesPostingExtra (journalAccountType j) q)) colps

    -- Sum the subreport totals by column. Handle these cases:
    -- - no subreports
    -- - empty subreports, having no subtotals (#588)
    -- - subreports with a shorter subtotals row than the others
    overalltotals = case subreports of
        []     -> PeriodicReportRow () [] nullmixedamt nullmixedamt
        (r:rs) -> sconcat $ fmap subreportTotal (r:|rs)
      where
        subreportTotal (_, sr, increasestotal) =
            (if increasestotal then id else fmap maNegate) $ prTotals sr

    cbr = CompoundPeriodicReport "" (map fst colps) subreports overalltotals

-- XXX seems refactorable
-- | Calculate accounts' balances on the report start date, from these postings
-- which should be all postings before that date, and possibly also from account declarations.
startingBalances :: ReportSpec -> Journal -> PriceOracle -> [Posting]
                             -> HashMap AccountName Account
startingBalances rspec j priceoracle ps =
    M.findWithDefault nullacct emptydatespan
      <$> calculateReportMatrix rspec j priceoracle mempty [(emptydatespan, ps)]

-- | Postings needed to calculate starting balances.
--
-- Balances at report start date, from all earlier postings which otherwise match the query.
-- These balances are unvalued.
-- TODO: Do we want to check whether to bother calculating these? isHistorical
-- and startDate is not nothing, otherwise mempty? This currently gives a
-- failure with some totals which are supposed to be 0 being blank.
startingPostings :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> [Posting]
startingPostings rspec@ReportSpec{_rsQuery=query,_rsReportOpts=ropts} j priceoracle reportspan =
    getPostings rspec' j priceoracle
  where
    rspec' = rspec{_rsQuery=startbalq,_rsReportOpts=ropts'}
    -- If we're re-valuing every period, we need to have the unvalued start
    -- balance, so we can do it ourselves later.
    ropts' = case value_ ropts of
        Just (AtEnd _) -> ropts{period_=precedingperiod, value_=Nothing}
        _              -> ropts{period_=precedingperiod}

    -- q projected back before the report start date.
    -- When there's no report start date, in case there are future txns (the hledger-ui case above),
    -- we use emptydatespan to make sure they aren't counted as starting balance.
    startbalq = dbg3 "startbalq" $ And [datelessq, precedingspanq]
    datelessq = dbg3 "datelessq" $ filterQuery (not . queryIsDateOrDate2) query

    precedingperiod = dateSpanAsPeriod . spanIntersect precedingspan .
                         periodAsDateSpan $ period_ ropts
    precedingspan = DateSpan Nothing $ spanStart reportspan
    precedingspanq = (if date2_ ropts then Date2 else Date) $ case precedingspan of
        DateSpan Nothing Nothing -> emptydatespan
        a -> a

-- | Remove any date queries and insert queries from the report span.
-- The user's query expanded to the report span
-- if there is one (otherwise any date queries are left as-is, which
-- handles the hledger-ui+future txns case above).
makeReportQuery :: ReportSpec -> DateSpan -> ReportSpec
makeReportQuery rspec reportspan
    | reportspan == nulldatespan = rspec
    | otherwise = rspec{_rsQuery=query}
  where
    query            = simplifyQuery $ And [dateless $ _rsQuery rspec, reportspandatesq]
    reportspandatesq = dbg3 "reportspandatesq" $ dateqcons reportspan
    dateless         = dbg3 "dateless" . filterQuery (not . queryIsDateOrDate2)
    dateqcons        = if date2_ (_rsReportOpts rspec) then Date2 else Date

-- | Group postings, grouped by their column
getPostingsByColumn :: ReportSpec -> Journal -> PriceOracle -> [DateSpan] -> [(DateSpan, [Posting])]
getPostingsByColumn rspec j priceoracle colspans =
    groupByDateSpan True getDate colspans ps
  where
    -- Postings matching the query within the report period.
    ps = dbg5 "getPostingsByColumn" $ getPostings rspec j priceoracle
    -- The date spans to be included as report columns.
    getDate = postingDateOrDate2 (whichDate (_rsReportOpts rspec))

-- | Gather postings matching the query within the report period.
getPostings :: ReportSpec -> Journal -> PriceOracle -> [Posting]
getPostings rspec@ReportSpec{_rsQuery=query, _rsReportOpts=ropts} j priceoracle =
    journalPostings $ journalValueAndFilterPostingsWith rspec' j priceoracle
  where
    rspec' = rspec{_rsQuery=depthless, _rsReportOpts = ropts'}
    ropts' = if isJust (valuationAfterSum ropts)
        then ropts{value_=Nothing, conversionop_=Just NoConversionOp}  -- If we're valuing after the sum, don't do it now
        else ropts

    -- The user's query with no depth limit, and expanded to the report span
    -- if there is one (otherwise any date queries are left as-is, which
    -- handles the hledger-ui+future txns case above).
    depthless = dbg3 "depthless" $ filterQuery (not . queryIsDepth) query

-- | From set of postings, eg for a single report column, calculate the balance change in each account. 
-- Accounts and amounts will be depth-clipped appropriately if a depth limit is in effect.
--
-- When --declared is used, accounts which have been declared with an account directive
-- are also included, with a 0 balance change. But only leaf accounts, since non-leaf
-- empty declared accounts are less useful in reports. This is primarily for hledger-ui.
acctChanges :: ReportSpec -> Journal -> [Posting] -> HashMap ClippedAccountName Account
acctChanges ReportSpec{_rsQuery=query,_rsReportOpts=ReportOpts{accountlistmode_, declared_}} j ps =
  HM.fromList [(aname a, a) | a <- accts]
  where
    -- With --declared, add the query-matching declared accounts
    -- (as dummy postings so they are processed like the rest).
    -- This function is used for calculating both pre-start changes and column changes,
    -- and the declared accounts are really only needed for the former, 
    -- but it's harmless to have them in the column changes as well.
    ps' = ps ++ if declared_ then declaredacctps else []
      where
        declaredacctps =
          [nullposting{paccount=a}
          | a <- journalLeafAccountNamesDeclared j
          , matchesAccountExtra (journalAccountType j) (journalAccountTags j) accttypetagsq a
          ]
          where
            accttypetagsq  = dbg3 "accttypetagsq" $
              filterQueryOrNotQuery (\q -> queryIsAcct q || queryIsType q || queryIsTag q) query

    filterbydepth = case accountlistmode_ of
      ALTree -> filter ((depthq `matchesAccount`) . aname)    -- a tree - just exclude deeper accounts
      ALFlat -> clipAccountsAndAggregate (queryDepth depthq)  -- a list - aggregate deeper accounts at the depth limit
                . filter ((0<) . anumpostings)                -- and exclude empty parent accounts
      where depthq = dbg3 "depthq" $ filterQuery queryIsDepth query

    accts = filterbydepth $ drop 1 $ accountsFromPostings ps'

-- | Gather the account balance changes into a regular matrix, then
-- accumulate and value amounts, as specified by the report options.
-- Makes sure all report columns have an entry.
calculateReportMatrix :: ReportSpec -> Journal -> PriceOracle
                      -> HashMap ClippedAccountName Account
                      -> [(DateSpan, [Posting])]
                      -> HashMap ClippedAccountName (Map DateSpan Account)
calculateReportMatrix rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle startbals colps =  -- PARTIAL:
    -- Ensure all columns have entries, including those with starting balances
    HM.mapWithKey rowbals allchanges
  where
    -- The valued row amounts to be displayed: per-period changes,
    -- zero-based cumulative totals, or
    -- starting-balance-based historical balances.
    rowbals name unvaluedChanges = dbg5 "rowbals" $ case balanceaccum_ ropts of
        PerPeriod  -> changes
        Cumulative -> cumulative
        Historical -> historical
      where
        -- changes to report on: usually just the valued changes themselves, but use the
        -- differences in the valued historical amount for CalcValueChange and CalcGain.
        changes = case balancecalc_ ropts of
            CalcChange      -> M.mapWithKey avalue unvaluedChanges
            CalcBudget      -> M.mapWithKey avalue unvaluedChanges
            CalcValueChange -> periodChanges valuedStart historical
            CalcGain        -> periodChanges valuedStart historical
        -- the historical balance is the valued cumulative sum of all unvalued changes
        historical = M.mapWithKey avalue $ cumulativeSum startingBalance unvaluedChanges
        -- since this is a cumulative sum of valued amounts, it should not be valued again
        cumulative = cumulativeSum nullacct changes
        startingBalance = HM.lookupDefault nullacct name startbals
        valuedStart = avalue (DateSpan Nothing historicalDate) startingBalance

    -- In each column, get each account's balance changes
    colacctchanges = dbg5 "colacctchanges" $ map (second $ acctChanges rspec j) colps :: [(DateSpan, HashMap ClippedAccountName Account)]
    -- Transpose it to get each account's balance changes across all columns
    acctchanges = dbg5 "acctchanges" $ transposeMap colacctchanges :: HashMap AccountName (Map DateSpan Account)
    -- Fill out the matrix with zeros in empty cells
    allchanges = ((<>zeros) <$> acctchanges) <> (zeros <$ startbals)

    avalue = acctApplyBoth . mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle
    acctApplyBoth f a = a{aibalance = f $ aibalance a, aebalance = f $ aebalance a}
    historicalDate = minimumMay $ mapMaybe spanStart colspans
    zeros = M.fromList [(span, nullacct) | span <- colspans]
    colspans = map fst colps


-- | 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
-- from the columns.
generateMultiBalanceReport :: ReportSpec -> Journal -> PriceOracle -> Set AccountName
                           -> [(DateSpan, [Posting])] -> HashMap AccountName Account
                           -> MultiBalanceReport
generateMultiBalanceReport rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle unelidableaccts colps startbals =
    report
  where
    -- Process changes into normal, cumulative, or historical amounts, plus value them
    matrix = calculateReportMatrix rspec j priceoracle startbals colps

    -- All account names that will be displayed, possibly depth-clipped.
    displaynames = dbg5 "displaynames" $ displayedAccounts rspec unelidableaccts matrix

    -- All the rows of the report.
    rows = dbg5 "rows" . (if invert_ ropts then map (fmap maNegate) else id)  -- Negate amounts if applicable
             $ buildReportRows ropts displaynames matrix

    -- Calculate column totals
    totalsrow = dbg5 "totalsrow" $ calculateTotalsRow ropts rows

    -- Sorted report rows.
    sortedrows = dbg5 "sortedrows" $ sortRows ropts j rows

    -- Take percentages if needed
    report = reportPercent ropts $ PeriodicReport (map fst colps) sortedrows totalsrow

-- | Build the report rows.
-- One row per account, with account name info, row amounts, row total and row average.
-- Rows are unsorted.
buildReportRows :: ReportOpts
                -> HashMap AccountName DisplayName
                -> HashMap AccountName (Map DateSpan Account)
                -> [MultiBalanceReportRow]
buildReportRows ropts displaynames =
  toList . HM.mapMaybeWithKey mkRow  -- toList of HashMap's Foldable instance - does not sort consistently
  where
    mkRow name accts = do
        displayname <- HM.lookup name displaynames
        return $ PeriodicReportRow displayname rowbals rowtot rowavg
      where
        rowbals = map balance $ toList accts  -- toList of Map's Foldable instance - does sort by key
        -- The total and average for the row.
        -- These are always simply the sum/average of the displayed row amounts.
        -- Total for a cumulative/historical report is always the last column.
        rowtot = case balanceaccum_ ropts of
            PerPeriod -> maSum rowbals
            _         -> lastDef nullmixedamt rowbals
        rowavg = averageMixedAmounts rowbals
    balance = case accountlistmode_ ropts of ALTree -> aibalance; ALFlat -> aebalance

-- | Calculate accounts which are to be displayed in the report, as well as
-- their name and depth
displayedAccounts :: ReportSpec
                  -> Set AccountName
                  -> HashMap AccountName (Map DateSpan Account)
                  -> HashMap AccountName DisplayName
displayedAccounts ReportSpec{_rsQuery=query,_rsReportOpts=ropts} unelidableaccts valuedaccts
    | depth == 0 = HM.singleton "..." $ DisplayName "..." "..." 1
    | otherwise  = HM.mapWithKey (\a _ -> displayedName a) displayedAccts
  where
    -- Accounts which are to be displayed
    displayedAccts = (if depth == 0 then id else HM.filterWithKey keep) valuedaccts
      where
        keep name amts = isInteresting name amts || name `HM.member` interestingParents

    displayedName name = case accountlistmode_ ropts of
        ALTree -> DisplayName name leaf . max 0 $ level - boringParents
        ALFlat -> DisplayName name droppedName 1
      where
        droppedName = accountNameDrop (drop_ ropts) name
        leaf = accountNameFromComponents . reverse . map accountLeafName $
            droppedName : takeWhile notDisplayed parents

        level = max 0 $ accountNameLevel name - drop_ ropts
        parents = take (level - 1) $ parentAccountNames name
        boringParents = if no_elide_ ropts then 0 else length $ filter notDisplayed parents
        notDisplayed = not . (`HM.member` displayedAccts)

    -- Accounts interesting for their own sake
    isInteresting name amts =
        d <= depth                                 -- Throw out anything too deep
        && ( name `Set.member` unelidableaccts     -- Unelidable accounts should be kept unless too deep
           ||(empty_ ropts && keepWhenEmpty amts)  -- Keep empty accounts when called with --empty
           || not (isZeroRow balance amts)         -- Keep everything with a non-zero balance in the row
           )
      where
        d = accountNameLevel name
        keepWhenEmpty = case accountlistmode_ ropts of
            ALFlat -> const True          -- Keep all empty accounts in flat mode
            ALTree -> all (null . asubs)  -- Keep only empty leaves in tree mode
        balance = maybeStripPrices . case accountlistmode_ ropts of
            ALTree | d == depth -> aibalance
            _                   -> aebalance
          where maybeStripPrices = if conversionop_ ropts == Just NoConversionOp then id else mixedAmountStripPrices

    -- Accounts interesting because they are a fork for interesting subaccounts
    interestingParents = dbg5 "interestingParents" $ case accountlistmode_ ropts of
        ALTree -> HM.filterWithKey hasEnoughSubs numSubs
        ALFlat -> mempty
      where
        hasEnoughSubs name nsubs = nsubs >= minSubs && accountNameLevel name > drop_ ropts
        minSubs = if no_elide_ ropts then 1 else 2

    isZeroRow balance = all (mixedAmountLooksZero . balance)
    depth = fromMaybe maxBound $  queryDepth query
    numSubs = subaccountTallies . HM.keys $ HM.filterWithKey isInteresting valuedaccts

-- | Sort the rows by amount or by account declaration order.
sortRows :: ReportOpts -> Journal -> [MultiBalanceReportRow] -> [MultiBalanceReportRow]
sortRows ropts j
    | sort_amount_ ropts, ALTree <- accountlistmode_ ropts = sortTreeMBRByAmount
    | sort_amount_ ropts, ALFlat <- accountlistmode_ ropts = sortFlatMBRByAmount
    | otherwise                                            = sortMBRByAccountDeclaration
  where
    -- Sort the report rows, representing a tree of accounts, by row total at each level.
    -- Similar to sortMBRByAccountDeclaration/sortAccountNamesByDeclaration.
    sortTreeMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow]
    sortTreeMBRByAmount rows = mapMaybe (`HM.lookup` rowMap) sortedanames
      where
        accounttree = accountTree "root" $ map prrFullName rows
        rowMap = HM.fromList $ map (\row -> (prrFullName row, row)) rows
        -- Set the inclusive balance of an account from the rows, or sum the
        -- subaccounts if it's not present
        accounttreewithbals = mapAccounts setibalance accounttree
        setibalance a = a{aibalance = maybe (maSum . map aibalance $ asubs a) prrTotal $
                                          HM.lookup (aname a) rowMap}
        sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive $ normalbalance_ ropts) accounttreewithbals
        sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree

    -- Sort the report rows, representing a flat account list, by row total (and then account name).
    sortFlatMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow]
    sortFlatMBRByAmount = case fromMaybe NormallyPositive $ normalbalance_ ropts of
        NormallyPositive -> sortOn (\r -> (Down $ amt r, prrFullName r))
        NormallyNegative -> sortOn (\r -> (amt r, prrFullName r))
      where amt = mixedAmountStripPrices . prrTotal

    -- Sort the report rows by account declaration order then account name.
    sortMBRByAccountDeclaration :: [MultiBalanceReportRow] -> [MultiBalanceReportRow]
    sortMBRByAccountDeclaration rows = sortRowsLike sortedanames rows
      where
        sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) $ map prrFullName rows

-- | Build the report totals row.
--
-- Calculate the column totals. These are always the sum of column amounts.
calculateTotalsRow :: ReportOpts -> [MultiBalanceReportRow] -> PeriodicReportRow () MixedAmount
calculateTotalsRow ropts rows =
    PeriodicReportRow () coltotals grandtotal grandaverage
  where
    isTopRow row = flat_ ropts || not (any (`HM.member` rowMap) parents)
      where parents = init . expandAccountName $ prrFullName row
    rowMap = HM.fromList $ map (\row -> (prrFullName row, row)) rows

    colamts = transpose . map prrAmounts $ filter isTopRow rows

    coltotals :: [MixedAmount] = dbg5 "coltotals" $ map maSum colamts

    -- Calculate the grand total and average. These are always the sum/average
    -- of the column totals.
    -- Total for a cumulative/historical report is always the last column.
    grandtotal = case balanceaccum_ ropts of
        PerPeriod -> maSum coltotals
        _         -> lastDef nullmixedamt coltotals
    grandaverage = averageMixedAmounts coltotals

-- | Map the report rows to percentages if needed
reportPercent :: ReportOpts -> MultiBalanceReport -> MultiBalanceReport
reportPercent ropts report@(PeriodicReport spans rows totalrow)
  | percent_ ropts = PeriodicReport spans (map percentRow rows) (percentRow totalrow)
  | otherwise      = report
  where
    percentRow (PeriodicReportRow name rowvals rowtotal rowavg) =
      PeriodicReportRow name
        (zipWith perdivide rowvals $ prrAmounts totalrow)
        (perdivide rowtotal $ prrTotal totalrow)
        (perdivide rowavg $ prrAverage totalrow)


-- | Transpose a Map of HashMaps to a HashMap of Maps.
--
-- Makes sure that all DateSpans are present in all rows.
transposeMap :: [(DateSpan, HashMap AccountName a)]
             -> HashMap AccountName (Map DateSpan a)
transposeMap = foldr (uncurry addSpan) mempty
  where
    addSpan span acctmap seen = HM.foldrWithKey (addAcctSpan span) seen acctmap

    addAcctSpan span acct a = HM.alter f acct
      where f = Just . M.insert span a . fromMaybe mempty

-- | A sorting helper: sort a list of things (eg report rows) keyed by account name
-- to match the provided ordering of those same account names.
sortRowsLike :: [AccountName] -> [PeriodicReportRow DisplayName b] -> [PeriodicReportRow DisplayName b]
sortRowsLike sortedas rows = mapMaybe (`HM.lookup` rowMap) sortedas
  where rowMap = HM.fromList $ map (\row -> (prrFullName row, row)) rows

-- | Given a list of account names, find all forking parent accounts, i.e.
-- those which fork between different branches
subaccountTallies :: [AccountName] -> HashMap AccountName Int
subaccountTallies = foldr incrementParent mempty . expandAccountNames
  where incrementParent a = HM.insertWith (+) (parentAccountName a) 1

-- | A helper: what percentage is the second mixed amount of the first ?
-- Keeps the sign of the first amount.
-- Uses unifyMixedAmount to unify each argument and then divides them.
-- Both amounts should be in the same, single commodity.
-- This can call error if the arguments are not right.
perdivide :: MixedAmount -> MixedAmount -> MixedAmount
perdivide a b = fromMaybe (error' errmsg) $ do  -- PARTIAL:
    a' <- unifyMixedAmount a
    b' <- unifyMixedAmount b
    guard $ amountIsZero a' || amountIsZero b' || acommodity a' == acommodity b'
    return $ mixed [per $ if aquantity b' == 0 then 0 else aquantity a' / abs (aquantity b') * 100]
  where errmsg = "Cannot calculate percentages if accounts have different commodities (Hint: Try --cost, -V or similar flags.)"

-- Add the values of two accounts. Should be right-biased, since it's used
-- in scanl, so other properties (such as anumpostings) stay in the right place
sumAcct :: Account -> Account -> Account
sumAcct Account{aibalance=i1,aebalance=e1} a@Account{aibalance=i2,aebalance=e2} =
    a{aibalance = i1 `maPlus` i2, aebalance = e1 `maPlus` e2}

-- Subtract the values in one account from another. Should be left-biased.
subtractAcct :: Account -> Account -> Account
subtractAcct a@Account{aibalance=i1,aebalance=e1} Account{aibalance=i2,aebalance=e2} =
    a{aibalance = i1 `maMinus` i2, aebalance = e1 `maMinus` e2}

-- | Extract period changes from a cumulative list
periodChanges :: Account -> Map k Account -> Map k Account
periodChanges start amtmap =
    M.fromDistinctAscList . zip dates $ zipWith subtractAcct amts (start:amts)
  where (dates, amts) = unzip $ M.toAscList amtmap

-- | Calculate a cumulative sum from a list of period changes.
cumulativeSum :: Account -> Map DateSpan Account -> Map DateSpan Account
cumulativeSum start = snd . M.mapAccum (\a b -> let s = sumAcct a b in (s, s)) start

-- | Given a table representing a multi-column balance report (for example,
-- made using 'balanceReportAsTable'), render it in a format suitable for
-- console output. Amounts with more than two commodities will be elided
-- unless --no-elide is used.
balanceReportTableAsText :: ReportOpts -> Tab.Table T.Text T.Text WideBuilder -> TB.Builder
balanceReportTableAsText ReportOpts{..} =
    Tab.renderTableByRowsB def{Tab.tableBorders=False, Tab.prettyTable=pretty_} renderCh renderRow
  where
    renderCh
      | layout_ /= LayoutBare || transpose_ = fmap (Tab.textCell Tab.TopRight)
      | otherwise = zipWith ($) (Tab.textCell Tab.TopLeft : repeat (Tab.textCell Tab.TopRight))

    renderRow (rh, row)
      | layout_ /= LayoutBare || transpose_ =
          (Tab.textCell Tab.TopLeft rh, fmap (Tab.Cell Tab.TopRight . pure) row)
      | otherwise =
          (Tab.textCell Tab.TopLeft rh, zipWith ($) (Tab.Cell Tab.TopLeft : repeat (Tab.Cell Tab.TopRight)) (fmap pure row))



-- tests

tests_MultiBalanceReport = testGroup "MultiBalanceReport" [

  let
    amt0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = Precision 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}}
    (rspec,journal) `gives` r = do
      let rspec' = rspec{_rsQuery=And [queryFromFlags $ _rsReportOpts rspec, _rsQuery rspec]}
          (eitems, etotal) = r
          (PeriodicReport _ aitems atotal) = multiBalanceReport rspec' journal
          showw (PeriodicReportRow a lAmt amt amt')
              = (displayFull a, displayName a, displayDepth a, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt')
      (map showw aitems) @?= (map showw eitems)
      showMixedAmountDebug (prrTotal atotal) @?= showMixedAmountDebug etotal -- we only check the sum of the totals
  in
   testGroup "multiBalanceReport" [
      testCase "null journal"  $
      (defreportspec, nulljournal) `gives` ([], nullmixedamt)

     ,testCase "with -H on a populated period"  $
      (defreportspec{_rsReportOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balanceaccum_=Historical}}, samplejournal) `gives`
       (
        [ PeriodicReportRow (flatDisplayName "assets:bank:checking") [mixedAmount $ usd 1]    (mixedAmount $ usd 1)    (mixedAmount amt0{aquantity=1})
        , PeriodicReportRow (flatDisplayName "income:salary")        [mixedAmount $ usd (-1)] (mixedAmount $ usd (-1)) (mixedAmount amt0{aquantity=(-1)})
        ],
        mixedAmount $ usd 0)

     -- ,testCase "a valid history on an empty period"  $
     --  (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3), balanceaccum_=Historical}, samplejournal) `gives`
     --   (
     --    [
     --     ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=1})
     --    ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",mixedAmount amt0 {aquantity=(-1)})
     --    ],
     --    mixedAmount usd0)

     -- ,testCase "a valid history on an empty period (more complex)"  $
     --  (defreportopts{period_= PeriodBetween (fromGregorian 2009 1 1) (fromGregorian 2009 1 2), balanceaccum_=Historical}, samplejournal) `gives`
     --   (
     --    [
     --    ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=1})
     --    ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=1})
     --    ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",mixedAmount amt0 {aquantity=(-2)})
     --    ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=(1)})
     --    ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",mixedAmount amt0 {aquantity=(1)})
     --    ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",mixedAmount amt0 {aquantity=(-1)})
     --    ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",mixedAmount amt0 {aquantity=(-1)})
     --    ],
     --    mixedAmount usd0)
    ]
 ]