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

{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-|

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

-}

module Hledger.Reports.MultiBalanceReport (
  MultiBalanceReport,
  MultiBalanceReportRow,

  multiBalanceReport,
  multiBalanceReportWith,

  compoundBalanceReport,
  compoundBalanceReportWith,

  -- * Helper functions
  makeReportQuery,
  getPostings,
  generateMultiBalanceAccount,
  generatePeriodicReport,
  makePeriodicReportRow,

  -- -- * Tests
  tests_MultiBalanceReport
)
where

#if !MIN_VERSION_base(4,18,0)
import Control.Applicative (liftA2)
#endif
import Control.Monad (guard)
import Data.Foldable (toList)
import Data.HashSet qualified as HS
import Data.List (sortOn)
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Map qualified as M
import Data.Maybe (fromMaybe, isJust)
import Data.Ord (Down(..))
import Data.Semigroup (sconcat)
import Data.These (these)
import Data.Time.Calendar (Day(..), fromGregorian)
import Data.Traversable (mapAccumL)

import Hledger.Data
import Hledger.Query
import Hledger.Utils
import Hledger.Reports.ReportOptions
import Hledger.Reports.ReportTypes


-- | 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


-- | 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)
  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 -> MultiBalanceReport
multiBalanceReportWith rspec' j priceoracle = report
  where
    -- Queries, report/column dates.
    (reportspan, colspans) = dbg5 "multiBalanceReportWith reportSpan" $ reportSpan j rspec'
    rspec = dbg3 "multiBalanceReportWith rspec" $ makeReportQuery rspec' reportspan
    -- force evaluation order to show price lookup after date spans in debug output (XXX not working)
    -- priceoracle = reportspan `seq` priceoracle0

    -- Get postings
    ps = dbg5 "multiBalanceReportWith ps" $ getPostings rspec j priceoracle reportspan

    -- Process changes into normal, cumulative, or historical amounts, plus value them and mark which are uninteresting
    acct = dbg5 "multiBalanceReportWith acct" $ generateMultiBalanceAccount rspec j priceoracle colspans ps

    -- Generate and postprocess the report, negating balances and taking percentages if needed
    report = dbg4 "multiBalanceReportWith report" $ generateMultiBalanceReport (_rsReportOpts rspec) colspans acct

-- | 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) = dbg5 "compoundBalanceReportWith reportSpan" $ reportSpan j rspec'
    rspec = dbg3 "compoundBalanceReportWith rspec" $ makeReportQuery rspec' reportspan

    -- Get postings
    ps = dbg5 "compoundBalanceReportWith ps" $ getPostings rspec j priceoracle reportspan

    subreports = map generateSubreport subreportspecs
      where
        generateSubreport CBCSubreportSpec{..} =
            ( cbcsubreporttitle
            -- Postprocess the report, negating balances and taking percentages if needed
            , cbcsubreporttransform $ generateMultiBalanceReport ropts colspans acct
            , cbcsubreportincreasestotal
            )
          where
            ropts = cbcsubreportoptions $ _rsReportOpts rspec
            -- Add a restriction to this subreport to the report query.
            -- XXX in non-thorough way, consider updateReportSpec ?
            rspecsub = rspec{_rsReportOpts=ropts, _rsQuery=And [cbcsubreportquery, _rsQuery rspec]}
            -- Match and postings for the subreport
            subreportps = filter (matchesPostingExtra (journalAccountType j) cbcsubreportquery) ps
            -- Account representing this subreport
            acct = generateMultiBalanceAccount rspecsub j priceoracle colspans subreportps

    -- 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 "" (maybeDayPartitionToDateSpans colspans) subreports overalltotals


-- | 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 "makeReportQuery reportspandatesq" $ dateqcons reportspan
    dateless         = dbg3 "makeReportQuery dateless" . filterQuery (not . queryIsDateOrDate2)
    dateqcons        = if date2_ (_rsReportOpts rspec) then Date2 else Date

