{-|

Balance report, used by the balance command.

-}

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

module Hledger.Reports.BalanceReport (
  BalanceReport,
  BalanceReportItem,
  balanceReport,
  flatShowsExclusiveBalance,
  sortAccountItemsLike,
  unifyMixedAmount,
  perdivide,

  -- * Tests
  tests_BalanceReport
)
where

import Data.List
import Data.Ord
import Data.Maybe
import Data.Time.Calendar

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


-- | A simple balance report. It has:
--
-- 1. a list of items, one per account, each containing:
--
--   * the full account name
--
--   * the Ledger-style elided short account name
--     (the leaf account name, prefixed by any boring parents immediately above);
--     or with --flat, the full account name again
--
--   * the number of indentation steps for rendering a Ledger-style account tree,
--     taking into account elided boring parents, --no-elide and --flat
--
--   * an amount
--
-- 2. the total of all amounts
--
type BalanceReport = ([BalanceReportItem], MixedAmount)
type BalanceReportItem = (AccountName, AccountName, Int, MixedAmount)

-- | When true (the default), this makes balance --flat reports and their implementation clearer.
-- Single/multi-col balance reports currently aren't all correct if this is false.
flatShowsExclusiveBalance :: Bool
flatShowsExclusiveBalance    = Bool
True

-- | Enabling this makes balance --flat --empty also show parent accounts without postings,
-- in addition to those with postings and a zero balance. Disabling it shows only the latter.
-- No longer supported, but leave this here for a bit.
-- flatShowsPostinglessAccounts = True

-- | Generate a simple balance report, containing the matched accounts and
-- their balances (change of balance) during the specified period.
-- This is like PeriodChangeReport with a single column (but more mature,
-- eg this can do hierarchical display).
balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport
balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport
balanceReport ropts :: ReportOpts
ropts@ReportOpts{..} q :: Query
q j :: Journal
j@Journal{..} =
  (if Bool
invert_ then BalanceReport -> BalanceReport
brNegate  else BalanceReport -> BalanceReport
forall a. a -> a
id) (BalanceReport -> BalanceReport) -> BalanceReport -> BalanceReport
forall a b. (a -> b) -> a -> b
$
  ([(Text, Text, Int, MixedAmount)]
mappedsorteditems, MixedAmount
mappedtotal)
    where
      -- dbg1 = const id -- exclude from debug output
      dbg1 :: String -> a -> a
dbg1 s :: String
s = let p :: String
p = "balanceReport" in String -> a -> a
forall a. Show a => String -> a -> a
Hledger.Utils.dbg1 (String
pString -> String -> String
forall a. [a] -> [a] -> [a]
++" "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
s)  -- add prefix in debug output

      -- Get all the summed accounts & balances, according to the query, as an account tree.
      -- If doing cost valuation, amounts will be converted to cost first.
      accttree :: Account
accttree = Ledger -> Account
ledgerRootAccount (Ledger -> Account) -> Ledger -> Account
forall a b. (a -> b) -> a -> b
$ Query -> Journal -> Ledger
ledgerFromJournal Query
q (Journal -> Ledger) -> Journal -> Ledger
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Journal -> Journal
journalSelectingAmountFromOpts ReportOpts
ropts Journal
j

      -- For other kinds of valuation, convert the summed amounts to value,
      -- per hledger_options.m4.md "Effect of --value on reports".
      valuedaccttree :: Account
valuedaccttree = (Account -> Account) -> Account -> Account
mapAccounts Account -> Account
avalue Account
accttree
        where
          avalue :: Account -> Account
avalue a :: Account
a@Account{..} = Account
a{aebalance :: MixedAmount
aebalance=MixedAmount -> MixedAmount
bvalue MixedAmount
aebalance, aibalance :: MixedAmount
aibalance=MixedAmount -> MixedAmount
bvalue MixedAmount
aibalance}
            where
              bvalue :: MixedAmount -> MixedAmount
bvalue = (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 Text AmountStyle
-> Day
-> Maybe Day
-> Day
-> Bool
-> ValuationType
-> MixedAmount
-> MixedAmount
mixedAmountApplyValuation (Journal -> PriceOracle
journalPriceOracle Journal
j) (Journal -> Map Text AmountStyle
journalCommodityStyles Journal
j) Day
periodlast Maybe Day
mreportlast Day
today Bool
multiperiod) Maybe ValuationType
value_
                where
                  periodlast :: Day
