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

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

Balance report, used by the balance command.

-}

module Hledger.Reports.BalanceReport (
  BalanceReport,
  BalanceReportItem,
  RenderableAccountName,
  balanceReport,
  balanceReportValue,
  mixedAmountValue,
  flatShowsExclusiveBalance,

  -- * Tests
  tests_Hledger_Reports_BalanceReport
)
where

import Data.List (sort)
import Data.Maybe
import Data.Time.Calendar
import Test.HUnit

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


-- | A simple single-column balance report. It has:
--
-- 1. a list of rows, each containing a renderable account name and a corresponding amount
--
-- 2. the final total of the amounts
type BalanceReport = ([BalanceReportItem], MixedAmount)
type BalanceReportItem = (RenderableAccountName, MixedAmount)

-- | A renderable account name includes some additional hints for rendering accounts in a balance report.
-- It has:
--
-- * The full account name
--
-- * The ledger-style short elided account name (the leaf name, prefixed by any boring parents immediately above)
--
-- * The number of indentation steps to use when rendering a ledger-style account tree
--   (normally the 0-based depth of this account excluding boring parents, or 0 with --flat).
type RenderableAccountName = (AccountName, AccountName, Int)

-- | 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 periodBalanceReport with a single column (but more mature,
-- eg this can do hierarchical display).
balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport
balanceReport opts q j = (items, total)
    where
      -- dbg1 = const id -- exclude from debug output
      dbg1 s = let p = "balanceReport" in Hledger.Utils.dbg1 (p++" "++s)  -- add prefix in debug output

      accts = ledgerRootAccount $ ledgerFromJournal q $ journalSelectingAmountFromOpts opts j
      accts' :: [Account]
          | queryDepth q == 0 =
                         dbg1 "accts" $
                         take 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts accts
          | flat_ opts = dbg1 "accts" $
                         filterzeros $
                         filterempty $
                         drop 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts accts
          | otherwise  = dbg1 "accts" $
                         filter (not.aboring) $
                         drop 1 $ flattenAccounts $
                         markboring $
                         prunezeros $
                         clipAccounts (queryDepth q) accts
          where
            balance     = if flat_ opts then aebalance else aibalance
            filterzeros = if empty_ opts then id else filter (not . isZeroMixedAmount . balance)
            filterempty = filter (\a -> anumpostings a > 0 || not (isZeroMixedAmount (balance a)))
            prunezeros  = if empty_ opts then id else fromMaybe nullacct . pruneAccounts (isZeroMixedAmount . balance)
            markboring  = if no_elide_ opts then id else markBoringParentAccounts
      items = dbg1 "items" $ map (balanceReportItem opts q) accts'
      total | not (flat_ opts) = dbg1 "total" $ sum [amt | ((_,_,indent),amt) <- items, indent == 0]
            | otherwise        = dbg1 "total" $
                                 if flatShowsExclusiveBalance
                                 then sum $ map snd items
                                 else sum $ map aebalance $ clipAccountsAndAggregate 1 accts'

-- | 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) = periodBalanceReport opts q j
--     items = [(a,a',n, headDef 0 bs) | ((a,a',n), bs) <- mbrrows]
--     total = headDef 0 mbrtotals

-- | Convert all the amounts in a single-column balance report to
-- their value on the given date in their default valuation
-- commodities.
balanceReportValue :: Journal -> Day -> BalanceReport -> BalanceReport
balanceReportValue j d r = r'
  where
    (items,total) = r
    r' = dbg8 "balanceReportValue" $
         ([(n, mixedAmountValue j d a) |(n,a) <- items], mixedAmountValue j d total)

mixedAmountValue :: Journal -> Day -> MixedAmount -> MixedAmount
mixedAmountValue j d (Mixed as) = Mixed $ map (amountValue j d) as