-- | Gather postings matching the query within the report period.
getPostings :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> [Posting]
getPostings rspec@ReportSpec{_rsQuery=query, _rsReportOpts=ropts} j priceoracle reportspan =
    setPostingsCount
    . journalPostings
    $ journalValueAndFilterPostingsWith rspec' j priceoracle
  where
    -- If doing --count, set all posting amounts to "1".
    setPostingsCount = case balancecalc_ ropts of
        CalcPostingsCount -> map (postingTransformAmount (const $ mixed [num 1]))
        _                 -> id

    rspec' = rspec{_rsQuery=fullreportq,_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' = if isJust (valuationAfterSum ropts)
        then ropts{period_=dateSpanAsPeriod fullreportspan, value_=Nothing, conversionop_=Just NoConversionOp}  -- If we're valuing after the sum, don't do it now
        else ropts{period_=dateSpanAsPeriod fullreportspan}

    -- 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.
    fullreportq = dbg3 "getPostings fullreportq" $ And [datelessq, fullreportspanq]
    datelessq   = dbg3 "getPostings datelessq" $ filterQuery (not . queryIsDateOrDate2) depthlessq

    -- 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).
    depthlessq = dbg3 "getPostings depthlessq" $ filterQuery (not . queryIsDepth) query

    fullreportspan  = if requiresHistorical ropts then DateSpan Nothing (Exact <$> spanEnd reportspan) else reportspan
    fullreportspanq = (if date2_ ropts then Date2 else Date) $ case fullreportspan of
        DateSpan Nothing Nothing -> emptydatespan
        a -> a

-- | Generate the 'Account' for the requested multi-balance report from a list
-- of 'Posting's.
generateMultiBalanceAccount :: ReportSpec -> Journal -> PriceOracle -> Maybe DayPartition -> [Posting] -> Account BalanceData
generateMultiBalanceAccount rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle colspans =
    -- Add declared accounts if called with --declared and --empty
    (if (declared_ ropts && empty_ ropts) then addDeclaredAccounts rspec j else id)
    -- Negate amounts if applicable
    . (if invert_ ropts then fmap (mapBalanceData maNegate) else id)
    -- Mark which accounts are boring and which are interesting
    . markAccountBoring rspec
    -- Set account declaration info (for sorting purposes)
    . mapAccounts (accountSetDeclarationInfo j)
    -- Process changes into normal, cumulative, or historical amounts, plus value them
    . calculateReportAccount rspec j priceoracle colspans
    -- Clip account names
    . map clipPosting
  where
    -- Clip postings to the requested depth according to the query
    clipPosting p = p{paccount = clipOrEllipsifyAccountName depthSpec $ paccount p}
    depthSpec = dbg3 "generateMultiBalanceAccount depthSpec"
              . queryDepth . filterQuery queryIsDepth $ _rsQuery rspec

-- | Add declared accounts to the account tree.
addDeclaredAccounts :: Monoid a => ReportSpec -> Journal -> Account a -> Account a
addDeclaredAccounts rspec j acct =
    these id id const <$> mergeAccounts acct declaredTree
  where
    declaredTree =
        mapAccounts (\a -> a{aboring = not $ aname a `HS.member` HS.fromList declaredAccounts}) $
          accountTreeFromBalanceAndNames "root" (mempty <$ adata acct) declaredAccounts

    -- With --declared, add the query-matching declared accounts (as dummy postings
    -- so they are processed like the rest).
    declaredAccounts =
      map (clipOrEllipsifyAccountName depthSpec) .
      filter (matchesAccountExtra (journalAccountType j) (journalAccountTags j) accttypetagsq) $
      journalAccountNamesDeclared j

    accttypetagsq  = dbg3 "addDeclaredAccounts accttypetagsq" .
      filterQueryOrNotQuery (\q -> queryIsAcct q || queryIsType q || queryIsTag q) $
      _rsQuery rspec

    depthSpec = queryDepth . filterQuery queryIsDepth $ _rsQuery rspec


