{-# LANGUAGE FlexibleInstances, RecordWildCards, ScopedTypeVariables, OverloadedStrings, DeriveGeneric #-}
{-|

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

-}

module Hledger.Reports.MultiBalanceReport (
  MultiBalanceReport,
  MultiBalanceReportRow,

  multiBalanceReport,
  multiBalanceReportWith,
  balanceReportFromMultiBalanceReport,
  tableAsText,

  -- -- * Tests
  tests_MultiBalanceReport
)
where

import Data.List
import Data.List.Extra (nubSort)
import qualified Data.Map as M
import Data.Maybe
import Data.Ord
import Data.Time.Calendar
import Safe
import Text.Tabular as T
import Text.Tabular.AsciiWide

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


-- | 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
--
--   * the account's 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 AccountName MixedAmount
type MultiBalanceReportRow = PeriodicReportRow AccountName 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. Does not support tree-mode boring parent eliding.
-- 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 multiBalanceReport') 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@ReportOpts{..} q :: Query
q j :: Journal
j priceoracle :: PriceOracle
priceoracle =
  (if Bool
invert_ then MultiBalanceReport -> MultiBalanceReport
forall b a. Num b => PeriodicReport a b -> PeriodicReport a b
prNegate else MultiBalanceReport -> MultiBalanceReport
forall a. a -> a
id) (MultiBalanceReport -> MultiBalanceReport)
-> MultiBalanceReport -> MultiBalanceReport
forall a b. (a -> b) -> a -> b
$
  [DateSpan]
-> [PeriodicReportRow AccountName MixedAmount]
-> PeriodicReportRow () MixedAmount
-> MultiBalanceReport
forall a b.
[DateSpan]
-> [PeriodicReportRow a b]
-> PeriodicReportRow () b
-> PeriodicReport a b
PeriodicReport [DateSpan]
colspans [PeriodicReportRow AccountName MixedAmount]
mappedsortedrows PeriodicReportRow () MixedAmount
mappedtotalsrow
    where
      -- add a prefix to this function's debug output
      dbg :: String -> a -> a
dbg   s :: String
s = let p :: String
p = "multiBalanceReport" in String -> a -> a
forall a. Show a => String -> a -> a
Hledger.Utils.dbg3 (String
pString -> String -> String
forall a. [a] -> [a] -> [a]
++" "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
s)
      dbg' :: String -> a -> a
dbg'  s :: String
s = let p :: String
p = "multiBalanceReport" in String -> a -> a
forall a. Show a => String -> a -> a
Hledger.Utils.dbg4 (String
pString -> String -> String
forall a. [a] -> [a] -> [a]
++" "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
s)
      dbg'' :: String -> a -> a
dbg'' s :: String
s = let p :: String
p = "multiBalanceReport" in String -> a -> a
forall a. Show a => String -> a -> a
Hledger.Utils.dbg5 (String
pString -> String -> String
forall a. [a] -> [a] -> [a]
++" "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
s)
      -- dbg = const id  -- exclude this function from debug output

      ----------------------------------------------------------------------
      -- 1. Queries, report/column dates.

      symq :: Query
symq       = String -> Query -> Query
forall a. Show a => String -> a -> a
dbg "symq"   (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsSym (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ String -> Query -> Query
forall a. Show a => String -> a -> a
dbg "requested q" Query
q
      depthq :: Query
depthq     = String -> Query -> Query
forall a. Show a => String -> 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
      depth :: Int
depth      = Query -> Int
queryDepth Query
depthq
      depthless :: Query -> Query
depthless  = String -> Query -> Query
forall a. Show a => String -> 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)
      datelessq :: Query
datelessq  = String -> Query -> Query
forall a. Show a => String -> 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
      dateqcons :: DateSpan -> Query
dateqcons  = if Bool
date2_ then DateSpan -> Query
Date2 else DateSpan -> Query
Date
      -- The date span specified by -b/-e/-p options and query args if any.
      requestedspan :: DateSpan
requestedspan  = String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg "requestedspan"  (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ Bool -> Query -> DateSpan
queryDateSpan Bool
date2_ 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' = String -> DateSpan -> DateSpan
forall a. Show a => String -> 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 Bool
date2_ 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  = String -> [DateSpan] -> [DateSpan]
forall a. Show a => String -> a -> a
dbg "intervalspans"  ([DateSpan] -> [DateSpan]) -> [DateSpan] -> [DateSpan]
forall a b. (a -> b) -> a -> b
$ Interval -> DateSpan -> [DateSpan]
splitSpan Interval
interval_ 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     = String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg "reportspan"     (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ Maybe Day -> Maybe Day -> DateSpan
DateSpan (Maybe Day -> (DateSpan -> Maybe Day) -> Maybe DateSpan -> Maybe Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Day
forall a. Maybe a
Nothing DateSpan -> Maybe Day
spanStart (Maybe DateSpan -> Maybe Day) -> Maybe DateSpan -> Maybe Day
forall a b. (a -> b) -> a -> b
$ [DateSpan] -> Maybe DateSpan
forall a. [a] -> Maybe a
headMay [DateSpan]
intervalspans)
                                                        (Maybe Day -> (DateSpan -> Maybe Day) -> Maybe DateSpan -> Maybe Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Day
forall a. Maybe a
Nothing DateSpan -> Maybe Day
spanEnd   (Maybe DateSpan -> Maybe Day) -> Maybe DateSpan -> Maybe Day
forall a b. (a -> b) -> a -> b
$ [DateSpan] -> Maybe DateSpan
forall a. [a] -> Maybe a
lastMay [DateSpan]
intervalspans)
      mreportstart :: Maybe Day
mreportstart = DateSpan -> Maybe Day
spanStart DateSpan
reportspan
      -- 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   = String -> Query -> Query
forall a. Show a => String -> a -> a
dbg "reportq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ Query -> Query
depthless (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$
        if DateSpan
reportspan DateSpan -> DateSpan -> Bool
forall a. Eq a => a -> a -> Bool
== DateSpan
nulldatespan
        then Query
q
        else [Query] -> Query
And [Query
datelessq, Query
reportspandatesq]
          where
            reportspandatesq :: Query
reportspandatesq = String -> Query -> Query
forall a. Show a => String -> a -> a
dbg "reportspandatesq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ DateSpan -> Query
dateqcons DateSpan
reportspan
      -- The date spans to be included as report columns.
      [DateSpan]
colspans :: [DateSpan] = String -> [DateSpan] -> [DateSpan]
forall a. Show a => String -> a -> a
dbg "colspans" ([DateSpan] -> [DateSpan]) -> [DateSpan] -> [DateSpan]
forall a b. (a -> b) -> a -> b
$ Interval -> DateSpan -> [DateSpan]
splitSpan Interval
interval_ DateSpan
displayspan
        where
          displayspan :: DateSpan
displayspan
            | Bool
empty_    = String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg "displayspan (-E)" DateSpan
reportspan                              -- all the requested intervals
            | Bool
otherwise = String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg "displayspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ DateSpan
requestedspan DateSpan -> DateSpan -> DateSpan
`spanIntersect` DateSpan
matchedspan  -- exclude leading/trailing empty intervals
          matchedspan :: DateSpan
matchedspan = String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg "matchedspan" (DateSpan -> DateSpan) -> ([Day] -> DateSpan) -> [Day] -> DateSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Day] -> DateSpan
daysSpan ([Day] -> DateSpan) -> [Day] -> DateSpan
forall a b. (a -> b) -> a -> b
$ ((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

      -- If doing cost valuation, convert amounts to cost.
      j' :: Journal
j' = ReportOpts -> Journal -> Journal
journalSelectingAmountFromOpts ReportOpts
ropts Journal
j

      ----------------------------------------------------------------------
      -- 2. 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 except maybe converted to cost.
      [(AccountName, MixedAmount)]
startbals :: [(AccountName, MixedAmount)] = String
-> [(AccountName, MixedAmount)] -> [(AccountName, MixedAmount)]
forall a. Show a => String -> a -> a
dbg' "startbals" ([(AccountName, MixedAmount)] -> [(AccountName, MixedAmount)])
-> [(AccountName, MixedAmount)] -> [(AccountName, MixedAmount)]
forall a b. (a -> b) -> a -> b
$ ((AccountName, AccountName, Int, MixedAmount)
 -> (AccountName, MixedAmount))
-> [(AccountName, AccountName, Int, MixedAmount)]
-> [(AccountName, MixedAmount)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: AccountName
a,_,_,b :: MixedAmount
b) -> (AccountName
a,MixedAmount
b)) [(AccountName, AccountName, Int, MixedAmount)]
startbalanceitems
        where
          (startbalanceitems :: [(AccountName, AccountName, Int, MixedAmount)]
startbalanceitems,_) = String
-> ([(AccountName, AccountName, Int, MixedAmount)], MixedAmount)
-> ([(AccountName, AccountName, Int, MixedAmount)], MixedAmount)
forall a. Show a => String -> a -> a
dbg'' "starting balance report" (([(AccountName, AccountName, Int, MixedAmount)], MixedAmount)
 -> ([(AccountName, AccountName, Int, MixedAmount)], MixedAmount))
-> ([(AccountName, AccountName, Int, MixedAmount)], MixedAmount)
-> ([(AccountName, AccountName, Int, MixedAmount)], MixedAmount)
forall a b. (a -> b) -> a -> b
$ ReportOpts
-> Query
-> Journal
-> ([(AccountName, AccountName, Int, MixedAmount)], MixedAmount)
balanceReport ReportOpts
ropts''{value_ :: Maybe ValuationType
value_=Maybe ValuationType
forall a. Maybe a
Nothing, percent_ :: Bool
percent_=Bool
False} Query
startbalq Journal
j'
            where
              ropts' :: ReportOpts
ropts' | ReportOpts -> Bool
tree_ ReportOpts
ropts = ReportOpts
ropts{no_elide_ :: Bool
no_elide_=Bool
True}
                     | Bool
otherwise   = ReportOpts
ropts{accountlistmode_ :: AccountListMode
accountlistmode_=AccountListMode
ALFlat}
              ropts'' :: ReportOpts
ropts'' = ReportOpts
ropts'{period_ :: Period
period_ = Period
precedingperiod}
                where
                  precedingperiod :: Period
precedingperiod = DateSpan -> Period
dateSpanAsPeriod (DateSpan -> Period) -> DateSpan -> Period
forall a b. (a -> b) -> a -> b
$ DateSpan -> DateSpan -> DateSpan
spanIntersect (Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing Maybe Day
mreportstart) (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ Period -> DateSpan
periodAsDateSpan Period
period_
              -- 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 = String -> Query -> Query
forall a. Show a => String -> a -> a
dbg'' "startbalq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [Query
datelessq, DateSpan -> Query
dateqcons DateSpan
precedingspan]
                where
                  precedingspan :: DateSpan
precedingspan = case Maybe Day
mreportstart of
                                  Just d :: Day
d  -> Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d)
                                  Nothing -> DateSpan
emptydatespan
      -- 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.
      startaccts :: [AccountName]
startaccts = String -> [AccountName] -> [AccountName]
forall a. Show a => String -> a -> a
dbg'' "startaccts" ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ ((AccountName, MixedAmount) -> AccountName)
-> [(AccountName, MixedAmount)] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName, MixedAmount) -> AccountName
forall a b. (a, b) -> a
fst [(AccountName, MixedAmount)]
startbals
      -- Helpers to look up an account's starting balance.
      startingBalanceFor :: AccountName -> MixedAmount
startingBalanceFor a :: AccountName
a = MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe MixedAmount
nullmixedamt (Maybe MixedAmount -> MixedAmount)
-> Maybe MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ AccountName -> [(AccountName, MixedAmount)] -> Maybe MixedAmount
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup AccountName
a [(AccountName, MixedAmount)]
startbals

      ----------------------------------------------------------------------
      -- 3. Gather postings for each column.

      -- Postings matching the query within the report period.
      [(Posting, Day)]
ps :: [(Posting, Day)] =
          String -> [(Posting, Day)] -> [(Posting, Day)]
forall a. Show a => String -> a -> a
dbg'' "ps" ([(Posting, Day)] -> [(Posting, Day)])
-> [(Posting, Day)] -> [(Posting, Day)]
forall a b. (a -> b) -> a -> b
$
          (Posting -> (Posting, Day)) -> [Posting] -> [(Posting, Day)]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> (Posting, Day)
postingWithDate ([Posting] -> [(Posting, Day)]) -> [Posting] -> [(Posting, Day)]
forall a b. (a -> b) -> a -> b
$
          Journal -> [Posting]
journalPostings (Journal -> [Posting]) -> Journal -> [Posting]
forall a b. (a -> b) -> a -> b
$
          Query -> Journal -> Journal
filterJournalAmounts Query
symq (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$      -- remove amount parts excluded by cur:
          Query -> Journal -> Journal
filterJournalPostings Query
reportq (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$  -- remove postings not matched by (adjusted) query
          Journal
j'
        where
          postingWithDate :: Posting -> (Posting, Day)
postingWithDate p :: Posting
p = case ReportOpts -> WhichDate
whichDateFromOpts ReportOpts
ropts of
              PrimaryDate   -> (Posting
p, Posting -> Day
postingDate Posting
p)
              SecondaryDate -> (Posting
p, Posting -> Day
postingDate2 Posting
p)

      -- Group postings into their columns, with the column end dates.
      [([Posting], Maybe Day)]
colps :: [([Posting], Maybe Day)] =
          String -> [([Posting], Maybe Day)] -> [([Posting], Maybe Day)]
forall a. Show a => String -> a -> a
dbg'' "colps"
          [ ([Posting]
posts, Maybe Day
end) | (DateSpan _ end :: Maybe Day
end, posts :: [Posting]
posts) <- Map DateSpan [Posting] -> [(DateSpan, [Posting])]
forall k a. Map k a -> [(k, a)]
M.toList Map DateSpan [Posting]
colMap ]
        where
          colMap :: Map DateSpan [Posting]
colMap = ((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
          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 []

      ----------------------------------------------------------------------
      -- 4. Calculate account balance changes in each column.

      -- In each column, gather the accounts that have postings and their change amount.
      acctChangesFromPostings :: [Posting] -> [(ClippedAccountName, MixedAmount)]
      acctChangesFromPostings :: [Posting] -> [(AccountName, MixedAmount)]
acctChangesFromPostings ps :: [Posting]
ps = [(Account -> AccountName
aname Account
a, (if ReportOpts -> Bool
tree_ ReportOpts
ropts then Account -> MixedAmount
aibalance else Account -> MixedAmount
aebalance) Account
a) | Account
a <- [Account]
as]
          where
            as :: [Account]
as = [Account] -> [Account]
depthLimit ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$
                 (if ReportOpts -> Bool
tree_ ReportOpts
ropts then [Account] -> [Account]
forall a. a -> a
id else (Account -> Bool) -> [Account] -> [Account]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>0)(Int -> Bool) -> (Account -> Int) -> Account -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Account -> Int
anumpostings)) ([Account] -> [Account]) -> [Account] -> [Account]
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
$ [Posting] -> [Account]
accountsFromPostings [Posting]
ps
            depthLimit :: [Account] -> [Account]
depthLimit
                | ReportOpts -> Bool
tree_ ReportOpts
ropts = (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
                | Bool
otherwise   = Int -> [Account] -> [Account]
clipAccountsAndAggregate Int
depth -- aggregate deeper balances at the depth limit
      [[(AccountName, MixedAmount)]]
colacctchanges :: [[(ClippedAccountName, MixedAmount)]] =
          String
-> [[(AccountName, MixedAmount)]] -> [[(AccountName, MixedAmount)]]
forall a. Show a => String -> a -> a
dbg'' "colacctchanges" ([[(AccountName, MixedAmount)]] -> [[(AccountName, MixedAmount)]])
-> [[(AccountName, MixedAmount)]] -> [[(AccountName, MixedAmount)]]
forall a b. (a -> b) -> a -> b
$ (([Posting], Maybe Day) -> [(AccountName, MixedAmount)])
-> [([Posting], Maybe Day)] -> [[(AccountName, MixedAmount)]]
forall a b. (a -> b) -> [a] -> [b]
map ([Posting] -> [(AccountName, MixedAmount)]
acctChangesFromPostings ([Posting] -> [(AccountName, MixedAmount)])
-> (([Posting], Maybe Day) -> [Posting])
-> ([Posting], Maybe Day)
-> [(AccountName, MixedAmount)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Posting], Maybe Day) -> [Posting]
forall a b. (a, b) -> a
fst) [([Posting], Maybe Day)]
colps

      ----------------------------------------------------------------------
      -- 5. Gather the account balance changes into a regular matrix including the accounts
      -- from all columns (and with -H, accounts with starting balances), adding zeroes where needed.

      -- All account names that will be displayed, possibly depth-clipped.
      [AccountName]
displayaccts :: [ClippedAccountName] =
          String -> [AccountName] -> [AccountName]
forall a. Show a => String -> a -> a
dbg'' "displayaccts" ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$
          (if ReportOpts -> Bool
tree_ ReportOpts
ropts then [AccountName] -> [AccountName]
expandAccountNames else [AccountName] -> [AccountName]
forall a. a -> a
id) ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$
          [AccountName] -> [AccountName]
forall a. Eq a => [a] -> [a]
nub ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ (AccountName -> AccountName) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> AccountName -> AccountName
clipOrEllipsifyAccountName Int
depth) ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$
          if Bool
empty_ Bool -> Bool -> Bool
|| BalanceType
balancetype_ BalanceType -> BalanceType -> Bool
forall a. Eq a => a -> a -> Bool
== BalanceType
HistoricalBalance
          then [AccountName] -> [AccountName]
forall a. Ord a => [a] -> [a]
nubSort ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ [AccountName]
startaccts [AccountName] -> [AccountName] -> [AccountName]
forall a. [a] -> [a] -> [a]
++ [AccountName]
allpostedaccts
          else [AccountName]
allpostedaccts
        where
          [AccountName]
allpostedaccts :: [AccountName] =
            String -> [AccountName] -> [AccountName]
forall a. Show a => String -> a -> a
dbg'' "allpostedaccts" ([AccountName] -> [AccountName])
-> ([Posting] -> [AccountName]) -> [Posting] -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AccountName] -> [AccountName]
forall a. Ord a => [a] -> [a]
sort ([AccountName] -> [AccountName])
-> ([Posting] -> [AccountName]) -> [Posting] -> [AccountName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Posting] -> [AccountName]
accountNamesFromPostings ([Posting] -> [AccountName]) -> [Posting] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ ((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)]
ps
      -- Each column's balance changes for each account, adding zeroes where needed.
      [[(AccountName, MixedAmount)]]
colallacctchanges :: [[(ClippedAccountName, MixedAmount)]] =
          String
-> [[(AccountName, MixedAmount)]] -> [[(AccountName, MixedAmount)]]
forall a. Show a => String -> a -> a
dbg'' "colallacctchanges"
          [ ((AccountName, MixedAmount) -> AccountName)
-> [(AccountName, MixedAmount)] -> [(AccountName, MixedAmount)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (AccountName, MixedAmount) -> AccountName
forall a b. (a, b) -> a
fst ([(AccountName, MixedAmount)] -> [(AccountName, MixedAmount)])
-> [(AccountName, MixedAmount)] -> [(AccountName, MixedAmount)]
forall a b. (a -> b) -> a -> b
$ ((AccountName, MixedAmount) -> (AccountName, MixedAmount) -> Bool)
-> [(AccountName, MixedAmount)]
-> [(AccountName, MixedAmount)]
-> [(AccountName, MixedAmount)]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
unionBy (\(a :: AccountName
a,_) (a' :: AccountName
a',_) -> AccountName
a AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== AccountName
a') [(AccountName, MixedAmount)]
postedacctchanges [(AccountName, MixedAmount)]
zeroes
             | [(AccountName, MixedAmount)]
postedacctchanges <- [[(AccountName, MixedAmount)]]
colacctchanges ]
          where zeroes :: [(AccountName, MixedAmount)]
zeroes = [(AccountName
a, MixedAmount
nullmixedamt) | AccountName
a <- [AccountName]
displayaccts]
      -- Transpose to get each account's balance changes across all columns.
      [(AccountName, [MixedAmount])]
acctchanges :: [(ClippedAccountName, [MixedAmount])] =
          String
-> [(AccountName, [MixedAmount])] -> [(AccountName, [MixedAmount])]
forall a. Show a => String -> a -> a
dbg'' "acctchanges"
          [(AccountName
a, ((AccountName, MixedAmount) -> MixedAmount)
-> [(AccountName, MixedAmount)] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName, MixedAmount) -> MixedAmount
forall a b. (a, b) -> b
snd [(AccountName, MixedAmount)]
abs) | abs :: [(AccountName, MixedAmount)]
abs@((a :: AccountName
a,_):_) <- [[(AccountName, MixedAmount)]] -> [[(AccountName, MixedAmount)]]
forall a. [[a]] -> [[a]]
transpose [[(AccountName, MixedAmount)]]
colallacctchanges] -- never null, or used when null...

      ----------------------------------------------------------------------
      -- 6. Build the report rows.

      -- One row per account, with account name info, row amounts, row total and row average.
      [PeriodicReportRow AccountName MixedAmount]
rows :: [MultiBalanceReportRow] =
          String
-> [PeriodicReportRow AccountName MixedAmount]
-> [PeriodicReportRow AccountName MixedAmount]
forall a. Show a => String -> a -> a
dbg'' "rows" ([PeriodicReportRow AccountName MixedAmount]
 -> [PeriodicReportRow AccountName MixedAmount])
-> [PeriodicReportRow AccountName MixedAmount]
-> [PeriodicReportRow AccountName MixedAmount]
forall a b. (a -> b) -> a -> b
$
          [ AccountName
-> Int
-> [MixedAmount]
-> MixedAmount
-> MixedAmount
-> PeriodicReportRow AccountName MixedAmount
forall a b. a -> Int -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow AccountName
a (AccountName -> Int
accountNameLevel AccountName
a) [MixedAmount]
valuedrowbals MixedAmount
rowtot MixedAmount
rowavg
           | (a :: AccountName
a,changes :: [MixedAmount]
changes) <- String
-> [(AccountName, [MixedAmount])] -> [(AccountName, [MixedAmount])]
forall a. Show a => String -> a -> a
dbg'' "acctchanges" [(AccountName, [MixedAmount])]
acctchanges
             -- The row amounts to be displayed: per-period changes,
             -- zero-based cumulative totals, or
             -- starting-balance-based historical balances.
           , let rowbals :: [MixedAmount]
rowbals = String -> [MixedAmount] -> [MixedAmount]
forall a. Show a => String -> a -> a
dbg'' "rowbals" ([MixedAmount] -> [MixedAmount]) -> [MixedAmount] -> [MixedAmount]
forall a b. (a -> b) -> a -> b
$ case BalanceType
balancetype_ of
                   PeriodChange      -> [MixedAmount]
changes
                   CumulativeChange  -> Int -> [MixedAmount] -> [MixedAmount]
forall a. Int -> [a] -> [a]
drop 1 ([MixedAmount] -> [MixedAmount]) -> [MixedAmount] -> [MixedAmount]
forall a b. (a -> b) -> a -> b
$ (MixedAmount -> MixedAmount -> MixedAmount)
-> MixedAmount -> [MixedAmount] -> [MixedAmount]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl MixedAmount -> MixedAmount -> MixedAmount
forall a. Num a => a -> a -> a
(+) 0                      [MixedAmount]
changes
                   HistoricalBalance -> Int -> [MixedAmount] -> [MixedAmount]
forall a. Int -> [a] -> [a]
drop 1 ([MixedAmount] -> [MixedAmount]) -> [MixedAmount] -> [MixedAmount]
forall a b. (a -> b) -> a -> b
$ (MixedAmount -> MixedAmount -> MixedAmount)
-> MixedAmount -> [MixedAmount] -> [MixedAmount]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl MixedAmount -> MixedAmount -> MixedAmount
forall a. Num a => a -> a -> a
(+) (AccountName -> MixedAmount
startingBalanceFor AccountName
a) [MixedAmount]
changes
             -- We may be converting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
           , let valuedrowbals :: [MixedAmount]
valuedrowbals = String -> [MixedAmount] -> [MixedAmount]
forall a. Show a => String -> a -> a
dbg'' "valuedrowbals" ([MixedAmount] -> [MixedAmount]) -> [MixedAmount] -> [MixedAmount]
forall a b. (a -> b) -> a -> b
$ [Day -> MixedAmount -> MixedAmount
avalue Day
periodlastday MixedAmount
amt | (amt :: MixedAmount
amt,periodlastday :: Day
periodlastday) <- [MixedAmount] -> [Day] -> [(MixedAmount, Day)]
forall a b. [a] -> [b] -> [(a, b)]
zip [MixedAmount]
rowbals [Day]
lastdays]
             -- 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 zero.
           , let rowtot :: MixedAmount
rowtot = if BalanceType
balancetype_BalanceType -> BalanceType -> Bool
forall a. Eq a => a -> a -> Bool
==BalanceType
PeriodChange then [MixedAmount] -> MixedAmount
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [MixedAmount]
valuedrowbals else 0
           , let rowavg :: MixedAmount
rowavg = [MixedAmount] -> MixedAmount
averageMixedAmounts [MixedAmount]
valuedrowbals
           , Bool
empty_ Bool -> Bool -> Bool
|| Int
depth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
|| (MixedAmount -> Bool) -> [MixedAmount] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (MixedAmount -> Bool) -> MixedAmount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> Bool
mixedAmountLooksZero) [MixedAmount]
valuedrowbals
           ]
        where
          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
value_
            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 (String -> Day
forall a. String -> a
error' "multiBalanceReport: could not pick a valuation date, ReportOpts today_ is unset") Maybe Day
today_  -- XXX shouldn't happen
              multiperiod :: Bool
multiperiod = Interval
interval_ Interval -> Interval -> Bool
forall a. Eq a => a -> a -> Bool
/= Interval
NoInterval
          -- The last day of each column's subperiod.
          lastdays :: [Day]
lastdays =
            (DateSpan -> Day) -> [DateSpan] -> [Day]
forall a b. (a -> b) -> [a] -> [b]
map ((Day -> (Day -> Day) -> Maybe Day -> Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                  (String -> Day
forall a. String -> a
error' "multiBalanceReport: expected all spans to have an end date")  -- XXX should not happen
                  (Integer -> Day -> Day
addDays (-1)))
                (Maybe Day -> Day) -> (DateSpan -> Maybe Day) -> DateSpan -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateSpan -> Maybe Day
spanEnd) [DateSpan]
colspans

      ----------------------------------------------------------------------
      -- 7. Sort the report rows.

      -- Sort the rows by amount or by account declaration order. This is a bit tricky.
      -- TODO: is it always ok to sort report rows after report has been generated, as a separate step ?
      [PeriodicReportRow AccountName MixedAmount]
sortedrows :: [MultiBalanceReportRow] =
        String
-> [PeriodicReportRow AccountName MixedAmount]
-> [PeriodicReportRow AccountName MixedAmount]
forall a. Show a => String -> a -> a
dbg' "sortedrows" ([PeriodicReportRow AccountName MixedAmount]
 -> [PeriodicReportRow AccountName MixedAmount])
-> [PeriodicReportRow AccountName MixedAmount]
-> [PeriodicReportRow AccountName MixedAmount]
forall a b. (a -> b) -> a -> b
$
        [PeriodicReportRow AccountName MixedAmount]
-> [PeriodicReportRow AccountName MixedAmount]
sortrows [PeriodicReportRow AccountName MixedAmount]
rows
        where
          sortrows :: [PeriodicReportRow AccountName MixedAmount]
-> [PeriodicReportRow AccountName MixedAmount]
sortrows
            | Bool
sort_amount_ Bool -> Bool -> Bool
&& AccountListMode
accountlistmode_ AccountListMode -> AccountListMode -> Bool
forall a. Eq a => a -> a -> Bool
== AccountListMode
ALTree = [PeriodicReportRow AccountName MixedAmount]
-> [PeriodicReportRow AccountName MixedAmount]
sortTreeMBRByAmount
            | Bool
sort_amount_                               = [PeriodicReportRow AccountName MixedAmount]
-> [PeriodicReportRow AccountName MixedAmount]
forall a.
[PeriodicReportRow a MixedAmount]
-> [PeriodicReportRow a MixedAmount]
sortFlatMBRByAmount
            | Bool
otherwise                                  = [PeriodicReportRow AccountName MixedAmount]
-> [PeriodicReportRow AccountName MixedAmount]
forall b.
[PeriodicReportRow AccountName b]
-> [PeriodicReportRow AccountName b]
sortMBRByAccountDeclaration
            where
              -- Sort the report rows, representing a tree of accounts, by row total at each level.
              -- Similar to sortMBRByAccountDeclaration/sortAccountNamesByDeclaration.
              sortTreeMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow]
              sortTreeMBRByAmount :: [PeriodicReportRow AccountName MixedAmount]
-> [PeriodicReportRow AccountName MixedAmount]
sortTreeMBRByAmount rows :: [PeriodicReportRow AccountName MixedAmount]
rows = [PeriodicReportRow AccountName MixedAmount]
sortedrows
                where
                  anamesandrows :: [(AccountName, PeriodicReportRow AccountName MixedAmount)]
anamesandrows = [(PeriodicReportRow AccountName MixedAmount -> AccountName
forall a b. PeriodicReportRow a b -> a
prrName PeriodicReportRow AccountName MixedAmount
r, PeriodicReportRow AccountName MixedAmount
r) | PeriodicReportRow AccountName MixedAmount
r <- [PeriodicReportRow AccountName MixedAmount]
rows]
                  anames :: [AccountName]
anames = ((AccountName, PeriodicReportRow AccountName MixedAmount)
 -> AccountName)
-> [(AccountName, PeriodicReportRow AccountName MixedAmount)]
-> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName, PeriodicReportRow AccountName MixedAmount)
-> AccountName
forall a b. (a, b) -> a
fst [(AccountName, PeriodicReportRow AccountName MixedAmount)]
anamesandrows
                  atotals :: [(AccountName, MixedAmount)]
atotals = [(PeriodicReportRow AccountName MixedAmount -> AccountName
forall a b. PeriodicReportRow a b -> a
prrName PeriodicReportRow AccountName MixedAmount
r, PeriodicReportRow AccountName MixedAmount -> MixedAmount
forall a b. PeriodicReportRow a b -> b
prrTotal PeriodicReportRow AccountName MixedAmount
r) | PeriodicReportRow AccountName MixedAmount
r <- [PeriodicReportRow AccountName MixedAmount]
rows]
                  accounttree :: Account
accounttree = AccountName -> [AccountName] -> Account
accountTree "root" [AccountName]
anames
                  accounttreewithbals :: Account
accounttreewithbals = (Account -> Account) -> Account -> Account
mapAccounts Account -> Account
setibalance Account
accounttree
                    where
                      -- should not happen, but it's dangerous; TODO
                      setibalance :: Account -> Account
setibalance a :: Account
a = Account
a{aibalance :: MixedAmount
aibalance=MixedAmount -> Maybe MixedAmount -> MixedAmount
forall a. a -> Maybe a -> a
fromMaybe (String -> MixedAmount
forall a. HasCallStack => String -> a
error "sortTreeMBRByAmount 1") (Maybe MixedAmount -> MixedAmount)
-> Maybe MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ AccountName -> [(AccountName, MixedAmount)] -> Maybe MixedAmount
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Account -> AccountName
aname Account
a) [(AccountName, MixedAmount)]
atotals}
                  sortedaccounttree :: Account
sortedaccounttree = NormalSign -> Account -> Account
sortAccountTreeByAmount (NormalSign -> Maybe NormalSign -> NormalSign
forall a. a -> Maybe a -> a
fromMaybe NormalSign
NormallyPositive Maybe NormalSign
normalbalance_) 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
                  sortedrows :: [PeriodicReportRow AccountName MixedAmount]
sortedrows = [AccountName]
-> [(AccountName, PeriodicReportRow AccountName MixedAmount)]
-> [PeriodicReportRow AccountName MixedAmount]
forall b. [AccountName] -> [(AccountName, b)] -> [b]
sortAccountItemsLike [AccountName]
sortedanames [(AccountName, PeriodicReportRow AccountName MixedAmount)]
anamesandrows

              -- Sort the report rows, representing a flat account list, by row total.
              sortFlatMBRByAmount :: [PeriodicReportRow a MixedAmount]
-> [PeriodicReportRow a MixedAmount]
sortFlatMBRByAmount = (PeriodicReportRow a MixedAmount
 -> PeriodicReportRow a MixedAmount -> Ordering)
-> [PeriodicReportRow a MixedAmount]
-> [PeriodicReportRow a MixedAmount]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((PeriodicReportRow a MixedAmount
 -> PeriodicReportRow a MixedAmount -> Ordering)
-> PeriodicReportRow a MixedAmount
-> PeriodicReportRow a MixedAmount
-> Ordering
forall a c. (a -> a -> c) -> a -> a -> c
maybeflip ((PeriodicReportRow a MixedAmount
  -> PeriodicReportRow a MixedAmount -> Ordering)
 -> PeriodicReportRow a MixedAmount
 -> PeriodicReportRow a MixedAmount
 -> Ordering)
-> (PeriodicReportRow a MixedAmount
    -> PeriodicReportRow a MixedAmount -> Ordering)
-> PeriodicReportRow a MixedAmount
-> PeriodicReportRow a MixedAmount
-> Ordering
forall a b. (a -> b) -> a -> b
$ (PeriodicReportRow a MixedAmount -> MixedAmount)
-> PeriodicReportRow a MixedAmount
-> PeriodicReportRow a MixedAmount
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (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))
                where
                  maybeflip :: (a -> a -> c) -> a -> a -> c
maybeflip = if Maybe NormalSign
normalbalance_ Maybe NormalSign -> Maybe NormalSign -> Bool
forall a. Eq a => a -> a -> Bool
== NormalSign -> Maybe NormalSign
forall a. a -> Maybe a
Just NormalSign
NormallyNegative then (a -> a -> c) -> a -> a -> c
forall a. a -> a
id else (a -> a -> c) -> a -> a -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip

              -- Sort the report rows by account declaration order then account name.
              sortMBRByAccountDeclaration :: [PeriodicReportRow AccountName b]
-> [PeriodicReportRow AccountName b]
sortMBRByAccountDeclaration rows :: [PeriodicReportRow AccountName b]
rows = [PeriodicReportRow AccountName b]
sortedrows
                where
                  anamesandrows :: [(AccountName, PeriodicReportRow AccountName b)]
anamesandrows = [(PeriodicReportRow AccountName b -> AccountName
forall a b. PeriodicReportRow a b -> a
prrName PeriodicReportRow AccountName b
r, PeriodicReportRow AccountName b
r) | PeriodicReportRow AccountName b
r <- [PeriodicReportRow AccountName b]
rows]
                  anames :: [AccountName]
anames = ((AccountName, PeriodicReportRow AccountName b) -> AccountName)
-> [(AccountName, PeriodicReportRow AccountName b)]
-> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName, PeriodicReportRow AccountName b) -> AccountName
forall a b. (a, b) -> a
fst [(AccountName, PeriodicReportRow AccountName b)]
anamesandrows
                  sortedanames :: [AccountName]
