CompoundBalanceCommand.hs

{-# LANGUAGE OverloadedStrings, RecordWildCards, LambdaCase #-}
{-|

Common helpers for making multi-section balance report commands
like balancesheet, cashflow, and incomestatement.

-}

module Hledger.Cli.CompoundBalanceCommand (
  CompoundBalanceCommandSpec(..)
 ,CBCSubreportSpec(..)
 ,compoundBalanceCommandMode
 ,compoundBalanceCommand
) where

import Data.List (foldl')
import Data.Maybe
import qualified Data.Text as TS
import qualified Data.Text.Lazy as TL
import Data.Time.Calendar
import System.Console.CmdArgs.Explicit as C
import Hledger.Read.CsvReader (CSV, printCSV)
import Lucid as L hiding (value_)
import Text.Tabular as T

import Hledger
import Hledger.Cli.Commands.Balance
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils (writeOutput)

-- | Description of a compound balance report command,
-- from which we generate the command's cmdargs mode and IO action.
-- A compound balance report command shows one or more sections/subreports,
-- each with its own title and subtotals row, in a certain order,
-- plus a grand totals row if there's more than one section.
-- Examples are the balancesheet, cashflow and incomestatement commands.
--
-- Compound balance reports do sign normalisation: they show all account balances
-- as normally positive, unlike the ordinary BalanceReport and most hledger commands
-- which show income/liability/equity balances as normally negative.
-- Each subreport specifies the normal sign of its amounts, and whether
-- it should be added to or subtracted from the grand total.
--
data CompoundBalanceCommandSpec = CompoundBalanceCommandSpec {
  cbcdoc      :: CommandDoc,          -- ^ the command's name(s) and documentation
  cbctitle    :: String,              -- ^ overall report title
  cbcqueries  :: [CBCSubreportSpec],  -- ^ subreport details
  cbctype     :: BalanceType          -- ^ the "balance" type (change, cumulative, historical)
                                      --   this report shows (overrides command line flags)
}

-- | Description of one subreport within a compound balance report.
data CBCSubreportSpec = CBCSubreportSpec {
   cbcsubreporttitle :: String
  ,cbcsubreportquery :: Journal -> Query
  ,cbcsubreportnormalsign :: NormalSign
  ,cbcsubreportincreasestotal :: Bool
}

-- | A compound balance report has:
--
-- * an overall title
--
-- * the period (date span) of each column
--
-- * one or more named, normal-positive multi balance reports,
--   with columns corresponding to the above, and a flag indicating
--   whether they increased or decreased the overall totals
--
-- * a list of overall totals for each column, and their grand total and average
--
-- It is used in compound balance report commands like balancesheet,
-- cashflow and incomestatement.
type CompoundBalanceReport =
  ( String
  , [DateSpan]
  , [(String, MultiBalanceReport, Bool)]
  , ([MixedAmount], MixedAmount, MixedAmount)
  )


-- | Generate a cmdargs option-parsing mode from a compound balance command
-- specification.
compoundBalanceCommandMode :: CompoundBalanceCommandSpec -> Mode RawOpts
compoundBalanceCommandMode CompoundBalanceCommandSpec{..} =
  hledgerCommandMode
    cbcdoc
    [flagNone ["change"] (setboolopt "change")
       ("show balance change in each period" ++ defType PeriodChange)
    ,flagNone ["cumulative"] (setboolopt "cumulative")
       ("show balance change accumulated across periods (in multicolumn reports)"
           ++ defType CumulativeChange
       )
    ,flagNone ["historical","H"] (setboolopt "historical")
       ("show historical ending balance in each period (includes postings before report start date)"
           ++ defType HistoricalBalance
       )
    ,flagNone ["flat"] (setboolopt "flat") "show accounts as a list"
    ,flagReq  ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "flat mode: omit N leading account name parts"
    ,flagNone ["no-total","N"] (setboolopt "no-total") "omit the final total row"
    ,flagNone ["tree"] (setboolopt "tree") "show accounts as a tree; amounts include subaccounts (default in simple reports)"
    ,flagNone ["average","A"] (setboolopt "average") "show a row average column (in multicolumn reports)"
    ,flagNone ["row-total","T"] (setboolopt "row-total") "show a row total column (in multicolumn reports)"
    ,flagNone ["no-elide"] (setboolopt "no-elide") "don't squash boring parent accounts (in tree mode)"
    ,flagReq  ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format (in simple reports)"
    ,flagNone ["pretty-tables"] (setboolopt "pretty-tables") "use unicode when displaying tables"
    ,flagNone ["sort-amount","S"] (setboolopt "sort-amount") "sort by amount instead of account code/name"
    ,flagNone ["percent", "%"] (setboolopt "percent") "express values in percentage of each column's total"
    ,outputFormatFlag
    ,outputFileFlag
    ]
    [generalflagsgroup1]
    hiddenflags
    ([], Just $ argsFlag "[QUERY]")
 where
   defType :: BalanceType -> String
   defType bt | bt == cbctype = " (default)"
              | otherwise    = ""

-- | Generate a runnable command from a compound balance command specification.
compoundBalanceCommand :: CompoundBalanceCommandSpec -> (CliOpts -> Journal -> IO ())
compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=ropts@ReportOpts{..}, rawopts_=rawopts} j = do
    d <- getCurrentDay
    let
      -- use the default balance type for this report, unless the user overrides
      mBalanceTypeOverride =
        choiceopt parse rawopts where
          parse = \case
            "historical" -> Just HistoricalBalance
            "cumulative" -> Just CumulativeChange
            "change"     -> Just PeriodChange
            _            -> Nothing
      balancetype = fromMaybe cbctype mBalanceTypeOverride
      -- Set balance type in the report options.
      -- Also, use tree mode (by default, at least?) if --cumulative/--historical
      -- are used in single column mode, since in that situation we will be using
      -- balanceReportFromMultiBalanceReport which does not support eliding boring parents,
      -- and tree mode hides this.. or something.. XXX
      ropts' = ropts{
        balancetype_=balancetype,
        accountlistmode_=if not (flat_ ropts) && interval_==NoInterval && balancetype `elem` [CumulativeChange, HistoricalBalance] then ALTree else accountlistmode_,
        no_total_=if percent_ && length cbcqueries > 1 then True else no_total_
      }
      userq = queryFromOpts d ropts'
      format = outputFormatFromOpts opts

      -- make a CompoundBalanceReport.
      -- For efficiency, generate a price oracle here and reuse it with each subreport.
      priceoracle = journalPriceOracle j
      subreports =
        map (\CBCSubreportSpec{..} ->
                (cbcsubreporttitle
                ,prNormaliseSign cbcsubreportnormalsign $ -- <- convert normal-negative to normal-positive
                  compoundBalanceSubreport ropts' userq j priceoracle cbcsubreportquery cbcsubreportnormalsign
                ,cbcsubreportincreasestotal
                ))
            cbcqueries

      subtotalrows =
        [(prrAmounts $ prTotals report, increasesoveralltotal)
        | (_, report, increasesoveralltotal) <- subreports
        ]

      -- Sum the subreport totals by column. Handle these cases:
      -- - no subreports
      -- - empty subreports, having no subtotals (#588)
      -- - subreports with a shorter subtotals row than the others
      overalltotals = case subtotalrows of
        [] -> ([], nullmixedamt, nullmixedamt)
        rs ->
          let
            numcols = maximum $ map (length.fst) rs  -- partial maximum is ok, rs is non-null
            paddedsignedsubtotalrows =
              [map (if increasesoveralltotal then id else negate) $  -- maybe flip the signs
               take numcols $ as ++ repeat nullmixedamt              -- pad short rows with zeros
              | (as,increasesoveralltotal) <- rs
              ]
            coltotals = foldl' (zipWith (+)) zeros paddedsignedsubtotalrows  -- sum the columns
              where zeros = replicate numcols nullmixedamt
            grandtotal = sum coltotals
            grandavg | null coltotals = nullmixedamt
                     | otherwise      = fromIntegral (length coltotals) `divideMixedAmount` grandtotal
          in
            (coltotals, grandtotal, grandavg)

      colspans =
        case subreports of
          (_, PeriodicReport ds _ _, _):_ -> ds
          [] -> []

      title =
        cbctitle
        ++ " "
        ++ titledatestr
        ++ maybe "" (' ':) mtitleclarification
        ++ valuationdesc
        where

          -- XXX #1078 the title of ending balance reports
          -- (HistoricalBalance) should mention the end date(s) shown as
          -- column heading(s) (not the date span of the transactions).
          -- Also the dates should not be simplified (it should show
          -- "2008/01/01-2008/12/31", not "2008").
          titledatestr
            | balancetype == HistoricalBalance = showEndDates enddates
            | otherwise                        = showDateSpan requestedspan 
            where
              enddates = map (addDays (-1)) $ catMaybes $ map spanEnd colspans  -- these spans will always have a definite end date
              requestedspan = queryDateSpan date2_ userq `spanDefaultsFrom` journalDateSpan date2_ j

          -- when user overrides, add an indication to the report title
          mtitleclarification = flip fmap mBalanceTypeOverride $ \t ->
            case t of
              PeriodChange      -> "(Balance Changes)"
              CumulativeChange  -> "(Cumulative Ending Balances)"
              HistoricalBalance -> "(Historical Ending Balances)"

          valuationdesc = case value_ of
            Just (AtCost _mc)   -> ", valued at cost"
            Just (AtThen _mc)   -> error' "Sorry, --value=then is not yet implemented for this kind of report."  -- TODO
            Just (AtEnd _mc)    -> ", valued at period ends"
            Just (AtNow _mc)    -> ", current value"
            Just (AtDefault _mc) | multiperiod   -> ", valued at period ends"
            Just (AtDefault _mc)    -> ", current value"
            Just (AtDate d _mc) -> ", valued at "++showDate d
            Nothing             -> ""
            where
              multiperiod = interval_ /= NoInterval
      cbr =
        (title
        ,colspans
        ,subreports
        ,overalltotals
        )

    -- render appropriately
    writeOutput opts $
      case format of
        "csv"  -> printCSV (compoundBalanceReportAsCsv ropts cbr) ++ "\n"
        "html" -> (++ "\n") $ TL.unpack $ L.renderText $ compoundBalanceReportAsHtml ropts cbr
        _      -> compoundBalanceReportAsText ropts' cbr

-- | Summarise one or more (inclusive) end dates, in a way that's
-- visually different from showDateSpan, suggesting discrete end dates
-- rather than a continuous span.
showEndDates :: [Day] -> String
showEndDates es = case es of
  -- cf showPeriod
  (e:_:_) -> showdate e ++ ",," ++ showdate (last es)
  [e]     -> showdate e
  []      -> ""
  where
    showdate = show

-- | Run one subreport for a compound balance command in multi-column mode.
-- This returns a MultiBalanceReport.
compoundBalanceSubreport :: ReportOpts -> Query -> Journal -> PriceOracle -> (Journal -> Query) -> NormalSign -> MultiBalanceReport
compoundBalanceSubreport ropts@ReportOpts{..} userq j priceoracle subreportqfn subreportnormalsign = r'
  where
    -- force --empty to ensure same columns in all sections
    ropts' = ropts { empty_=True, normalbalance_=Just subreportnormalsign }
    -- run the report
    q = And [subreportqfn j, userq]
    r@(PeriodicReport dates rows totals) = multiBalanceReportWith ropts' q j priceoracle
    -- if user didn't specify --empty, now remove the all-zero rows, unless they have non-zero subaccounts
    -- in this report
    r' | empty_    = r
       | otherwise = PeriodicReport dates rows' totals
          where
            nonzeroaccounts =
              dbg1 "nonzeroaccounts" $
              mapMaybe (\(PeriodicReportRow act _ amts _ _) ->
                            if not (all isZeroMixedAmount amts) then Just act else Nothing) rows
            rows' = filter (not . emptyRow) rows
              where
                emptyRow (PeriodicReportRow act _ amts _ _) =
                  all isZeroMixedAmount amts && not (any (act `isAccountNamePrefixOf`) nonzeroaccounts)

-- | Render a compound balance report as plain text suitable for console output.
{- Eg:
Balance Sheet

             ||  2017/12/31    Total  Average
=============++===============================
 Assets      ||
-------------++-------------------------------
 assets:b    ||           1        1        1
-------------++-------------------------------
             ||           1        1        1
=============++===============================
 Liabilities ||
-------------++-------------------------------
-------------++-------------------------------
             ||
=============++===============================
 Total       ||           1        1        1

-}
compoundBalanceReportAsText :: ReportOpts -> CompoundBalanceReport -> String
compoundBalanceReportAsText ropts (title, _colspans, subreports, (coltotals, grandtotal, grandavg)) =
  title ++ "\n\n" ++
  balanceReportTableAsText ropts bigtable'
  where
    singlesubreport = length subreports == 1
    bigtable =
      case map (subreportAsTable ropts singlesubreport) subreports of
        []   -> T.empty
        r:rs -> foldl' concatTables r rs
    bigtable'
      | no_total_ ropts || singlesubreport =
          bigtable
      | otherwise =
          bigtable
          +====+
          row "Net:" (
            coltotals
            ++ (if row_total_ ropts then [grandtotal] else [])
            ++ (if average_ ropts   then [grandavg]   else [])
            )

    -- | Convert a named multi balance report to a table suitable for
    -- concatenating with others to make a compound balance report table.
    subreportAsTable ropts singlesubreport (title, r, _) = t
      where
        -- unless there's only one section, always show the subtotal row
        ropts' | singlesubreport = ropts
               | otherwise       = ropts{ no_total_=False }
        -- convert to table
        Table lefthdrs tophdrs cells = balanceReportAsTable ropts' r
        -- tweak the layout
        t = Table (T.Group SingleLine [Header title, lefthdrs]) tophdrs ([]:cells)

-- | Add the second table below the first, discarding its column headings.
concatTables (Table hLeft hTop dat) (Table hLeft' _ dat') =
    Table (T.Group DoubleLine [hLeft, hLeft']) hTop (dat ++ dat')

-- | Render a compound balance report as CSV.
-- Subreports' CSV is concatenated, with the headings rows replaced by a
-- subreport title row, and an overall title row, one headings row, and an
-- optional overall totals row is added.
compoundBalanceReportAsCsv :: ReportOpts -> CompoundBalanceReport -> CSV
compoundBalanceReportAsCsv ropts (title, colspans, subreports, (coltotals, grandtotal, grandavg)) =
  addtotals $
  padRow title :
  ("Account" :
   map showDateSpanMonthAbbrev colspans
   ++ (if row_total_ ropts then ["Total"] else [])
   ++ (if average_ ropts then ["Average"] else [])
   ) :
  concatMap (subreportAsCsv ropts singlesubreport) subreports
  where
    singlesubreport = length subreports == 1
    -- | Add a subreport title row and drop the heading row.
    subreportAsCsv ropts singlesubreport (subreporttitle, multibalreport, _) =
      padRow subreporttitle :
      tail (multiBalanceReportAsCsv ropts' multibalreport)
      where
        -- unless there's only one section, always show the subtotal row
        ropts' | singlesubreport = ropts
               | otherwise       = ropts{ no_total_=False }
    padRow s = take numcols $ s : repeat ""
      where
        numcols
          | null subreports = 1
          | otherwise =
            (1 +) $ -- account name column
            (if row_total_ ropts then (1+) else id) $
            (if average_ ropts then (1+) else id) $
            maximum $ -- depends on non-null subreports
            map (length . prDates . second3) subreports
    addtotals
      | no_total_ ropts || length subreports == 1 = id
      | otherwise = (++
          ["Net:" :
           map showMixedAmountOneLineWithoutPrice (
             coltotals
             ++ (if row_total_ ropts then [grandtotal] else [])
             ++ (if average_ ropts   then [grandavg]   else [])
             )
          ])

-- | Render a compound balance report as HTML.
compoundBalanceReportAsHtml :: ReportOpts -> CompoundBalanceReport -> Html ()
compoundBalanceReportAsHtml ropts cbr =
  let
    (title, colspans, subreports, (coltotals, grandtotal, grandavg)) = cbr
    colspanattr = colspan_ $ TS.pack $ show $
      1 + length colspans + (if row_total_ ropts then 1 else 0) + (if average_ ropts then 1 else 0)
    leftattr = style_ "text-align:left"
    blankrow = tr_ $ td_ [colspanattr] $ toHtmlRaw ("&nbsp;"::String)

    titlerows =
         [tr_ $ th_ [colspanattr, leftattr] $ h2_ $ toHtml title]
      ++ [thRow $
          "" :
          map showDateSpanMonthAbbrev colspans
          ++ (if row_total_ ropts then ["Total"] else [])
          ++ (if average_ ropts then ["Average"] else [])
          ]

    thRow :: [String] -> Html ()
    thRow = tr_ . mconcat . map (th_ . toHtml)

    -- Make rows for a subreport: its title row, not the headings row,
    -- the data rows, any totals row, and a blank row for whitespace.
    subreportrows :: (String, MultiBalanceReport, Bool) -> [Html ()]
    subreportrows (subreporttitle, mbr, _increasestotal) =
      let
        (_,bodyrows,mtotalsrow) = multiBalanceReportHtmlRows ropts mbr
      in
           [tr_ $ th_ [colspanattr, leftattr] $ toHtml subreporttitle]
        ++ bodyrows
        ++ maybe [] (:[]) mtotalsrow
        ++ [blankrow]

    totalrows | no_total_ ropts || length subreports == 1 = []
              | otherwise =
                  let defstyle = style_ "text-align:right"
                  in
                    [tr_ $ mconcat $
                         th_ [class_ "", style_ "text-align:left"] "Net:"
                       : [th_ [class_ "amount coltotal", defstyle] (toHtml $ showMixedAmountOneLineWithoutPrice a) | a <- coltotals]
                      ++ (if row_total_ ropts then [th_ [class_ "amount coltotal", defstyle] $ toHtml $ showMixedAmountOneLineWithoutPrice $ grandtotal] else [])
                      ++ (if average_ ropts   then [th_ [class_ "amount colaverage", defstyle] $ toHtml $ showMixedAmountOneLineWithoutPrice $ grandavg] else [])
                    ]

  in do
    style_ (TS.unlines [""
      ,"td { padding:0 0.5em; }"
      ,"td:nth-child(1) { white-space:nowrap; }"
      ,"tr:nth-child(even) td { background-color:#eee; }"
      ])
    link_ [rel_ "stylesheet", href_ "hledger.css"]
    table_ $ mconcat $
         titlerows
      ++ [blankrow]
      ++ concatMap subreportrows subreports
      ++ totalrows