periodlast =
                    Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (String -> Day
forall a. String -> a
error' "balanceReport: expected a non-empty journal") (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ -- XXX shouldn't happen
                    ReportOpts -> Journal -> Maybe Day
reportPeriodOrJournalLastDay ReportOpts
ropts 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' "balanceReport: could not pick a valuation date, ReportOpts today_ is unset") Maybe Day
today_
                  multiperiod :: Bool
multiperiod = Interval
interval_ Interval -> Interval -> Bool
forall a. Eq a => a -> a -> Bool
/= Interval
NoInterval

      -- Modify this tree for display - depth limit, boring parents, zeroes - and convert to a list.
      [Account]
displayaccts :: [Account]
          | Query -> Int
queryDepth Query
q Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 =
                         String -> [Account] -> [Account]
forall a. Show a => String -> a -> a
dbg1 "displayaccts" ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$
                         Int -> [Account] -> [Account]
forall a. Int -> [a] -> [a]
take 1 ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$ Int -> [Account] -> [Account]
clipAccountsAndAggregate (Query -> Int
queryDepth Query
q) ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$ Account -> [Account]
flattenAccounts Account
valuedaccttree
          | ReportOpts -> Bool
flat_ ReportOpts
ropts = String -> [Account] -> [Account]
forall a. Show a => String -> a -> a
dbg1 "displayaccts" ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$
                         [Account] -> [Account]
filterzeros ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$
                         [Account] -> [Account]
filterempty ([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
$ Int -> [Account] -> [Account]
clipAccountsAndAggregate (Query -> Int
queryDepth Query
q) ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$ Account -> [Account]
flattenAccounts Account
valuedaccttree
          | Bool
otherwise  = String -> [Account] -> [Account]
forall a. Show a => String -> a -> a
dbg1 "displayaccts" ([Account] -> [Account]) -> [Account] -> [Account]
forall a b. (a -> b) -> a -> b
$
                         (Account -> Bool) -> [Account] -> [Account]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Account -> Bool) -> Account -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Account -> Bool
aboring) ([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
$ Account -> [Account]
flattenAccounts (Account -> [Account]) -> Account -> [Account]
forall a b. (a -> b) -> a -> b
$
                         Account -> Account
markboring (Account -> Account) -> Account -> Account
forall a b. (a -> b) -> a -> b
$
                         Account -> Account
prunezeros (Account -> Account) -> Account -> Account
forall a b. (a -> b) -> a -> b
$
                         NormalSign -> Account -> Account
sortAccountTreeByAmount (NormalSign -> Maybe NormalSign -> NormalSign
forall a. a -> Maybe a -> a
fromMaybe NormalSign
NormallyPositive Maybe NormalSign
normalbalance_) (Account -> Account) -> Account -> Account
forall a b. (a -> b) -> a -> b
$
                         Int -> Account -> Account
clipAccounts (Query -> Int
queryDepth Query
q) Account
valuedaccttree
          where
            balance :: Account -> MixedAmount
balance     = if ReportOpts -> Bool
flat_ ReportOpts
ropts then Account -> MixedAmount
aebalance else Account -> MixedAmount
aibalance
            filterzeros :: [Account] -> [Account]
filterzeros = if Bool
empty_ then [Account] -> [Account]
forall a. a -> a
id else (Account -> Bool) -> [Account] -> [Account]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Account -> Bool) -> Account -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> Bool
isZeroMixedAmount (MixedAmount -> Bool)
-> (Account -> MixedAmount) -> Account -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Account -> MixedAmount
balance)
            filterempty :: [Account] -> [Account]
filterempty = (Account -> Bool) -> [Account] -> [Account]
forall a. (a -> Bool) -> [a] -> [a]
filter (\a :: Account
a -> Account -> Int
anumpostings Account
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
|| Bool -> Bool
not (MixedAmount -> Bool
isZeroMixedAmount (Account -> MixedAmount
balance Account
a)))
            prunezeros :: Account -> Account
prunezeros  = if Bool
empty_ then Account -> Account
forall a. a -> a
id else Account -> Maybe Account -> Account
forall a. a -> Maybe a -> a
fromMaybe Account
nullacct (Maybe Account -> Account)
-> (Account -> Maybe Account) -> Account -> Account
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Account -> Bool) -> Account -> Maybe Account
pruneAccounts (MixedAmount -> Bool
isZeroMixedAmount (MixedAmount -> Bool)
-> (Account -> MixedAmount) -> Account -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Account -> MixedAmount
balance)
            markboring :: Account -> Account
markboring  = if Bool
no_elide_ then Account -> Account
forall a. a -> a
id else Account -> Account
markBoringParentAccounts

      -- Make a report row for each account.
      items :: [(Text, Text, Int, MixedAmount)]
items = String
-> [(Text, Text, Int, MixedAmount)]
-> [(Text, Text, Int, MixedAmount)]
forall a. Show a => String -> a -> a
dbg1 "items" ([(Text, Text, Int, MixedAmount)]
 -> [(Text, Text, Int, MixedAmount)])
