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

{-|

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    = 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 ropts@ReportOpts{..} q j@Journal{..} =
  (if invert_ then brNegate  else id) $
  (mappedsorteditems, mappedtotal)
    where
      -- dbg1 = const id -- exclude from debug output
      dbg1 s = let p = "balanceReport" in Hledger.Utils.dbg1 (p++" "++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 = ledgerRootAccount $ ledgerFromJournal q $ journalSelectingAmountFromOpts ropts j

      -- For other kinds of valuation, convert the summed amounts to value,
      -- per hledger_options.m4.md "Effect of --value on reports".
      valuedaccttree = mapAccounts avalue accttree
        where
          avalue a@Account{..} = a{aebalance=bvalue aebalance, aibalance=bvalue aibalance}
            where
              bvalue = maybe id (mixedAmountApplyValuation (journalPriceOracle j) (journalCommodityStyles j) periodlast mreportlast today multiperiod) value_
                where
                  periodlast =
                    fromMaybe (error' "balanceReport: expected a non-empty journal") $ -- XXX shouldn't happen
                    reportPeriodOrJournalLastDay ropts j
                  mreportlast = reportPeriodLastDay ropts
                  today = fromMaybe (error' "balanceReport: could not pick a valuation date, ReportOpts today_ is unset") today_
                  multiperiod = interval_ /= NoInterval

      -- Modify this tree for display - depth limit, boring parents, zeroes - and convert to a list.
      displayaccts :: [Account]
          | queryDepth q == 0 =
                         dbg1 "displayaccts" $
                         take 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts valuedaccttree
          | flat_ ropts = dbg1 "displayaccts" $
                         filterzeros $
                         filterempty $
                         drop 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts valuedaccttree
          | otherwise  = dbg1 "displayaccts" $
                         filter (not.aboring) $
                         drop 1 $ flattenAccounts $
                         markboring $
                         prunezeros $
                         sortAccountTreeByAmount (fromMaybe NormallyPositive normalbalance_) $
                         clipAccounts (queryDepth q) valuedaccttree
          where
            balance     = if flat_ ropts then aebalance else aibalance
            filterzeros = if empty_ then id else filter (not . isZeroMixedAmount . balance)
            filterempty = filter (\a -> anumpostings a > 0 || not (isZeroMixedAmount (balance a)))
            prunezeros  = if empty_ then id else fromMaybe nullacct . pruneAccounts (isZeroMixedAmount . balance)
            markboring  = if no_elide_ then id else markBoringParentAccounts

      -- Make a report row for each account.
      items = dbg1 "items" $ map (balanceReportItem ropts q) displayaccts

      -- Sort report rows (except sorting by amount in tree mode, which was done above).
      sorteditems
        | sort_amount_ && tree_ ropts = items
        | sort_amount_                = sortFlatBRByAmount items
        | otherwise                   = sortBRByAccountDeclaration items
        where
          -- Sort the report rows, representing a flat account list, by row total.
          sortFlatBRByAmount :: [BalanceReportItem] -> [BalanceReportItem]
          sortFlatBRByAmount = sortBy (maybeflip $ comparing (normaliseMixedAmountSquashPricesForDisplay . fourth4))
            where
              maybeflip = if normalbalance_ == Just NormallyNegative then id else flip
          -- Sort the report rows by account declaration order then account name.
          sortBRByAccountDeclaration :: [BalanceReportItem] -> [BalanceReportItem]
          sortBRByAccountDeclaration rows = sortedrows
            where
              anamesandrows = [(first4 r, r) | r <- rows]
              anames = map fst anamesandrows
              sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames
              sortedrows = sortAccountItemsLike sortedanames anamesandrows

      -- Calculate the grand total.
      total | not (flat_ ropts) = dbg1 "total" $ sum [amt | (_,_,indent,amt) <- items, indent == 0]
            | otherwise         = dbg1 "total" $
                                  if flatShowsExclusiveBalance
                                  then sum $ map fourth4 items
                                  else sum $ map aebalance $ clipAccountsAndAggregate 1 displayaccts
      
      -- Calculate percentages if needed.
      mappedtotal | percent_  = dbg1 "mappedtotal" $ total `perdivide` total
                  | otherwise = total
      mappedsorteditems | percent_ =
                            dbg1 "mappedsorteditems" $
                            map (\(fname, sname, indent, amount) -> (fname, sname, indent, amount `perdivide` total)) sorteditems
                        | otherwise = 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 sortedas items =
  concatMap (\a -> maybe [] (:[]) $ lookup a items) 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 = tieAccountParents . mapAccounts mark
  where
    mark a | length (asubs a) == 1 && isZeroMixedAmount (aebalance a) = a{aboring=True}
           | otherwise = a

balanceReportItem :: ReportOpts -> Query -> Account -> BalanceReportItem
balanceReportItem opts q a
  | flat_ opts = (name, name,       0,      (if flatShowsExclusiveBalance then aebalance else aibalance) a)
  | otherwise  = (name, elidedname, indent, aibalance a)
  where
    name | queryDepth q > 0 = aname a
         | otherwise        = "..."
    elidedname = accountNameFromComponents (adjacentboringparentnames ++ [accountLeafName name])
    adjacentboringparentnames = reverse $ map (accountLeafName.aname) $ takeWhile aboring parents
    indent = length $ filter (not.aboring) parents
    -- parents exclude the tree's root node
    parents = case parentAccounts a of [] -> []
                                       as -> init 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 (is, tot) = (map brItemNegate is, -tot)
  where
    brItemNegate (a, a', d, amt) = (a, a', 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 = foldl combine (num 0) (amounts mixedAmount)
  where
    combine amount result =
      if isReallyZeroAmount amount
      then result
      else if isReallyZeroAmount result
        then amount
        else if acommodity amount == acommodity result
          then amount + result
          else 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 a b =
  let a' = unifyMixedAmount a
      b' = unifyMixedAmount b
  in if isReallyZeroAmount a' || isReallyZeroAmount b' || acommodity a' == acommodity b'
    then mixed [per $ if aquantity b' == 0 then 0 else (aquantity a' / abs (aquantity b') * 100)]
    else error' "Cannot calculate percentages if accounts have different commodities. (Hint: Try --cost, -V or similar flags.)"

-- tests

Right samplejournal2 =
  journalBalanceTransactions False
    nulljournal{
      jtxns = [
        txnTieKnot Transaction{
          tindex=0,
          tsourcepos=nullsourcepos,
          tdate=parsedate "2008/01/01",
          tdate2=Just $ parsedate "2009/01/01",
          tstatus=Unmarked,
          tcode="",
          tdescription="income",
          tcomment="",
          ttags=[],
          tpostings=
            [posting {paccount="assets:bank:checking", pamount=Mixed [usd 1]}
            ,posting {paccount="income:salary", pamount=missingmixedamt}
            ],
          tprecedingcomment=""
        }
      ]
    }

tests_BalanceReport = tests "BalanceReport" [

  let
    (opts,journal) `gives` r = do
      let (eitems, etotal) = r
          (aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal
          showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt)
      (map showw eitems) @?= (map showw aitems)
      (showMixedAmountDebug etotal) @?= (showMixedAmountDebug atotal)
  in
    tests "balanceReport" [

     test "no args, null journal" $
     (defreportopts, nulljournal) `gives` ([], Mixed [nullamt])

    ,test "no args, sample journal" $
     (defreportopts, samplejournal) `gives`
      ([
        ("assets","assets",0, mamountp' "$0.00")
       ,("assets:bank","bank",1, mamountp' "$2.00")
       ,("assets:bank:checking","checking",2, mamountp' "$1.00")
       ,("assets:bank:saving","saving",2, mamountp' "$1.00")
       ,("assets:cash","cash",1, mamountp' "$-2.00")
       ,("expenses","expenses",0, mamountp' "$2.00")
       ,("expenses:food","food",1, mamountp' "$1.00")
       ,("expenses:supplies","supplies",1, mamountp' "$1.00")
       ,("income","income",0, mamountp' "$-2.00")
       ,("income:gifts","gifts",1, mamountp' "$-1.00")
       ,("income:salary","salary",1, mamountp' "$-1.00")
       ],
       Mixed [usd 0])

    ,test "with --depth=N" $
     (defreportopts{depth_=Just 1}, samplejournal) `gives`
      ([
       ("expenses",    "expenses",    0, mamountp'  "$2.00")
       ,("income",      "income",      0, mamountp' "$-2.00")
       ],
       Mixed [usd 0])

    ,test "with depth:N" $
     (defreportopts{query_="depth:1"}, samplejournal) `gives`
      ([
       ("expenses",    "expenses",    0, mamountp'  "$2.00")
       ,("income",      "income",      0, mamountp' "$-2.00")
       ],
       Mixed [usd 0])

    ,test "with date:" $
     (defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives`
      ([],
       Mixed [nullamt])

    ,test "with date2:" $
     (defreportopts{query_="date2:'in 2009'"}, samplejournal2) `gives`
      ([
        ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
       ,("income:salary","income:salary",0,mamountp' "$-1.00")
       ],
       Mixed [usd 0])

    ,test "with desc:" $
     (defreportopts{query_="desc:income"}, samplejournal) `gives`
      ([
        ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
       ,("income:salary","income:salary",0, mamountp' "$-1.00")
       ],
       Mixed [usd 0])

    ,test "with not:desc:" $
     (defreportopts{query_="not:desc:income"}, samplejournal) `gives`
      ([
        ("assets","assets",0, mamountp' "$-1.00")
       ,("assets:bank:saving","bank:saving",1, mamountp' "$1.00")
       ,("assets:cash","cash",1, mamountp' "$-2.00")
       ,("expenses","expenses",0, mamountp' "$2.00")
       ,("expenses:food","food",1, mamountp' "$1.00")
       ,("expenses:supplies","supplies",1, mamountp' "$1.00")
       ,("income:gifts","income:gifts",0, mamountp' "$-1.00")
       ],
       Mixed [usd 0])

    ,test "with period on a populated period" $
      (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2)}, samplejournal) `gives`
       (
        [
         ("assets:bank:checking","assets:bank:checking",0, mamountp' "$1.00")
        ,("income:salary","income:salary",0, mamountp' "$-1.00")
        ],
        Mixed [usd 0])

     ,test "with period on an unpopulated period" $
      (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}, samplejournal) `gives`
       ([],Mixed [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"
           ]
  -}
     ]

 ]