-- | 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.
calculateReportAccount :: ReportSpec -> Journal -> PriceOracle -> Maybe DayPartition -> [Posting] -> Account BalanceData
calculateReportAccount _ _ _ Nothing _ =
    accountFromBalances "root" $ periodDataFromList mempty [(nulldate, mempty)]
calculateReportAccount rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle (Just colspans) ps =
    mapPeriodData rowbals changesAcct
  where
    -- The valued row amounts to be displayed: per-period changes,
    -- zero-based cumulative totals, or
    -- starting-balance-based historical balances.
    rowbals :: PeriodData BalanceData -> PeriodData BalanceData
    rowbals unvaluedChanges = 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        -> avalue unvaluedChanges
            CalcBudget        -> avalue unvaluedChanges
            CalcValueChange   -> periodChanges historical
            CalcGain          -> periodChanges historical
            CalcPostingsCount -> avalue unvaluedChanges
        -- the historical balance is the valued cumulative sum of all unvalued changes
        historical = avalue $ cumulativeSum unvaluedChanges
        -- since this is a cumulative sum of valued amounts, it should not be valued again
        cumulative = cumulativeSum changes{pdpre = mempty}
        avalue = periodDataValuation ropts j priceoracle colspans

    changesAcct = dbg5With (\x -> "calculateReportAccount changesAcct\n" ++ showAccounts x) .
        mapPeriodData (padPeriodData mempty (dayPartitionToPeriodData colspans)) $
        accountFromPostings getIntervalStartDate ps

    getIntervalStartDate p = fst $ dayPartitionFind (getPostingDate p) colspans
    getPostingDate = postingDateOrDate2 (whichDate (_rsReportOpts rspec))

-- | The valuation function to use for the chosen report options.
periodDataValuation :: ReportOpts -> Journal -> PriceOracle -> DayPartition
                    -> PeriodData BalanceData -> PeriodData BalanceData
periodDataValuation ropts j priceoracle colspans =
    opPeriodData valueBalanceData (dayPartitionToPeriodData colspans)
  where
    valueBalanceData :: Day -> BalanceData -> BalanceData
    valueBalanceData d = mapBalanceData (valueMixedAmount d)

    valueMixedAmount :: Day -> MixedAmount -> MixedAmount
    valueMixedAmount = mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle

-- | Mark which nodes of an 'Account' are boring, and so should be omitted from reports.
markAccountBoring :: ReportSpec -> Account BalanceData -> Account BalanceData
markAccountBoring ReportSpec{_rsQuery=query,_rsReportOpts=ropts}
    -- If depth 0, all accounts except the top-level account are boring
    | qdepthIsZero = markBoring False . mapAccounts (markBoring True)
    -- Otherwise the top level account is boring, and subaccounts are boring if
    -- they are both boring in and of themselves and are boring parents
    | otherwise    = markBoring True . mapAccounts (markBoringBy (liftA2 (&&) isBoring isBoringParent))
  where
    -- Accounts boring on their own
    isBoring :: Account BalanceData -> Bool
    isBoring acct = tooDeep || allZeros
      where
        tooDeep = d > qdepth                                       -- Throw out anything too deep
        allZeros = isZeroRow balance amts && not keepEmptyAccount  -- Throw away everything with a zero balance in the row, unless..
        keepEmptyAccount = empty_ ropts && keepWhenEmpty acct      -- We are keeping empty rows and this row meets the criteria

        amts = pdperiods $ adata acct
        d = accountNameLevel $ aname acct

        qdepth = fromMaybe maxBound . getAccountNameClippedDepth depthspec $ aname acct
        balance = maybeStripPrices . case accountlistmode_ ropts of
            ALTree | d == qdepth -> bdincludingsubs
            _                    -> bdexcludingsubs

    -- Accounts which don't have enough interesting subaccounts
    isBoringParent :: Account a -> Bool
    isBoringParent acct = case accountlistmode_ ropts of
        ALTree -> notEnoughSubs || droppedAccount
        ALFlat -> True
      where
        notEnoughSubs = length interestingSubs < minimumSubs
        droppedAccount = accountNameLevel (aname acct) <= drop_ ropts
        interestingSubs = filter (anyAccounts (not . aboring)) $ asubs acct
        minimumSubs = if no_elide_ ropts then 1 else 2

    isZeroRow balance = all (mixedAmountLooksZero . balance)
    keepWhenEmpty = case accountlistmode_ ropts of
        ALFlat -> any ((0<) . bdnumpostings) . pdperiods . adata  -- Keep all accounts that have postings in flat mode
        ALTree -> null . asubs                                    -- Keep only empty leaves in tree mode
    maybeStripPrices = if conversionop_ ropts == Just NoConversionOp then id else mixedAmountStripCosts

    qdepthIsZero = depthspec == DepthSpec (Just 0) []
    depthspec = queryDepth query

    markBoring   v a = a{aboring = v}
    markBoringBy f a = a{aboring = f a}