-> [(Text, Text, Int, MixedAmount)]
-> [(Text, Text, Int, MixedAmount)]
forall a b. (a -> b) -> a -> b
$ (Account -> (Text, Text, Int, MixedAmount))
-> [Account] -> [(Text, Text, Int, MixedAmount)]
forall a b. (a -> b) -> [a] -> [b]
map (ReportOpts -> Query -> Account -> (Text, Text, Int, MixedAmount)
balanceReportItem ReportOpts
ropts Query
q) [Account]
displayaccts

      -- Sort report rows (except sorting by amount in tree mode, which was done above).
      sorteditems :: [(Text, Text, Int, MixedAmount)]
sorteditems
        | Bool
sort_amount_ Bool -> Bool -> Bool
&& ReportOpts -> Bool
tree_ ReportOpts
ropts = [(Text, Text, Int, MixedAmount)]
items
        | Bool
sort_amount_                = [(Text, Text, Int, MixedAmount)]
-> [(Text, Text, Int, MixedAmount)]
sortFlatBRByAmount [(Text, Text, Int, MixedAmount)]
items
        | Bool
otherwise                   = [(Text, Text, Int, MixedAmount)]
-> [(Text, Text, Int, MixedAmount)]
sortBRByAccountDeclaration [(Text, Text, Int, MixedAmount)]
items
        where
          -- Sort the report rows, representing a flat account list, by row total.
          sortFlatBRByAmount :: [BalanceReportItem] -> [BalanceReportItem]
          sortFlatBRByAmount :: [(Text, Text, Int, MixedAmount)]
-> [(Text, Text, Int, MixedAmount)]
sortFlatBRByAmount = ((Text, Text, Int, MixedAmount)
 -> (Text, Text, Int, MixedAmount) -> Ordering)
-> [(Text, Text, Int, MixedAmount)]
-> [(Text, Text, Int, MixedAmount)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Text, Text, Int, MixedAmount)
 -> (Text, Text, Int, MixedAmount) -> Ordering)
-> (Text, Text, Int, MixedAmount)
-> (Text, Text, Int, MixedAmount)
-> Ordering
forall a c. (a -> a -> c) -> a -> a -> c
maybeflip (((Text, Text, Int, MixedAmount)
  -> (Text, Text, Int, MixedAmount) -> Ordering)
 -> (Text, Text, Int, MixedAmount)
 -> (Text, Text, Int, MixedAmount)
 -> Ordering)
-> ((Text, Text, Int, MixedAmount)
    -> (Text, Text, Int, MixedAmount) -> Ordering)
-> (Text, Text, Int, MixedAmount)
-> (Text, Text, Int, MixedAmount)
-> Ordering
forall a b. (a -> b) -> a -> b
$ ((Text, Text, Int, MixedAmount) -> MixedAmount)
-> (Text, Text, Int, MixedAmount)
-> (Text, Text, Int, MixedAmount)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (MixedAmount -> MixedAmount
normaliseMixedAmountSquashPricesForDisplay (MixedAmount -> MixedAmount)
-> ((Text, Text, Int, MixedAmount) -> MixedAmount)
-> (Text, Text, Int, MixedAmount)
-> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text, Int, MixedAmount) -> MixedAmount
forall a b c d. (a, b, c, d) -> d
fourth4))
            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.
          sortBRByAccountDeclaration :: [BalanceReportItem] -> [BalanceReportItem]
          sortBRByAccountDeclaration :: [(Text, Text, Int, MixedAmount)]
-> [(Text, Text, Int, MixedAmount)]
sortBRByAccountDeclaration rows :: [(Text, Text, Int, MixedAmount)]
rows = [(Text, Text, Int, MixedAmount)]
sortedrows
            where
              anamesandrows :: [(Text, (Text, Text, Int, MixedAmount))]
anamesandrows = [((Text, Text, Int, MixedAmount) -> Text
forall a b c d. (a, b, c, d) -> a
first4 (Text, Text, Int, MixedAmount)
r, (Text, Text, Int, MixedAmount)
r) | (Text, Text, Int, MixedAmount)
r <- [(Text, Text, Int, MixedAmount)]
rows]
              anames :: [Text]
anames = ((Text, (Text, Text, Int, MixedAmount)) -> Text)
-> [(Text, (Text, Text, Int, MixedAmount))] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, (Text, Text, Int, MixedAmount)) -> Text
forall a b. (a, b) -> a
fst [(Text, (Text, Text, Int, MixedAmount))]
anamesandrows
              sortedanames :: [Text]
sortedanames = Journal -> Bool -> [Text] -> [Text]
sortAccountNamesByDeclaration Journal
j (ReportOpts -> Bool
tree_ ReportOpts
ropts) [Text]
anames
              sortedrows :: [(Text, Text, Int, MixedAmount)]
sortedrows = [Text]
-> [(Text, (Text, Text, Int, MixedAmount))]
-> [(Text, Text, Int, MixedAmount)]
forall b. [Text] -> [(Text, b)] -> [b]
sortAccountItemsLike [Text]
sortedanames [(Text, (Text, Text, Int, MixedAmount))]
anamesandrows

      -- Calculate the grand total.
      total :: MixedAmount