sortedanames = Journal -> Bool -> [AccountName] -> [AccountName]
sortAccountNamesByDeclaration Journal
j (ReportOpts -> Bool
tree_ ReportOpts
ropts) [AccountName]
anames
                  sortedrows :: [PeriodicReportRow AccountName b]
sortedrows = [AccountName]
-> [(AccountName, PeriodicReportRow AccountName b)]
-> [PeriodicReportRow AccountName b]
forall b. [AccountName] -> [(AccountName, b)] -> [b]
sortAccountItemsLike [AccountName]
sortedanames [(AccountName, PeriodicReportRow AccountName b)]
anamesandrows

      ----------------------------------------------------------------------
      -- 8. Build the report totals row.

      -- Calculate the column totals. These are always the sum of column amounts.
      highestlevelaccts :: [AccountName]
highestlevelaccts = [AccountName
a | AccountName
a <- [AccountName]
displayaccts, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (AccountName -> Bool) -> [AccountName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (AccountName -> [AccountName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AccountName]
displayaccts) ([AccountName] -> Bool) -> [AccountName] -> Bool
forall a b. (a -> b) -> a -> b
$ [AccountName] -> [AccountName]
forall a. [a] -> [a]
init ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ AccountName -> [AccountName]
expandAccountName AccountName
a]
      colamts :: [[MixedAmount]]
colamts = [[MixedAmount]] -> [[MixedAmount]]
forall a. [[a]] -> [[a]]
transpose ([[MixedAmount]] -> [[MixedAmount]])
-> ([PeriodicReportRow AccountName MixedAmount] -> [[MixedAmount]])
-> [PeriodicReportRow AccountName MixedAmount]
-> [[MixedAmount]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeriodicReportRow AccountName MixedAmount -> [MixedAmount])
-> [PeriodicReportRow AccountName MixedAmount] -> [[MixedAmount]]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow AccountName MixedAmount -> [MixedAmount]
forall a b. PeriodicReportRow a b -> [b]
prrAmounts ([PeriodicReportRow AccountName MixedAmount] -> [[MixedAmount]])
-> [PeriodicReportRow AccountName MixedAmount] -> [[MixedAmount]]
forall a b. (a -> b) -> a -> b
$ (PeriodicReportRow AccountName MixedAmount -> Bool)
-> [PeriodicReportRow AccountName MixedAmount]
-> [PeriodicReportRow AccountName MixedAmount]
forall a. (a -> Bool) -> [a] -> [a]
filter PeriodicReportRow AccountName MixedAmount -> Bool
forall b. PeriodicReportRow AccountName b -> Bool
isHighest [PeriodicReportRow AccountName MixedAmount]
rows
        where isHighest :: PeriodicReportRow AccountName b -> Bool
isHighest row :: PeriodicReportRow AccountName b
row = Bool -> Bool
not (ReportOpts -> Bool
tree_ ReportOpts
ropts) Bool -> Bool -> Bool
|| PeriodicReportRow AccountName b -> AccountName
forall a b. PeriodicReportRow a b -> a
prrName PeriodicReportRow AccountName b
row AccountName -> [AccountName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AccountName]
highestlevelaccts
      [MixedAmount]
coltotals :: [MixedAmount] =
        String -> [MixedAmount] -> [MixedAmount]
forall a. Show a => String -> 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.
      [grandtotal :: MixedAmount
grandtotal,grandaverage :: MixedAmount
grandaverage] =
        let amts :: [MixedAmount]
amts = (([MixedAmount] -> MixedAmount) -> MixedAmount)
-> [[MixedAmount] -> MixedAmount] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (([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)
              [if BalanceType
balancetype_BalanceType -> BalanceType -> Bool
forall a. Eq a => a -> a -> Bool
==BalanceType
PeriodChange then [MixedAmount] -> MixedAmount
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum else MixedAmount -> [MixedAmount] -> MixedAmount
forall a b. a -> b -> a
const 0
              ,[MixedAmount] -> MixedAmount
averageMixedAmounts
              ]
        in [MixedAmount]
amts
      -- Totals row.
      PeriodicReportRow () MixedAmount
totalsrow :: PeriodicReportRow () MixedAmount =
        String
-> PeriodicReportRow () MixedAmount
-> PeriodicReportRow () MixedAmount
forall a. Show a => String -> a -> a
dbg' "totalsrow" (PeriodicReportRow () MixedAmount
 -> PeriodicReportRow () MixedAmount)
-> PeriodicReportRow () MixedAmount
-> PeriodicReportRow () MixedAmount
forall a b. (a -> b) -> a -> b
$ ()
-> Int
-> [MixedAmount]
-> MixedAmount
-> MixedAmount
-> PeriodicReportRow () MixedAmount
forall a b. a -> Int -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow () 0 [MixedAmount]
coltotals MixedAmount
grandtotal MixedAmount
grandaverage

      ----------------------------------------------------------------------
      -- 9. Map the report rows to percentages if needed
      -- It is not correct to do this before step 6 due to the total and average columns.
      -- This is not done in step 6, since the report totals are calculated in 8.
      -- Perform the divisions to obtain percentages
      [PeriodicReportRow AccountName MixedAmount]
mappedsortedrows :: [MultiBalanceReportRow] =
        if Bool -> Bool
not Bool
percent_ then [PeriodicReportRow AccountName MixedAmount]
sortedrows
        else String
-> [PeriodicReportRow AccountName MixedAmount]
-> [PeriodicReportRow AccountName MixedAmount]
forall a. Show a => String -> a -> a
dbg'' "mappedsortedrows"
          [ AccountName
-> Int
-> [MixedAmount]
-> MixedAmount
-> MixedAmount
-> PeriodicReportRow AccountName MixedAmount
forall a b. a -> Int -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow AccountName
aname Int
alevel
              ((MixedAmount -> MixedAmount -> MixedAmount)
-> [MixedAmount] -> [MixedAmount] -> [MixedAmount]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith MixedAmount -> MixedAmount -> MixedAmount
perdivide [MixedAmount]
rowvals [MixedAmount]
coltotals)
              (MixedAmount
rowtotal MixedAmount -> MixedAmount -> MixedAmount
`perdivide` MixedAmount
grandtotal)
              (MixedAmount
rowavg MixedAmount -> MixedAmount -> MixedAmount
`perdivide` MixedAmount
grandaverage)
           | PeriodicReportRow aname :: AccountName
aname alevel :: Int
alevel rowvals :: [MixedAmount]
rowvals rowtotal :: MixedAmount
rowtotal rowavg :: MixedAmount
rowavg <- [PeriodicReportRow AccountName MixedAmount]
sortedrows
          ]
      PeriodicReportRow () MixedAmount
mappedtotalsrow :: PeriodicReportRow () MixedAmount
        | Bool
percent_  = String
-> PeriodicReportRow () MixedAmount
-> PeriodicReportRow () MixedAmount
forall a. Show a => String -> a -> a
dbg'' "mappedtotalsrow" (PeriodicReportRow () MixedAmount
 -> PeriodicReportRow () MixedAmount)
-> PeriodicReportRow () MixedAmount
-> PeriodicReportRow () MixedAmount
forall a b. (a -> b) -> a -> b
$ ()
-> Int
-> [MixedAmount]
-> MixedAmount
-> MixedAmount
-> PeriodicReportRow () MixedAmount
forall a b. a -> Int -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow () 0
             ((MixedAmount -> MixedAmount) -> [MixedAmount] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (\t :: MixedAmount
t -> MixedAmount -> MixedAmount -> MixedAmount
perdivide MixedAmount
t MixedAmount
t) [MixedAmount]
coltotals)
             (MixedAmount -> MixedAmount -> MixedAmount
perdivide MixedAmount
grandtotal MixedAmount
grandtotal)
             (MixedAmount -> MixedAmount -> MixedAmount
perdivide MixedAmount
grandaverage MixedAmount
grandaverage)
        | Bool
otherwise = PeriodicReportRow () MixedAmount
totalsrow

-- | Generates a simple non-columnar BalanceReport, but using multiBalanceReport,
-- in order to support --historical. Does not support tree-mode boring parent eliding.
-- If the normalbalance_ option is set, it adjusts the sorting and sign of amounts
-- (see ReportOpts and CompoundBalanceCommand).
balanceReportFromMultiBalanceReport :: ReportOpts -> Query -> Journal -> BalanceReport
balanceReportFromMultiBalanceReport :: ReportOpts
-> Query
-> Journal
-> ([(AccountName, AccountName, Int, MixedAmount)], MixedAmount)
balanceReportFromMultiBalanceReport opts :: ReportOpts
opts q :: Query
q j :: Journal
j = ([(AccountName, AccountName, Int, MixedAmount)]
rows', MixedAmount
total)
  where
    PeriodicReport _ rows :: [PeriodicReportRow AccountName MixedAmount]
rows (PeriodicReportRow _ _ totals :: [MixedAmount]
totals _ _) =
      ReportOpts -> Query -> Journal -> PriceOracle -> MultiBalanceReport
multiBalanceReportWith ReportOpts
opts Query
q Journal
j (Bool -> Journal -> PriceOracle
journalPriceOracle (ReportOpts -> Bool
infer_value_ ReportOpts
opts) Journal
j)
    rows' :: [(AccountName, AccountName, Int, MixedAmount)]
rows' = [( AccountName
a
             , if ReportOpts -> Bool
flat_ ReportOpts
opts then AccountName
a else AccountName -> AccountName
accountLeafName AccountName
a   -- BalanceReport expects full account name here with --flat
             , if ReportOpts -> Bool
tree_ ReportOpts
opts then Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-1 else 0  -- BalanceReport uses 0-based account depths
             , MixedAmount -> [MixedAmount] -> MixedAmount
forall a. a -> [a] -> a
headDef MixedAmount
nullmixedamt [MixedAmount]
amts     -- 0 columns is illegal, should not happen, return zeroes if it does
             ) | PeriodicReportRow a :: AccountName
a d :: Int
d amts :: [MixedAmount]
amts _ _ <- [PeriodicReportRow AccountName MixedAmount]
rows]
    total :: MixedAmount