-- | Build a report row.
--
-- Calculate the column totals. These are always the sum of column amounts.
generateMultiBalanceReport :: ReportOpts -> Maybe DayPartition -> Account BalanceData -> MultiBalanceReport
generateMultiBalanceReport ropts colspans =
    reportPercent ropts . generatePeriodicReport makeMultiBalanceReportRow bdincludingsubs id ropts colspans

-- | 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.
generatePeriodicReport :: Show c =>
    (forall a. ReportOpts -> (BalanceData -> MixedAmount) -> a -> Account b -> PeriodicReportRow a c)
    -> (b -> MixedAmount) -> (c -> MixedAmount)
    -> ReportOpts -> Maybe DayPartition -> Account b -> PeriodicReport DisplayName c
generatePeriodicReport makeRow treeAmt flatAmt ropts colspans acct =
    PeriodicReport (maybeDayPartitionToDateSpans colspans) (buildAndSort acct) totalsrow
  where
    -- Build report rows and sort them
    buildAndSort = dbg5 "generatePeriodicReport buildAndSort" . case accountlistmode_ ropts of
        ALTree | sort_amount_ ropts -> buildRows . sortTreeByAmount
        ALFlat | sort_amount_ ropts -> sortFlatByAmount . buildRows
        _                           -> buildRows . sortAccountTreeByDeclaration

    buildRows = buildReportRows makeRow ropts

    -- Calculate column totals from the inclusive balances of the root account
    totalsrow = dbg5 "generatePeriodicReport totalsrow" $ makeRow ropts bdincludingsubs () acct

    sortTreeByAmount = case fromMaybe NormallyPositive $ normalbalance_ ropts of
        NormallyPositive -> sortAccountTreeOn (\r -> (Down $ amt r, aname r))
        NormallyNegative -> sortAccountTreeOn (\r -> (amt r, aname r))
      where
        amt = mixedAmountStripCosts . sortKey . fmap treeAmt . pdperiods . adata
        sortKey = case balanceaccum_ ropts of
          PerPeriod -> maSum
          _         -> maybe nullmixedamt snd . M.lookupMax

    sortFlatByAmount = case fromMaybe NormallyPositive $ normalbalance_ ropts of
        NormallyPositive -> sortOn (\r -> (Down $ amt r, prrFullName r))
        NormallyNegative -> sortOn (\r -> (amt r, prrFullName r))
      where amt = mixedAmountStripCosts . flatAmt . prrTotal

-- | Build the report rows.
-- One row per account, with account name info, row amounts, row total and row average.
-- Rows are sorted according to the order in the 'Account' tree.
buildReportRows :: forall b c.
                (ReportOpts -> (BalanceData -> MixedAmount) -> DisplayName -> Account b -> PeriodicReportRow DisplayName c)
                -> ReportOpts -> Account b -> [PeriodicReportRow DisplayName c]