total | Bool -> Bool
not (ReportOpts -> Bool
flat_ ReportOpts
ropts) = String -> MixedAmount -> MixedAmount
forall a. Show a => String -> a -> a
dbg1 "total" (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ [MixedAmount] -> MixedAmount
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [MixedAmount
amt | (_,_,indent :: Int
indent,amt :: MixedAmount
amt) <- [(Text, Text, Int, MixedAmount)]
items, Int
indent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0]
            | Bool
otherwise         = String -> MixedAmount -> MixedAmount
forall a. Show a => String -> a -> a
dbg1 "total" (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$
                                  if Bool
flatShowsExclusiveBalance
                                  then [MixedAmount] -> MixedAmount
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([MixedAmount] -> MixedAmount) -> [MixedAmount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ ((Text, Text, Int, MixedAmount) -> MixedAmount)
-> [(Text, Text, Int, MixedAmount)] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text, Int, MixedAmount) -> MixedAmount
forall a b c d. (a, b, c, d) -> d
fourth4 [(Text, Text, Int, MixedAmount)]
items
                                  else [MixedAmount] -> MixedAmount
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([MixedAmount] -> MixedAmount) -> [MixedAmount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Account -> MixedAmount) -> [Account] -> [MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map Account -> MixedAmount
aebalance ([Account] -> [MixedAmount]) -> [Account] -> [MixedAmount]
forall a b. (a -> b) -> a -> b
$ Int -> [Account] -> [Account]
clipAccountsAndAggregate 1 [Account]
displayaccts
      
      -- Calculate percentages if needed.
      mappedtotal :: MixedAmount
mappedtotal | Bool
percent_  = String -> MixedAmount -> MixedAmount
forall a. Show a => String -> a -> a
dbg1 "mappedtotal" (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount
total MixedAmount -> MixedAmount -> MixedAmount
`perdivide` MixedAmount
total
                  | Bool
otherwise = MixedAmount
total
      mappedsorteditems :: [(Text, Text, Int, MixedAmount)]
mappedsorteditems | Bool
percent_ =
                            String
-> [(Text, Text, Int, MixedAmount)]
-> [(Text, Text, Int, MixedAmount)]
forall a. Show a => String -> a -> a
dbg1 "mappedsorteditems" ([(Text, Text, Int, MixedAmount)]
 -> [(Text, Text, Int, MixedAmount)])
-> [(Text, Text, Int, MixedAmount)]
-> [(Text, Text, Int, MixedAmount)]
forall a b. (a -> b) -> a -> b
$
                            ((Text, Text, Int, MixedAmount) -> (Text, Text, Int, MixedAmount))
-> [(Text, Text, Int, MixedAmount)]
-> [(Text, Text, Int, MixedAmount)]
forall a b. (a -> b) -> [a] -> [b]
map (\(fname :: Text
fname, sname :: Text
sname, indent :: Int
indent, amount :: MixedAmount
amount) -> (Text
fname, Text
sname, Int
indent, MixedAmount
amount MixedAmount -> MixedAmount -> MixedAmount
`perdivide` MixedAmount
total)) [(Text, Text, Int, MixedAmount)]
sorteditems
                        | Bool
otherwise = [(Text, Text, Int, MixedAmount)]
sorteditems

-- | 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.
sortAccountItemsLike :: [AccountName] -> [(AccountName, b)] -> [b]
sortAccountItemsLike :: [Text] -> [(Text, b)] -> [b]
sortAccountItemsLike sortedas :: [Text]
sortedas items :: [(Text, b)]
items =
  (Text -> [b]) -> [Text] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a :: Text
a -> [b] -> (b -> [b]) -> Maybe b -> [b]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (b -> [b] -> [b]
forall a. a -> [a] -> [a]
:[]) (Maybe b -> [b]) -> Maybe b -> [b]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
a [(Text, b)]
items) [Text]
sortedas

-- | In an account tree with zero-balance leaves removed, mark the
-- elidable parent accounts (those with one subaccount and no balance
-- of their own).
markBoringParentAccounts :: Account -> Account
markBoringParentAccounts :: Account -> Account
markBoringParentAccounts = Account -> Account
tieAccountParents (Account -> Account) -> (Account -> Account) -> Account -> Account
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Account -> Account) -> Account -> Account
mapAccounts Account -> Account
mark
  where
    mark :: Account -> Account
mark a :: Account
a | [Account] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Account -> [Account]
asubs Account
a) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
&& MixedAmount -> Bool
isZeroMixedAmount (Account -> MixedAmount
aebalance Account
a) = Account
a{aboring :: Bool
aboring=Bool
True}
           | Bool
otherwise = Account
a

balanceReportItem :: ReportOpts -> Query -> Account -> BalanceReportItem
balanceReportItem :: ReportOpts -> Query -> Account -> (Text, Text, Int, MixedAmount)
balanceReportItem opts :: ReportOpts
opts q :: Query
q a :: Account
a
  | ReportOpts -> Bool
flat_ ReportOpts
opts = (Text
name, Text
name,       0,      (if Bool
flatShowsExclusiveBalance then Account -> MixedAmount
aebalance else Account -> MixedAmount
aibalance) Account
a)
  | Bool
otherwise  = (Text
name, Text
elidedname, Int
indent, Account -> MixedAmount
aibalance Account
a)
  where
    name :: Text
name | Query -> Int
queryDepth Query
q Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Account -> Text
aname Account
a
         | Bool
otherwise        = "..."
    elidedname :: Text
elidedname = [Text] -> Text
accountNameFromComponents ([Text]
adjacentboringparentnames [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text -> Text
accountLeafName Text
name])
    adjacentboringparentnames :: [Text]
adjacentboringparentnames = [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Account -> Text) -> [Account] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
accountLeafName(Text -> Text) -> (Account -> Text) -> Account -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Account -> Text
aname) ([Account] -> [Text]) -> [Account] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Account -> Bool) -> [Account] -> [Account]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Account -> Bool
aboring [Account]
parents
    indent :: Int
