{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# 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,
  startingBalancesFromPostings,
  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.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 :: [Char] -> a -> a
dbg3 [Char]
s = let p :: [Char]
p = [Char]
"multiBalanceReport" in [Char] -> a -> a
forall a. Show a => [Char] -> a -> a
Hledger.Utils.dbg3 ([Char]
p[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
s)
dbg4 :: [Char] -> a -> a
dbg4 [Char]
s = let p :: [Char]
p = [Char]
"multiBalanceReport" in [Char] -> a -> a
forall a. Show a => [Char] -> a -> a
Hledger.Utils.dbg4 ([Char]
p[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
s)
dbg5 :: [Char] -> a -> a
dbg5 [Char]
s = let p :: [Char]
p = [Char]
"multiBalanceReport" in [Char] -> a -> a
forall a. Show a => [Char] -> a -> a
Hledger.Utils.dbg5 ([Char]
p[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
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 :: ReportSpec -> Journal -> MultiBalanceReport
multiBalanceReport ReportSpec
rspec Journal
j = ReportSpec -> Journal -> PriceOracle -> MultiBalanceReport
multiBalanceReportWith ReportSpec
rspec Journal
j (Bool -> Journal -> PriceOracle
journalPriceOracle Bool
infer Journal
j)
  where infer :: Bool
infer = ReportOpts -> Bool
infer_prices_ (ReportOpts -> Bool) -> ReportOpts -> Bool
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec

-- | A helper for multiBalanceReport. This one takes an extra argument,
-- a PriceOracle to be used for looking up market prices. 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 :: ReportSpec -> Journal -> PriceOracle -> MultiBalanceReport
multiBalanceReportWith ReportSpec
rspec' Journal
j PriceOracle
priceoracle = MultiBalanceReport
report
  where
    -- Queries, report/column dates.
    reportspan :: DateSpan
reportspan = [Char] -> DateSpan -> DateSpan
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"reportspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ Journal -> ReportSpec -> DateSpan
reportSpan Journal
j ReportSpec
rspec'
    rspec :: ReportSpec
rspec      = [Char] -> ReportSpec -> ReportSpec
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"reportopts" (ReportSpec -> ReportSpec) -> ReportSpec -> ReportSpec
forall a b. (a -> b) -> a -> b
$ ReportSpec -> DateSpan -> ReportSpec
makeReportQuery ReportSpec
rspec' DateSpan
reportspan

    -- Group postings into their columns.
    colps :: [(DateSpan, [Posting])]
colps = [Char] -> [(DateSpan, [Posting])] -> [(DateSpan, [Posting])]
forall a. Show a => [Char] -> a -> a
dbg5 [Char]
"colps" ([(DateSpan, [Posting])] -> [(DateSpan, [Posting])])
-> [(DateSpan, [Posting])] -> [(DateSpan, [Posting])]
forall a b. (a -> b) -> a -> b
$ ReportSpec
-> Journal -> PriceOracle -> DateSpan -> [(DateSpan, [Posting])]
getPostingsByColumn ReportSpec
rspec Journal
j PriceOracle
priceoracle DateSpan
reportspan

    -- 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 :: HashMap AccountName Account
startbals = [Char]
-> HashMap AccountName Account -> HashMap AccountName Account
forall a. Show a => [Char] -> a -> a
dbg5 [Char]
"startbals" (HashMap AccountName Account -> HashMap AccountName Account)
-> ([Posting] -> HashMap AccountName Account)
-> [Posting]
-> HashMap AccountName Account
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec
-> Journal
-> PriceOracle
-> [Posting]
-> HashMap AccountName Account
startingBalancesFromPostings ReportSpec
rspec Journal
j PriceOracle
priceoracle
                                 ([Posting] -> HashMap AccountName Account)
-> [Posting] -> HashMap AccountName Account
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> PriceOracle -> DateSpan -> [Posting]
startingPostings ReportSpec
rspec Journal
j PriceOracle
priceoracle DateSpan
reportspan

    -- Generate and postprocess the report, negating balances and taking percentages if needed
    report :: MultiBalanceReport
report = [Char] -> MultiBalanceReport -> MultiBalanceReport
forall a. Show a => [Char] -> a -> a
dbg4 [Char]
"multiBalanceReportWith" (MultiBalanceReport -> MultiBalanceReport)
-> MultiBalanceReport -> MultiBalanceReport
forall a b. (a -> b) -> a -> b
$
      ReportSpec
-> Journal
-> PriceOracle
-> [(DateSpan, [Posting])]
-> HashMap AccountName Account
-> MultiBalanceReport
generateMultiBalanceReport ReportSpec
rspec Journal
j PriceOracle
priceoracle [(DateSpan, [Posting])]
colps HashMap AccountName Account
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 :: ReportSpec
-> Journal
-> [CBCSubreportSpec a]
-> CompoundPeriodicReport a MixedAmount
compoundBalanceReport ReportSpec
rspec Journal
j = ReportSpec
-> Journal
-> PriceOracle
-> [CBCSubreportSpec a]
-> CompoundPeriodicReport a MixedAmount
forall a.
ReportSpec
-> Journal
-> PriceOracle
-> [CBCSubreportSpec a]
-> CompoundPeriodicReport a MixedAmount
compoundBalanceReportWith ReportSpec
rspec Journal
j (Bool -> Journal -> PriceOracle
journalPriceOracle Bool
infer Journal
j)
  where infer :: Bool
infer = ReportOpts -> Bool
infer_prices_ (ReportOpts -> Bool) -> ReportOpts -> Bool
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec

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

    -- Group postings into their columns.
    colps :: [(DateSpan, [Posting])]
colps = [Char] -> [(DateSpan, [Posting])] -> [(DateSpan, [Posting])]
forall a. Show a => [Char] -> a -> a
dbg5 [Char]
"colps" ([(DateSpan, [Posting])] -> [(DateSpan, [Posting])])
-> [(DateSpan, [Posting])] -> [(DateSpan, [Posting])]
forall a b. (a -> b) -> a -> b
$ ReportSpec
-> Journal -> PriceOracle -> DateSpan -> [(DateSpan, [Posting])]
getPostingsByColumn ReportSpec
rspec Journal
j PriceOracle
priceoracle DateSpan
reportspan

    -- 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 :: [Posting]
startps = [Char] -> [Posting] -> [Posting]
forall a. Show a => [Char] -> a -> a
dbg5 [Char]
"startps" ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> PriceOracle -> DateSpan -> [Posting]
startingPostings ReportSpec
rspec Journal
j PriceOracle
priceoracle DateSpan
reportspan

    subreports :: [(AccountName, PeriodicReport a MixedAmount, Bool)]
subreports = (CBCSubreportSpec a
 -> (AccountName, PeriodicReport a MixedAmount, Bool))
-> [CBCSubreportSpec a]
-> [(AccountName, PeriodicReport a MixedAmount, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map CBCSubreportSpec a
-> (AccountName, PeriodicReport a MixedAmount, Bool)
forall a.
CBCSubreportSpec a
-> (AccountName, PeriodicReport a MixedAmount, Bool)
generateSubreport [CBCSubreportSpec a]
subreportspecs
      where
        generateSubreport :: CBCSubreportSpec a
-> (AccountName, PeriodicReport a MixedAmount, Bool)
generateSubreport CBCSubreportSpec{Bool
AccountName
Journal -> Query
ReportOpts -> ReportOpts
MultiBalanceReport -> PeriodicReport a MixedAmount
cbcsubreportincreasestotal :: forall a. CBCSubreportSpec a -> Bool
cbcsubreporttransform :: forall a.
CBCSubreportSpec a
-> MultiBalanceReport -> PeriodicReport a MixedAmount
cbcsubreportoptions :: forall a. CBCSubreportSpec a -> ReportOpts -> ReportOpts
cbcsubreportquery :: forall a. CBCSubreportSpec a -> Journal -> Query
cbcsubreporttitle :: forall a. CBCSubreportSpec a -> AccountName
cbcsubreportincreasestotal :: Bool
cbcsubreporttransform :: MultiBalanceReport -> PeriodicReport a MixedAmount
cbcsubreportoptions :: ReportOpts -> ReportOpts
cbcsubreportquery :: Journal -> Query
cbcsubreporttitle :: AccountName
..} =
            ( AccountName
cbcsubreporttitle
            -- Postprocess the report, negating balances and taking percentages if needed
            , MultiBalanceReport -> PeriodicReport a MixedAmount
cbcsubreporttransform (MultiBalanceReport -> PeriodicReport a MixedAmount)
-> MultiBalanceReport -> PeriodicReport a MixedAmount
forall a b. (a -> b) -> a -> b
$
                ReportSpec
-> Journal
-> PriceOracle
-> [(DateSpan, [Posting])]
-> HashMap AccountName Account
-> MultiBalanceReport
generateMultiBalanceReport ReportSpec
rspec{_rsReportOpts :: ReportOpts
_rsReportOpts=ReportOpts
ropts} Journal
j PriceOracle
priceoracle [(DateSpan, [Posting])]
colps' HashMap AccountName Account
startbals'
            , Bool
cbcsubreportincreasestotal
            )
          where
            -- Filter the column postings according to each subreport
            colps' :: [(DateSpan, [Posting])]
colps'     = ((DateSpan, [Posting]) -> (DateSpan, [Posting]))
-> [(DateSpan, [Posting])] -> [(DateSpan, [Posting])]
forall a b. (a -> b) -> [a] -> [b]
map (([Posting] -> [Posting])
-> (DateSpan, [Posting]) -> (DateSpan, [Posting])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (([Posting] -> [Posting])
 -> (DateSpan, [Posting]) -> (DateSpan, [Posting]))
-> ([Posting] -> [Posting])
-> (DateSpan, [Posting])
-> (DateSpan, [Posting])
forall a b. (a -> b) -> a -> b
$ (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Posting -> Bool
matchesPosting Query
q)) [(DateSpan, [Posting])]
colps
            -- We need to filter historical postings directly, rather than their accumulated balances. (#1698)
            startbals' :: HashMap AccountName Account
startbals' = ReportSpec
-> Journal
-> PriceOracle
-> [Posting]
-> HashMap AccountName Account
startingBalancesFromPostings ReportSpec
rspec Journal
j PriceOracle
priceoracle ([Posting] -> HashMap AccountName Account)
-> [Posting] -> HashMap AccountName Account
forall a b. (a -> b) -> a -> b
$ (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Posting -> Bool
matchesPosting Query
q) [Posting]
startps
            ropts :: ReportOpts
ropts      = ReportOpts -> ReportOpts
cbcsubreportoptions (ReportOpts -> ReportOpts) -> ReportOpts -> ReportOpts
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec
            q :: Query
q          = Journal -> Query
cbcsubreportquery Journal
j

    -- 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 :: PeriodicReportRow () MixedAmount
overalltotals = case [(AccountName, PeriodicReport a MixedAmount, Bool)]
subreports of
        []     -> ()
-> [MixedAmount]
-> MixedAmount
-> MixedAmount
-> PeriodicReportRow () MixedAmount
forall a b. a -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow () [] MixedAmount
nullmixedamt MixedAmount
nullmixedamt
        ((AccountName, PeriodicReport a MixedAmount, Bool)
r:[(AccountName, PeriodicReport a MixedAmount, Bool)]
rs) -> NonEmpty (PeriodicReportRow () MixedAmount)
-> PeriodicReportRow () MixedAmount
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty (PeriodicReportRow () MixedAmount)
 -> PeriodicReportRow () MixedAmount)
-> NonEmpty (PeriodicReportRow () MixedAmount)
-> PeriodicReportRow () MixedAmount
forall a b. (a -> b) -> a -> b
$ ((AccountName, PeriodicReport a MixedAmount, Bool)
 -> PeriodicReportRow () MixedAmount)
-> NonEmpty (AccountName, PeriodicReport a MixedAmount, Bool)
-> NonEmpty (PeriodicReportRow () MixedAmount)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AccountName, PeriodicReport a MixedAmount, Bool)
-> PeriodicReportRow () MixedAmount
forall a a.
(a, PeriodicReport a MixedAmount, Bool)
-> PeriodicReportRow () MixedAmount
subreportTotal ((AccountName, PeriodicReport a MixedAmount, Bool)
r(AccountName, PeriodicReport a MixedAmount, Bool)
-> [(AccountName, PeriodicReport a MixedAmount, Bool)]
-> NonEmpty (AccountName, PeriodicReport a MixedAmount, Bool)
forall a. a -> [a] -> NonEmpty a
:|[(AccountName, PeriodicReport a MixedAmount, Bool)]
rs)
      where
        subreportTotal :: (a, PeriodicReport a MixedAmount, Bool)
-> PeriodicReportRow () MixedAmount
subreportTotal (a
_, PeriodicReport a MixedAmount
sr, Bool
increasestotal) =
            (if Bool
increasestotal then PeriodicReportRow () MixedAmount
-> PeriodicReportRow () MixedAmount
forall a. a -> a
id else (MixedAmount -> MixedAmount)
-> PeriodicReportRow () MixedAmount
-> PeriodicReportRow () MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MixedAmount -> MixedAmount
maNegate) (PeriodicReportRow () MixedAmount
 -> PeriodicReportRow () MixedAmount)
-> PeriodicReportRow () MixedAmount
-> PeriodicReportRow () MixedAmount
forall a b. (a -> b) -> a -> b
$ PeriodicReport a MixedAmount -> PeriodicReportRow () MixedAmount
forall a b. PeriodicReport a b -> PeriodicReportRow () b
prTotals PeriodicReport a MixedAmount
sr

    cbr :: CompoundPeriodicReport a MixedAmount
cbr = AccountName
-> [DateSpan]
-> [(AccountName, PeriodicReport a MixedAmount, Bool)]
-> PeriodicReportRow () MixedAmount
-> CompoundPeriodicReport a MixedAmount
forall a b.
AccountName
-> [DateSpan]
-> [(AccountName, PeriodicReport a b, Bool)]
-> PeriodicReportRow () b
-> CompoundPeriodicReport a b
CompoundPeriodicReport AccountName
"" (((DateSpan, [Posting]) -> DateSpan)
-> [(DateSpan, [Posting])] -> [DateSpan]
forall a b. (a -> b) -> [a] -> [b]
map (DateSpan, [Posting]) -> DateSpan
forall a b. (a, b) -> a
fst [(DateSpan, [Posting])]
colps) [(AccountName, PeriodicReport a MixedAmount, Bool)]
subreports PeriodicReportRow () MixedAmount
overalltotals

-- | Calculate starting balances from postings, if needed for -H.
startingBalancesFromPostings :: ReportSpec -> Journal -> PriceOracle -> [Posting]
                             -> HashMap AccountName Account
startingBalancesFromPostings :: ReportSpec
-> Journal
-> PriceOracle
-> [Posting]
-> HashMap AccountName Account
startingBalancesFromPostings ReportSpec
rspec Journal
j PriceOracle
priceoracle [Posting]
ps =
    Account -> DateSpan -> Map DateSpan Account -> Account
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Account
nullacct DateSpan
emptydatespan
      (Map DateSpan Account -> Account)
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName Account
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportSpec
-> Journal
-> PriceOracle
-> HashMap AccountName Account
-> [(DateSpan, [Posting])]
-> HashMap AccountName (Map DateSpan Account)
calculateReportMatrix ReportSpec
rspec Journal
j PriceOracle
priceoracle HashMap AccountName Account
forall a. Monoid a => a
mempty [(DateSpan
emptydatespan, [Posting]
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 :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> [Posting]
startingPostings rspec :: ReportSpec
rspec@ReportSpec{_rsQuery :: ReportSpec -> Query
_rsQuery=Query
query,_rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts} Journal
j PriceOracle
priceoracle DateSpan
reportspan =
    ReportSpec -> Journal -> PriceOracle -> [Posting]
getPostings ReportSpec
rspec' Journal
j PriceOracle
priceoracle
  where
    rspec' :: ReportSpec
rspec' = ReportSpec
rspec{_rsQuery :: Query
_rsQuery=Query
startbalq,_rsReportOpts :: ReportOpts
_rsReportOpts=ReportOpts
ropts'}
    -- If we're re-valuing every period, we need to have the unvalued start
    -- balance, so we can do it ourselves later.
    ropts' :: ReportOpts
ropts' = case ReportOpts -> Maybe ValuationType
value_ ReportOpts
ropts of
        Just (AtEnd Maybe AccountName
_) -> ReportOpts
ropts{period_ :: Period
period_=Period
precedingperiod, value_ :: Maybe ValuationType
value_=Maybe ValuationType
forall a. Maybe a
Nothing}
        Maybe ValuationType
_              -> ReportOpts
ropts{period_ :: Period
period_=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 :: Query
startbalq = [Char] -> Query -> Query
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"startbalq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [Query
datelessq, Query
precedingspanq]
    datelessq :: Query
datelessq = [Char] -> Query -> Query
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"datelessq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery (Bool -> Bool
not (Bool -> Bool) -> (Query -> Bool) -> Query -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Bool
queryIsDateOrDate2) Query
query

    precedingperiod :: Period
precedingperiod = DateSpan -> Period
dateSpanAsPeriod (DateSpan -> Period) -> (Period -> DateSpan) -> Period -> Period
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateSpan -> DateSpan -> DateSpan
spanIntersect DateSpan
precedingspan (DateSpan -> DateSpan)
-> (Period -> DateSpan) -> Period -> DateSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         Period -> DateSpan
periodAsDateSpan (Period -> Period) -> Period -> Period
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Period
period_ ReportOpts
ropts
    precedingspan :: DateSpan
precedingspan = Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing (Maybe Day -> DateSpan) -> Maybe Day -> DateSpan
forall a b. (a -> b) -> a -> b
$ DateSpan -> Maybe Day
spanStart DateSpan
reportspan
    precedingspanq :: Query
precedingspanq = (if ReportOpts -> Bool
date2_ ReportOpts
ropts then DateSpan -> Query
Date2 else DateSpan -> Query
Date) (DateSpan -> Query) -> DateSpan -> Query
forall a b. (a -> b) -> a -> b
$ case DateSpan
precedingspan of
        DateSpan Maybe Day
Nothing Maybe Day
Nothing -> DateSpan
emptydatespan
        DateSpan
a -> DateSpan
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 :: ReportSpec -> DateSpan -> ReportSpec
makeReportQuery ReportSpec
rspec DateSpan
reportspan
    | DateSpan
reportspan DateSpan -> DateSpan -> Bool
forall a. Eq a => a -> a -> Bool
== DateSpan
nulldatespan = ReportSpec
rspec
    | Bool
otherwise = ReportSpec
rspec{_rsQuery :: Query
_rsQuery=Query
query}
  where
    query :: Query
query            = Query -> Query
simplifyQuery (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [Query -> Query
dateless (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Query
_rsQuery ReportSpec
rspec, Query
reportspandatesq]
    reportspandatesq :: Query
reportspandatesq = [Char] -> Query -> Query
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"reportspandatesq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ DateSpan -> Query
dateqcons DateSpan
reportspan
    dateless :: Query -> Query
dateless         = [Char] -> Query -> Query
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"dateless" (Query -> Query) -> (Query -> Query) -> Query -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query -> Bool) -> Query -> Query
filterQuery (Bool -> Bool
not (Bool -> Bool) -> (Query -> Bool) -> Query -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Bool
queryIsDateOrDate2)
    dateqcons :: DateSpan -> Query
dateqcons        = if ReportOpts -> Bool
date2_ (ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec) then DateSpan -> Query
Date2 else DateSpan -> Query
Date

-- | Group postings, grouped by their column
getPostingsByColumn :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> [(DateSpan, [Posting])]
getPostingsByColumn :: ReportSpec
-> Journal -> PriceOracle -> DateSpan -> [(DateSpan, [Posting])]
getPostingsByColumn ReportSpec
rspec Journal
j PriceOracle
priceoracle DateSpan
reportspan =
    Bool
-> (Posting -> Day)
-> [DateSpan]
-> [Posting]
-> [(DateSpan, [Posting])]
forall a.
Bool -> (a -> Day) -> [DateSpan] -> [a] -> [(DateSpan, [a])]
groupByDateSpan Bool
True Posting -> Day
getDate [DateSpan]
colspans [Posting]
ps
  where
    -- Postings matching the query within the report period.
    ps :: [Posting]
ps = [Char] -> [Posting] -> [Posting]
forall a. Show a => [Char] -> a -> a
dbg5 [Char]
"getPostingsByColumn" ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> PriceOracle -> [Posting]
getPostings ReportSpec
rspec Journal
j PriceOracle
priceoracle
    -- The date spans to be included as report columns.
    colspans :: [DateSpan]
colspans = [Char] -> [DateSpan] -> [DateSpan]
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"colspans" ([DateSpan] -> [DateSpan]) -> [DateSpan] -> [DateSpan]
forall a b. (a -> b) -> a -> b
$ Interval -> DateSpan -> [DateSpan]
splitSpan (ReportOpts -> Interval
interval_ (ReportOpts -> Interval) -> ReportOpts -> Interval
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec) DateSpan
reportspan
    getDate :: Posting -> Day
getDate = case ReportOpts -> WhichDate
whichDateFromOpts (ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec) of
        WhichDate
PrimaryDate   -> Posting -> Day
postingDate
        WhichDate
SecondaryDate -> Posting -> Day
postingDate2

-- | Gather postings matching the query within the report period.
getPostings :: ReportSpec -> Journal -> PriceOracle -> [Posting]
getPostings :: ReportSpec -> Journal -> PriceOracle -> [Posting]
getPostings rspec :: ReportSpec
rspec@ReportSpec{_rsQuery :: ReportSpec -> Query
_rsQuery=Query
query,_rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts} Journal
j PriceOracle
priceoracle =
    Journal -> [Posting]
journalPostings (Journal -> [Posting])
-> (Journal -> Journal) -> Journal -> [Posting]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Journal -> Journal
valueJournal (Journal -> Journal) -> (Journal -> Journal) -> Journal -> Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Query -> Journal -> Journal
filterJournalAmounts Query
symq (Journal -> [Posting]) -> Journal -> [Posting]
forall a b. (a -> b) -> a -> b
$      -- remove amount parts excluded by cur:
    Query -> Journal -> Journal
filterJournalPostings Query
reportq Journal
j  -- remove postings not matched by (adjusted) query
  where
    symq :: Query
symq = [Char] -> Query -> Query
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"symq" (Query -> Query) -> (Query -> Query) -> Query -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsSym (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ [Char] -> Query -> Query
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"requested q" Query
query
    -- 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).
    reportq :: Query
reportq = [Char] -> Query -> Query
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"reportq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ Query -> Query
depthless Query
query
    depthless :: Query -> Query
depthless = [Char] -> Query -> Query
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"depthless" (Query -> Query) -> (Query -> Query) -> Query -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query -> Bool) -> Query -> Query
filterQuery (Bool -> Bool
not (Bool -> Bool) -> (Query -> Bool) -> Query -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Bool
queryIsDepth)
    valueJournal :: Journal -> Journal
valueJournal Journal
j' | Maybe (Maybe AccountName) -> Bool
forall a. Maybe a -> Bool
isJust (ReportOpts -> Maybe (Maybe AccountName)
valuationAfterSum ReportOpts
ropts) = Journal
j'
                    | Bool
otherwise = ReportSpec -> Journal -> PriceOracle -> Journal
journalApplyValuationFromOptsWith ReportSpec
rspec Journal
j' PriceOracle
priceoracle


-- | Given a set of postings, eg for a single report column, gather
-- the accounts that have postings and calculate the change amount for
-- each. Accounts and amounts will be depth-clipped appropriately if
-- a depth limit is in effect.
acctChangesFromPostings :: ReportSpec -> [Posting] -> HashMap ClippedAccountName Account
acctChangesFromPostings :: ReportSpec -> [Posting] -> HashMap AccountName Account
acctChangesFromPostings ReportSpec{_rsQuery :: ReportSpec -> Query
_rsQuery=Query
query,_rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts} [Posting]
ps =
    [(AccountName, Account)] -> HashMap AccountName Account
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(Account -> AccountName
aname Account
a, Account
a) | Account
a <- [Account]
as]
  where
    as :: [Account]
as = [Account] -> [Account]
filterAccounts ([Account] -> [Account])
-> ([Account] -> [Account]) -> [Account] -> [Account]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Account] -> [Account]
forall a. Int -> [a] -> [a]
drop Int
1 ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$ [Posting] -> [Account]
accountsFromPostings [Posting]
ps
    filterAccounts :: [Account] -> [Account]
filterAccounts = case ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts of
        AccountListMode
ALTree -> (Account -> Bool) -> [Account] -> [Account]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Query
depthq Query -> AccountName -> Bool
`matchesAccount`) (AccountName -> Bool)
-> (Account -> AccountName) -> Account -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Account -> AccountName
aname)      -- exclude deeper balances
        AccountListMode
ALFlat -> Maybe Int -> [Account] -> [Account]
clipAccountsAndAggregate (Query -> Maybe Int
queryDepth Query
depthq) ([Account] -> [Account])
-> ([Account] -> [Account]) -> [Account] -> [Account]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  -- aggregate deeper balances at the depth limit.
                      (Account -> Bool) -> [Account] -> [Account]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int
0Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<) (Int -> Bool) -> (Account -> Int) -> Account -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Account -> Int
anumpostings)
    depthq :: Query
depthq = [Char] -> Query -> Query
forall a. Show a => [Char] -> a -> a
dbg3 [Char]
"depthq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsDepth Query
query

-- | 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 :: ReportSpec
-> Journal
-> PriceOracle
-> HashMap AccountName Account
-> [(DateSpan, [Posting])]
-> HashMap AccountName (Map DateSpan Account)
calculateReportMatrix rspec :: ReportSpec
rspec@ReportSpec{_rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts} Journal
j PriceOracle
priceoracle HashMap AccountName Account
startbals [(DateSpan, [Posting])]
colps =  -- PARTIAL:
    -- Ensure all columns have entries, including those with starting balances
    (AccountName -> Map DateSpan Account -> Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey AccountName -> Map DateSpan Account -> Map DateSpan Account
rowbals HashMap AccountName (Map DateSpan Account)
allchanges
  where
    -- The valued row amounts to be displayed: per-period changes,
    -- zero-based cumulative totals, or
    -- starting-balance-based historical balances.
    rowbals :: AccountName -> Map DateSpan Account -> Map DateSpan Account
rowbals AccountName
name Map DateSpan Account
changes = [Char] -> Map DateSpan Account -> Map DateSpan Account
forall a. Show a => [Char] -> a -> a
dbg5 [Char]
"rowbals" (Map DateSpan Account -> Map DateSpan Account)
-> Map DateSpan Account -> Map DateSpan Account
forall a b. (a -> b) -> a -> b
$ case ReportOpts -> BalanceAccumulation
balanceaccum_ ReportOpts
ropts of
        BalanceAccumulation
PerPeriod  -> Map DateSpan Account
changeamts
        BalanceAccumulation
Cumulative -> Map DateSpan Account
cumulative
        BalanceAccumulation
Historical -> Map DateSpan Account
historical
      where
        -- changes to report on: usually just the changes itself, but use the
        -- differences in the historical amount for ValueChangeReports.
        changeamts :: Map DateSpan Account
changeamts = case ReportOpts -> BalanceCalculation
balancecalc_ ReportOpts
ropts of
            BalanceCalculation
CalcChange      -> (DateSpan -> Account -> Account)
-> Map DateSpan Account -> Map DateSpan Account
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey DateSpan -> Account -> Account
avalue Map DateSpan Account
changes
            BalanceCalculation
CalcBudget      -> (DateSpan -> Account -> Account)
-> Map DateSpan Account -> Map DateSpan Account
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey DateSpan -> Account -> Account
avalue Map DateSpan Account
changes
            BalanceCalculation
CalcValueChange -> Account -> Map DateSpan Account -> Map DateSpan Account
forall k. Account -> Map k Account -> Map k Account
periodChanges Account
valuedStart Map DateSpan Account
historical
            BalanceCalculation
CalcGain        -> Account -> Map DateSpan Account -> Map DateSpan Account
forall k. Account -> Map k Account -> Map k Account
periodChanges Account
valuedStart Map DateSpan Account
historical
        cumulative :: Map DateSpan Account
cumulative = (DateSpan -> Account -> Account)
-> Account -> Map DateSpan Account -> Map DateSpan Account
cumulativeSum DateSpan -> Account -> Account
avalue Account
nullacct Map DateSpan Account
changeamts
        historical :: Map DateSpan Account
historical = (DateSpan -> Account -> Account)
-> Account -> Map DateSpan Account -> Map DateSpan Account
cumulativeSum DateSpan -> Account -> Account
avalue Account
startingBalance Map DateSpan Account
changes
        startingBalance :: Account
startingBalance = Account -> AccountName -> HashMap AccountName Account -> Account
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HM.lookupDefault Account
nullacct AccountName
name HashMap AccountName Account
startbals
        valuedStart :: Account
valuedStart = DateSpan -> Account -> Account
avalue (Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing Maybe Day
historicalDate) Account
startingBalance

    -- Transpose to get each account's balance changes across all columns, then
    -- pad with zeros
    allchanges :: HashMap AccountName (Map DateSpan Account)
allchanges     = ((Map DateSpan Account
-> Map DateSpan Account -> Map DateSpan Account
forall a. Semigroup a => a -> a -> a
<>Map DateSpan Account
zeros) (Map DateSpan Account -> Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap AccountName (Map DateSpan Account)
acctchanges) HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
forall a. Semigroup a => a -> a -> a
<> (Map DateSpan Account
zeros Map DateSpan Account
-> HashMap AccountName Account
-> HashMap AccountName (Map DateSpan Account)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ HashMap AccountName Account
startbals)
    acctchanges :: HashMap AccountName (Map DateSpan Account)
acctchanges    = [Char]
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
forall a. Show a => [Char] -> a -> a
dbg5 [Char]
"acctchanges" (HashMap AccountName (Map DateSpan Account)
 -> HashMap AccountName (Map DateSpan Account))
-> (HashMap AccountName (Map DateSpan Account)
    -> HashMap AccountName (Map DateSpan Account))
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
addElided (HashMap AccountName (Map DateSpan Account)
 -> HashMap AccountName (Map DateSpan Account))
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
forall a b. (a -> b) -> a -> b
$ [(DateSpan, HashMap AccountName Account)]
-> HashMap AccountName (Map DateSpan Account)
forall a.
[(DateSpan, HashMap AccountName a)]
-> HashMap AccountName (Map DateSpan a)
transposeMap [(DateSpan, HashMap AccountName Account)]
colacctchanges
    colacctchanges :: [(DateSpan, HashMap AccountName Account)]
colacctchanges = [Char]
-> [(DateSpan, HashMap AccountName Account)]
-> [(DateSpan, HashMap AccountName Account)]
forall a. Show a => [Char] -> a -> a
dbg5 [Char]
"colacctchanges" ([(DateSpan, HashMap AccountName Account)]
 -> [(DateSpan, HashMap AccountName Account)])
-> [(DateSpan, HashMap AccountName Account)]
-> [(DateSpan, HashMap AccountName Account)]
forall a b. (a -> b) -> a -> b
$ ((DateSpan, [Posting]) -> (DateSpan, HashMap AccountName Account))
-> [(DateSpan, [Posting])]
-> [(DateSpan, HashMap AccountName Account)]
forall a b. (a -> b) -> [a] -> [b]
map (([Posting] -> HashMap AccountName Account)
-> (DateSpan, [Posting]) -> (DateSpan, HashMap AccountName Account)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (([Posting] -> HashMap AccountName Account)
 -> (DateSpan, [Posting])
 -> (DateSpan, HashMap AccountName Account))
-> ([Posting] -> HashMap AccountName Account)
-> (DateSpan, [Posting])
-> (DateSpan, HashMap AccountName Account)
forall a b. (a -> b) -> a -> b
$ ReportSpec -> [Posting] -> HashMap AccountName Account
acctChangesFromPostings ReportSpec
rspec) [(DateSpan, [Posting])]
colps

    avalue :: DateSpan -> Account -> Account
avalue = (MixedAmount -> MixedAmount) -> Account -> Account
acctApplyBoth ((MixedAmount -> MixedAmount) -> Account -> Account)
-> (DateSpan -> MixedAmount -> MixedAmount)
-> DateSpan
-> Account
-> Account
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts
-> Journal -> PriceOracle -> DateSpan -> MixedAmount -> MixedAmount
mixedAmountApplyValuationAfterSumFromOptsWith ReportOpts
ropts Journal
j PriceOracle
priceoracle
    acctApplyBoth :: (MixedAmount -> MixedAmount) -> Account -> Account
acctApplyBoth MixedAmount -> MixedAmount
f Account
a = Account
a{aibalance :: MixedAmount
aibalance = MixedAmount -> MixedAmount
f (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Account -> MixedAmount
aibalance Account
a, aebalance :: MixedAmount
aebalance = MixedAmount -> MixedAmount
f (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Account -> MixedAmount
aebalance Account
a}
    addElided :: HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
addElided = if Query -> Maybe Int
queryDepth (ReportSpec -> Query
_rsQuery ReportSpec
rspec) Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0 then AccountName
-> Map DateSpan Account
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert AccountName
"..." Map DateSpan Account
zeros else HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
forall a. a -> a
id
    historicalDate :: Maybe Day
historicalDate = [Day] -> Maybe Day
forall a. Ord a => [a] -> Maybe a
minimumMay ([Day] -> Maybe Day) -> [Day] -> Maybe Day
forall a b. (a -> b) -> a -> b
$ (DateSpan -> Maybe Day) -> [DateSpan] -> [Day]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DateSpan -> Maybe Day
spanStart [DateSpan]
colspans
    zeros :: Map DateSpan Account
zeros = [(DateSpan, Account)] -> Map DateSpan Account
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(DateSpan
span, Account
nullacct) | DateSpan
span <- [DateSpan]
colspans]
    colspans :: [DateSpan]
colspans = ((DateSpan, [Posting]) -> DateSpan)
-> [(DateSpan, [Posting])] -> [DateSpan]
forall a b. (a -> b) -> [a] -> [b]
map (DateSpan, [Posting]) -> DateSpan
forall a b. (a, b) -> a
fst [(DateSpan, [Posting])]
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
                           -> [(DateSpan, [Posting])] -> HashMap AccountName Account
                           -> MultiBalanceReport
generateMultiBalanceReport :: ReportSpec
-> Journal
-> PriceOracle
-> [(DateSpan, [Posting])]
-> HashMap AccountName Account
-> MultiBalanceReport
generateMultiBalanceReport rspec :: ReportSpec
rspec@ReportSpec{_rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts} Journal
j PriceOracle
priceoracle [(DateSpan, [Posting])]
colps HashMap AccountName Account
startbals =
    MultiBalanceReport
report
  where
    -- Process changes into normal, cumulative, or historical amounts, plus value them
    matrix :: HashMap AccountName (Map DateSpan Account)
matrix = ReportSpec
-> Journal
-> PriceOracle
-> HashMap AccountName Account
-> [(DateSpan, [Posting])]
-> HashMap AccountName (Map DateSpan Account)
calculateReportMatrix ReportSpec
rspec Journal
j PriceOracle
priceoracle HashMap AccountName Account
startbals [(DateSpan, [Posting])]
colps

    -- All account names that will be displayed, possibly depth-clipped.
    displaynames :: HashMap AccountName DisplayName
displaynames = [Char]
-> HashMap AccountName DisplayName
-> HashMap AccountName DisplayName
forall a. Show a => [Char] -> a -> a
dbg5 [Char]
"displaynames" (HashMap AccountName DisplayName
 -> HashMap AccountName DisplayName)
-> HashMap AccountName DisplayName
-> HashMap AccountName DisplayName
forall a b. (a -> b) -> a -> b
$ ReportSpec
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName DisplayName
displayedAccounts ReportSpec
rspec HashMap AccountName (Map DateSpan Account)
matrix

    -- All the rows of the report.
    rows :: [PeriodicReportRow DisplayName MixedAmount]
rows = [Char]
-> [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
forall a. Show a => [Char] -> a -> a
dbg5 [Char]
"rows" ([PeriodicReportRow DisplayName MixedAmount]
 -> [PeriodicReportRow DisplayName MixedAmount])
-> ([PeriodicReportRow DisplayName MixedAmount]
    -> [PeriodicReportRow DisplayName MixedAmount])
-> [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if ReportOpts -> Bool
invert_ ReportOpts
ropts then (PeriodicReportRow DisplayName MixedAmount
 -> PeriodicReportRow DisplayName MixedAmount)
-> [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map ((MixedAmount -> MixedAmount)
-> PeriodicReportRow DisplayName MixedAmount
-> PeriodicReportRow DisplayName MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MixedAmount -> MixedAmount
maNegate) else [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
forall a. a -> a
id)  -- Negate amounts if applicable
             ([PeriodicReportRow DisplayName MixedAmount]
 -> [PeriodicReportRow DisplayName MixedAmount])
-> [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
forall a b. (a -> b) -> a -> b
$ ReportOpts
-> HashMap AccountName DisplayName
-> HashMap AccountName (Map DateSpan Account)
-> [PeriodicReportRow DisplayName MixedAmount]
buildReportRows ReportOpts
ropts HashMap AccountName DisplayName
displaynames HashMap AccountName (Map DateSpan Account)
matrix

    -- Calculate column totals
    totalsrow :: PeriodicReportRow () MixedAmount
totalsrow = [Char]
-> PeriodicReportRow () MixedAmount
-> PeriodicReportRow () MixedAmount
forall a. Show a => [Char] -> a -> a
dbg5 [Char]
"totalsrow" (PeriodicReportRow () MixedAmount
 -> PeriodicReportRow () MixedAmount)
-> PeriodicReportRow () MixedAmount
-> PeriodicReportRow () MixedAmount
forall a b. (a -> b) -> a -> b
$ ReportOpts
-> [PeriodicReportRow DisplayName MixedAmount]
-> PeriodicReportRow () MixedAmount
calculateTotalsRow ReportOpts
ropts [PeriodicReportRow DisplayName MixedAmount]
rows

    -- Sorted report rows.
    sortedrows :: [PeriodicReportRow DisplayName MixedAmount]
sortedrows = [Char]
-> [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
forall a. Show a => [Char] -> a -> a
dbg5 [Char]
"sortedrows" ([PeriodicReportRow DisplayName MixedAmount]
 -> [PeriodicReportRow DisplayName MixedAmount])
-> [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
forall a b. (a -> b) -> a -> b
$ ReportOpts
-> Journal
-> [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
sortRows ReportOpts
ropts Journal
j [PeriodicReportRow DisplayName MixedAmount]
rows

    -- Take percentages if needed
    report :: MultiBalanceReport
report = ReportOpts -> MultiBalanceReport -> MultiBalanceReport
reportPercent ReportOpts
ropts (MultiBalanceReport -> MultiBalanceReport)
-> MultiBalanceReport -> MultiBalanceReport
forall a b. (a -> b) -> a -> b
$ [DateSpan]
-> [PeriodicReportRow DisplayName MixedAmount]
-> PeriodicReportRow () MixedAmount
-> MultiBalanceReport
forall a b.
[DateSpan]
-> [PeriodicReportRow a b]
-> PeriodicReportRow () b
-> PeriodicReport a b
PeriodicReport (((DateSpan, [Posting]) -> DateSpan)
-> [(DateSpan, [Posting])] -> [DateSpan]
forall a b. (a -> b) -> [a] -> [b]
map (DateSpan, [Posting]) -> DateSpan
forall a b. (a, b) -> a
fst [(DateSpan, [Posting])]
colps) [PeriodicReportRow DisplayName MixedAmount]
sortedrows PeriodicReportRow () MixedAmount
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 :: ReportOpts
-> HashMap AccountName DisplayName
-> HashMap AccountName (Map DateSpan Account)
-> [PeriodicReportRow DisplayName MixedAmount]
buildReportRows ReportOpts
ropts HashMap AccountName DisplayName
displaynames =
  HashMap AccountName (PeriodicReportRow DisplayName MixedAmount)
-> [PeriodicReportRow DisplayName MixedAmount]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (HashMap AccountName (PeriodicReportRow DisplayName MixedAmount)
 -> [PeriodicReportRow DisplayName MixedAmount])
-> (HashMap AccountName (Map DateSpan Account)
    -> HashMap AccountName (PeriodicReportRow DisplayName MixedAmount))
-> HashMap AccountName (Map DateSpan Account)
-> [PeriodicReportRow DisplayName MixedAmount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AccountName
 -> Map DateSpan Account
 -> Maybe (PeriodicReportRow DisplayName MixedAmount))
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (PeriodicReportRow DisplayName MixedAmount)
forall k v1 v2.
(k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybeWithKey AccountName
-> Map DateSpan Account
-> Maybe (PeriodicReportRow DisplayName MixedAmount)
forall (t :: * -> *).
Foldable t =>
AccountName
-> t Account -> Maybe (PeriodicReportRow DisplayName MixedAmount)
mkRow  -- toList of HashMap's Foldable instance - does not sort consistently
  where
    mkRow :: AccountName
-> t Account -> Maybe (PeriodicReportRow DisplayName MixedAmount)
mkRow AccountName
name t Account
accts = do
        DisplayName
displayname <- AccountName -> HashMap AccountName DisplayName -> Maybe DisplayName
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup AccountName
name HashMap AccountName DisplayName
displaynames
        PeriodicReportRow DisplayName MixedAmount
-> Maybe (PeriodicReportRow DisplayName MixedAmount)
forall (m :: * -> *) a. Monad m => a -> m a
return (PeriodicReportRow DisplayName MixedAmount
 -> Maybe (PeriodicReportRow DisplayName MixedAmount))
-> PeriodicReportRow DisplayName MixedAmount
-> Maybe (PeriodicReportRow DisplayName MixedAmount)
forall a b. (a -> b) -> a -> b
$ DisplayName
-> [MixedAmount]
-> MixedAmount
-> MixedAmount
-> PeriodicReportRow DisplayName MixedAmount
forall a b. a -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow DisplayName
displayname [MixedAmount]
rowbals MixedAmount
rowtot MixedAmount
rowavg
      where
        rowbals :: [MixedAmount]
rowbals = (Account -> MixedAmount) -> [Account] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map Account -> MixedAmount
balance ([Account] -> [MixedAmount]) -> [Account] -> [MixedAmount]
forall a b. (a -> b) -> a -> b
$ t Account -> [Account]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Account
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 :: MixedAmount
rowtot = case ReportOpts -> BalanceAccumulation
balanceaccum_ ReportOpts
ropts of
            BalanceAccumulation
PerPeriod -> [MixedAmount] -> MixedAmount
forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum [MixedAmount]
rowbals
            BalanceAccumulation
_         -> MixedAmount -> [MixedAmount] -> MixedAmount
forall a. a -> [a] -> a
lastDef MixedAmount
nullmixedamt [MixedAmount]
rowbals
        rowavg :: MixedAmount
rowavg = [MixedAmount] -> MixedAmount
averageMixedAmounts [MixedAmount]
rowbals
    balance :: Account -> MixedAmount
balance = case ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts of AccountListMode
ALTree -> Account -> MixedAmount
aibalance; AccountListMode
ALFlat -> Account -> MixedAmount
aebalance

-- | Calculate accounts which are to be displayed in the report, as well as
-- their name and depth
displayedAccounts :: ReportSpec -> HashMap AccountName (Map DateSpan Account)
                  -> HashMap AccountName DisplayName
displayedAccounts :: ReportSpec
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName DisplayName
displayedAccounts ReportSpec{_rsQuery :: ReportSpec -> Query
_rsQuery=Query
query,_rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts} HashMap AccountName (Map DateSpan Account)
valuedaccts
    | Int
depth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = AccountName -> DisplayName -> HashMap AccountName DisplayName
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton AccountName
"..." (DisplayName -> HashMap AccountName DisplayName)
-> DisplayName -> HashMap AccountName DisplayName
forall a b. (a -> b) -> a -> b
$ AccountName -> AccountName -> Int -> DisplayName
DisplayName AccountName
"..." AccountName
"..." Int
1
    | Bool
otherwise  = (AccountName -> Map DateSpan Account -> DisplayName)
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName DisplayName
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey (\AccountName
a Map DateSpan Account
_ -> AccountName -> DisplayName
displayedName AccountName
a) HashMap AccountName (Map DateSpan Account)
displayedAccts
  where
    -- Accounts which are to be displayed
    displayedAccts :: HashMap AccountName (Map DateSpan Account)
displayedAccts = (if Int
depth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
forall a. a -> a
id else (AccountName -> Map DateSpan Account -> Bool)
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HM.filterWithKey AccountName -> Map DateSpan Account -> Bool
forall (t :: * -> *).
Foldable t =>
AccountName -> t Account -> Bool
keep) HashMap AccountName (Map DateSpan Account)
valuedaccts
      where
        keep :: AccountName -> t Account -> Bool
keep AccountName
name t Account
amts = AccountName -> t Account -> Bool
forall (t :: * -> *).
Foldable t =>
AccountName -> t Account -> Bool
isInteresting AccountName
name t Account
amts Bool -> Bool -> Bool
|| AccountName
name AccountName -> HashMap AccountName Int -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HM.member` HashMap AccountName Int
interestingParents

    displayedName :: AccountName -> DisplayName
displayedName AccountName
name = case ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts of
        AccountListMode
ALTree -> AccountName -> AccountName -> Int -> DisplayName
DisplayName AccountName
name AccountName
leaf (Int -> DisplayName) -> (Int -> Int) -> Int -> DisplayName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> DisplayName) -> Int -> DisplayName
forall a b. (a -> b) -> a -> b
$ Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
boringParents
        AccountListMode
ALFlat -> AccountName -> AccountName -> Int -> DisplayName
DisplayName AccountName
name AccountName
droppedName Int
1
      where
        droppedName :: AccountName
droppedName = Int -> AccountName -> AccountName
accountNameDrop (ReportOpts -> Int
drop_ ReportOpts
ropts) AccountName
name
        leaf :: AccountName
leaf = [AccountName] -> AccountName
accountNameFromComponents ([AccountName] -> AccountName)
-> ([AccountName] -> [AccountName]) -> [AccountName] -> AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AccountName] -> [AccountName]
forall a. [a] -> [a]
reverse ([AccountName] -> [AccountName])
-> ([AccountName] -> [AccountName])
-> [AccountName]
-> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AccountName -> AccountName) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map AccountName -> AccountName
accountLeafName ([AccountName] -> AccountName) -> [AccountName] -> AccountName
forall a b. (a -> b) -> a -> b
$
            AccountName
droppedName AccountName -> [AccountName] -> [AccountName]
forall a. a -> [a] -> [a]
: (AccountName -> Bool) -> [AccountName] -> [AccountName]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile AccountName -> Bool
notDisplayed [AccountName]
parents

        level :: Int
level = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ AccountName -> Int
accountNameLevel AccountName
name Int -> Int -> Int
forall a. Num a => a -> a -> a
- ReportOpts -> Int
drop_ ReportOpts
ropts
        parents :: [AccountName]
parents = Int -> [AccountName] -> [AccountName]
forall a. Int -> [a] -> [a]
take (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ AccountName -> [AccountName]
parentAccountNames AccountName
name
        boringParents :: Int
boringParents = if ReportOpts -> Bool
no_elide_ ReportOpts
ropts then Int
0 else [AccountName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([AccountName] -> Int) -> [AccountName] -> Int
forall a b. (a -> b) -> a -> b
$ (AccountName -> Bool) -> [AccountName] -> [AccountName]
forall a. (a -> Bool) -> [a] -> [a]
filter AccountName -> Bool
notDisplayed [AccountName]
parents
        notDisplayed :: AccountName -> Bool
notDisplayed = Bool -> Bool
not (Bool -> Bool) -> (AccountName -> Bool) -> AccountName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AccountName -> HashMap AccountName (Map DateSpan Account) -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HM.member` HashMap AccountName (Map DateSpan Account)
displayedAccts)

    -- Accounts interesting for their own sake
    isInteresting :: AccountName -> t Account -> Bool
isInteresting AccountName
name t Account
amts =
        Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
depth                                 -- Throw out anything too deep
        Bool -> Bool -> Bool
&& ( (ReportOpts -> Bool
empty_ ReportOpts
ropts Bool -> Bool -> Bool
&& t Account -> Bool
keepWhenEmpty t Account
amts)  -- Keep empty accounts when called with --empty
           Bool -> Bool -> Bool
|| Bool -> Bool
not ((Account -> MixedAmount) -> t Account -> Bool
forall (t :: * -> *) a.
Foldable t =>
(a -> MixedAmount) -> t a -> Bool
isZeroRow Account -> MixedAmount
balance t Account
amts)         -- Keep everything with a non-zero balance in the row
           )
      where
        d :: Int
d = AccountName -> Int
accountNameLevel AccountName
name
        keepWhenEmpty :: t Account -> Bool
keepWhenEmpty = case ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts of
            AccountListMode
ALFlat -> Bool -> t Account -> Bool
forall a b. a -> b -> a
const Bool
True          -- Keep all empty accounts in flat mode
            AccountListMode
ALTree -> (Account -> Bool) -> t Account -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Account] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Account] -> Bool) -> (Account -> [Account]) -> Account -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Account -> [Account]
asubs)  -- Keep only empty leaves in tree mode
        balance :: Account -> MixedAmount
balance = MixedAmount -> MixedAmount
maybeStripPrices (MixedAmount -> MixedAmount)
-> (Account -> MixedAmount) -> Account -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts of
            AccountListMode
ALTree | Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
depth -> Account -> MixedAmount
aibalance
            AccountListMode
_                   -> Account -> MixedAmount
aebalance
          where maybeStripPrices :: MixedAmount -> MixedAmount
maybeStripPrices = if ReportOpts -> Bool
show_costs_ ReportOpts
ropts then MixedAmount -> MixedAmount
forall a. a -> a
id else MixedAmount -> MixedAmount
mixedAmountStripPrices

    -- Accounts interesting because they are a fork for interesting subaccounts
    interestingParents :: HashMap AccountName Int
interestingParents = [Char] -> HashMap AccountName Int -> HashMap AccountName Int
forall a. Show a => [Char] -> a -> a
dbg5 [Char]
"interestingParents" (HashMap AccountName Int -> HashMap AccountName Int)
-> HashMap AccountName Int -> HashMap AccountName Int
forall a b. (a -> b) -> a -> b
$ case ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts of
        AccountListMode
ALTree -> (AccountName -> Int -> Bool)
-> HashMap AccountName Int -> HashMap AccountName Int
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HM.filterWithKey AccountName -> Int -> Bool
hasEnoughSubs HashMap AccountName Int
numSubs
        AccountListMode
ALFlat -> HashMap AccountName Int
forall a. Monoid a => a
mempty
      where
        hasEnoughSubs :: AccountName -> Int -> Bool
hasEnoughSubs AccountName
name Int
nsubs = Int
nsubs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minSubs Bool -> Bool -> Bool
&& AccountName -> Int
accountNameLevel AccountName
name Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ReportOpts -> Int
drop_ ReportOpts
ropts
        minSubs :: Int
minSubs = if ReportOpts -> Bool
no_elide_ ReportOpts
ropts then Int
1 else Int
2

    isZeroRow :: (a -> MixedAmount) -> t a -> Bool
isZeroRow a -> MixedAmount
balance = (a -> Bool) -> t a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (MixedAmount -> Bool
mixedAmountLooksZero (MixedAmount -> Bool) -> (a -> MixedAmount) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MixedAmount
balance)
    depth :: Int
depth = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
forall a. Bounded a => a
maxBound (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$  Query -> Maybe Int
queryDepth Query
query
    numSubs :: HashMap AccountName Int
numSubs = [AccountName] -> HashMap AccountName Int
subaccountTallies ([AccountName] -> HashMap AccountName Int)
-> (HashMap AccountName (Map DateSpan Account) -> [AccountName])
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap AccountName (Map DateSpan Account) -> [AccountName]
forall k v. HashMap k v -> [k]
HM.keys (HashMap AccountName (Map DateSpan Account)
 -> HashMap AccountName Int)
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName Int
forall a b. (a -> b) -> a -> b
$ (AccountName -> Map DateSpan Account -> Bool)
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HM.filterWithKey AccountName -> Map DateSpan Account -> Bool
forall (t :: * -> *).
Foldable t =>
AccountName -> t Account -> Bool
isInteresting HashMap AccountName (Map DateSpan Account)
valuedaccts

-- | Sort the rows by amount or by account declaration order.
sortRows :: ReportOpts -> Journal -> [MultiBalanceReportRow] -> [MultiBalanceReportRow]
sortRows :: ReportOpts
-> Journal
-> [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
sortRows ReportOpts
ropts Journal
j
    | ReportOpts -> Bool
sort_amount_ ReportOpts
ropts, AccountListMode
ALTree <- ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts = [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
sortTreeMBRByAmount
    | ReportOpts -> Bool
sort_amount_ ReportOpts
ropts, AccountListMode
ALFlat <- ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts = [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
sortFlatMBRByAmount
    | Bool
otherwise                                            = [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
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 :: [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
sortTreeMBRByAmount [PeriodicReportRow DisplayName MixedAmount]
rows = (AccountName -> Maybe (PeriodicReportRow DisplayName MixedAmount))
-> [AccountName] -> [PeriodicReportRow DisplayName MixedAmount]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (AccountName
-> HashMap AccountName (PeriodicReportRow DisplayName MixedAmount)
-> Maybe (PeriodicReportRow DisplayName MixedAmount)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HM.lookup` HashMap AccountName (PeriodicReportRow DisplayName MixedAmount)
rowMap) [AccountName]
sortedanames
      where
        accounttree :: Account
accounttree = AccountName -> [AccountName] -> Account
accountTree AccountName
"root" ([AccountName] -> Account) -> [AccountName] -> Account
forall a b. (a -> b) -> a -> b
$ (PeriodicReportRow DisplayName MixedAmount -> AccountName)
-> [PeriodicReportRow DisplayName MixedAmount] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow DisplayName MixedAmount -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrFullName [PeriodicReportRow DisplayName MixedAmount]
rows
        rowMap :: HashMap AccountName (PeriodicReportRow DisplayName MixedAmount)
rowMap = [(AccountName, PeriodicReportRow DisplayName MixedAmount)]
-> HashMap AccountName (PeriodicReportRow DisplayName MixedAmount)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(AccountName, PeriodicReportRow DisplayName MixedAmount)]
 -> HashMap AccountName (PeriodicReportRow DisplayName MixedAmount))
-> [(AccountName, PeriodicReportRow DisplayName MixedAmount)]
-> HashMap AccountName (PeriodicReportRow DisplayName MixedAmount)
forall a b. (a -> b) -> a -> b
$ (PeriodicReportRow DisplayName MixedAmount
 -> (AccountName, PeriodicReportRow DisplayName MixedAmount))
-> [PeriodicReportRow DisplayName MixedAmount]
-> [(AccountName, PeriodicReportRow DisplayName MixedAmount)]
forall a b. (a -> b) -> [a] -> [b]
map (\PeriodicReportRow DisplayName MixedAmount
row -> (PeriodicReportRow DisplayName MixedAmount -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrFullName PeriodicReportRow DisplayName MixedAmount
row, PeriodicReportRow DisplayName MixedAmount
row)) [PeriodicReportRow DisplayName MixedAmount]
rows
        -- Set the inclusive balance of an account from the rows, or sum the
        -- subaccounts if it's not present
        accounttreewithbals :: Account
accounttreewithbals = (Account -> Account) -> Account -> Account
mapAccounts Account -> Account
setibalance Account
accounttree
        setibalance :: Account -> Account
setibalance Account
a = Account
a{aibalance :: MixedAmount
aibalance = MixedAmount
-> (PeriodicReportRow DisplayName MixedAmount -> MixedAmount)
-> Maybe (PeriodicReportRow DisplayName MixedAmount)
-> MixedAmount
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([MixedAmount] -> MixedAmount
forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum ([MixedAmount] -> MixedAmount)
-> ([Account] -> [MixedAmount]) -> [Account] -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Account -> MixedAmount) -> [Account] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map Account -> MixedAmount
aibalance ([Account] -> MixedAmount) -> [Account] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Account -> [Account]
asubs Account
a) PeriodicReportRow DisplayName MixedAmount -> MixedAmount
forall a b. PeriodicReportRow a b -> b
prrTotal (Maybe (PeriodicReportRow DisplayName MixedAmount) -> MixedAmount)
-> Maybe (PeriodicReportRow DisplayName MixedAmount) -> MixedAmount
forall a b. (a -> b) -> a -> b
$
                                          AccountName
-> HashMap AccountName (PeriodicReportRow DisplayName MixedAmount)
-> Maybe (PeriodicReportRow DisplayName MixedAmount)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Account -> AccountName
aname Account
a) HashMap AccountName (PeriodicReportRow DisplayName MixedAmount)
rowMap}
        sortedaccounttree :: Account
sortedaccounttree = NormalSign -> Account -> Account
sortAccountTreeByAmount (NormalSign -> Maybe NormalSign -> NormalSign
forall a. a -> Maybe a -> a
fromMaybe NormalSign
NormallyPositive (Maybe NormalSign -> NormalSign) -> Maybe NormalSign -> NormalSign
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Maybe NormalSign
normalbalance_ ReportOpts
ropts) Account
accounttreewithbals
        sortedanames :: [AccountName]
sortedanames = (Account -> AccountName) -> [Account] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map Account -> AccountName
aname ([Account] -> [AccountName]) -> [Account] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ Int -> [Account] -> [Account]
forall a. Int -> [a] -> [a]
drop Int
1 ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$ Account -> [Account]
flattenAccounts Account
sortedaccounttree

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

    -- Sort the report rows by account declaration order then account name.
    sortMBRByAccountDeclaration :: [MultiBalanceReportRow] -> [MultiBalanceReportRow]
    sortMBRByAccountDeclaration :: [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
sortMBRByAccountDeclaration [PeriodicReportRow DisplayName MixedAmount]
rows = [AccountName]
-> [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
forall b.
[AccountName]
-> [PeriodicReportRow DisplayName b]
-> [PeriodicReportRow DisplayName b]
sortRowsLike [AccountName]
sortedanames [PeriodicReportRow DisplayName MixedAmount]
rows
      where
        sortedanames :: [AccountName]
sortedanames = Journal -> Bool -> [AccountName] -> [AccountName]
sortAccountNamesByDeclaration Journal
j (ReportOpts -> Bool
tree_ ReportOpts
ropts) ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ (PeriodicReportRow DisplayName MixedAmount -> AccountName)
-> [PeriodicReportRow DisplayName MixedAmount] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow DisplayName MixedAmount -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrFullName [PeriodicReportRow DisplayName MixedAmount]
rows

-- | Build the report totals row.
--
-- Calculate the column totals. These are always the sum of column amounts.
calculateTotalsRow :: ReportOpts -> [MultiBalanceReportRow] -> PeriodicReportRow () MixedAmount
calculateTotalsRow :: ReportOpts
-> [PeriodicReportRow DisplayName MixedAmount]
-> PeriodicReportRow () MixedAmount
calculateTotalsRow ReportOpts
ropts [PeriodicReportRow DisplayName MixedAmount]
rows =
    ()
-> [MixedAmount]
-> MixedAmount
-> MixedAmount
-> PeriodicReportRow () MixedAmount
forall a b. a -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow () [MixedAmount]
coltotals MixedAmount
grandtotal MixedAmount
grandaverage
  where
    isTopRow :: PeriodicReportRow DisplayName a -> Bool
isTopRow PeriodicReportRow DisplayName a
row = ReportOpts -> Bool
flat_ ReportOpts
ropts Bool -> Bool -> Bool
|| Bool -> Bool
not ((AccountName -> Bool) -> [AccountName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (AccountName
-> HashMap AccountName (PeriodicReportRow DisplayName MixedAmount)
-> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HM.member` HashMap AccountName (PeriodicReportRow DisplayName MixedAmount)
rowMap) [AccountName]
parents)
      where parents :: [AccountName]
parents = [AccountName] -> [AccountName]
forall a. [a] -> [a]
init ([AccountName] -> [AccountName])
-> (AccountName -> [AccountName]) -> AccountName -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> [AccountName]
expandAccountName (AccountName -> [AccountName]) -> AccountName -> [AccountName]
forall a b. (a -> b) -> a -> b
$ PeriodicReportRow DisplayName a -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrFullName PeriodicReportRow DisplayName a
row
    rowMap :: HashMap AccountName (PeriodicReportRow DisplayName MixedAmount)
rowMap = [(AccountName, PeriodicReportRow DisplayName MixedAmount)]
-> HashMap AccountName (PeriodicReportRow DisplayName MixedAmount)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(AccountName, PeriodicReportRow DisplayName MixedAmount)]
 -> HashMap AccountName (PeriodicReportRow DisplayName MixedAmount))
-> [(AccountName, PeriodicReportRow DisplayName MixedAmount)]
-> HashMap AccountName (PeriodicReportRow DisplayName MixedAmount)
forall a b. (a -> b) -> a -> b
$ (PeriodicReportRow DisplayName MixedAmount
 -> (AccountName, PeriodicReportRow DisplayName MixedAmount))
-> [PeriodicReportRow DisplayName MixedAmount]
-> [(AccountName, PeriodicReportRow DisplayName MixedAmount)]
forall a b. (a -> b) -> [a] -> [b]
map (\PeriodicReportRow DisplayName MixedAmount
row -> (PeriodicReportRow DisplayName MixedAmount -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrFullName PeriodicReportRow DisplayName MixedAmount
row, PeriodicReportRow DisplayName MixedAmount
row)) [PeriodicReportRow DisplayName MixedAmount]
rows

    colamts :: [[MixedAmount]]
colamts = [[MixedAmount]] -> [[MixedAmount]]
forall a. [[a]] -> [[a]]
transpose ([[MixedAmount]] -> [[MixedAmount]])
-> ([PeriodicReportRow DisplayName MixedAmount] -> [[MixedAmount]])
-> [PeriodicReportRow DisplayName MixedAmount]
-> [[MixedAmount]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeriodicReportRow DisplayName MixedAmount -> [MixedAmount])
-> [PeriodicReportRow DisplayName MixedAmount] -> [[MixedAmount]]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow DisplayName MixedAmount -> [MixedAmount]
forall a b. PeriodicReportRow a b -> [b]
prrAmounts ([PeriodicReportRow DisplayName MixedAmount] -> [[MixedAmount]])
-> [PeriodicReportRow DisplayName MixedAmount] -> [[MixedAmount]]
forall a b. (a -> b) -> a -> b
$ (PeriodicReportRow DisplayName MixedAmount -> Bool)
-> [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
forall a. (a -> Bool) -> [a] -> [a]
filter PeriodicReportRow DisplayName MixedAmount -> Bool
forall a. PeriodicReportRow DisplayName a -> Bool
isTopRow [PeriodicReportRow DisplayName MixedAmount]
rows

    [MixedAmount]
coltotals :: [MixedAmount] = [Char] -> [MixedAmount] -> [MixedAmount]
forall a. Show a => [Char] -> a -> a
dbg5 [Char]
"coltotals" ([MixedAmount] -> [MixedAmount]) -> [MixedAmount] -> [MixedAmount]
forall a b. (a -> b) -> a -> b
$ ([MixedAmount] -> MixedAmount) -> [[MixedAmount]] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map [MixedAmount] -> MixedAmount
forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum [[MixedAmount]]
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 :: MixedAmount
grandtotal = case ReportOpts -> BalanceAccumulation
balanceaccum_ ReportOpts
ropts of
        BalanceAccumulation
PerPeriod -> [MixedAmount] -> MixedAmount
forall (t :: * -> *). Foldable t => t MixedAmount -> MixedAmount
maSum [MixedAmount]
coltotals
        BalanceAccumulation
_         -> MixedAmount -> [MixedAmount] -> MixedAmount
forall a. a -> [a] -> a
lastDef MixedAmount
nullmixedamt [MixedAmount]
coltotals
    grandaverage :: MixedAmount
grandaverage = [MixedAmount] -> MixedAmount
averageMixedAmounts [MixedAmount]
coltotals

-- | Map the report rows to percentages if needed
reportPercent :: ReportOpts -> MultiBalanceReport -> MultiBalanceReport
reportPercent :: ReportOpts -> MultiBalanceReport -> MultiBalanceReport
reportPercent ReportOpts
ropts report :: MultiBalanceReport
report@(PeriodicReport [DateSpan]
spans [PeriodicReportRow DisplayName MixedAmount]
rows PeriodicReportRow () MixedAmount
totalrow)
  | ReportOpts -> Bool
percent_ ReportOpts
ropts = [DateSpan]
-> [PeriodicReportRow DisplayName MixedAmount]
-> PeriodicReportRow () MixedAmount
-> MultiBalanceReport
forall a b.
[DateSpan]
-> [PeriodicReportRow a b]
-> PeriodicReportRow () b
-> PeriodicReport a b
PeriodicReport [DateSpan]
spans ((PeriodicReportRow DisplayName MixedAmount
 -> PeriodicReportRow DisplayName MixedAmount)
-> [PeriodicReportRow DisplayName MixedAmount]
-> [PeriodicReportRow DisplayName MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow DisplayName MixedAmount
-> PeriodicReportRow DisplayName MixedAmount
forall a.
PeriodicReportRow a MixedAmount -> PeriodicReportRow a MixedAmount
percentRow [PeriodicReportRow DisplayName MixedAmount]
rows) (PeriodicReportRow () MixedAmount
-> PeriodicReportRow () MixedAmount
forall a.
PeriodicReportRow a MixedAmount -> PeriodicReportRow a MixedAmount
percentRow PeriodicReportRow () MixedAmount
totalrow)
  | Bool
otherwise      = MultiBalanceReport
report
  where
    percentRow :: PeriodicReportRow a MixedAmount -> PeriodicReportRow a MixedAmount
percentRow (PeriodicReportRow a
name [MixedAmount]
rowvals MixedAmount
rowtotal MixedAmount
rowavg) =
      a
-> [MixedAmount]
-> MixedAmount
-> MixedAmount
-> PeriodicReportRow a MixedAmount
forall a b. a -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow a
name
        ((MixedAmount -> MixedAmount -> MixedAmount)
-> [MixedAmount] -> [MixedAmount] -> [MixedAmount]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith MixedAmount -> MixedAmount -> MixedAmount
perdivide [MixedAmount]
rowvals ([MixedAmount] -> [MixedAmount]) -> [MixedAmount] -> [MixedAmount]
forall a b. (a -> b) -> a -> b
$ PeriodicReportRow () MixedAmount -> [MixedAmount]
forall a b. PeriodicReportRow a b -> [b]
prrAmounts PeriodicReportRow () MixedAmount
totalrow)
        (MixedAmount -> MixedAmount -> MixedAmount
perdivide MixedAmount
rowtotal (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ PeriodicReportRow () MixedAmount -> MixedAmount
forall a b. PeriodicReportRow a b -> b
prrTotal PeriodicReportRow () MixedAmount
totalrow)
        (MixedAmount -> MixedAmount -> MixedAmount
perdivide MixedAmount
rowavg (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ PeriodicReportRow () MixedAmount -> MixedAmount
forall a b. PeriodicReportRow a b -> b
prrAverage PeriodicReportRow () MixedAmount
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 :: [(DateSpan, HashMap AccountName a)]
-> HashMap AccountName (Map DateSpan a)
transposeMap = ((DateSpan, HashMap AccountName a)
 -> HashMap AccountName (Map DateSpan a)
 -> HashMap AccountName (Map DateSpan a))
-> HashMap AccountName (Map DateSpan a)
-> [(DateSpan, HashMap AccountName a)]
-> HashMap AccountName (Map DateSpan a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((DateSpan
 -> HashMap AccountName a
 -> HashMap AccountName (Map DateSpan a)
 -> HashMap AccountName (Map DateSpan a))
-> (DateSpan, HashMap AccountName a)
-> HashMap AccountName (Map DateSpan a)
-> HashMap AccountName (Map DateSpan a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry DateSpan
-> HashMap AccountName a
-> HashMap AccountName (Map DateSpan a)
-> HashMap AccountName (Map DateSpan a)
forall k k a.
(Hashable k, Ord k, Eq k) =>
k -> HashMap k a -> HashMap k (Map k a) -> HashMap k (Map k a)
addSpan) HashMap AccountName (Map DateSpan a)
forall a. Monoid a => a
mempty
  where
    addSpan :: k -> HashMap k a -> HashMap k (Map k a) -> HashMap k (Map k a)
addSpan k
span HashMap k a
acctmap HashMap k (Map k a)
seen = (k -> a -> HashMap k (Map k a) -> HashMap k (Map k a))
-> HashMap k (Map k a) -> HashMap k a -> HashMap k (Map k a)
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HM.foldrWithKey (k -> k -> a -> HashMap k (Map k a) -> HashMap k (Map k a)
forall k k a.
(Eq k, Hashable k, Ord k) =>
k -> k -> a -> HashMap k (Map k a) -> HashMap k (Map k a)
addAcctSpan k
span) HashMap k (Map k a)
seen HashMap k a
acctmap

    addAcctSpan :: k -> k -> a -> HashMap k (Map k a) -> HashMap k (Map k a)
addAcctSpan k
span k
acct a
a = (Maybe (Map k a) -> Maybe (Map k a))
-> k -> HashMap k (Map k a) -> HashMap k (Map k a)
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HM.alter Maybe (Map k a) -> Maybe (Map k a)
f k
acct
      where f :: Maybe (Map k a) -> Maybe (Map k a)
f = Map k a -> Maybe (Map k a)
forall a. a -> Maybe a
Just (Map k a -> Maybe (Map k a))
-> (Maybe (Map k a) -> Map k a)
-> Maybe (Map k a)
-> Maybe (Map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
span a
a (Map k a -> Map k a)
-> (Maybe (Map k a) -> Map k a) -> Maybe (Map k a) -> Map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> Maybe (Map k a) -> Map k a
forall a. a -> Maybe a -> a
fromMaybe Map k a
forall a. Monoid a => a
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 :: [AccountName]
-> [PeriodicReportRow DisplayName b]
-> [PeriodicReportRow DisplayName b]
sortRowsLike [AccountName]
sortedas [PeriodicReportRow DisplayName b]
rows = (AccountName -> Maybe (PeriodicReportRow DisplayName b))
-> [AccountName] -> [PeriodicReportRow DisplayName b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (AccountName
-> HashMap AccountName (PeriodicReportRow DisplayName b)
-> Maybe (PeriodicReportRow DisplayName b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HM.lookup` HashMap AccountName (PeriodicReportRow DisplayName b)
rowMap) [AccountName]
sortedas
  where rowMap :: HashMap AccountName (PeriodicReportRow DisplayName b)
rowMap = [(AccountName, PeriodicReportRow DisplayName b)]
-> HashMap AccountName (PeriodicReportRow DisplayName b)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(AccountName, PeriodicReportRow DisplayName b)]
 -> HashMap AccountName (PeriodicReportRow DisplayName b))
-> [(AccountName, PeriodicReportRow DisplayName b)]
-> HashMap AccountName (PeriodicReportRow DisplayName b)
forall a b. (a -> b) -> a -> b
$ (PeriodicReportRow DisplayName b
 -> (AccountName, PeriodicReportRow DisplayName b))
-> [PeriodicReportRow DisplayName b]
-> [(AccountName, PeriodicReportRow DisplayName b)]
forall a b. (a -> b) -> [a] -> [b]
map (\PeriodicReportRow DisplayName b
row -> (PeriodicReportRow DisplayName b -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrFullName PeriodicReportRow DisplayName b
row, PeriodicReportRow DisplayName b
row)) [PeriodicReportRow DisplayName b]
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 :: [AccountName] -> HashMap AccountName Int
subaccountTallies = (AccountName -> HashMap AccountName Int -> HashMap AccountName Int)
-> HashMap AccountName Int
-> [AccountName]
-> HashMap AccountName Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AccountName -> HashMap AccountName Int -> HashMap AccountName Int
forall v.
Num v =>
AccountName -> HashMap AccountName v -> HashMap AccountName v
incrementParent HashMap AccountName Int
forall a. Monoid a => a
mempty ([AccountName] -> HashMap AccountName Int)
-> ([AccountName] -> [AccountName])
-> [AccountName]
-> HashMap AccountName Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AccountName] -> [AccountName]
expandAccountNames
  where incrementParent :: AccountName -> HashMap AccountName v -> HashMap AccountName v
incrementParent AccountName
a = (v -> v -> v)
-> AccountName
-> v
-> HashMap AccountName v
-> HashMap AccountName v
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith v -> v -> v
forall a. Num a => a -> a -> a
(+) (AccountName -> AccountName
parentAccountName AccountName
a) v
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 :: MixedAmount -> MixedAmount -> MixedAmount
perdivide MixedAmount
a MixedAmount
b = MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> MixedAmount
forall a. [Char] -> a
error' [Char]
errmsg) (Maybe MixedAmount -> MixedAmount)
-> Maybe MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ do  -- PARTIAL:
    Amount
a' <- MixedAmount -> Maybe Amount
unifyMixedAmount MixedAmount
a
    Amount
b' <- MixedAmount -> Maybe Amount
unifyMixedAmount MixedAmount
b
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Amount -> Bool
amountIsZero Amount
a' Bool -> Bool -> Bool
|| Amount -> Bool
amountIsZero Amount
b' Bool -> Bool -> Bool
|| Amount -> AccountName
acommodity Amount
a' AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> AccountName
acommodity Amount
b'
    MixedAmount -> Maybe MixedAmount
forall (m :: * -> *) a. Monad m => a -> m a
return (MixedAmount -> Maybe MixedAmount)
-> MixedAmount -> Maybe MixedAmount
forall a b. (a -> b) -> a -> b
$ [Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [Quantity -> Amount
per (Quantity -> Amount) -> Quantity -> Amount
forall a b. (a -> b) -> a -> b
$ if Amount -> Quantity
aquantity Amount
b' Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
== Quantity
0 then Quantity
0 else Amount -> Quantity
aquantity Amount
a' Quantity -> Quantity -> Quantity
forall a. Fractional a => a -> a -> a
/ Quantity -> Quantity
forall a. Num a => a -> a
abs (Amount -> Quantity
aquantity Amount
b') Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
* Quantity
100]
  where errmsg :: [Char]
errmsg = [Char]
"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 -> Account -> Account
sumAcct Account{aibalance :: Account -> MixedAmount
aibalance=MixedAmount
i1,aebalance :: Account -> MixedAmount
aebalance=MixedAmount
e1} a :: Account
a@Account{aibalance :: Account -> MixedAmount
aibalance=MixedAmount
i2,aebalance :: Account -> MixedAmount
aebalance=MixedAmount
e2} =
    Account
a{aibalance :: MixedAmount
aibalance = MixedAmount
i1 MixedAmount -> MixedAmount -> MixedAmount
`maPlus` MixedAmount
i2, aebalance :: MixedAmount
aebalance = MixedAmount
e1 MixedAmount -> MixedAmount -> MixedAmount
`maPlus` MixedAmount
e2}

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

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

-- | Calculate a cumulative sum from a list of period changes and a valuation
-- function.
cumulativeSum :: (DateSpan -> Account -> Account) -> Account -> Map DateSpan Account -> Map DateSpan Account
cumulativeSum :: (DateSpan -> Account -> Account)
-> Account -> Map DateSpan Account -> Map DateSpan Account
cumulativeSum DateSpan -> Account -> Account
value Account
start = (Account, Map DateSpan Account) -> Map DateSpan Account
forall a b. (a, b) -> b
snd ((Account, Map DateSpan Account) -> Map DateSpan Account)
-> (Map DateSpan Account -> (Account, Map DateSpan Account))
-> Map DateSpan Account
-> Map DateSpan Account
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Account -> DateSpan -> Account -> (Account, Account))
-> Account
-> Map DateSpan Account
-> (Account, Map DateSpan Account)
forall a k b c.
(a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
M.mapAccumWithKey Account -> DateSpan -> Account -> (Account, Account)
accumValued Account
start
  where accumValued :: Account -> DateSpan -> Account -> (Account, Account)
accumValued Account
startAmt DateSpan
date Account
newAmt = let s :: Account
s = Account -> Account -> Account
sumAcct Account
startAmt Account
newAmt in (Account
s, DateSpan -> Account -> Account
value DateSpan
date Account
s)

-- | 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 -> Table AccountName AccountName WideBuilder -> Builder
balanceReportTableAsText ReportOpts{Bool
Int
[AccountName]
[Status]
Maybe Int
Maybe AccountName
Maybe NormalSign
Maybe ValuationType
Interval
Period
StringFormat
Costing
AccountListMode
BalanceAccumulation
BalanceCalculation
commodity_column_ :: ReportOpts -> Bool
transpose_ :: ReportOpts -> Bool
color_ :: ReportOpts -> Bool
no_total_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
budgetpat_ :: ReportOpts -> Maybe AccountName
txn_dates_ :: ReportOpts -> Bool
related_ :: ReportOpts -> Bool
average_ :: ReportOpts -> Bool
querystring_ :: ReportOpts -> [AccountName]
pretty_ :: ReportOpts -> Bool
format_ :: ReportOpts -> StringFormat
real_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> Maybe Int
cost_ :: ReportOpts -> Costing
statuses_ :: ReportOpts -> [Status]
commodity_column_ :: Bool
transpose_ :: Bool
color_ :: Bool
normalbalance_ :: Maybe NormalSign
invert_ :: Bool
percent_ :: Bool
sort_amount_ :: Bool
show_costs_ :: Bool
no_total_ :: Bool
row_total_ :: Bool
drop_ :: Int
accountlistmode_ :: AccountListMode
budgetpat_ :: Maybe AccountName
balanceaccum_ :: BalanceAccumulation
balancecalc_ :: BalanceCalculation
txn_dates_ :: Bool
related_ :: Bool
average_ :: Bool
querystring_ :: [AccountName]
pretty_ :: Bool
format_ :: StringFormat
real_ :: Bool
no_elide_ :: Bool
empty_ :: Bool
date2_ :: Bool
depth_ :: Maybe Int
infer_prices_ :: Bool
value_ :: Maybe ValuationType
cost_ :: Costing
statuses_ :: [Status]
interval_ :: Interval
period_ :: Period
percent_ :: ReportOpts -> Bool
normalbalance_ :: ReportOpts -> Maybe NormalSign
sort_amount_ :: ReportOpts -> Bool
show_costs_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
drop_ :: ReportOpts -> Int
invert_ :: ReportOpts -> Bool
balancecalc_ :: ReportOpts -> BalanceCalculation
balanceaccum_ :: ReportOpts -> BalanceAccumulation
accountlistmode_ :: ReportOpts -> AccountListMode
interval_ :: ReportOpts -> Interval
date2_ :: ReportOpts -> Bool
period_ :: ReportOpts -> Period
value_ :: ReportOpts -> Maybe ValuationType
infer_prices_ :: ReportOpts -> Bool
..} =
    TableOpts
-> ([AccountName] -> [Cell])
-> ((AccountName, [WideBuilder]) -> (Cell, [Cell]))
-> Table AccountName AccountName WideBuilder
-> Builder
forall ch rh a.
TableOpts
-> ([ch] -> [Cell])
-> ((rh, [a]) -> (Cell, [Cell]))
-> Table rh ch a
-> Builder
Tab.renderTableByRowsB TableOpts
forall a. Default a => a
def{tableBorders :: Bool
Tab.tableBorders=Bool
False, prettyTable :: Bool
Tab.prettyTable=Bool
pretty_} [AccountName] -> [Cell]
renderCh (AccountName, [WideBuilder]) -> (Cell, [Cell])
renderRow
  where
    renderCh :: [AccountName] -> [Cell]
renderCh
      | Bool -> Bool
not Bool
commodity_column_ Bool -> Bool -> Bool
|| Bool
transpose_ = (AccountName -> Cell) -> [AccountName] -> [Cell]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Align -> AccountName -> Cell
Tab.textCell Align
Tab.TopRight)
      | Bool
otherwise = ((AccountName -> Cell) -> AccountName -> Cell)
-> [AccountName -> Cell] -> [AccountName] -> [Cell]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (AccountName -> Cell) -> AccountName -> Cell
forall a b. (a -> b) -> a -> b
($) (Align -> AccountName -> Cell
Tab.textCell Align
Tab.TopLeft (AccountName -> Cell)
-> [AccountName -> Cell] -> [AccountName -> Cell]
forall a. a -> [a] -> [a]
: (AccountName -> Cell) -> [AccountName -> Cell]
forall a. a -> [a]
repeat (Align -> AccountName -> Cell
Tab.textCell Align
Tab.TopRight))

    renderRow :: (AccountName, [WideBuilder]) -> (Cell, [Cell])
renderRow (AccountName
rh, [WideBuilder]
row)
      | Bool -> Bool
not Bool
commodity_column_ Bool -> Bool -> Bool
|| Bool
transpose_ =
          (Align -> AccountName -> Cell
Tab.textCell Align
Tab.TopLeft AccountName
rh, (WideBuilder -> Cell) -> [WideBuilder] -> [Cell]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Align -> [WideBuilder] -> Cell
Tab.Cell Align
Tab.TopRight ([WideBuilder] -> Cell)
-> (WideBuilder -> [WideBuilder]) -> WideBuilder -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WideBuilder -> [WideBuilder]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) [WideBuilder]
row)
      | Bool
otherwise =
          (Align -> AccountName -> Cell
Tab.textCell Align
Tab.TopLeft AccountName
rh, (([WideBuilder] -> Cell) -> [WideBuilder] -> Cell)
-> [[WideBuilder] -> Cell] -> [[WideBuilder]] -> [Cell]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([WideBuilder] -> Cell) -> [WideBuilder] -> Cell
forall a b. (a -> b) -> a -> b
($) (Align -> [WideBuilder] -> Cell
Tab.Cell Align
Tab.TopLeft ([WideBuilder] -> Cell)
-> [[WideBuilder] -> Cell] -> [[WideBuilder] -> Cell]
forall a. a -> [a] -> [a]
: ([WideBuilder] -> Cell) -> [[WideBuilder] -> Cell]
forall a. a -> [a]
repeat (Align -> [WideBuilder] -> Cell
Tab.Cell Align
Tab.TopRight)) ((WideBuilder -> [WideBuilder]) -> [WideBuilder] -> [[WideBuilder]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WideBuilder -> [WideBuilder]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [WideBuilder]
row))


-- tests

tests_MultiBalanceReport :: TestTree
tests_MultiBalanceReport = [Char] -> [TestTree] -> TestTree
testGroup [Char]
"MultiBalanceReport" [

  let
    amt0 :: Amount
amt0 = Amount :: AccountName
-> Quantity -> AmountStyle -> Maybe AmountPrice -> Amount
Amount {acommodity :: AccountName
acommodity=AccountName
"$", aquantity :: Quantity
aquantity=Quantity
0, aprice :: Maybe AmountPrice
aprice=Maybe AmountPrice
forall a. Maybe a
Nothing, astyle :: AmountStyle
astyle=AmountStyle :: Side
-> Bool
-> AmountPrecision
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle {ascommodityside :: Side
ascommodityside = Side
L, ascommodityspaced :: Bool
ascommodityspaced = Bool
False, asprecision :: AmountPrecision
asprecision = Word8 -> AmountPrecision
Precision Word8
2, asdecimalpoint :: Maybe Char
asdecimalpoint = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.', asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups = Maybe DigitGroupStyle
forall a. Maybe a
Nothing}}
    (ReportSpec
rspec,Journal
journal) gives :: (ReportSpec, Journal)
-> ([PeriodicReportRow DisplayName MixedAmount], MixedAmount)
-> IO ()
`gives` ([PeriodicReportRow DisplayName MixedAmount], MixedAmount)
r = do
      let rspec' :: ReportSpec
rspec' = ReportSpec
rspec{_rsQuery :: Query
_rsQuery=[Query] -> Query
And [ReportOpts -> Query
queryFromFlags (ReportOpts -> Query) -> ReportOpts -> Query
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec, ReportSpec -> Query
_rsQuery ReportSpec
rspec]}
          ([PeriodicReportRow DisplayName MixedAmount]
eitems, MixedAmount
etotal) = ([PeriodicReportRow DisplayName MixedAmount], MixedAmount)
r
          (PeriodicReport [DateSpan]
_ [PeriodicReportRow DisplayName MixedAmount]
aitems PeriodicReportRow () MixedAmount
atotal) = ReportSpec -> Journal -> MultiBalanceReport
multiBalanceReport ReportSpec
rspec' Journal
journal
          showw :: PeriodicReportRow DisplayName MixedAmount
-> (AccountName, AccountName, Int, [[Char]], [Char], [Char])
showw (PeriodicReportRow DisplayName
a [MixedAmount]
lAmt MixedAmount
amt MixedAmount
amt')
              = (DisplayName -> AccountName
displayFull DisplayName
a, DisplayName -> AccountName
displayName DisplayName
a, DisplayName -> Int
displayDepth DisplayName
a, (MixedAmount -> [Char]) -> [MixedAmount] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map MixedAmount -> [Char]
showMixedAmountDebug [MixedAmount]
lAmt, MixedAmount -> [Char]
showMixedAmountDebug MixedAmount
amt, MixedAmount -> [Char]
showMixedAmountDebug MixedAmount
amt')
      ((PeriodicReportRow DisplayName MixedAmount
 -> (AccountName, AccountName, Int, [[Char]], [Char], [Char]))
-> [PeriodicReportRow DisplayName MixedAmount]
-> [(AccountName, AccountName, Int, [[Char]], [Char], [Char])]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow DisplayName MixedAmount
-> (AccountName, AccountName, Int, [[Char]], [Char], [Char])
showw [PeriodicReportRow DisplayName MixedAmount]
aitems) [(AccountName, AccountName, Int, [[Char]], [Char], [Char])]
-> [(AccountName, AccountName, Int, [[Char]], [Char], [Char])]
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= ((PeriodicReportRow DisplayName MixedAmount
 -> (AccountName, AccountName, Int, [[Char]], [Char], [Char]))
-> [PeriodicReportRow DisplayName MixedAmount]
-> [(AccountName, AccountName, Int, [[Char]], [Char], [Char])]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow DisplayName MixedAmount
-> (AccountName, AccountName, Int, [[Char]], [Char], [Char])
showw [PeriodicReportRow DisplayName MixedAmount]
eitems)
      MixedAmount -> [Char]
showMixedAmountDebug (PeriodicReportRow () MixedAmount -> MixedAmount
forall a b. PeriodicReportRow a b -> b
prrTotal PeriodicReportRow () MixedAmount
atotal) [Char] -> [Char] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= MixedAmount -> [Char]
showMixedAmountDebug MixedAmount
etotal -- we only check the sum of the totals
  in
   [Char] -> [TestTree] -> TestTree
testGroup [Char]
"multiBalanceReport" [
      [Char] -> IO () -> TestTree
testCase [Char]
"null journal"  (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      (ReportSpec
defreportspec, Journal
nulljournal) (ReportSpec, Journal)
-> ([PeriodicReportRow DisplayName MixedAmount], MixedAmount)
-> IO ()
`gives` ([], MixedAmount
nullmixedamt)

     ,[Char] -> IO () -> TestTree
testCase [Char]
"with -H on a populated period"  (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      (ReportSpec
defreportspec{_rsReportOpts :: ReportOpts
_rsReportOpts=ReportOpts
defreportopts{period_ :: Period
period_= Day -> Day -> Period
PeriodBetween (Integer -> Int -> Int -> Day
fromGregorian Integer
2008 Int
1 Int
1) (Integer -> Int -> Int -> Day
fromGregorian Integer
2008 Int
1 Int
2), balanceaccum_ :: BalanceAccumulation
balanceaccum_=BalanceAccumulation
Historical}}, Journal
samplejournal) (ReportSpec, Journal)
-> ([PeriodicReportRow DisplayName MixedAmount], MixedAmount)
-> IO ()
`gives`
       (
        [ DisplayName
-> [MixedAmount]
-> MixedAmount
-> MixedAmount
-> PeriodicReportRow DisplayName MixedAmount
forall a b. a -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow (AccountName -> DisplayName
flatDisplayName AccountName
"assets:bank:checking") [Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd Quantity
1]    (Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd Quantity
1)    (Amount -> MixedAmount
mixedAmount Amount
amt0{aquantity :: Quantity
aquantity=Quantity
1})
        , DisplayName
-> [MixedAmount]
-> MixedAmount
-> MixedAmount
-> PeriodicReportRow DisplayName MixedAmount
forall a b. a -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow (AccountName -> DisplayName
flatDisplayName AccountName
"income:salary")        [Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd (-Quantity
1)] (Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd (-Quantity
1)) (Amount -> MixedAmount
mixedAmount Amount
amt0{aquantity :: Quantity
aquantity=(-Quantity
1)})
        ],
        Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd Quantity
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)
    ]
 ]