buildReportRows makeRow ropts = mkRows True (-drop_ ropts) 0
  where
    -- Build the row for an account at a given depth with some number of boring parents
    mkRows :: Bool -> Int -> Int -> Account b -> [PeriodicReportRow DisplayName c]
    mkRows isRoot d boringParents acct
        -- Account is boring and has no interesting children at any depth, so we stop
        | allBoring acct                 = []
        -- Account is a boring root account, and should be bypassed entirely
        | aboring acct && isRoot         = buildSubrows d 0
        -- Account is boring and has been dropped, so should be skipped and move up the hierarchy
        | aboring acct && d < 0          = buildSubrows (d + 1) 0
        -- Account is boring, and we can omit boring parents, so we should omit but keep track
        | aboring acct && canOmitParents = buildSubrows d (boringParents + 1)
        -- Account is not boring or otherwise should be displayed.
        | otherwise = makeRow ropts balance displayname acct : buildSubrows (d + 1) 0
      where
        displayname = displayedName d boringParents $ aname acct
        buildSubrows i b = concatMap (mkRows False i b) $ asubs acct

    canOmitParents = flat_ ropts || not (no_elide_ ropts)
    allBoring a = aboring a && all allBoring (asubs a)
    balance = case accountlistmode_ ropts of
        ALTree -> bdincludingsubs
        ALFlat -> bdexcludingsubs

    displayedName d boringParents name
        | d == 0 && name == "root" = DisplayName "..." "..." 0
        | otherwise = case accountlistmode_ ropts of
            ALTree -> DisplayName name leaf $ max 0 d
            ALFlat -> DisplayName name droppedName 0
      where
        leaf = accountNameFromComponents
               . reverse . take (boringParents + 1) . reverse
               $ accountNameComponents droppedName
        droppedName = accountNameDrop (drop_ ropts) name


-- | Build a report row.
--
-- Calculate the column totals. These are always the sum of column amounts.
makeMultiBalanceReportRow :: ReportOpts -> (BalanceData -> MixedAmount)
                          -> a -> Account BalanceData -> PeriodicReportRow a MixedAmount
makeMultiBalanceReportRow = makePeriodicReportRow nullmixedamt sumAndAverageMixedAmounts

-- | Build a report row.
--
-- Calculate the column totals. These are always the sum of column amounts.
makePeriodicReportRow :: c -> (M.Map Day c -> (c, c))
                      -> ReportOpts -> (b -> c)
                      -> a -> Account b -> PeriodicReportRow a c
makePeriodicReportRow nullEntry totalAndAverage ropts balance name acct =
    PeriodicReportRow name (toList rowbals) rowtotal avg
  where
    rowbals = fmap balance . pdperiods $ adata acct
    (total, avg) = totalAndAverage rowbals
    -- Total for a cumulative/historical report is always the last column.
    rowtotal = case balanceaccum_ ropts of
        PerPeriod -> total
        _         -> maybe nullEntry snd $ M.lookupMax rowbals

-- | 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)

-- | 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.)"

-- | Calculate a cumulative sum from a list of period changes.
cumulativeSum :: Traversable t => t BalanceData -> t BalanceData
cumulativeSum = snd . mapAccumL (\prev new -> let z = prev <> new in (z, z)) mempty

-- | Extract period changes from a cumulative list.
periodChanges :: Traversable t => t BalanceData -> t BalanceData
periodChanges = snd . mapAccumL (\prev new -> (new, opBalanceData maMinus new prev)) mempty

-- tests

tests_MultiBalanceReport = testGroup "MultiBalanceReport" [

  let
    amt0 = Amount {acommodity="$", aquantity=0, acost=Nothing,
      astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asdigitgroups = Nothing,
      asdecimalmark = Just '.', asprecision = Precision 2, asrounding = NoRounding}}
    (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, displayIndent 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)
    ]
 ]