indent = [Account] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Account] -> Int) -> [Account] -> Int
forall a b. (a -> b) -> a -> b
$ (Account -> Bool) -> [Account] -> [Account]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Account -> Bool) -> Account -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Account -> Bool
aboring) [Account]
parents
    -- parents exclude the tree's root node
    parents :: [Account]
parents = case Account -> [Account]
parentAccounts Account
a of [] -> []
                                       as :: [Account]
as -> [Account] -> [Account]
forall a. [a] -> [a]
init [Account]
as

-- -- the above using the newer multi balance report code:
-- balanceReport' opts q j = (items, total)
--   where
--     MultiBalanceReport (_,mbrrows,mbrtotals) = PeriodChangeReport opts q j
--     items = [(a,a',n, headDef 0 bs) | ((a,a',n), bs) <- mbrrows]
--     total = headDef 0 mbrtotals

-- | Flip the sign of all amounts in a BalanceReport.
brNegate :: BalanceReport -> BalanceReport
brNegate :: BalanceReport -> BalanceReport
brNegate (is :: [(Text, Text, Int, MixedAmount)]
is, tot :: MixedAmount
tot) = (((Text, Text, Int, MixedAmount) -> (Text, Text, Int, MixedAmount))
-> [(Text, Text, Int, MixedAmount)]
-> [(Text, Text, Int, MixedAmount)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text, Int, MixedAmount) -> (Text, Text, Int, MixedAmount)
forall d a b c. Num d => (a, b, c, d) -> (a, b, c, d)
brItemNegate [(Text, Text, Int, MixedAmount)]
is, -MixedAmount
tot)
  where
    brItemNegate :: (a, b, c, d) -> (a, b, c, d)
brItemNegate (a :: a
a, a' :: b
a', d :: c
d, amt :: d
amt) = (a
a, b
a', c
d, -d
amt)

-- | Helper to unify a MixedAmount to a single commodity value.
-- Like normaliseMixedAmount, this consolidates amounts of the same commodity
-- and discards zero amounts; but this one insists on simplifying to
-- a single commodity, and will throw a program-terminating error if
-- this is not possible.
unifyMixedAmount :: MixedAmount -> Amount
unifyMixedAmount :: MixedAmount -> Amount
unifyMixedAmount mixedAmount :: MixedAmount
mixedAmount = (Amount -> Amount -> Amount) -> Amount -> [Amount] -> Amount
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Amount -> Amount -> Amount
combine (Quantity -> Amount
num 0) (MixedAmount -> [Amount]
amounts MixedAmount
mixedAmount)
  where
    combine :: Amount -> Amount -> Amount
combine amount :: Amount
amount result :: Amount
result =
      if Amount -> Bool
isReallyZeroAmount Amount
amount
      then Amount
result
      else if Amount -> Bool
isReallyZeroAmount Amount
result
        then Amount
amount
        else if Amount -> Text
acommodity Amount
amount Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> Text
acommodity Amount
result
          then Amount
amount Amount -> Amount -> Amount
forall a. Num a => a -> a -> a
+ Amount
result
          else String -> Amount
forall a. String -> a
error' "Cannot calculate percentages for accounts with multiple commodities. (Hint: Try --cost, -V or similar flags.)"

-- | Helper to calculate the percentage from two mixed. Keeps the sign of the first argument.
-- Uses unifyMixedAmount to unify each argument and then divides them.
perdivide :: MixedAmount -> MixedAmount -> MixedAmount
perdivide :: MixedAmount -> MixedAmount -> MixedAmount
perdivide a :: MixedAmount
a b :: MixedAmount
b =
  let a' :: Amount
