{-# LANGUAGE CPP                 #-}
{-# 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,
  compoundBalanceReport,
  compoundBalanceReportWith,

  tableAsText,

  sortRows,
  sortRowsLike,

  -- -- * Tests
  tests_MultiBalanceReport
)
where

import Control.Monad (guard)
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, mapMaybe)
import Data.Ord (Down(..))
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
import Data.Semigroup (sconcat)
import Data.Time.Calendar (Day, addDays, fromGregorian)
import Safe (headMay, lastDef, lastMay)
import Text.Tabular as T
import Text.Tabular.AsciiWide (render)

import Hledger.Data
import Hledger.Query
import Hledger.Utils
import Hledger.Read (mamountp')
import Hledger.Reports.ReportOptions
import Hledger.Reports.ReportTypes


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

type MultiBalanceReport    = PeriodicReport    DisplayName MixedAmount
type MultiBalanceReportRow = PeriodicReportRow DisplayName MixedAmount
type CompoundBalanceReport = CompoundPeriodicReport 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 :: Day -> ReportOpts -> Journal -> MultiBalanceReport
multiBalanceReport :: Day -> ReportOpts -> Journal -> MultiBalanceReport
multiBalanceReport today :: Day
today ropts :: ReportOpts
ropts j :: Journal
j =
    ReportOpts -> Query -> Journal -> PriceOracle -> MultiBalanceReport
multiBalanceReportWith ReportOpts
ropts Query
q Journal
j (Bool -> Journal -> PriceOracle
journalPriceOracle Bool
infer Journal
j)
  where
    q :: Query
q = Day -> ReportOpts -> Query
queryFromOpts Day
today ReportOpts
ropts
    infer :: Bool
infer = ReportOpts -> Bool
infer_value_ ReportOpts
ropts

-- | A helper for multiBalanceReport. This one takes an explicit Query
-- instead of deriving one from ReportOpts, and 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 :: ReportOpts -> Query -> Journal -> PriceOracle -> MultiBalanceReport
multiBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle -> MultiBalanceReport
multiBalanceReportWith ropts :: ReportOpts
ropts q :: Query
q j :: Journal
j priceoracle :: PriceOracle
priceoracle = MultiBalanceReport
report
  where
    -- Queries, report/column dates.
    reportspan :: DateSpan
reportspan = [Char] -> DateSpan -> DateSpan
forall a. Show a => [Char] -> a -> a
dbg "reportspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Query -> Journal -> DateSpan
calculateReportSpan ReportOpts
ropts Query
q Journal
j
    reportq :: Query
reportq    = [Char] -> Query -> Query
forall a. Show a => [Char] -> a -> a
dbg "reportq"    (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ ReportOpts -> DateSpan -> Query -> Query
makeReportQuery ReportOpts
ropts DateSpan
reportspan Query
q

    -- Group postings into their columns.
    colps :: Map DateSpan [Posting]
colps    = [Char] -> Map DateSpan [Posting] -> Map DateSpan [Posting]
forall a. Show a => [Char] -> a -> a
dbg'' "colps"  (Map DateSpan [Posting] -> Map DateSpan [Posting])
-> Map DateSpan [Posting] -> Map DateSpan [Posting]
forall a b. (a -> b) -> a -> b
$ ReportOpts
-> Query -> Journal -> DateSpan -> Map DateSpan [Posting]
getPostingsByColumn ReportOpts
ropts Query
reportq Journal
j DateSpan
reportspan
    colspans :: [DateSpan]
colspans = [Char] -> [DateSpan] -> [DateSpan]
forall a. Show a => [Char] -> a -> a
dbg "colspans" ([DateSpan] -> [DateSpan]) -> [DateSpan] -> [DateSpan]
forall a b. (a -> b) -> a -> b
$ Map DateSpan [Posting] -> [DateSpan]
forall k a. Map k a -> [k]
M.keys Map DateSpan [Posting]
colps

    -- 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
dbg' "startbals" (HashMap AccountName Account -> HashMap AccountName Account)
-> HashMap AccountName Account -> HashMap AccountName Account
forall a b. (a -> b) -> a -> b
$ ReportOpts
-> Query -> Journal -> DateSpan -> HashMap AccountName Account
startingBalances ReportOpts
ropts Query
reportq Journal
j 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
dbg' "report" (MultiBalanceReport -> MultiBalanceReport)
-> MultiBalanceReport -> MultiBalanceReport
forall a b. (a -> b) -> a -> b
$
      ReportOpts
-> Query
-> Journal
-> PriceOracle
-> [DateSpan]
-> Map DateSpan [Posting]
-> HashMap AccountName Account
-> MultiBalanceReport
generateMultiBalanceReport ReportOpts
ropts Query
reportq Journal
j PriceOracle
priceoracle [DateSpan]
colspans Map DateSpan [Posting]
colps HashMap AccountName Account
startbals

-- | Generate a compound balance report from a list of CBCSubreportSpec. This
-- shares postings between the subreports.
compoundBalanceReport :: Day -> ReportOpts -> Journal -> [CBCSubreportSpec]
                      -> CompoundBalanceReport
compoundBalanceReport :: Day
-> ReportOpts
-> Journal
-> [CBCSubreportSpec]
-> CompoundBalanceReport
compoundBalanceReport today :: Day
today ropts :: ReportOpts
ropts j :: Journal
j =
    ReportOpts
-> Query
-> Journal
-> PriceOracle
-> [CBCSubreportSpec]
-> CompoundBalanceReport
compoundBalanceReportWith ReportOpts
ropts Query
q Journal
j (Bool -> Journal -> PriceOracle
journalPriceOracle Bool
infer Journal
j)
  where
    q :: Query
q = Day -> ReportOpts -> Query
queryFromOpts Day
today ReportOpts
ropts
    infer :: Bool
infer = ReportOpts -> Bool
infer_value_ ReportOpts
ropts

-- | A helper for compoundBalanceReport, similar to multiBalanceReportWith.
compoundBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle
                          -> [CBCSubreportSpec] -> CompoundBalanceReport
compoundBalanceReportWith :: ReportOpts
-> Query
-> Journal
-> PriceOracle
-> [CBCSubreportSpec]
-> CompoundBalanceReport
compoundBalanceReportWith ropts :: ReportOpts
ropts q :: Query
q j :: Journal
j priceoracle :: PriceOracle
priceoracle subreportspecs :: [CBCSubreportSpec]
subreportspecs = CompoundBalanceReport
cbr
  where
    -- Queries, report/column dates.
    reportspan :: DateSpan
reportspan = [Char] -> DateSpan -> DateSpan
forall a. Show a => [Char] -> a -> a
dbg "reportspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Query -> Journal -> DateSpan
calculateReportSpan ReportOpts
ropts Query
q Journal
j
    reportq :: Query
reportq    = [Char] -> Query -> Query
forall a. Show a => [Char] -> a -> a
dbg "reportq"    (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ ReportOpts -> DateSpan -> Query -> Query
makeReportQuery ReportOpts
ropts DateSpan
reportspan Query
q

    -- Group postings into their columns.
    colps :: Map DateSpan [Posting]
colps    = [Char] -> Map DateSpan [Posting] -> Map DateSpan [Posting]
forall a. Show a => [Char] -> a -> a
dbg'' "colps"  (Map DateSpan [Posting] -> Map DateSpan [Posting])
-> Map DateSpan [Posting] -> Map DateSpan [Posting]
forall a b. (a -> b) -> a -> b
$ ReportOpts
-> Query -> Journal -> DateSpan -> Map DateSpan [Posting]
getPostingsByColumn ReportOpts
ropts{empty_ :: Bool
empty_=Bool
True} Query
reportq Journal
j DateSpan
reportspan
    colspans :: [DateSpan]
colspans = [Char] -> [DateSpan] -> [DateSpan]
forall a. Show a => [Char] -> a -> a
dbg "colspans" ([DateSpan] -> [DateSpan]) -> [DateSpan] -> [DateSpan]
forall a b. (a -> b) -> a -> b
$ Map DateSpan [Posting] -> [DateSpan]
forall k a. Map k a -> [k]
M.keys Map DateSpan [Posting]
colps

    -- 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
dbg' "startbals" (HashMap AccountName Account -> HashMap AccountName Account)
-> HashMap AccountName Account -> HashMap AccountName Account
forall a b. (a -> b) -> a -> b
$ ReportOpts
-> Query -> Journal -> DateSpan -> HashMap AccountName Account
startingBalances ReportOpts
ropts Query
reportq Journal
j DateSpan
reportspan

    subreports :: [([Char], MultiBalanceReport, Bool)]
subreports = (CBCSubreportSpec -> ([Char], MultiBalanceReport, Bool))
-> [CBCSubreportSpec] -> [([Char], MultiBalanceReport, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map CBCSubreportSpec -> ([Char], MultiBalanceReport, Bool)
generateSubreport [CBCSubreportSpec]
subreportspecs
      where
        generateSubreport :: CBCSubreportSpec -> ([Char], MultiBalanceReport, Bool)
generateSubreport CBCSubreportSpec{..} =
            ( [Char]
cbcsubreporttitle
            -- Postprocess the report, negating balances and taking percentages if needed
            , NormalSign -> MultiBalanceReport -> MultiBalanceReport
forall b a.
Num b =>
NormalSign -> PeriodicReport a b -> PeriodicReport a b
prNormaliseSign NormalSign
cbcsubreportnormalsign (MultiBalanceReport -> MultiBalanceReport)
-> MultiBalanceReport -> MultiBalanceReport
forall a b. (a -> b) -> a -> b
$
                ReportOpts
-> Query
-> Journal
-> PriceOracle
-> [DateSpan]
-> Map DateSpan [Posting]
-> HashMap AccountName Account
-> MultiBalanceReport
generateMultiBalanceReport ReportOpts
ropts' Query
reportq Journal
j PriceOracle
priceoracle [DateSpan]
colspans Map DateSpan [Posting]
colps' HashMap AccountName Account
startbals'
            , Bool
cbcsubreportincreasestotal
            )
          where
            ropts' :: ReportOpts
ropts'     = ReportOpts
ropts{normalbalance_ :: Maybe NormalSign
normalbalance_=NormalSign -> Maybe NormalSign
forall a. a -> Maybe a
Just NormalSign
cbcsubreportnormalsign}
            -- Filter the column postings according to each subreport
            colps' :: Map DateSpan [Posting]
colps'     = (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Posting -> Bool
matchesPosting (Query -> Posting -> Bool) -> Query -> Posting -> Bool
forall a b. (a -> b) -> a -> b
$ Journal -> Query
cbcsubreportquery Journal
j) ([Posting] -> [Posting])
-> Map DateSpan [Posting] -> Map DateSpan [Posting]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map DateSpan [Posting]
colps
            startbals' :: HashMap AccountName Account
startbals' = (AccountName -> Account -> Bool)
-> HashMap AccountName Account -> HashMap AccountName Account
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HM.filterWithKey (\k :: AccountName
k _ -> Query -> AccountName -> Bool
matchesAccount (Journal -> Query
cbcsubreportquery Journal
j) AccountName
k) HashMap AccountName Account
startbals

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

    cbr :: CompoundBalanceReport
cbr = [Char]
-> [DateSpan]
-> [([Char], MultiBalanceReport, Bool)]
-> PeriodicReportRow () MixedAmount
-> CompoundBalanceReport
forall a b.
[Char]
-> [DateSpan]
-> [([Char], PeriodicReport a b, Bool)]
-> PeriodicReportRow () b
-> CompoundPeriodicReport a b
CompoundPeriodicReport "" [DateSpan]
colspans [([Char], MultiBalanceReport, Bool)]
subreports PeriodicReportRow () MixedAmount
overalltotals


-- | Calculate starting balances, if needed for -H
--
-- 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.
startingBalances :: ReportOpts -> Query -> Journal -> DateSpan -> HashMap AccountName Account
startingBalances :: ReportOpts
-> Query -> Journal -> DateSpan -> HashMap AccountName Account
startingBalances ropts :: ReportOpts
ropts q :: Query
q j :: Journal
j reportspan :: DateSpan
reportspan = HashMap AccountName Account
acctchanges
  where
    acctchanges :: HashMap AccountName Account
acctchanges = ReportOpts -> Query -> [Posting] -> HashMap AccountName Account
acctChangesFromPostings ReportOpts
ropts' Query
startbalq ([Posting] -> HashMap AccountName Account)
-> ([(Posting, Day)] -> [Posting])
-> [(Posting, Day)]
-> HashMap AccountName Account
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Posting, Day) -> Posting) -> [(Posting, Day)] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map (Posting, Day) -> Posting
forall a b. (a, b) -> a
fst ([(Posting, Day)] -> HashMap AccountName Account)
-> [(Posting, Day)] -> HashMap AccountName Account
forall a b. (a -> b) -> a -> b
$
        ReportOpts -> Query -> Journal -> [(Posting, Day)]
getPostings ReportOpts
ropts' Query
startbalq Journal
j

    -- 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
dbg'' "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
dbg "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
q

    ropts' :: ReportOpts
ropts' = case ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts of
        ALTree -> ReportOpts
ropts{no_elide_ :: Bool
no_elide_=Bool
True, period_ :: Period
period_=Period
precedingperiod}
        ALFlat -> ReportOpts
ropts{period_ :: Period
period_=Period
precedingperiod}

    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 Nothing Nothing -> DateSpan
emptydatespan
        a :: DateSpan
a -> DateSpan
a

-- | Calculate the span of the report to be generated.
calculateReportSpan :: ReportOpts -> Query -> Journal -> DateSpan
calculateReportSpan :: ReportOpts -> Query -> Journal -> DateSpan
calculateReportSpan ropts :: ReportOpts
ropts q :: Query
q j :: Journal
j = DateSpan
reportspan
  where
    -- The date span specified by -b/-e/-p options and query args if any.
    requestedspan :: DateSpan
requestedspan  = [Char] -> DateSpan -> DateSpan
forall a. Show a => [Char] -> a -> a
dbg "requestedspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ Bool -> Query -> DateSpan
queryDateSpan (ReportOpts -> Bool
date2_ ReportOpts
ropts) Query
q
    -- If the requested span is open-ended, close it using the journal's end dates.
    -- This can still be the null (open) span if the journal is empty.
    requestedspan' :: DateSpan
requestedspan' = [Char] -> DateSpan -> DateSpan
forall a. Show a => [Char] -> a -> a
dbg "requestedspan'" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$
        DateSpan
requestedspan DateSpan -> DateSpan -> DateSpan
`spanDefaultsFrom` Bool -> Journal -> DateSpan
journalDateSpan (ReportOpts -> Bool
date2_ ReportOpts
ropts) Journal
j
    -- The list of interval spans enclosing the requested span.
    -- This list can be empty if the journal was empty,
    -- or if hledger-ui has added its special date:-tomorrow to the query
    -- and all txns are in the future.
    intervalspans :: [DateSpan]
intervalspans  = [Char] -> [DateSpan] -> [DateSpan]
forall a. Show a => [Char] -> a -> a
dbg "intervalspans" ([DateSpan] -> [DateSpan]) -> [DateSpan] -> [DateSpan]
forall a b. (a -> b) -> a -> b
$ Interval -> DateSpan -> [DateSpan]
splitSpan (ReportOpts -> Interval
interval_ ReportOpts
ropts) DateSpan
requestedspan'
    -- The requested span enlarged to enclose a whole number of intervals.
    -- This can be the null span if there were no intervals.
    reportspan :: DateSpan
reportspan = Maybe Day -> Maybe Day -> DateSpan
DateSpan (DateSpan -> Maybe Day
spanStart (DateSpan -> Maybe Day) -> Maybe DateSpan -> Maybe Day
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [DateSpan] -> Maybe DateSpan
forall a. [a] -> Maybe a
headMay [DateSpan]
intervalspans)
                          (DateSpan -> Maybe Day
spanEnd (DateSpan -> Maybe Day) -> Maybe DateSpan -> Maybe Day
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [DateSpan] -> Maybe DateSpan
forall a. [a] -> Maybe a
lastMay [DateSpan]
intervalspans)

-- | 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 :: ReportOpts -> DateSpan -> Query -> Query
makeReportQuery :: ReportOpts -> DateSpan -> Query -> Query
makeReportQuery ropts :: ReportOpts
ropts reportspan :: DateSpan
reportspan q :: Query
q
    | DateSpan
reportspan DateSpan -> DateSpan -> Bool
forall a. Eq a => a -> a -> Bool
== DateSpan
nulldatespan = Query
q
    | Bool
otherwise = [Query] -> Query
And [Query -> Query
dateless Query
q, Query
reportspandatesq]
  where
    reportspandatesq :: Query
reportspandatesq = [Char] -> Query -> Query
forall a. Show a => [Char] -> a -> a
dbg "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
dbg "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_ ReportOpts
ropts then DateSpan -> Query
Date2 else DateSpan -> Query
Date

-- | Group postings, grouped by their column
getPostingsByColumn :: ReportOpts -> Query -> Journal -> DateSpan -> Map DateSpan [Posting]
getPostingsByColumn :: ReportOpts
-> Query -> Journal -> DateSpan -> Map DateSpan [Posting]
getPostingsByColumn ropts :: ReportOpts
ropts q :: Query
q j :: Journal
j reportspan :: DateSpan
reportspan = Map DateSpan [Posting]
columns
  where
    -- Postings matching the query within the report period.
    [(Posting, Day)]
ps :: [(Posting, Day)] = [Char] -> [(Posting, Day)] -> [(Posting, Day)]
forall a. Show a => [Char] -> a -> a
dbg'' "ps" ([(Posting, Day)] -> [(Posting, Day)])
-> [(Posting, Day)] -> [(Posting, Day)]
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Query -> Journal -> [(Posting, Day)]
getPostings ReportOpts
ropts Query
q Journal
j
    days :: [Day]
days = ((Posting, Day) -> Day) -> [(Posting, Day)] -> [Day]
forall a b. (a -> b) -> [a] -> [b]
map (Posting, Day) -> Day
forall a b. (a, b) -> b
snd [(Posting, Day)]
ps

    -- The date spans to be included as report columns.
    colspans :: [DateSpan]
colspans = ReportOpts -> DateSpan -> [Day] -> [DateSpan]
calculateColSpans ReportOpts
ropts DateSpan
reportspan [Day]
days
    addPosting :: (a, Day) -> Map DateSpan [a] -> Map DateSpan [a]
addPosting (p :: a
p, d :: Day
d) = (Map DateSpan [a] -> Map DateSpan [a])
-> (DateSpan -> Map DateSpan [a] -> Map DateSpan [a])
-> Maybe DateSpan
-> Map DateSpan [a]
-> Map DateSpan [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map DateSpan [a] -> Map DateSpan [a]
forall a. a -> a
id (([a] -> [a]) -> DateSpan -> Map DateSpan [a] -> Map DateSpan [a]
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (a
pa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) (Maybe DateSpan -> Map DateSpan [a] -> Map DateSpan [a])
-> Maybe DateSpan -> Map DateSpan [a] -> Map DateSpan [a]
forall a b. (a -> b) -> a -> b
$ [DateSpan] -> Day -> Maybe DateSpan
latestSpanContaining [DateSpan]
colspans Day
d
    emptyMap :: Map DateSpan [a]
emptyMap = [(DateSpan, [a])] -> Map DateSpan [a]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(DateSpan, [a])] -> Map DateSpan [a])
-> ([[a]] -> [(DateSpan, [a])]) -> [[a]] -> Map DateSpan [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DateSpan] -> [[a]] -> [(DateSpan, [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip [DateSpan]
colspans ([[a]] -> Map DateSpan [a]) -> [[a]] -> Map DateSpan [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]]
forall a. a -> [a]
repeat []

    -- Group postings into their columns
    columns :: Map DateSpan [Posting]
columns = ((Posting, Day)
 -> Map DateSpan [Posting] -> Map DateSpan [Posting])
-> Map DateSpan [Posting]
-> [(Posting, Day)]
-> Map DateSpan [Posting]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Posting, Day) -> Map DateSpan [Posting] -> Map DateSpan [Posting]
forall a. (a, Day) -> Map DateSpan [a] -> Map DateSpan [a]
addPosting Map DateSpan [Posting]
forall a. Map DateSpan [a]
emptyMap [(Posting, Day)]
ps

-- | Gather postings matching the query within the report period.
getPostings :: ReportOpts -> Query -> Journal -> [(Posting, Day)]
getPostings :: ReportOpts -> Query -> Journal -> [(Posting, Day)]
getPostings ropts :: ReportOpts
ropts q :: Query
q =
    (Posting -> (Posting, Day)) -> [Posting] -> [(Posting, Day)]
forall a b. (a -> b) -> [a] -> [b]
map (\p :: Posting
p -> (Posting
p, Posting -> Day
date Posting
p)) ([Posting] -> [(Posting, Day)])
-> (Journal -> [Posting]) -> Journal -> [(Posting, Day)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Journal -> [Posting]
journalPostings (Journal -> [Posting])
-> (Journal -> Journal) -> Journal -> [Posting]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Query -> Journal -> Journal
filterJournalAmounts Query
symq (Journal -> Journal) -> (Journal -> Journal) -> Journal -> Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
.    -- remove amount parts excluded by cur:
    Query -> Journal -> Journal
filterJournalPostings Query
reportq  -- remove postings not matched by (adjusted) query
  where
    symq :: Query
symq = [Char] -> Query -> Query
forall a. Show a => [Char] -> a -> a
dbg "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
dbg "requested q" Query
q
    -- 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
dbg "reportq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ Query -> Query
depthless Query
q
    depthless :: Query -> Query
depthless = [Char] -> Query -> Query
forall a. Show a => [Char] -> a -> a
dbg "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)

    date :: Posting -> Day
date = case ReportOpts -> WhichDate
whichDateFromOpts ReportOpts
ropts of
        PrimaryDate   -> Posting -> Day
postingDate
        SecondaryDate -> Posting -> Day
postingDate2

-- | Calculate the DateSpans to be used for the columns of the report.
calculateColSpans :: ReportOpts -> DateSpan -> [Day] -> [DateSpan]
calculateColSpans :: ReportOpts -> DateSpan -> [Day] -> [DateSpan]
calculateColSpans ropts :: ReportOpts
ropts reportspan :: DateSpan
reportspan days :: [Day]
days =
    Interval -> DateSpan -> [DateSpan]
splitSpan (ReportOpts -> Interval
interval_ ReportOpts
ropts) DateSpan
displayspan
  where
    displayspan :: DateSpan
displayspan
      | ReportOpts -> Bool
empty_ ReportOpts
ropts = [Char] -> DateSpan -> DateSpan
forall a. Show a => [Char] -> a -> a
dbg "displayspan (-E)" DateSpan
reportspan                        -- all the requested intervals
      | Bool
otherwise = [Char] -> DateSpan -> DateSpan
forall a. Show a => [Char] -> a -> a
dbg "displayspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ DateSpan
reportspan DateSpan -> DateSpan -> DateSpan
`spanIntersect` DateSpan
matchedspan  -- exclude leading/trailing empty intervals
    matchedspan :: DateSpan
matchedspan = [Char] -> DateSpan -> DateSpan
forall a. Show a => [Char] -> a -> a
dbg "matchedspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ [Day] -> DateSpan
daysSpan [Day]
days


-- | Gather the account balance changes into a regular matrix
-- including the accounts from all columns.
calculateAccountChanges :: ReportOpts -> Query -> [DateSpan]
                        -> Map DateSpan [Posting]
                        -> HashMap ClippedAccountName (Map DateSpan Account)
calculateAccountChanges :: ReportOpts
-> Query
-> [DateSpan]
-> Map DateSpan [Posting]
-> HashMap AccountName (Map DateSpan Account)
calculateAccountChanges ropts :: ReportOpts
ropts q :: Query
q colspans :: [DateSpan]
colspans colps :: Map DateSpan [Posting]
colps
    | Query -> Maybe Int
queryDepth Query
q Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just 0 = 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
<> HashMap AccountName (Map DateSpan Account)
elided
    | Bool
otherwise              = HashMap AccountName (Map DateSpan Account)
acctchanges
  where
    -- Transpose to get each account's balance changes across all columns.
    acctchanges :: HashMap AccountName (Map DateSpan Account)
acctchanges = Map DateSpan (HashMap AccountName Account)
-> HashMap AccountName (Map DateSpan Account)
forall a.
Map DateSpan (HashMap AccountName a)
-> HashMap AccountName (Map DateSpan a)
transposeMap Map DateSpan (HashMap AccountName Account)
colacctchanges

    Map DateSpan (HashMap AccountName Account)
colacctchanges :: Map DateSpan (HashMap ClippedAccountName Account) =
      [Char]
-> Map DateSpan (HashMap AccountName Account)
-> Map DateSpan (HashMap AccountName Account)
forall a. Show a => [Char] -> a -> a
dbg'' "colacctchanges" (Map DateSpan (HashMap AccountName Account)
 -> Map DateSpan (HashMap AccountName Account))
-> Map DateSpan (HashMap AccountName Account)
-> Map DateSpan (HashMap AccountName Account)
forall a b. (a -> b) -> a -> b
$ ([Posting] -> HashMap AccountName Account)
-> Map DateSpan [Posting]
-> Map DateSpan (HashMap AccountName Account)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReportOpts -> Query -> [Posting] -> HashMap AccountName Account
acctChangesFromPostings ReportOpts
ropts Query
q) Map DateSpan [Posting]
colps

    elided :: HashMap AccountName (Map DateSpan Account)
elided = AccountName
-> Map DateSpan Account
-> HashMap AccountName (Map DateSpan Account)
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton "..." (Map DateSpan Account
 -> HashMap AccountName (Map DateSpan Account))
-> Map DateSpan Account
-> HashMap AccountName (Map DateSpan Account)
forall a b. (a -> b) -> a -> b
$ [(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]

-- | 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 :: ReportOpts -> Query -> [Posting] -> HashMap ClippedAccountName Account
acctChangesFromPostings :: ReportOpts -> Query -> [Posting] -> HashMap AccountName Account
acctChangesFromPostings ropts :: ReportOpts
ropts q :: Query
q ps :: [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 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
        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
        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 ((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
dbg "depthq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsDepth Query
q

-- | Accumulate and value amounts, as specified by the report options.
--
-- Makes sure all report columns have an entry.
accumValueAmounts :: ReportOpts -> Journal -> PriceOracle -> [DateSpan]
                  -> HashMap ClippedAccountName Account
                  -> HashMap ClippedAccountName (Map DateSpan Account)
                  -> HashMap ClippedAccountName (Map DateSpan Account)
accumValueAmounts :: ReportOpts
-> Journal
-> PriceOracle
-> [DateSpan]
-> HashMap AccountName Account
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
accumValueAmounts ropts :: ReportOpts
ropts j :: Journal
j priceoracle :: PriceOracle
priceoracle colspans :: [DateSpan]
colspans startbals :: HashMap AccountName Account
startbals acctchanges :: HashMap AccountName (Map DateSpan Account)
acctchanges =  -- PARTIAL:
    (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
processRow (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
$ 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
forall a. Monoid a => a
mempty 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)
  where
    -- Must accumulate before valuing, since valuation can change without any
    -- postings. Make sure every column has an entry.
    processRow :: AccountName -> Map DateSpan Account -> Map DateSpan Account
processRow name :: AccountName
name changes :: Map DateSpan Account
changes = (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
valueAcct (Map DateSpan Account -> Map DateSpan Account)
-> (Map DateSpan Account -> Map DateSpan Account)
-> Map DateSpan Account
-> Map DateSpan Account
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> Map DateSpan Account -> Map DateSpan Account
forall k. Show k => AccountName -> Map k Account -> Map k Account
rowbals AccountName
name (Map DateSpan Account -> Map DateSpan Account)
-> Map DateSpan Account -> Map DateSpan Account
forall a b. (a -> b) -> a -> b
$ Map DateSpan Account
changes Map DateSpan Account
-> Map DateSpan Account -> Map DateSpan Account
forall a. Semigroup a => a -> a -> a
<> Map DateSpan Account
zeros

    -- The row amounts to be displayed: per-period changes,
    -- zero-based cumulative totals, or
    -- starting-balance-based historical balances.
    rowbals :: AccountName -> Map k Account -> Map k Account
rowbals name :: AccountName
name changes :: Map k Account
changes = [Char] -> Map k Account -> Map k Account
forall a. Show a => [Char] -> a -> a
dbg'' "rowbals" (Map k Account -> Map k Account) -> Map k Account -> Map k Account
forall a b. (a -> b) -> a -> b
$ case ReportOpts -> BalanceType
balancetype_ ReportOpts
ropts of
        PeriodChange      -> Map k Account
changes
        CumulativeChange  -> (Account, Map k Account) -> Map k Account
forall a b. (a, b) -> b
snd ((Account, Map k Account) -> Map k Account)
-> (Account, Map k Account) -> Map k Account
forall a b. (a -> b) -> a -> b
$ (Account -> Account -> (Account, Account))
-> Account -> Map k Account -> (Account, Map k Account)
forall a b c k. (a -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
M.mapAccum Account -> Account -> (Account, Account)
f Account
nullacct                  Map k Account
changes
        HistoricalBalance -> (Account, Map k Account) -> Map k Account
forall a b. (a, b) -> b
snd ((Account, Map k Account) -> Map k Account)
-> (Account, Map k Account) -> Map k Account
forall a b. (a -> b) -> a -> b
$ (Account -> Account -> (Account, Account))
-> Account -> Map k Account -> (Account, Map k Account)
forall a b c k. (a -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
M.mapAccum Account -> Account -> (Account, Account)
f (AccountName -> Account
startingBalanceFor AccountName
name) Map k Account
changes
      where f :: Account -> Account -> (Account, Account)
f a :: Account
a b :: Account
b = let s :: Account
s = Account -> Account -> Account
sumAcct Account
a Account
b in (Account
s, Account
s)

    -- Add the values of two accounts. Should be right-biased, since it's used
    -- in scanl, so other properties (such as anumpostings) stay in the right place
    sumAcct :: Account -> Account -> Account
sumAcct Account{aibalance :: 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
forall a. Num a => a -> a -> a
+ MixedAmount
i2, aebalance :: MixedAmount
aebalance = MixedAmount
e1 MixedAmount -> MixedAmount -> MixedAmount
forall a. Num a => a -> a -> a
+ MixedAmount
e2}

    -- We may be converting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
    valueAcct :: DateSpan -> Account -> Account
valueAcct (DateSpan _ (Just end :: Day
end)) acct :: Account
acct =
        Account
acct{aibalance :: MixedAmount
aibalance = MixedAmount -> MixedAmount
value (Account -> MixedAmount
aibalance Account
acct), aebalance :: MixedAmount
aebalance = MixedAmount -> MixedAmount
value (Account -> MixedAmount
aebalance Account
acct)}
      where value :: MixedAmount -> MixedAmount
value = Day -> MixedAmount -> MixedAmount
avalue (Integer -> Day -> Day
addDays (-1) Day
end)
    valueAcct _ _ = [Char] -> Account
forall a. [Char] -> a
error' "multiBalanceReport: expected all spans to have an end date"  -- XXX should not happen

    avalue :: Day -> MixedAmount -> MixedAmount
avalue periodlast :: Day
periodlast = (MixedAmount -> MixedAmount)
-> (ValuationType -> MixedAmount -> MixedAmount)
-> Maybe ValuationType
-> MixedAmount
-> MixedAmount
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MixedAmount -> MixedAmount
forall a. a -> a
id
        (PriceOracle
-> Map AccountName AmountStyle
-> Day
-> Maybe Day
-> Day
-> Bool
-> ValuationType
-> MixedAmount
-> MixedAmount
mixedAmountApplyValuation PriceOracle
priceoracle Map AccountName AmountStyle
styles Day
periodlast Maybe Day
mreportlast Day
today Bool
multiperiod) (Maybe ValuationType -> MixedAmount -> MixedAmount)
-> Maybe ValuationType -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$
        ReportOpts -> Maybe ValuationType
value_ ReportOpts
ropts
      where
        -- Some things needed if doing valuation.
        styles :: Map AccountName AmountStyle
styles = Journal -> Map AccountName AmountStyle
journalCommodityStyles Journal
j
        mreportlast :: Maybe Day
mreportlast = ReportOpts -> Maybe Day
reportPeriodLastDay ReportOpts
ropts
        today :: Day
today = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Day
forall a. [Char] -> a
error' "multiBalanceReport: could not pick a valuation date, ReportOpts today_ is unset") (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Maybe Day
today_ ReportOpts
ropts  -- XXX shouldn't happen
        multiperiod :: Bool
multiperiod = ReportOpts -> Interval
interval_ ReportOpts
ropts Interval -> Interval -> Bool
forall a. Eq a => a -> a -> Bool
/= Interval
NoInterval

    startingBalanceFor :: AccountName -> Account
startingBalanceFor a :: AccountName
a = Account -> AccountName -> HashMap AccountName Account -> Account
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HM.lookupDefault Account
nullacct AccountName
a HashMap AccountName Account
startbals
    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]


-- | 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 :: ReportOpts -> Query -> Journal -> PriceOracle
                           -> [DateSpan]
                           -> Map DateSpan [Posting]
                           -> HashMap AccountName Account
                           -> MultiBalanceReport
generateMultiBalanceReport :: ReportOpts
-> Query
-> Journal
-> PriceOracle
-> [DateSpan]
-> Map DateSpan [Posting]
-> HashMap AccountName Account
-> MultiBalanceReport
generateMultiBalanceReport ropts :: ReportOpts
ropts q :: Query
q j :: Journal
j priceoracle :: PriceOracle
priceoracle colspans :: [DateSpan]
colspans colps :: Map DateSpan [Posting]
colps startbals :: HashMap AccountName Account
startbals = MultiBalanceReport
report
  where
    -- Each account's balance changes across all columns.
    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
dbg'' "acctchanges" (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
$ ReportOpts
-> Query
-> [DateSpan]
-> Map DateSpan [Posting]
-> HashMap AccountName (Map DateSpan Account)
calculateAccountChanges ReportOpts
ropts Query
q [DateSpan]
colspans Map DateSpan [Posting]
colps

    -- Process changes into normal, cumulative, or historical amounts, plus value them
    accumvalued :: HashMap AccountName (Map DateSpan Account)
accumvalued = ReportOpts
-> Journal
-> PriceOracle
-> [DateSpan]
-> HashMap AccountName Account
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName (Map DateSpan Account)
accumValueAmounts ReportOpts
ropts Journal
j PriceOracle
priceoracle [DateSpan]
colspans HashMap AccountName Account
startbals HashMap AccountName (Map DateSpan Account)
acctchanges

    -- 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
dbg'' "displaynames" (HashMap AccountName DisplayName
 -> HashMap AccountName DisplayName)
-> HashMap AccountName DisplayName
-> HashMap AccountName DisplayName
forall a b. (a -> b) -> a -> b
$ ReportOpts
-> Query
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName DisplayName
displayedAccounts ReportOpts
ropts Query
q HashMap AccountName (Map DateSpan Account)
accumvalued

    -- All the rows of the report.
    rows :: [MultiBalanceReportRow]
rows = [Char] -> [MultiBalanceReportRow] -> [MultiBalanceReportRow]
forall a. Show a => [Char] -> a -> a
dbg'' "rows" ([MultiBalanceReportRow] -> [MultiBalanceReportRow])
-> [MultiBalanceReportRow] -> [MultiBalanceReportRow]
forall a b. (a -> b) -> a -> b
$ ReportOpts
-> HashMap AccountName DisplayName
-> HashMap AccountName (Map DateSpan Account)
-> [MultiBalanceReportRow]
buildReportRows ReportOpts
ropts HashMap AccountName DisplayName
displaynames HashMap AccountName (Map DateSpan Account)
accumvalued

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

    -- Sorted report rows.
    sortedrows :: [MultiBalanceReportRow]
sortedrows = [Char] -> [MultiBalanceReportRow] -> [MultiBalanceReportRow]
forall a. Show a => [Char] -> a -> a
dbg' "sortedrows" ([MultiBalanceReportRow] -> [MultiBalanceReportRow])
-> [MultiBalanceReportRow] -> [MultiBalanceReportRow]
forall a b. (a -> b) -> a -> b
$ ReportOpts
-> Journal -> [MultiBalanceReportRow] -> [MultiBalanceReportRow]
sortRows ReportOpts
ropts Journal
j [MultiBalanceReportRow]
rows

    -- Postprocess the report, negating balances and taking percentages if needed
    report :: MultiBalanceReport
report = ReportOpts -> MultiBalanceReport -> MultiBalanceReport
postprocessReport ReportOpts
ropts (MultiBalanceReport -> MultiBalanceReport)
-> MultiBalanceReport -> MultiBalanceReport
forall a b. (a -> b) -> a -> b
$ [DateSpan]
-> [MultiBalanceReportRow]
-> PeriodicReportRow () MixedAmount
-> MultiBalanceReport
forall a b.
[DateSpan]
-> [PeriodicReportRow a b]
-> PeriodicReportRow () b
-> PeriodicReport a b
PeriodicReport [DateSpan]
colspans [MultiBalanceReportRow]
sortedrows PeriodicReportRow () MixedAmount
totalsrow

-- | Build the report rows.
--
-- One row per account, with account name info, row amounts, row total and row average.
buildReportRows :: ReportOpts
                -> HashMap AccountName DisplayName
                -> HashMap AccountName (Map DateSpan Account)
                -> [MultiBalanceReportRow]
buildReportRows :: ReportOpts
-> HashMap AccountName DisplayName
-> HashMap AccountName (Map DateSpan Account)
-> [MultiBalanceReportRow]
buildReportRows ropts :: ReportOpts
ropts displaynames :: HashMap AccountName DisplayName
displaynames = HashMap AccountName MultiBalanceReportRow
-> [MultiBalanceReportRow]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (HashMap AccountName MultiBalanceReportRow
 -> [MultiBalanceReportRow])
-> (HashMap AccountName (Map DateSpan Account)
    -> HashMap AccountName MultiBalanceReportRow)
-> HashMap AccountName (Map DateSpan Account)
-> [MultiBalanceReportRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AccountName
 -> Map DateSpan Account -> Maybe MultiBalanceReportRow)
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName MultiBalanceReportRow
forall k v1 v2.
(k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybeWithKey AccountName -> Map DateSpan Account -> Maybe MultiBalanceReportRow
forall (t :: * -> *).
Foldable t =>
AccountName -> t Account -> Maybe MultiBalanceReportRow
mkRow
  where
    mkRow :: AccountName -> t Account -> Maybe MultiBalanceReportRow
mkRow name :: AccountName
name accts :: 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
        MultiBalanceReportRow -> Maybe MultiBalanceReportRow
forall (m :: * -> *) a. Monad m => a -> m a
return (MultiBalanceReportRow -> Maybe MultiBalanceReportRow)
-> MultiBalanceReportRow -> Maybe MultiBalanceReportRow
forall a b. (a -> b) -> a -> b
$ DisplayName
-> [MixedAmount]
-> MixedAmount
-> MixedAmount
-> MultiBalanceReportRow
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
        -- 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 -> BalanceType
balancetype_ ReportOpts
ropts of
            PeriodChange -> [MixedAmount] -> MixedAmount
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [MixedAmount]
rowbals
            _            -> MixedAmount -> [MixedAmount] -> MixedAmount
forall a. a -> [a] -> a
lastDef 0 [MixedAmount]
rowbals
        rowavg :: MixedAmount
rowavg = [MixedAmount] -> MixedAmount
averageMixedAmounts [MixedAmount]
rowbals
    balance :: Account -> MixedAmount
balance = case ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts of ALTree -> Account -> MixedAmount
aibalance; ALFlat -> Account -> MixedAmount
aebalance

-- | Calculate accounts which are to be displayed in the report, as well as
-- their name and depth
displayedAccounts :: ReportOpts -> Query
                  -> HashMap AccountName (Map DateSpan Account)
                  -> HashMap AccountName DisplayName
displayedAccounts :: ReportOpts
-> Query
-> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName DisplayName
displayedAccounts ropts :: ReportOpts
ropts q :: Query
q valuedaccts :: HashMap AccountName (Map DateSpan Account)
valuedaccts
    | Int
depth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = AccountName -> DisplayName -> HashMap AccountName DisplayName
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton "..." (DisplayName -> HashMap AccountName DisplayName)
-> DisplayName -> HashMap AccountName DisplayName
forall a b. (a -> b) -> a -> b
$ AccountName -> AccountName -> Int -> DisplayName
DisplayName "..." "..." 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 (\a :: AccountName
a _ -> 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
== 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 name :: AccountName
name amts :: 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 name :: AccountName
name = case ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts of
        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 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
        ALFlat -> AccountName -> AccountName -> Int -> DisplayName
DisplayName AccountName
name AccountName
droppedName 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 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
- 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 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 name :: AccountName
name amts :: 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
&& (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) t Account
amts)  -- Keep all leaves when using 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))            -- Throw out anything with zero balance
      where
        d :: Int
d = AccountName -> Int
accountNameLevel AccountName
name
        balance :: Account -> MixedAmount
balance | AccountListMode
ALTree <- ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts, Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
depth = Account -> MixedAmount
aibalance
                | Bool
otherwise = Account -> MixedAmount
aebalance

    -- 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
dbg'' "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
        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
        ALFlat -> HashMap AccountName Int
forall a. Monoid a => a
mempty
      where
        hasEnoughSubs :: AccountName -> Int -> Bool
hasEnoughSubs name :: AccountName
name nsubs :: 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 1 else 2

    isZeroRow :: (a -> MixedAmount) -> t a -> Bool
isZeroRow balance :: 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
q
    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 -> [MultiBalanceReportRow] -> [MultiBalanceReportRow]
sortRows ropts :: ReportOpts
ropts j :: Journal
j
    | ReportOpts -> Bool
sort_amount_ ReportOpts
ropts, AccountListMode
ALTree <- ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts = [MultiBalanceReportRow] -> [MultiBalanceReportRow]
sortTreeMBRByAmount
    | ReportOpts -> Bool
sort_amount_ ReportOpts
ropts, AccountListMode
ALFlat <- ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts = [MultiBalanceReportRow] -> [MultiBalanceReportRow]
sortFlatMBRByAmount
    | Bool
otherwise                                            = [MultiBalanceReportRow] -> [MultiBalanceReportRow]
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 :: [MultiBalanceReportRow] -> [MultiBalanceReportRow]
sortTreeMBRByAmount rows :: [MultiBalanceReportRow]
rows = (AccountName -> Maybe MultiBalanceReportRow)
-> [AccountName] -> [MultiBalanceReportRow]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (AccountName
-> HashMap AccountName MultiBalanceReportRow
-> Maybe MultiBalanceReportRow
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HM.lookup` HashMap AccountName MultiBalanceReportRow
rowMap) [AccountName]
sortedanames
      where
        accounttree :: Account
accounttree = AccountName -> [AccountName] -> Account
accountTree "root" ([AccountName] -> Account) -> [AccountName] -> Account
forall a b. (a -> b) -> a -> b
$ (MultiBalanceReportRow -> AccountName)
-> [MultiBalanceReportRow] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map MultiBalanceReportRow -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrFullName [MultiBalanceReportRow]
rows
        rowMap :: HashMap AccountName MultiBalanceReportRow
rowMap = [(AccountName, MultiBalanceReportRow)]
-> HashMap AccountName MultiBalanceReportRow
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(AccountName, MultiBalanceReportRow)]
 -> HashMap AccountName MultiBalanceReportRow)
-> [(AccountName, MultiBalanceReportRow)]
-> HashMap AccountName MultiBalanceReportRow
forall a b. (a -> b) -> a -> b
$ (MultiBalanceReportRow -> (AccountName, MultiBalanceReportRow))
-> [MultiBalanceReportRow]
-> [(AccountName, MultiBalanceReportRow)]
forall a b. (a -> b) -> [a] -> [b]
map (\row :: MultiBalanceReportRow
row -> (MultiBalanceReportRow -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrFullName MultiBalanceReportRow
row, MultiBalanceReportRow
row)) [MultiBalanceReportRow]
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 a :: Account
a = Account
a{aibalance :: MixedAmount
aibalance = MixedAmount
-> (MultiBalanceReportRow -> MixedAmount)
-> Maybe MultiBalanceReportRow
-> MixedAmount
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([MixedAmount] -> MixedAmount
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([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) MultiBalanceReportRow -> MixedAmount
forall a b. PeriodicReportRow a b -> b
prrTotal (Maybe MultiBalanceReportRow -> MixedAmount)
-> Maybe MultiBalanceReportRow -> MixedAmount
forall a b. (a -> b) -> a -> b
$
                                          AccountName
-> HashMap AccountName MultiBalanceReportRow
-> Maybe MultiBalanceReportRow
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (Account -> AccountName
aname Account
a) HashMap AccountName MultiBalanceReportRow
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 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.
    sortFlatMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow]
    sortFlatMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow]
sortFlatMBRByAmount = case ReportOpts -> Maybe NormalSign
normalbalance_ ReportOpts
ropts of
        Just NormallyNegative -> (MultiBalanceReportRow -> MixedAmount)
-> [MultiBalanceReportRow] -> [MultiBalanceReportRow]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn MultiBalanceReportRow -> MixedAmount
forall a. PeriodicReportRow a MixedAmount -> MixedAmount
amt
        _                     -> (MultiBalanceReportRow -> Down MixedAmount)
-> [MultiBalanceReportRow] -> [MultiBalanceReportRow]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (MixedAmount -> Down MixedAmount
forall a. a -> Down a
Down (MixedAmount -> Down MixedAmount)
-> (MultiBalanceReportRow -> MixedAmount)
-> MultiBalanceReportRow
-> Down MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiBalanceReportRow -> MixedAmount
forall a. PeriodicReportRow a MixedAmount -> MixedAmount
amt)
      where amt :: PeriodicReportRow a MixedAmount -> MixedAmount
amt = MixedAmount -> MixedAmount
normaliseMixedAmountSquashPricesForDisplay (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 :: [MultiBalanceReportRow] -> [MultiBalanceReportRow]
sortMBRByAccountDeclaration rows :: [MultiBalanceReportRow]
rows = [AccountName] -> [MultiBalanceReportRow] -> [MultiBalanceReportRow]
forall b.
[AccountName]
-> [PeriodicReportRow DisplayName b]
-> [PeriodicReportRow DisplayName b]
sortRowsLike [AccountName]
sortedanames [MultiBalanceReportRow]
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
$ (MultiBalanceReportRow -> AccountName)
-> [MultiBalanceReportRow] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map MultiBalanceReportRow -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrFullName [MultiBalanceReportRow]
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
-> [MultiBalanceReportRow] -> PeriodicReportRow () MixedAmount
calculateTotalsRow ropts :: ReportOpts
ropts rows :: [MultiBalanceReportRow]
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 row :: 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 MultiBalanceReportRow -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HM.member` HashMap AccountName MultiBalanceReportRow
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 MultiBalanceReportRow
rowMap = [(AccountName, MultiBalanceReportRow)]
-> HashMap AccountName MultiBalanceReportRow
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(AccountName, MultiBalanceReportRow)]
 -> HashMap AccountName MultiBalanceReportRow)
-> [(AccountName, MultiBalanceReportRow)]
-> HashMap AccountName MultiBalanceReportRow
forall a b. (a -> b) -> a -> b
$ (MultiBalanceReportRow -> (AccountName, MultiBalanceReportRow))
-> [MultiBalanceReportRow]
-> [(AccountName, MultiBalanceReportRow)]
forall a b. (a -> b) -> [a] -> [b]
map (\row :: MultiBalanceReportRow
row -> (MultiBalanceReportRow -> AccountName
forall a. PeriodicReportRow DisplayName a -> AccountName
prrFullName MultiBalanceReportRow
row, MultiBalanceReportRow
row)) [MultiBalanceReportRow]
rows

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

    [MixedAmount]
coltotals :: [MixedAmount] = [Char] -> [MixedAmount] -> [MixedAmount]
forall a. Show a => [Char] -> a -> a
dbg'' "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 :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [[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 -> BalanceType
balancetype_ ReportOpts
ropts of
        PeriodChange -> [MixedAmount] -> MixedAmount
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [MixedAmount]
coltotals
        _            -> MixedAmount -> [MixedAmount] -> MixedAmount
forall a. a -> [a] -> a
lastDef 0 [MixedAmount]
coltotals
    grandaverage :: MixedAmount
grandaverage = [MixedAmount] -> MixedAmount
averageMixedAmounts [MixedAmount]
coltotals

-- | Map the report rows to percentages and negate if needed
postprocessReport :: ReportOpts -> MultiBalanceReport -> MultiBalanceReport
postprocessReport :: ReportOpts -> MultiBalanceReport -> MultiBalanceReport
postprocessReport ropts :: ReportOpts
ropts = MultiBalanceReport -> MultiBalanceReport
forall a.
PeriodicReport a MixedAmount -> PeriodicReport a MixedAmount
maybePercent (MultiBalanceReport -> MultiBalanceReport)
-> (MultiBalanceReport -> MultiBalanceReport)
-> MultiBalanceReport
-> MultiBalanceReport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiBalanceReport -> MultiBalanceReport
maybeInvert
  where
    maybeInvert :: MultiBalanceReport -> MultiBalanceReport
maybeInvert  = if ReportOpts -> Bool
invert_  ReportOpts
ropts then (MixedAmount -> MixedAmount)
-> MultiBalanceReport -> MultiBalanceReport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MixedAmount -> MixedAmount
forall a. Num a => a -> a
negate else MultiBalanceReport -> MultiBalanceReport
forall a. a -> a
id
    maybePercent :: PeriodicReport a MixedAmount -> PeriodicReport a MixedAmount
maybePercent = if ReportOpts -> Bool
percent_ ReportOpts
ropts then PeriodicReport a MixedAmount -> PeriodicReport a MixedAmount
forall a.
PeriodicReport a MixedAmount -> PeriodicReport a MixedAmount
prPercent   else PeriodicReport a MixedAmount -> PeriodicReport a MixedAmount
forall a. a -> a
id

    prPercent :: PeriodicReport a MixedAmount -> PeriodicReport a MixedAmount
prPercent (PeriodicReport spans :: [DateSpan]
spans rows :: [PeriodicReportRow a MixedAmount]
rows totalrow :: PeriodicReportRow () MixedAmount
totalrow) =
        [DateSpan]
-> [PeriodicReportRow a MixedAmount]
-> PeriodicReportRow () MixedAmount
-> PeriodicReport a MixedAmount
forall a b.
[DateSpan]
-> [PeriodicReportRow a b]
-> PeriodicReportRow () b
-> PeriodicReport a b
PeriodicReport [DateSpan]
spans ((PeriodicReportRow a MixedAmount
 -> PeriodicReportRow a MixedAmount)
-> [PeriodicReportRow a MixedAmount]
-> [PeriodicReportRow a MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow a MixedAmount -> PeriodicReportRow a MixedAmount
forall a.
PeriodicReportRow a MixedAmount -> PeriodicReportRow a MixedAmount
percentRow [PeriodicReportRow a MixedAmount]
rows) (PeriodicReportRow () MixedAmount
-> PeriodicReportRow () MixedAmount
forall a.
PeriodicReportRow a MixedAmount -> PeriodicReportRow a MixedAmount
percentRow PeriodicReportRow () MixedAmount
totalrow)
      where
        percentRow :: PeriodicReportRow a MixedAmount -> PeriodicReportRow a MixedAmount
percentRow (PeriodicReportRow name :: a
name rowvals :: [MixedAmount]
rowvals rowtotal :: MixedAmount
rowtotal rowavg :: 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 :: Map DateSpan (HashMap AccountName a)
             -> HashMap AccountName (Map DateSpan a)
transposeMap :: Map DateSpan (HashMap AccountName a)
-> HashMap AccountName (Map DateSpan a)
transposeMap xs :: Map DateSpan (HashMap AccountName a)
xs = (DateSpan
 -> HashMap AccountName a
 -> HashMap AccountName (Map DateSpan a)
 -> HashMap AccountName (Map DateSpan a))
-> HashMap AccountName (Map DateSpan a)
-> Map DateSpan (HashMap AccountName a)
-> HashMap AccountName (Map DateSpan a)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey 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 Map DateSpan (HashMap AccountName a)
xs
  where
    addSpan :: k -> HashMap k a -> HashMap k (Map k a) -> HashMap k (Map k a)
addSpan span :: k
span acctmap :: HashMap k a
acctmap seen :: 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 span :: k
span acct :: k
acct a :: 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 sortedas :: [AccountName]
sortedas rows :: [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 (\row :: 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 a :: 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) 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 a :: MixedAmount
a b :: 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
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
== 0 then 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
* 100]
  where errmsg :: [Char]
errmsg = "Cannot calculate percentages if accounts have different commodities (Hint: Try --cost, -V or similar flags.)"

-- Local debug helper
-- add a prefix to this function's debug output
dbg :: [Char] -> a -> a
dbg   s :: [Char]
s = let p :: [Char]
p = "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]
forall a. [a] -> [a] -> [a]
++[Char]
s)
dbg' :: [Char] -> a -> a
dbg'  s :: [Char]
s = let p :: [Char]
p = "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]
forall a. [a] -> [a] -> [a]
++[Char]
s)
dbg'' :: [Char] -> a -> a
dbg'' s :: [Char]
s = let p :: [Char]
p = "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]
forall a. [a] -> [a] -> [a]
++[Char]
s)
-- dbg = const id  -- exclude this function from debug output

-- common rendering helper, XXX here for now
tableAsText :: ReportOpts -> (a -> String) -> Table String String a -> String
tableAsText :: ReportOpts -> (a -> [Char]) -> Table [Char] [Char] a -> [Char]
tableAsText (ReportOpts{pretty_tables_ :: ReportOpts -> Bool
pretty_tables_ = Bool
pretty}) showcell :: a -> [Char]
showcell =
  [[Char]] -> [Char]
unlines
  ([[Char]] -> [Char])
-> (Table [Char] [Char] a -> [[Char]])
-> Table [Char] [Char] a
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. [[a]] -> [[a]]
trimborder
  ([[Char]] -> [[Char]])
-> (Table [Char] [Char] a -> [[Char]])
-> Table [Char] [Char] a
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
  ([Char] -> [[Char]])
-> (Table [Char] [Char] a -> [Char])
-> Table [Char] [Char] a
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> ([Char] -> [Char])
-> ([Char] -> [Char])
-> (a -> [Char])
-> Table [Char] [Char] a
-> [Char]
forall rh ch a.
Bool
-> (rh -> [Char])
-> (ch -> [Char])
-> (a -> [Char])
-> Table rh ch a
-> [Char]
render Bool
pretty [Char] -> [Char]
forall a. a -> a
id [Char] -> [Char]
forall a. a -> a
id a -> [Char]
showcell
  (Table [Char] [Char] a -> [Char])
-> (Table [Char] [Char] a -> Table [Char] [Char] a)
-> Table [Char] [Char] a
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table [Char] [Char] a -> Table [Char] [Char] a
forall ch a. Table [Char] ch a -> Table [Char] ch a
align
  where
    trimborder :: [[a]] -> [[a]]
trimborder = Int -> [[a]] -> [[a]]
forall a. Int -> [a] -> [a]
drop 1 ([[a]] -> [[a]]) -> ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
forall a. [a] -> [a]
init ([[a]] -> [[a]]) -> ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop 1 ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
init)
    align :: Table [Char] ch a -> Table [Char] ch a
align (Table l :: Header [Char]
l t :: Header ch
t d :: [[a]]
d) = Header [Char] -> Header ch -> [[a]] -> Table [Char] ch a
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table Header [Char]
l' Header ch
t [[a]]
d
      where
        acctswidth :: Int
acctswidth = [Int] -> Int
forall a. Integral a => [a] -> a
maximum' ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
strWidth (Header [Char] -> [[Char]]
forall h. Header h -> [h]
headerContents Header [Char]
l)
        l' :: Header [Char]
l'         = Int -> [Char] -> [Char]
padRightWide Int
acctswidth ([Char] -> [Char]) -> Header [Char] -> Header [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Header [Char]
l

-- tests

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

  let
    amt0 :: Amount
amt0 = Amount :: AccountName
-> Quantity -> Bool -> AmountStyle -> Maybe AmountPrice -> Amount
Amount {acommodity :: AccountName
acommodity="$", aquantity :: Quantity
aquantity=0, aprice :: Maybe AmountPrice
aprice=Maybe AmountPrice
forall a. Maybe a
Nothing, astyle :: AmountStyle
astyle=$WAmountStyle :: 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 2, asdecimalpoint :: Maybe Char
asdecimalpoint = Char -> Maybe Char
forall a. a -> Maybe a
Just '.', asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups = Maybe DigitGroupStyle
forall a. Maybe a
Nothing}, aismultiplier :: Bool
aismultiplier=Bool
False}
    (opts :: ReportOpts
opts,journal :: Journal
journal) gives :: (ReportOpts, Journal)
-> ([MultiBalanceReportRow], MixedAmount) -> IO ()
`gives` r :: ([MultiBalanceReportRow], MixedAmount)
r = do
      let (eitems :: [MultiBalanceReportRow]
eitems, etotal :: MixedAmount
etotal) = ([MultiBalanceReportRow], MixedAmount)
r
          (PeriodicReport _ aitems :: [MultiBalanceReportRow]
aitems atotal :: PeriodicReportRow () MixedAmount
atotal) = Day -> ReportOpts -> Journal -> MultiBalanceReport
multiBalanceReport Day
nulldate ReportOpts
opts Journal
journal
          showw :: MultiBalanceReportRow
-> (AccountName, AccountName, Int, [[Char]], [Char], [Char])
showw (PeriodicReportRow a :: DisplayName
a lAmt :: [MixedAmount]
lAmt amt :: MixedAmount
amt 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')
      ((MultiBalanceReportRow
 -> (AccountName, AccountName, Int, [[Char]], [Char], [Char]))
-> [MultiBalanceReportRow]
-> [(AccountName, AccountName, Int, [[Char]], [Char], [Char])]
forall a b. (a -> b) -> [a] -> [b]
map MultiBalanceReportRow
-> (AccountName, AccountName, Int, [[Char]], [Char], [Char])
showw [MultiBalanceReportRow]
aitems) [(AccountName, AccountName, Int, [[Char]], [Char], [Char])]
-> [(AccountName, AccountName, Int, [[Char]], [Char], [Char])]
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= ((MultiBalanceReportRow
 -> (AccountName, AccountName, Int, [[Char]], [Char], [Char]))
-> [MultiBalanceReportRow]
-> [(AccountName, AccountName, Int, [[Char]], [Char], [Char])]
forall a b. (a -> b) -> [a] -> [b]
map MultiBalanceReportRow
-> (AccountName, AccountName, Int, [[Char]], [Char], [Char])
showw [MultiBalanceReportRow]
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
tests "multiBalanceReport" [
      [Char] -> IO () -> TestTree
test "null journal"  (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      (ReportOpts
defreportopts, Journal
nulljournal) (ReportOpts, Journal)
-> ([MultiBalanceReportRow], MixedAmount) -> IO ()
`gives` ([], [Amount] -> MixedAmount
Mixed [Amount
nullamt])

     ,[Char] -> IO () -> TestTree
test "with -H on a populated period"  (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      (ReportOpts
defreportopts{period_ :: Period
period_= Day -> Day -> Period
PeriodBetween (Integer -> Int -> Int -> Day
fromGregorian 2008 1 1) (Integer -> Int -> Int -> Day
fromGregorian 2008 1 2), balancetype_ :: BalanceType
balancetype_=BalanceType
HistoricalBalance}, Journal
samplejournal) (ReportOpts, Journal)
-> ([MultiBalanceReportRow], MixedAmount) -> IO ()
`gives`
       (
        [ DisplayName
-> [MixedAmount]
-> MixedAmount
-> MixedAmount
-> MultiBalanceReportRow
forall a b. a -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow (AccountName -> DisplayName
flatDisplayName "assets:bank:checking") [[Char] -> MixedAmount
mamountp' "$1.00"]  ([Char] -> MixedAmount
mamountp' "$1.00")  ([Amount] -> MixedAmount
Mixed [Amount
amt0 {aquantity :: Quantity
aquantity=1}])
        , DisplayName
-> [MixedAmount]
-> MixedAmount
-> MixedAmount
-> MultiBalanceReportRow
forall a b. a -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow (AccountName -> DisplayName
flatDisplayName "income:salary")        [[Char] -> MixedAmount
mamountp' "$-1.00"] ([Char] -> MixedAmount
mamountp' "$-1.00") ([Amount] -> MixedAmount
Mixed [Amount
amt0 {aquantity :: Quantity
aquantity=(-1)}])
        ],
        [Char] -> MixedAmount
mamountp' "$0.00")

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

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