total = MixedAmount -> [MixedAmount] -> MixedAmount
forall a. a -> [a] -> a
headDef MixedAmount
nullmixedamt [MixedAmount]
totals


-- common rendering helper, XXX here for now

tableAsText :: ReportOpts -> (a -> String) -> Table String String a -> String
tableAsText :: ReportOpts -> (a -> String) -> Table String String a -> String
tableAsText (ReportOpts{pretty_tables_ :: ReportOpts -> Bool
pretty_tables_ = Bool
pretty}) showcell :: a -> String
showcell =
  [String] -> String
unlines
  ([String] -> String)
-> (Table String String a -> [String])
-> Table String String a
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [[a]] -> [[a]]
trimborder
  ([String] -> [String])
-> (Table String String a -> [String])
-> Table String String a
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
  (String -> [String])
-> (Table String String a -> String)
-> Table String String a
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> (String -> String)
-> (String -> String)
-> (a -> String)
-> Table String String a
-> String
forall rh ch a.
Bool
-> (rh -> String)
-> (ch -> String)
-> (a -> String)
-> Table rh ch a
-> String
render Bool
pretty String -> String
forall a. a -> a
id String -> String
forall a. a -> a
id a -> String
showcell
  (Table String String a -> String)
-> (Table String String a -> Table String String a)
-> Table String String a
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table String String a -> Table String String a
forall ch a. Table String ch a -> Table String 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 String ch a -> Table String ch a
align (Table l :: Header String
l t :: Header ch
t d :: [[a]]
d) = Header String -> Header ch -> [[a]] -> Table String ch a
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table Header String
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
$ (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
strWidth (Header String -> [String]
forall h. Header h -> [h]
headerContents Header String
l)
        l' :: Header String
l'         = Int -> String -> String
padRightWide Int
acctswidth (String -> String) -> Header String -> Header String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Header String
l

-- tests

tests_MultiBalanceReport :: TestTree
tests_MultiBalanceReport = String -> [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
-> Int
-> Maybe Char
-> Maybe DigitGroupStyle
-> AmountStyle
AmountStyle {ascommodityside :: Side
ascommodityside = Side
L, ascommodityspaced :: Bool
ascommodityspaced = Bool
False, asprecision :: Int
asprecision = 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)
-> ([PeriodicReportRow AccountName MixedAmount], MixedAmount)
-> IO ()
`gives` r :: ([PeriodicReportRow AccountName MixedAmount], MixedAmount)
r = do
      let (eitems :: [PeriodicReportRow AccountName MixedAmount]
eitems, etotal :: MixedAmount
etotal) = ([PeriodicReportRow AccountName MixedAmount], MixedAmount)
r
          (PeriodicReport _ aitems :: [PeriodicReportRow AccountName MixedAmount]
aitems atotal :: PeriodicReportRow () MixedAmount
atotal) = Day -> ReportOpts -> Journal -> MultiBalanceReport
multiBalanceReport Day
nulldate ReportOpts
opts Journal
journal
          showw :: PeriodicReportRow AccountName MixedAmount
-> (AccountName, AccountName, Int, [String], String, String)
showw (PeriodicReportRow acct :: AccountName
acct indent :: Int
indent lAmt :: [MixedAmount]
lAmt amt :: MixedAmount
amt amt' :: MixedAmount
amt')
              = (AccountName
acct, AccountName -> AccountName
accountLeafName AccountName
acct, Int
indent, (MixedAmount -> String) -> [MixedAmount] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map MixedAmount -> String
showMixedAmountDebug [MixedAmount]
lAmt, MixedAmount -> String
showMixedAmountDebug MixedAmount
amt, MixedAmount -> String
showMixedAmountDebug MixedAmount
amt')
      ((PeriodicReportRow AccountName MixedAmount
 -> (AccountName, AccountName, Int, [String], String, String))
-> [PeriodicReportRow AccountName MixedAmount]
-> [(AccountName, AccountName, Int, [String], String, String)]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow AccountName MixedAmount
-> (AccountName, AccountName, Int, [String], String, String)
showw [PeriodicReportRow AccountName MixedAmount]
aitems) [(AccountName, AccountName, Int, [String], String, String)]
-> [(AccountName, AccountName, Int, [String], String, String)]
-> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= ((PeriodicReportRow AccountName MixedAmount
 -> (AccountName, AccountName, Int, [String], String, String))
-> [PeriodicReportRow AccountName MixedAmount]
-> [(AccountName, AccountName, Int, [String], String, String)]
forall a b. (a -> b) -> [a] -> [b]
map PeriodicReportRow AccountName MixedAmount
-> (AccountName, AccountName, Int, [String], String, String)
showw [PeriodicReportRow AccountName MixedAmount]
eitems)
      MixedAmount -> String
showMixedAmountDebug (PeriodicReportRow () MixedAmount -> MixedAmount
forall a b. PeriodicReportRow a b -> b
prrTotal PeriodicReportRow () MixedAmount
atotal) String -> String -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= MixedAmount -> String
showMixedAmountDebug MixedAmount
etotal -- we only check the sum of the totals
  in
   String -> [TestTree] -> TestTree
tests "multiBalanceReport" [
      String -> IO () -> TestTree
test "null journal"  (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      (ReportOpts
defreportopts, Journal
nulljournal) (ReportOpts, Journal)
-> ([PeriodicReportRow AccountName MixedAmount], MixedAmount)
-> IO ()
`gives` ([], [Amount] -> MixedAmount
Mixed [Amount
nullamt])

     ,String -> 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)
-> ([PeriodicReportRow AccountName MixedAmount], MixedAmount)
-> IO ()
`gives`
       (
        [ AccountName
-> Int
-> [MixedAmount]
-> MixedAmount
-> MixedAmount
-> PeriodicReportRow AccountName MixedAmount
forall a b. a -> Int -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow "assets:bank:checking" 3 [String -> MixedAmount
mamountp' "$1.00"]  ([Amount] -> MixedAmount
Mixed [Amount
nullamt]) ([Amount] -> MixedAmount
Mixed [Amount
amt0 {aquantity :: Quantity
aquantity=1}])
        , AccountName
-> Int
-> [MixedAmount]
-> MixedAmount
-> MixedAmount
-> PeriodicReportRow AccountName MixedAmount
forall a b. a -> Int -> [b] -> b -> b -> PeriodicReportRow a b
PeriodicReportRow "income:salary"        2 [String -> MixedAmount
mamountp' "$-1.00"] ([Amount] -> MixedAmount
Mixed [Amount
nullamt]) ([Amount] -> MixedAmount
Mixed [Amount
amt0 {aquantity :: Quantity
aquantity=(-1)}])
        ],
        [Amount] -> MixedAmount
Mixed [Amount
nullamt])

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