a' = MixedAmount -> Amount
unifyMixedAmount MixedAmount
a
      b' :: Amount
b' = MixedAmount -> Amount
unifyMixedAmount MixedAmount
b
  in if Amount -> Bool
isReallyZeroAmount Amount
a' Bool -> Bool -> Bool
|| Amount -> Bool
isReallyZeroAmount Amount
b' Bool -> Bool -> Bool
|| Amount -> Text
acommodity Amount
a' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> Text
acommodity Amount
b'
    then [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)]
    else String -> MixedAmount
forall a. String -> a
error' "Cannot calculate percentages if accounts have different commodities. (Hint: Try --cost, -V or similar flags.)"

-- tests

Right samplejournal2 :: Journal
samplejournal2 =
  Bool -> Journal -> Either String Journal
journalBalanceTransactions Bool
False
    Journal
nulljournal{
      jtxns :: [Transaction]
jtxns = [
        Transaction -> Transaction
txnTieKnot Transaction :: Year
-> Text
-> GenericSourcePos
-> Day
-> Maybe Day
-> Status
-> Text
-> Text
-> Text
-> [Tag]
-> [Posting]
-> Transaction
Transaction{
          tindex :: Year
tindex=0,
          tsourcepos :: GenericSourcePos
tsourcepos=GenericSourcePos
nullsourcepos,
          tdate :: Day
tdate=String -> Day
parsedate "2008/01/01",
          tdate2 :: Maybe Day
tdate2=Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ String -> Day
parsedate "2009/01/01",
          tstatus :: Status
tstatus=Status
Unmarked,
          tcode :: Text
tcode="",
          tdescription :: Text
tdescription="income",
          tcomment :: Text
tcomment="",
          ttags :: [Tag]
ttags=[],
          tpostings :: [Posting]
tpostings=
            [Posting
posting {paccount :: Text
paccount="assets:bank:checking", pamount :: MixedAmount
pamount=[Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd 1]}
            ,Posting
posting {paccount :: Text
paccount="income:salary", pamount :: MixedAmount
pamount=MixedAmount
missingmixedamt}
            ],
          tprecedingcomment :: Text
tprecedingcomment=""
        }
      ]
    }