-- | Find the market value of this amount on the given date, in it's
-- default valuation commodity, based on historical prices. If no
-- default valuation commodity can be found, the amount is left
-- unchanged.
amountValue :: Journal -> Day -> Amount -> Amount
amountValue j d a =
  case commodityValue j d (acommodity a) of
    Just v  -> v{aquantity=aquantity v * aquantity a
                ,aprice=aprice a
                }
    Nothing -> a

-- | Find the market value, if known, of one unit of this commodity on
-- the given date, in the commodity in which it has most recently been
-- market-priced (ie the commodity mentioned in the most recent
-- applicable historical price directive before this date).
commodityValue :: Journal -> Day -> CommoditySymbol -> Maybe Amount
commodityValue j d c
    | null applicableprices = Nothing
    | otherwise             = Just $ mpamount $ last applicableprices
  where
    applicableprices = [p | p <- sort $ jmarketprices j, mpcommodity p == c, mpdate p <= d]

tests_balanceReport =
  let
    (opts,journal) `gives` r = do
      let (eitems, etotal) = r
          (aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal
          showw (acct,amt) = (acct, showMixedAmountDebug amt)
      assertEqual "items" (map showw eitems) (map showw aitems)
      assertEqual "total" (showMixedAmountDebug etotal) (showMixedAmountDebug atotal)
    usd0 = usd 0
  in [

   "balanceReport with no args on null journal" ~: do
   (defreportopts, nulljournal) `gives` ([], Mixed [nullamt])

  ,"balanceReport with no args on sample journal" ~: do
   (defreportopts, 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","income",0), mamountp' "$-2.00")
     ,(("income:gifts","gifts",1), mamountp' "$-1.00")
     ,(("income:salary","salary",1), mamountp' "$-1.00")
     ,(("liabilities:debts","liabilities:debts",0), mamountp' "$1.00")
     ],
     Mixed [usd0])

  ,"balanceReport with --depth=N" ~: do
   (defreportopts{depth_=Just 1}, samplejournal) `gives`
    ([
      (("assets",      "assets",      0), mamountp' "$-1.00")
     ,(("expenses",    "expenses",    0), mamountp'  "$2.00")
     ,(("income",      "income",      0), mamountp' "$-2.00")
     ,(("liabilities", "liabilities", 0), mamountp'  "$1.00")
     ],
     Mixed [usd0])

  ,"balanceReport with depth:N" ~: do
   (defreportopts{query_="depth:1"}, samplejournal) `gives`
    ([
      (("assets",      "assets",      0), mamountp' "$-1.00")
     ,(("expenses",    "expenses",    0), mamountp'  "$2.00")
     ,(("income",      "income",      0), mamountp' "$-2.00")
     ,(("liabilities", "liabilities", 0), mamountp'  "$1.00")
     ],
     Mixed [usd0])

  ,"balanceReport with a date or secondary date span" ~: do
   (defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives`
    ([],
     Mixed [nullamt])
   (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 [usd0])

  ,"balanceReport with desc:" ~: do
   (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 [usd0])

  ,"balanceReport with not:desc:" ~: do
   (defreportopts{query_="not:desc:income"}, samplejournal) `gives`
    ([
      (("assets","assets",0), mamountp' "$-2.00")
     ,(("assets:bank","bank",1), Mixed [usd0])
     ,(("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:gifts","income:gifts",0), mamountp' "$-1.00")
     ,(("liabilities:debts","liabilities:debts",0), mamountp' "$1.00")
     ],
     Mixed [usd0])


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

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

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

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

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

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

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

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

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

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

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

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

-- tests_isInterestingIndented = [
--   "isInterestingIndented" ~: do
--    let (opts, journal, acctname) `gives` r = isInterestingIndented opts l acctname `is` r
--           where l = ledgerFromJournal (queryFromOpts nulldate opts) journal

--    (defreportopts, samplejournal, "expenses") `gives` True
--  ]

tests_Hledger_Reports_BalanceReport :: Test
tests_Hledger_Reports_BalanceReport = TestList $
    tests_balanceReport