tests_BalanceReport :: TestTree
tests_BalanceReport = String -> [TestTree] -> TestTree
tests "BalanceReport" [

  let
    (opts :: ReportOpts
opts,journal :: Journal
journal) gives :: (ReportOpts, Journal) -> BalanceReport -> IO ()
`gives` r :: BalanceReport
r = do
      let (eitems :: [(Text, Text, Int, MixedAmount)]
eitems, etotal :: MixedAmount
etotal) = BalanceReport
r
          (aitems :: [(Text, Text, Int, MixedAmount)]
aitems, atotal :: MixedAmount
atotal) = ReportOpts -> Query -> Journal -> BalanceReport
balanceReport ReportOpts
opts (Day -> ReportOpts -> Query
queryFromOpts Day
nulldate ReportOpts
opts) Journal
journal
          showw :: (a, b, c, MixedAmount) -> (a, b, c, String)
showw (acct :: a
acct,acct' :: b
acct',indent :: c
indent,amt :: MixedAmount
amt) = (a
acct, b
acct', c
indent, MixedAmount -> String
showMixedAmountDebug MixedAmount
amt)
      (((Text, Text, Int, MixedAmount) -> (Text, Text, Int, String))
-> [(Text, Text, Int, MixedAmount)] -> [(Text, Text, Int, String)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text, Int, MixedAmount) -> (Text, Text, Int, String)
forall a b c. (a, b, c, MixedAmount) -> (a, b, c, String)
showw [(Text, Text, Int, MixedAmount)]
eitems) [(Text, Text, Int, String)] -> [(Text, Text, Int, String)] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (((Text, Text, Int, MixedAmount) -> (Text, Text, Int, String))
-> [(Text, Text, Int, MixedAmount)] -> [(Text, Text, Int, String)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text, Int, MixedAmount) -> (Text, Text, Int, String)
forall a b c. (a, b, c, MixedAmount) -> (a, b, c, String)
showw [(Text, Text, Int, MixedAmount)]
aitems)
      (MixedAmount -> String
showMixedAmountDebug MixedAmount
etotal) String -> String -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= (MixedAmount -> String
showMixedAmountDebug MixedAmount
atotal)
  in
    String -> [TestTree] -> TestTree
tests "balanceReport" [

     String -> IO () -> TestTree
test "no args, null journal" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
     (ReportOpts
defreportopts, Journal
nulljournal) (ReportOpts, Journal) -> BalanceReport -> IO ()
`gives` ([], [Amount] -> MixedAmount
Mixed [Amount
nullamt])

    ,String -> IO () -> TestTree
test "no args, sample journal" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
     (ReportOpts
defreportopts, Journal
samplejournal) (ReportOpts, Journal) -> BalanceReport -> IO ()
`gives`
      ([
        ("assets","assets",0, String -> MixedAmount
mamountp' "$0.00")
       ,("assets:bank","bank",1, String -> MixedAmount
mamountp' "$2.00")
       ,("assets:bank:checking","checking",2, String -> MixedAmount
mamountp' "$1.00")
       ,("assets:bank:saving","saving",2, String -> MixedAmount
mamountp' "$1.00")
       ,("assets:cash","cash",1, String -> MixedAmount
mamountp' "$-2.00")
       ,("expenses","expenses",0, String -> MixedAmount
mamountp' "$2.00")
       ,("expenses:food","food",1, String -> MixedAmount
mamountp' "$1.00")
       ,("expenses:supplies","supplies",1, String -> MixedAmount
mamountp' "$1.00")
       ,("income","income",0, String -> MixedAmount
mamountp' "$-2.00")
       ,("income:gifts","gifts",1, String -> MixedAmount
mamountp' "$-1.00")
       ,("income:salary","salary",1, String -> MixedAmount
mamountp' "$-1.00")
       ],
       [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd 0])

    ,String -> IO () -> TestTree
test "with --depth=N" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
     (ReportOpts
defreportopts{depth_ :: Maybe Int
depth_=Int -> Maybe Int
forall a. a -> Maybe a
Just 1}, Journal
samplejournal) (ReportOpts, Journal) -> BalanceReport -> IO ()
`gives`
      ([
       ("expenses",    "expenses",    0, String -> MixedAmount
mamountp'  "$2.00")
       ,("income",      "income",      0, String -> MixedAmount
mamountp' "$-2.00")
       ],
       [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd 0])

    ,String -> IO () -> TestTree
test "with depth:N" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
     (ReportOpts
defreportopts{query_ :: String
query_="depth:1"}, Journal
samplejournal) (ReportOpts, Journal) -> BalanceReport -> IO ()
`gives`
      ([
       ("expenses",    "expenses",    0, String -> MixedAmount
mamountp'  "$2.00")
       ,("income",      "income",      0, String -> MixedAmount
mamountp' "$-2.00")
       ],
       [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd 0])

    ,String -> IO () -> TestTree
test "with date:" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
     (ReportOpts
defreportopts{query_ :: String
query_="date:'in 2009'"}, Journal
samplejournal2) (ReportOpts, Journal) -> BalanceReport -> IO ()
`gives`
      ([],
       [Amount] -> MixedAmount
Mixed [Amount
nullamt])

    ,String -> IO () -> TestTree
test "with date2:" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
     (ReportOpts
defreportopts{query_ :: String
query_="date2:'in 2009'"}, Journal
samplejournal2) (ReportOpts, Journal) -> BalanceReport -> IO ()
`gives`
      ([
        ("assets:bank:checking","assets:bank:checking",0,String -> MixedAmount
mamountp' "$1.00")
       ,("income:salary","income:salary",0,String -> MixedAmount
mamountp' "$-1.00")
       ],
       [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd 0])

    ,String -> IO () -> TestTree
test "with desc:" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
     (ReportOpts
defreportopts{query_ :: String
query_="desc:income"}, Journal
samplejournal) (ReportOpts, Journal) -> BalanceReport -> IO ()
`gives`
      ([
        ("assets:bank:checking","assets:bank:checking",0,String -> MixedAmount
mamountp' "$1.00")
       ,("income:salary","income:salary",0, String -> MixedAmount
mamountp' "$-1.00")
       ],
       [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd 0])

    ,String -> IO () -> TestTree
test "with not:desc:" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
     (ReportOpts
defreportopts{query_ :: String
query_="not:desc:income"}, Journal
samplejournal) (ReportOpts, Journal) -> BalanceReport -> IO ()
`gives`
      ([
        ("assets","assets",0, String -> MixedAmount
mamountp' "$-1.00")
       ,("assets:bank:saving","bank:saving",1, String -> MixedAmount
mamountp' "$1.00")
       ,("assets:cash","cash",1, String -> MixedAmount
mamountp' "$-2.00")
       ,("expenses","expenses",0, String -> MixedAmount
mamountp' "$2.00")
       ,("expenses:food","food",1, String -> MixedAmount
mamountp' "$1.00")
       ,("expenses:supplies","supplies",1, String -> MixedAmount
mamountp' "$1.00")
       ,("income:gifts","income:gifts",0, String -> MixedAmount
mamountp' "$-1.00")
       ],
       [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd 0])

    ,String -> IO () -> TestTree
test "with period on a populated period" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      (ReportOpts
defreportopts{period_ :: Period
period_= Day -> Day -> Period
PeriodBetween (Year -> Int -> Int -> Day
fromGregorian 2008 1 1) (Year -> Int -> Int -> Day
fromGregorian 2008 1 2)}, Journal
samplejournal) (ReportOpts, Journal) -> BalanceReport -> IO ()
`gives`
       (
        [
         ("assets:bank:checking","assets:bank:checking",0, String -> MixedAmount
mamountp' "$1.00")
        ,("income:salary","income:salary",0, String -> MixedAmount
mamountp' "$-1.00")
        ],
        [Amount] -> MixedAmount
Mixed [Quantity -> Amount
usd 0])

     ,String -> IO () -> TestTree
test "with period on an unpopulated period" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$
      (ReportOpts
defreportopts{period_ :: Period
period_= Day -> Day -> Period
PeriodBetween (Year -> Int -> Int -> Day
fromGregorian 2008 1 2) (Year -> Int -> Int -> Day
fromGregorian 2008 1 3)}, Journal
samplejournal) (ReportOpts, Journal) -> BalanceReport -> IO ()
`gives`
       ([],[Amount] -> MixedAmount
Mixed [Amount
nullamt])



  {-
      ,test "accounts report with account pattern o" ~:
       defreportopts{patterns_=["o"]} `gives`
       ["                  $1  expenses:food"
       ,"                 $-2  income"
       ,"                 $-1    gifts"
       ,"                 $-1    salary"
       ,"--------------------"
       ,"                 $-1"
       ]

      ,test "accounts report with account pattern o and --depth 1" ~:
       defreportopts{patterns_=["o"],depth_=Just 1} `gives`
       ["                  $1  expenses"
       ,"                 $-2  income"
       ,"--------------------"
       ,"                 $-1"
       ]

      ,test "accounts report with account pattern a" ~:
       defreportopts{patterns_=["a"]} `gives`
       ["                 $-1  assets"
       ,"                  $1    bank:saving"
       ,"                 $-2    cash"
       ,"                 $-1  income:salary"
       ,"                  $1  liabilities:debts"
       ,"--------------------"
       ,"                 $-1"
       ]

      ,test "accounts report with account pattern e" ~:
       defreportopts{patterns_=["e"]} `gives`
       ["                 $-1  assets"
       ,"                  $1    bank:saving"
       ,"                 $-2    cash"
       ,"                  $2  expenses"
       ,"                  $1    food"
       ,"                  $1    supplies"
       ,"                 $-2  income"
       ,"                 $-1    gifts"
       ,"                 $-1    salary"
       ,"                  $1  liabilities:debts"
       ,"--------------------"
       ,"                   0"
       ]

      ,test "accounts report with unmatched parent of two matched subaccounts" ~:
       defreportopts{patterns_=["cash","saving"]} `gives`
       ["                 $-1  assets"
       ,"                  $1    bank:saving"
       ,"                 $-2    cash"
       ,"--------------------"
       ,"                 $-1"
       ]

      ,test "accounts report with multi-part account name" ~:
       defreportopts{patterns_=["expenses:food"]} `gives`
       ["                  $1  expenses:food"
       ,"--------------------"
       ,"                  $1"
       ]

      ,test "accounts report with negative account pattern" ~:
       defreportopts{patterns_=["not:assets"]} `gives`
       ["                  $2  expenses"
       ,"                  $1    food"
       ,"                  $1    supplies"
       ,"                 $-2  income"
       ,"                 $-1    gifts"
       ,"                 $-1    salary"
       ,"                  $1  liabilities:debts"
       ,"--------------------"
       ,"                  $1"
       ]

      ,test "accounts report negative account pattern always matches full name" ~:
       defreportopts{patterns_=["not:e"]} `gives`
       ["--------------------"
       ,"                   0"
       ]

      ,test "accounts report negative patterns affect totals" ~:
       defreportopts{patterns_=["expenses","not:food"]} `gives`
       ["                  $1  expenses:supplies"
       ,"--------------------"
       ,"                  $1"
       ]

      ,test "accounts report with -E shows zero-balance accounts" ~:
       defreportopts{patterns_=["assets"],empty_=True} `gives`
       ["                 $-1  assets"
       ,"                  $1    bank"
       ,"                   0      checking"
       ,"                  $1      saving"
       ,"                 $-2    cash"
       ,"--------------------"
       ,"                 $-1"
       ]

      ,test "accounts report with cost basis" $
         j <- (readJournal def Nothing $ unlines
                [""
                ,"2008/1/1 test           "
                ,"  a:b          10h @ $50"
                ,"  c:d                   "
                ]) >>= either error' return
         let j' = journalCanonicaliseAmounts $ journalToCost j -- enable cost basis adjustment
         balanceReportAsText defreportopts (balanceReport defreportopts Any j') `is`
           ["                $500  a:b"
           ,"               $-500  c:d"
           ,"--------------------"
           ,"                   0"
           ]
  -}
     ]

 ]