{-|

A ledger-compatible @balance@ command, with additional support for
multi-column reports.

Here is a description/specification for the balance command.  See also
"Hledger.Reports" -> \"Balance reports\".


/Basic balance report/

With no report interval (@--monthly@ etc.), hledger's balance
command emulates ledger's, showing accounts indented according to
hierarchy, along with their total amount posted (including subaccounts).

Here's an example. With @examples/sample.journal@, which defines the following account tree:

@
 assets
   bank
     checking
     saving
   cash
 expenses
   food
   supplies
 income
   gifts
   salary
 liabilities
   debts
@

the basic @balance@ command gives this output:

@
 $ hledger -f sample.journal balance
                 $-1  assets
                  $1    bank:saving
                 $-2    cash
                  $2  expenses
                  $1    food
                  $1    supplies
                 $-2  income
                 $-1    gifts
                 $-1    salary
                  $1  liabilities:debts
--------------------
                   0
@

Subaccounts are displayed indented below their parent. Only the account leaf name (the final part) is shown.
(With @--flat@, account names are shown in full and unindented.)

Each account's \"balance\" is the sum of postings in that account and any subaccounts during the report period.
When the report period includes all transactions, this is equivalent to the account's current balance.

The overall total of the highest-level displayed accounts is shown below the line.
(The @--no-total/-N@ flag prevents this.)

/Eliding and omitting/

Accounts which have a zero balance, and no non-zero subaccount
balances, are normally omitted from the report.
(The @--empty/-E@ flag forces such accounts to be displayed.)
Eg, above @checking@ is omitted because it has a zero balance and no subaccounts.

Accounts which have a single subaccount also being displayed, with the same balance,
are normally elided into the subaccount's line.
(The @--no-elide@ flag prevents this.)
Eg, above @bank@ is elided to @bank:saving@ because it has only a
single displayed subaccount (@saving@) and their balance is the same
($1). Similarly, @liabilities@ is elided to @liabilities:debts@.

/Date limiting/

The default report period is that of the whole journal, including all
known transactions. The @--begin\/-b@, @--end\/-e@, @--period\/-p@
options or @date:@/@date2:@ patterns can be used to report only
on transactions before and/or after specified dates.

/Depth limiting/

The @--depth@ option can be used to limit the depth of the balance report.
Eg, to see just the top level accounts (still including their subaccount balances):

@
$ hledger -f sample.journal balance --depth 1
                 $-1  assets
                  $2  expenses
                 $-2  income
                  $1  liabilities
--------------------
                   0
@

/Account limiting/

With one or more account pattern arguments, the report is restricted
to accounts whose name matches one of the patterns, plus their parents
and subaccounts. Eg, adding the pattern @o@ to the first example gives:

@
 $ hledger -f sample.journal balance o
                  $1  expenses:food
                 $-2  income
                 $-1    gifts
                 $-1    salary
--------------------
                 $-1
@

* The @o@ pattern matched @food@ and @income@, so they are shown.

* @food@'s parent (@expenses@) is shown even though the pattern didn't
  match it, to clarify the hierarchy. The usual eliding rules cause it to be elided here.

* @income@'s subaccounts are also shown.

/Multi-column balance report/

hledger's balance command will show multiple columns when a reporting
interval is specified (eg with @--monthly@), one column for each sub-period.

There are three accumulation strategies for multi-column balance report, indicated by
the heading:

* A \"period balance\" (or \"flow\") report (with @--change@, the default) shows the
  change of account balance in each period, which is equivalent to the sum of postings
  in each period. Here, checking's balance increased by 10 in Feb:

  > Change of balance (flow):
  >
  >                  Jan   Feb   Mar
  > assets:checking   20    10    -5

* A \"cumulative balance\" report (with @--cumulative@) shows the accumulated ending balance
  across periods, starting from zero at the report's start date.
  Here, 30 is the sum of checking postings during Jan and Feb:

  > Ending balance (cumulative):
  >
  >                  Jan   Feb   Mar
  > assets:checking   20    30    25

* A \"historical balance\" report (with @--historical/-H@) also shows ending balances,
  but it includes the starting balance from any postings before the report start date.
  Here, 130 is the balance from all checking postings at the end of Feb, including
  pre-Jan postings which created a starting balance of 100:

  > Ending balance (historical):
  >
  >                  Jan   Feb   Mar
  > assets:checking  120   130   125

/Eliding and omitting, 2/

Here's a (imperfect?) specification for the eliding/omitting behaviour:

* Each account is normally displayed on its own line.

* An account less deep than the report's max depth, with just one
interesting subaccount, and the same balance as the subaccount, is
non-interesting, and prefixed to the subaccount's line, unless
@--no-elide@ is in effect.

* An account with a zero inclusive balance and less than two interesting
subaccounts is not displayed at all, unless @--empty@ is in effect.

* Multi-column balance reports show full account names with no eliding
  (like @--flat@). Accounts (and periods) are omitted as described below.

/Which accounts to show in balance reports/

By default:

* single-column: accounts with non-zero balance in report period.
                 (With @--flat@: accounts with non-zero balance and postings.)

* change:        accounts with postings and non-zero period balance in any period

* cumulative:    accounts with non-zero cumulative balance in any period

* historical:    accounts with non-zero historical balance in any period

With @-E/--empty@:

* single-column: accounts with postings in report period

* change:        accounts with postings in report period

* cumulative:    accounts with postings in report period

* historical:    accounts with non-zero starting balance +
                 accounts with postings in report period

/Which periods (columns) to show in balance reports/

An empty period/column is one where no report account has any postings.
A zero period/column is one where no report account has a non-zero period balance.

Currently,

by default:

* single-column: N/A

* change:        all periods within the overall report period,
                 except for leading and trailing empty periods

* cumulative:    all periods within the overall report period,
                 except for leading and trailing empty periods

* historical:    all periods within the overall report period,
                 except for leading and trailing empty periods

With @-E/--empty@:

* single-column: N/A

* change:        all periods within the overall report period

* cumulative:    all periods within the overall report period

* historical:    all periods within the overall report period

/What to show in empty cells/

An empty periodic balance report cell is one which has no corresponding postings.
An empty cumulative/historical balance report cell is one which has no corresponding
or prior postings, ie the account doesn't exist yet.
Currently, empty cells show 0.

-}

{-# LANGUAGE CPP                  #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE NamedFieldPuns       #-}
{-# LANGUAGE RecordWildCards      #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TemplateHaskell      #-}

module Hledger.Cli.Commands.Balance (
  -- ** balance command
  balancemode
 ,balance
  -- ** balance output rendering
 ,balanceReportAsText
 ,balanceReportAsCsv
 ,balanceReportAsSpreadsheet
 ,balanceReportItemAsText
 ,budgetReportAsText
 ,budgetReportAsCsv
 ,budgetReportAsSpreadsheet
 ,multiBalanceRowAsCellBuilders
 ,multiBalanceRowAsCsvText
 ,multiBalanceRowAsText
 ,multiBalanceReportAsText
 ,multiBalanceReportAsCsv
 ,multiBalanceReportAsHtml
 ,multiBalanceReportAsTable
 ,multiBalanceReportTableAsText
 ,multiBalanceReportAsSpreadsheet
 ,multiBalanceReportAsSpreadsheetParts
 ,multiBalanceHasTotalsColumn
 ,addTotalBorders
 ,simpleDateSpanCell
 ,tidyColumnLabels
 ,nbsp
 ,RowClass(..)
  -- ** Tests
 ,tests_Balance
) where

import Control.Arrow (second, (***))
import Control.Monad (guard)
import Data.Decimal (roundTo)
import Data.Default (def)
import Data.Function (on)
import Data.List (find, transpose)
#if !MIN_VERSION_base(4,20,0)
import Data.List (foldl')
#endif
import qualified Data.Map as Map
import qualified Data.Set as S
import Data.Maybe (mapMaybe, fromMaybe)
import Data.Tuple (swap)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Data.Time (addDays, fromGregorian)
import System.Console.CmdArgs.Explicit as C (flagNone, flagReq, flagOpt)
import Safe (headMay, maximumMay)
import Text.Tabular.AsciiWide
    (Header(..), Align(..), Properties(..), Cell(..), Table(..), TableOpts(..),
    cellWidth, concatTables, renderColumns, renderRowB, renderTableByRowsB, textCell)

import qualified System.IO as IO

import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
import Hledger.Cli.Anchor (setAccountAnchor, dateSpanCell, headerDateSpanCell)
import Hledger.Write.Csv (CSV, printCSV, printTSV)
import Hledger.Write.Ods (printFods)
import Hledger.Write.Html (Html, styledTableHtml, htmlAsLazyText, toHtml)
import Hledger.Write.Spreadsheet (rawTableContent, headerCell,
            addHeaderBorders, addRowSpanHeader,
            cellFromMixedAmount, cellsFromMixedAmount)
import qualified Hledger.Write.Spreadsheet as Ods


-- | Command line options for this command.
balancemode :: Mode RawOpts
balancemode = CommandHelpStr
-> [Flag RawOpts]
-> [(CommandHelpStr, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Balance.txt")
  (
    -- https://hledger.org/dev/hledger.html#calculation-mode :
    [[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"sum"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"sum")
      (CommandHelpStr
calcprefix CommandHelpStr -> CommandHelpStr -> CommandHelpStr
forall a. [a] -> [a] -> [a]
++ CommandHelpStr
"show sum of posting amounts (default)")
    ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"valuechange"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"valuechange")
      (CommandHelpStr
calcprefix CommandHelpStr -> CommandHelpStr -> CommandHelpStr
forall a. [a] -> [a] -> [a]
++ CommandHelpStr
"show total change of value of period-end historical balances (caused by deposits, withdrawals, market price fluctuations)")
    ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"gain"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"gain")
      (CommandHelpStr
calcprefix CommandHelpStr -> CommandHelpStr -> CommandHelpStr
forall a. [a] -> [a] -> [a]
++ CommandHelpStr
"show unrealised capital gain/loss (historical balance value minus cost basis)")
    -- XXX --budget[=DESCPAT], --forecast[=PERIODEXP], could be more consistent
    ,CommandHelpStr
-> [CommandHelpStr]
-> Update RawOpts
-> CommandHelpStr
-> CommandHelpStr
-> Flag RawOpts
forall a.
CommandHelpStr
-> [CommandHelpStr]
-> Update a
-> CommandHelpStr
-> CommandHelpStr
-> Flag a
flagOpt CommandHelpStr
"" [CommandHelpStr
"budget"] (\CommandHelpStr
s RawOpts
opts -> RawOpts -> Either CommandHelpStr RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either CommandHelpStr RawOpts)
-> RawOpts -> Either CommandHelpStr RawOpts
forall a b. (a -> b) -> a -> b
$ CommandHelpStr -> CommandHelpStr -> RawOpts -> RawOpts
setopt CommandHelpStr
"budget" CommandHelpStr
s RawOpts
opts) CommandHelpStr
"DESCPAT"
      ([CommandHelpStr] -> CommandHelpStr
unlines
      [ CommandHelpStr
calcprefix CommandHelpStr -> CommandHelpStr -> CommandHelpStr
forall a. [a] -> [a] -> [a]
++ CommandHelpStr
"show sum of posting amounts together with budget goals defined by periodic"
      , CommandHelpStr
"transactions. With a DESCPAT argument (must be separated by = not space),"
      , CommandHelpStr
"use only periodic transactions with matching description"
      , CommandHelpStr
"(case insensitive substring match)."
      ])
    ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"count"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"count")
      (CommandHelpStr
calcprefix CommandHelpStr -> CommandHelpStr -> CommandHelpStr
forall a. [a] -> [a] -> [a]
++ CommandHelpStr
"show the count of postings")

    -- https://hledger.org/dev/hledger.html#accumulation-mode :
    ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"change"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"change")
      (CommandHelpStr
accumprefix CommandHelpStr -> CommandHelpStr -> CommandHelpStr
forall a. [a] -> [a] -> [a]
++ CommandHelpStr
"accumulate amounts from column start to column end (in multicolumn reports, default)")
    ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"cumulative"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"cumulative")
      (CommandHelpStr
accumprefix CommandHelpStr -> CommandHelpStr -> CommandHelpStr
forall a. [a] -> [a] -> [a]
++ CommandHelpStr
"accumulate amounts from report start (specified by e.g. -b/--begin) to column end")
    ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"historical",CommandHelpStr
"H"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"historical")
      (CommandHelpStr
accumprefix CommandHelpStr -> CommandHelpStr -> CommandHelpStr
forall a. [a] -> [a] -> [a]
++ CommandHelpStr
"accumulate amounts from journal start to column end (includes postings before report start date)")
    ]

    -- other options specific to this command:
    [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++ Bool -> [Flag RawOpts]
flattreeflags Bool
True [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++
    [[CommandHelpStr]
-> Update RawOpts
-> CommandHelpStr
-> CommandHelpStr
-> Flag RawOpts
forall a.
[CommandHelpStr]
-> Update a -> CommandHelpStr -> CommandHelpStr -> Flag a
flagReq  [CommandHelpStr
"drop"] (\CommandHelpStr
s RawOpts
opts -> RawOpts -> Either CommandHelpStr RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either CommandHelpStr RawOpts)
-> RawOpts -> Either CommandHelpStr RawOpts
forall a b. (a -> b) -> a -> b
$ CommandHelpStr -> CommandHelpStr -> RawOpts -> RawOpts
setopt CommandHelpStr
"drop" CommandHelpStr
s RawOpts
opts) CommandHelpStr
"N" CommandHelpStr
"in list mode, omit N leading account name parts"
    ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"declared"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"declared") CommandHelpStr
"include non-parent declared accounts (best used with -E)"
    ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"average",CommandHelpStr
"A"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"average") CommandHelpStr
"show a row average column (in multicolumn reports)"
    ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"row-total",CommandHelpStr
"T"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"row-total") CommandHelpStr
"show a row total column (in multicolumn reports)"
    ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"summary-only"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"summary-only") CommandHelpStr
"display only row summaries (e.g. row total, average) (in multicolumn reports)"
    ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"no-total",CommandHelpStr
"N"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"no-total") CommandHelpStr
"omit the final total row"
    ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"no-elide"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"no-elide") CommandHelpStr
"in tree mode, don't squash boring parent accounts"
    ,[CommandHelpStr]
-> Update RawOpts
-> CommandHelpStr
-> CommandHelpStr
-> Flag RawOpts
forall a.
[CommandHelpStr]
-> Update a -> CommandHelpStr -> CommandHelpStr -> Flag a
flagReq  [CommandHelpStr
"format"] (\CommandHelpStr
s RawOpts
opts -> RawOpts -> Either CommandHelpStr RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either CommandHelpStr RawOpts)
-> RawOpts -> Either CommandHelpStr RawOpts
forall a b. (a -> b) -> a -> b
$ CommandHelpStr -> CommandHelpStr -> RawOpts -> RawOpts
setopt CommandHelpStr
"format" CommandHelpStr
s RawOpts
opts) CommandHelpStr
"FORMATSTR" CommandHelpStr
"use this custom line format (in simple reports)"
    ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"sort-amount",CommandHelpStr
"S"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"sort-amount") CommandHelpStr
"sort by amount instead of account code/name (in flat mode). With multiple columns, sorts by the row total, or by row average if that is displayed."
    ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"percent", CommandHelpStr
"%"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"percent") CommandHelpStr
"express values in percentage of each column's total"
    ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"related",CommandHelpStr
"r"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"related") CommandHelpStr
"show the other accounts transacted with, instead"
    ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"invert"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"invert") CommandHelpStr
"display all amounts with reversed sign"
    ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"transpose"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"transpose") CommandHelpStr
"switch rows and columns (use vertical time axis)"
    ,[CommandHelpStr]
-> Update RawOpts
-> CommandHelpStr
-> CommandHelpStr
-> Flag RawOpts
forall a.
[CommandHelpStr]
-> Update a -> CommandHelpStr -> CommandHelpStr -> Flag a
flagReq  [CommandHelpStr
"layout"] (\CommandHelpStr
s RawOpts
opts -> RawOpts -> Either CommandHelpStr RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either CommandHelpStr RawOpts)
-> RawOpts -> Either CommandHelpStr RawOpts
forall a b. (a -> b) -> a -> b
$ CommandHelpStr -> CommandHelpStr -> RawOpts -> RawOpts
setopt CommandHelpStr
"layout" CommandHelpStr
s RawOpts
opts) CommandHelpStr
"ARG"
      ([CommandHelpStr] -> CommandHelpStr
unlines
        [CommandHelpStr
"how to lay out multi-commodity amounts and the overall table:"
        ,CommandHelpStr
"'wide[,W]': commodities on same line, up to W wide"
        ,CommandHelpStr
"'tall'    : commodities on separate lines"
        ,CommandHelpStr
"'bare'    : commodity symbols in a separate column"
        ,CommandHelpStr
"'tidy'    : each data field in its own column"
        ])
     ,[CommandHelpStr]
-> Update RawOpts
-> CommandHelpStr
-> CommandHelpStr
-> Flag RawOpts
forall a.
[CommandHelpStr]
-> Update a -> CommandHelpStr -> CommandHelpStr -> Flag a
flagReq  [CommandHelpStr
"base-url"] (\CommandHelpStr
s RawOpts
opts -> RawOpts -> Either CommandHelpStr RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either CommandHelpStr RawOpts)
-> RawOpts -> Either CommandHelpStr RawOpts
forall a b. (a -> b) -> a -> b
$ CommandHelpStr -> CommandHelpStr -> RawOpts -> RawOpts
setopt CommandHelpStr
"base-url" CommandHelpStr
s RawOpts
opts) CommandHelpStr
"URLPREFIX" CommandHelpStr
"in html output, generate links to hledger-web, with this prefix. (Usually the base url shown by hledger-web; can also be relative.)"

    -- output:
    ,[CommandHelpStr] -> Flag RawOpts
outputFormatFlag [CommandHelpStr
"txt",CommandHelpStr
"html",CommandHelpStr
"csv",CommandHelpStr
"tsv",CommandHelpStr
"json",CommandHelpStr
"fods"]
    ,Flag RawOpts
outputFileFlag

    ]
  )
  [(CommandHelpStr, [Flag RawOpts])]
cligeneralflagsgroups1
  ([Flag RawOpts]
hiddenflags [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++
    [ [CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"commodity-column"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"commodity-column")
      CommandHelpStr
"show commodity symbols in a separate column, amounts as bare numbers, one row per commodity"
    ])
  ([], Arg RawOpts -> Maybe (Arg RawOpts)
forall a. a -> Maybe a
Just (Arg RawOpts -> Maybe (Arg RawOpts))
-> Arg RawOpts -> Maybe (Arg RawOpts)
forall a b. (a -> b) -> a -> b
$ CommandHelpStr -> Arg RawOpts
argsFlag CommandHelpStr
"[QUERY]")

  where
    calcprefix :: CommandHelpStr
calcprefix = CommandHelpStr
"calculation mode: "
    accumprefix :: CommandHelpStr
accumprefix = CommandHelpStr
"accumulation mode: "

-- | The balance command, prints a balance report.
balance :: CliOpts -> Journal -> IO ()
balance :: CliOpts -> Journal -> IO ()
balance opts :: CliOpts
opts@CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec} Journal
j = case ReportOpts -> BalanceCalculation
balancecalc_ ReportOpts
ropts of
    BalanceCalculation
CalcBudget -> do  -- single or multi period budget report
      let rspan :: DateSpan
rspan = (DateSpan, [DateSpan]) -> DateSpan
forall a b. (a, b) -> a
fst ((DateSpan, [DateSpan]) -> DateSpan)
-> (DateSpan, [DateSpan]) -> DateSpan
forall a b. (a -> b) -> a -> b
$ Journal -> ReportSpec -> (DateSpan, [DateSpan])
reportSpan Journal
j ReportSpec
rspec
          budgetreport :: BudgetReport
budgetreport = Map Text AmountStyle -> BudgetReport -> BudgetReport
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles (BudgetReport -> BudgetReport) -> BudgetReport -> BudgetReport
forall a b. (a -> b) -> a -> b
$ ReportSpec -> BalancingOpts -> DateSpan -> Journal -> BudgetReport
budgetReport ReportSpec
rspec (InputOpts -> BalancingOpts
balancingopts_ (InputOpts -> BalancingOpts) -> InputOpts -> BalancingOpts
forall a b. (a -> b) -> a -> b
$ CliOpts -> InputOpts
inputopts_ CliOpts
opts) DateSpan
rspan Journal
j
          render :: BudgetReport -> Text
render = case CommandHelpStr
fmt of
            CommandHelpStr
"txt"  -> ReportOpts -> BudgetReport -> Text
budgetReportAsText ReportOpts
ropts
            CommandHelpStr
"json" -> (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n") (Text -> Text) -> (BudgetReport -> Text) -> BudgetReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BudgetReport -> Text
forall a. ToJSON a => a -> Text
toJsonText
            CommandHelpStr
"csv"  -> CSV -> Text
printCSV (CSV -> Text) -> (BudgetReport -> CSV) -> BudgetReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> BudgetReport -> CSV
budgetReportAsCsv ReportOpts
ropts
            CommandHelpStr
"tsv"  -> CSV -> Text
printTSV (CSV -> Text) -> (BudgetReport -> CSV) -> BudgetReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> BudgetReport -> CSV
budgetReportAsCsv ReportOpts
ropts
            CommandHelpStr
"html" -> (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n") (Text -> Text) -> (BudgetReport -> Text) -> BudgetReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
htmlAsLazyText (Html -> Text) -> (BudgetReport -> Html) -> BudgetReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      [[Cell NumLines Html]] -> Html
forall border. Lines border => [[Cell border Html]] -> Html
styledTableHtml ([[Cell NumLines Html]] -> Html)
-> (BudgetReport -> [[Cell NumLines Html]]) -> BudgetReport -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Cell NumLines Text] -> [Cell NumLines Html])
-> [[Cell NumLines Text]] -> [[Cell NumLines Html]]
forall a b. (a -> b) -> [a] -> [b]
map ((Cell NumLines Text -> Cell NumLines Html)
-> [Cell NumLines Text] -> [Cell NumLines Html]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Html) -> Cell NumLines Text -> Cell NumLines Html
forall a b. (a -> b) -> Cell NumLines a -> Cell NumLines b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Html
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml)) ([[Cell NumLines Text]] -> [[Cell NumLines Html]])
-> (BudgetReport -> [[Cell NumLines Text]])
-> BudgetReport
-> [[Cell NumLines Html]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> BudgetReport -> [[Cell NumLines Text]]
budgetReportAsSpreadsheet ReportOpts
ropts
            CommandHelpStr
"fods" -> TextEncoding
-> Map Text ((Int, Int), [[Cell NumLines Text]]) -> Text
printFods TextEncoding
IO.localeEncoding (Map Text ((Int, Int), [[Cell NumLines Text]]) -> Text)
-> (BudgetReport -> Map Text ((Int, Int), [[Cell NumLines Text]]))
-> BudgetReport
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      Text
-> ((Int, Int), [[Cell NumLines Text]])
-> Map Text ((Int, Int), [[Cell NumLines Text]])
forall k a. k -> a -> Map k a
Map.singleton Text
"Budget Report" (((Int, Int), [[Cell NumLines Text]])
 -> Map Text ((Int, Int), [[Cell NumLines Text]]))
-> (BudgetReport -> ((Int, Int), [[Cell NumLines Text]]))
-> BudgetReport
-> Map Text ((Int, Int), [[Cell NumLines Text]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) (Int
1,Int
0) ([[Cell NumLines Text]] -> ((Int, Int), [[Cell NumLines Text]]))
-> (BudgetReport -> [[Cell NumLines Text]])
-> BudgetReport
-> ((Int, Int), [[Cell NumLines Text]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> BudgetReport -> [[Cell NumLines Text]]
budgetReportAsSpreadsheet ReportOpts
ropts
            CommandHelpStr
_      -> CommandHelpStr -> BudgetReport -> Text
forall a. CommandHelpStr -> a
error' (CommandHelpStr -> BudgetReport -> Text)
-> CommandHelpStr -> BudgetReport -> Text
forall a b. (a -> b) -> a -> b
$ CommandHelpStr -> CommandHelpStr
unsupportedOutputFormatError CommandHelpStr
fmt
      CliOpts -> Text -> IO ()
writeOutputLazyText CliOpts
opts (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ BudgetReport -> Text
render BudgetReport
budgetreport

    BalanceCalculation
_ | Bool
multiperiod -> do  -- multi period balance report
        let report :: MultiBalanceReport
report = Map Text AmountStyle -> MultiBalanceReport -> MultiBalanceReport
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles (MultiBalanceReport -> MultiBalanceReport)
-> MultiBalanceReport -> MultiBalanceReport
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> MultiBalanceReport
multiBalanceReport ReportSpec
rspec Journal
j
            render :: MultiBalanceReport -> Text
render = case CommandHelpStr
fmt of
              CommandHelpStr
"txt"  -> ReportOpts -> MultiBalanceReport -> Text
multiBalanceReportAsText ReportOpts
ropts
              CommandHelpStr
"csv"  -> CSV -> Text
printCSV (CSV -> Text)
-> (MultiBalanceReport -> CSV) -> MultiBalanceReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> MultiBalanceReport -> CSV
multiBalanceReportAsCsv ReportOpts
ropts
              CommandHelpStr
"tsv"  -> CSV -> Text
printTSV (CSV -> Text)
-> (MultiBalanceReport -> CSV) -> MultiBalanceReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> MultiBalanceReport -> CSV
multiBalanceReportAsCsv ReportOpts
ropts
              CommandHelpStr
"html" -> (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n") (Text -> Text)
-> (MultiBalanceReport -> Text) -> MultiBalanceReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
htmlAsLazyText (Html -> Text)
-> (MultiBalanceReport -> Html) -> MultiBalanceReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> MultiBalanceReport -> Html
multiBalanceReportAsHtml ReportOpts
ropts
              CommandHelpStr
"json" -> (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n") (Text -> Text)
-> (MultiBalanceReport -> Text) -> MultiBalanceReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiBalanceReport -> Text
forall a. ToJSON a => a -> Text
toJsonText
              CommandHelpStr
"fods" -> TextEncoding
-> Map Text ((Int, Int), [[Cell NumLines Text]]) -> Text
printFods TextEncoding
IO.localeEncoding (Map Text ((Int, Int), [[Cell NumLines Text]]) -> Text)
-> (MultiBalanceReport
    -> Map Text ((Int, Int), [[Cell NumLines Text]]))
-> MultiBalanceReport
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        Text
-> ((Int, Int), [[Cell NumLines Text]])
-> Map Text ((Int, Int), [[Cell NumLines Text]])
forall k a. k -> a -> Map k a
Map.singleton Text
"Multi-period Balance Report" (((Int, Int), [[Cell NumLines Text]])
 -> Map Text ((Int, Int), [[Cell NumLines Text]]))
-> (MultiBalanceReport -> ((Int, Int), [[Cell NumLines Text]]))
-> MultiBalanceReport
-> Map Text ((Int, Int), [[Cell NumLines Text]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts
-> MultiBalanceReport -> ((Int, Int), [[Cell NumLines Text]])
multiBalanceReportAsSpreadsheet ReportOpts
ropts
              CommandHelpStr
_      -> Text -> MultiBalanceReport -> Text
forall a b. a -> b -> a
const (Text -> MultiBalanceReport -> Text)
-> Text -> MultiBalanceReport -> Text
forall a b. (a -> b) -> a -> b
$ CommandHelpStr -> Text
forall a. CommandHelpStr -> a
error' (CommandHelpStr -> Text) -> CommandHelpStr -> Text
forall a b. (a -> b) -> a -> b
$ CommandHelpStr -> CommandHelpStr
unsupportedOutputFormatError CommandHelpStr
fmt  -- PARTIAL:
        CliOpts -> Text -> IO ()
writeOutputLazyText CliOpts
opts (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ MultiBalanceReport -> Text
render MultiBalanceReport
report

    BalanceCalculation
_ -> do  -- single period simple balance report
        let report :: BalanceReport
report = Map Text AmountStyle -> BalanceReport -> BalanceReport
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles (BalanceReport -> BalanceReport) -> BalanceReport -> BalanceReport
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> BalanceReport
balanceReport ReportSpec
rspec Journal
j -- simple Ledger-style balance report
            render :: BalanceReport -> Text
render = case CommandHelpStr
fmt of
              CommandHelpStr
"txt"  -> Builder -> Text
TB.toLazyText (Builder -> Text)
-> (BalanceReport -> Builder) -> BalanceReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> BalanceReport -> Builder
balanceReportAsText ReportOpts
ropts
              CommandHelpStr
"csv"  -> CSV -> Text
printCSV (CSV -> Text) -> (BalanceReport -> CSV) -> BalanceReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> BalanceReport -> CSV
balanceReportAsCsv ReportOpts
ropts
              CommandHelpStr
"tsv"  -> CSV -> Text
printTSV (CSV -> Text) -> (BalanceReport -> CSV) -> BalanceReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> BalanceReport -> CSV
balanceReportAsCsv ReportOpts
ropts
              CommandHelpStr
"html" -> (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n") (Text -> Text) -> (BalanceReport -> Text) -> BalanceReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
htmlAsLazyText (Html -> Text) -> (BalanceReport -> Html) -> BalanceReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   [[Cell NumLines Html]] -> Html
forall border. Lines border => [[Cell border Html]] -> Html
styledTableHtml ([[Cell NumLines Html]] -> Html)
-> (BalanceReport -> [[Cell NumLines Html]])
-> BalanceReport
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Cell NumLines Text] -> [Cell NumLines Html])
-> [[Cell NumLines Text]] -> [[Cell NumLines Html]]
forall a b. (a -> b) -> [a] -> [b]
map ((Cell NumLines Text -> Cell NumLines Html)
-> [Cell NumLines Text] -> [Cell NumLines Html]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Html) -> Cell NumLines Text -> Cell NumLines Html
forall a b. (a -> b) -> Cell NumLines a -> Cell NumLines b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Html
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml)) ([[Cell NumLines Text]] -> [[Cell NumLines Html]])
-> (BalanceReport -> [[Cell NumLines Text]])
-> BalanceReport
-> [[Cell NumLines Html]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> BalanceReport -> [[Cell NumLines Text]]
balanceReportAsSpreadsheet ReportOpts
ropts
              CommandHelpStr
"json" -> (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n") (Text -> Text) -> (BalanceReport -> Text) -> BalanceReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalanceReport -> Text
forall a. ToJSON a => a -> Text
toJsonText
              CommandHelpStr
"fods" -> TextEncoding
-> Map Text ((Int, Int), [[Cell NumLines Text]]) -> Text
printFods TextEncoding
IO.localeEncoding (Map Text ((Int, Int), [[Cell NumLines Text]]) -> Text)
-> (BalanceReport -> Map Text ((Int, Int), [[Cell NumLines Text]]))
-> BalanceReport
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> ((Int, Int), [[Cell NumLines Text]])
-> Map Text ((Int, Int), [[Cell NumLines Text]])
forall k a. k -> a -> Map k a
Map.singleton Text
"Balance Report" (((Int, Int), [[Cell NumLines Text]])
 -> Map Text ((Int, Int), [[Cell NumLines Text]]))
-> (BalanceReport -> ((Int, Int), [[Cell NumLines Text]]))
-> BalanceReport
-> Map Text ((Int, Int), [[Cell NumLines Text]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) (Int
1,Int
0) ([[Cell NumLines Text]] -> ((Int, Int), [[Cell NumLines Text]]))
-> (BalanceReport -> [[Cell NumLines Text]])
-> BalanceReport
-> ((Int, Int), [[Cell NumLines Text]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> BalanceReport -> [[Cell NumLines Text]]
balanceReportAsSpreadsheet ReportOpts
ropts
              CommandHelpStr
_      -> CommandHelpStr -> BalanceReport -> Text
forall a. CommandHelpStr -> a
error' (CommandHelpStr -> BalanceReport -> Text)
-> CommandHelpStr -> BalanceReport -> Text
forall a b. (a -> b) -> a -> b
$ CommandHelpStr -> CommandHelpStr
unsupportedOutputFormatError CommandHelpStr
fmt  -- PARTIAL:
        CliOpts -> Text -> IO ()
writeOutputLazyText CliOpts
opts (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ BalanceReport -> Text
render BalanceReport
report
  where
    styles :: Map Text AmountStyle
styles = Rounding -> Journal -> Map Text AmountStyle
journalCommodityStylesWith Rounding
HardRounding Journal
j
    ropts :: ReportOpts
ropts =
        let ropts0 :: ReportOpts
ropts0 = ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec in
        ReportOpts
ropts0 {
            -- tidy csv is defined externally and must not include totals or averages
            no_total_ = no_total_ ropts0 || layout_ ropts0 == LayoutTidy
        }
    -- Tidy csv/tsv should be consistent between single period and multiperiod reports.
    multiperiod :: Bool
multiperiod = ReportOpts -> Interval
interval_ ReportOpts
ropts Interval -> Interval -> Bool
forall a. Eq a => a -> a -> Bool
/= Interval
NoInterval Bool -> Bool -> Bool
|| (ReportOpts -> Layout
layout_ ReportOpts
ropts Layout -> Layout -> Bool
forall a. Eq a => a -> a -> Bool
== Layout
LayoutTidy Bool -> Bool -> Bool
&& Bool
delimited)
    delimited :: Bool
delimited   = CommandHelpStr
fmt CommandHelpStr -> CommandHelpStr -> Bool
forall a. Eq a => a -> a -> Bool
== CommandHelpStr
"csv" Bool -> Bool -> Bool
|| CommandHelpStr
fmt CommandHelpStr -> CommandHelpStr -> Bool
forall a. Eq a => a -> a -> Bool
== CommandHelpStr
"tsv"
    fmt :: CommandHelpStr
fmt         = CliOpts -> CommandHelpStr
outputFormatFromOpts CliOpts
opts

-- Rendering

data RowClass = Value | Total
    deriving (RowClass -> RowClass -> Bool
(RowClass -> RowClass -> Bool)
-> (RowClass -> RowClass -> Bool) -> Eq RowClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RowClass -> RowClass -> Bool
== :: RowClass -> RowClass -> Bool
$c/= :: RowClass -> RowClass -> Bool
/= :: RowClass -> RowClass -> Bool
Eq, Eq RowClass
Eq RowClass =>
(RowClass -> RowClass -> Ordering)
-> (RowClass -> RowClass -> Bool)
-> (RowClass -> RowClass -> Bool)
-> (RowClass -> RowClass -> Bool)
-> (RowClass -> RowClass -> Bool)
-> (RowClass -> RowClass -> RowClass)
-> (RowClass -> RowClass -> RowClass)
-> Ord RowClass
RowClass -> RowClass -> Bool
RowClass -> RowClass -> Ordering
RowClass -> RowClass -> RowClass
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RowClass -> RowClass -> Ordering
compare :: RowClass -> RowClass -> Ordering
$c< :: RowClass -> RowClass -> Bool
< :: RowClass -> RowClass -> Bool
$c<= :: RowClass -> RowClass -> Bool
<= :: RowClass -> RowClass -> Bool
$c> :: RowClass -> RowClass -> Bool
> :: RowClass -> RowClass -> Bool
$c>= :: RowClass -> RowClass -> Bool
>= :: RowClass -> RowClass -> Bool
$cmax :: RowClass -> RowClass -> RowClass
max :: RowClass -> RowClass -> RowClass
$cmin :: RowClass -> RowClass -> RowClass
min :: RowClass -> RowClass -> RowClass
Ord, Int -> RowClass
RowClass -> Int
RowClass -> [RowClass]
RowClass -> RowClass
RowClass -> RowClass -> [RowClass]
RowClass -> RowClass -> RowClass -> [RowClass]
(RowClass -> RowClass)
-> (RowClass -> RowClass)
-> (Int -> RowClass)
-> (RowClass -> Int)
-> (RowClass -> [RowClass])
-> (RowClass -> RowClass -> [RowClass])
-> (RowClass -> RowClass -> [RowClass])
-> (RowClass -> RowClass -> RowClass -> [RowClass])
-> Enum RowClass
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RowClass -> RowClass
succ :: RowClass -> RowClass
$cpred :: RowClass -> RowClass
pred :: RowClass -> RowClass
$ctoEnum :: Int -> RowClass
toEnum :: Int -> RowClass
$cfromEnum :: RowClass -> Int
fromEnum :: RowClass -> Int
$cenumFrom :: RowClass -> [RowClass]
enumFrom :: RowClass -> [RowClass]
$cenumFromThen :: RowClass -> RowClass -> [RowClass]
enumFromThen :: RowClass -> RowClass -> [RowClass]
$cenumFromTo :: RowClass -> RowClass -> [RowClass]
enumFromTo :: RowClass -> RowClass -> [RowClass]
$cenumFromThenTo :: RowClass -> RowClass -> RowClass -> [RowClass]
enumFromThenTo :: RowClass -> RowClass -> RowClass -> [RowClass]
Enum, RowClass
RowClass -> RowClass -> Bounded RowClass
forall a. a -> a -> Bounded a
$cminBound :: RowClass
minBound :: RowClass
$cmaxBound :: RowClass
maxBound :: RowClass
Bounded, Int -> RowClass -> CommandHelpStr -> CommandHelpStr
[RowClass] -> CommandHelpStr -> CommandHelpStr
RowClass -> CommandHelpStr
(Int -> RowClass -> CommandHelpStr -> CommandHelpStr)
-> (RowClass -> CommandHelpStr)
-> ([RowClass] -> CommandHelpStr -> CommandHelpStr)
-> Show RowClass
forall a.
(Int -> a -> CommandHelpStr -> CommandHelpStr)
-> (a -> CommandHelpStr)
-> ([a] -> CommandHelpStr -> CommandHelpStr)
-> Show a
$cshowsPrec :: Int -> RowClass -> CommandHelpStr -> CommandHelpStr
showsPrec :: Int -> RowClass -> CommandHelpStr -> CommandHelpStr
$cshow :: RowClass -> CommandHelpStr
show :: RowClass -> CommandHelpStr
$cshowList :: [RowClass] -> CommandHelpStr -> CommandHelpStr
showList :: [RowClass] -> CommandHelpStr -> CommandHelpStr
Show)

amountClass :: RowClass -> Ods.Class
amountClass :: RowClass -> Class
amountClass RowClass
rc =
    Text -> Class
Ods.Class (Text -> Class) -> Text -> Class
forall a b. (a -> b) -> a -> b
$
    case RowClass
rc of RowClass
Value -> Text
"amount"; RowClass
Total -> Text
"amount coltotal"

budgetClass :: RowClass -> Ods.Class
budgetClass :: RowClass -> Class
budgetClass RowClass
rc =
    Text -> Class
Ods.Class (Text -> Class) -> Text -> Class
forall a b. (a -> b) -> a -> b
$
    case RowClass
rc of RowClass
Value -> Text
"budget"; RowClass
Total -> Text
"budget coltotal"

rowTotalClass :: RowClass -> Ods.Class
rowTotalClass :: RowClass -> Class
rowTotalClass RowClass
rc =
    Text -> Class
Ods.Class (Text -> Class) -> Text -> Class
forall a b. (a -> b) -> a -> b
$
    case RowClass
rc of RowClass
Value -> Text
"amount rowtotal"; RowClass
Total -> Text
"amount coltotal"

rowAverageClass :: RowClass -> Ods.Class
rowAverageClass :: RowClass -> Class
rowAverageClass RowClass
rc =
    Text -> Class
Ods.Class (Text -> Class) -> Text -> Class
forall a b. (a -> b) -> a -> b
$
    case RowClass
rc of RowClass
Value -> Text
"amount rowaverage"; RowClass
Total -> Text
"amount colaverage"

budgetTotalClass :: RowClass -> Ods.Class
budgetTotalClass :: RowClass -> Class
budgetTotalClass RowClass
rc =
    Text -> Class
Ods.Class (Text -> Class) -> Text -> Class
forall a b. (a -> b) -> a -> b
$
    case RowClass
rc of RowClass
Value -> Text
"budget rowtotal"; RowClass
Total -> Text
"budget coltotal"

budgetAverageClass :: RowClass -> Ods.Class
budgetAverageClass :: RowClass -> Class
budgetAverageClass RowClass
rc =
    Text -> Class
Ods.Class (Text -> Class) -> Text -> Class
forall a b. (a -> b) -> a -> b
$
    case RowClass
rc of RowClass
Value -> Text
"budget rowaverage"; RowClass
Total -> Text
"budget colaverage"

-- What to show as heading for the totals row in balance reports ?
-- Currently nothing in terminal, Total: in HTML, FODS and xSV output.
totalRowHeadingText :: Text
totalRowHeadingText        = Text
""
totalRowHeadingSpreadsheet :: Text
totalRowHeadingSpreadsheet = Text
"Total:"
totalRowHeadingBudgetText :: Text
totalRowHeadingBudgetText  = Text
""
totalRowHeadingBudgetCsv :: Text
totalRowHeadingBudgetCsv   = Text
"Total:"

-- Single-column balance reports

-- | Render a single-column balance report as CSV.
balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV
balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV
balanceReportAsCsv ReportOpts
opts =
    [[Cell NumLines Text]] -> CSV
forall border text. [[Cell border text]] -> [[text]]
rawTableContent ([[Cell NumLines Text]] -> CSV)
-> (BalanceReport -> [[Cell NumLines Text]])
-> BalanceReport
-> CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> BalanceReport -> [[Cell NumLines Text]]
balanceReportAsSpreadsheet ReportOpts
opts

-- | Render a single-column balance report as plain text.
balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder
balanceReportAsText :: ReportOpts -> BalanceReport -> Builder
balanceReportAsText ReportOpts
opts (([BalanceReportItem]
items, Change
total)) = case ReportOpts -> Layout
layout_ ReportOpts
opts of
    Layout
LayoutBare | Bool
iscustom -> CommandHelpStr -> Builder
forall a. CommandHelpStr -> a
error' CommandHelpStr
"Custom format not supported with commodity columns"  -- PARTIAL:
    Layout
LayoutBare -> ReportOpts -> BalanceReport -> Builder
bareLayoutBalanceReportAsText ReportOpts
opts (([BalanceReportItem]
items, Change
total))
    Layout
_ -> [Builder] -> Builder
unlinesB [Builder]
ls Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
unlinesB (if ReportOpts -> Bool
no_total_ ReportOpts
opts then [] else [Builder
overline, Builder
totalLines])
  where
    ([Builder]
ls, [[Int]]
sizes) = [(Builder, [Int])] -> ([Builder], [[Int]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Builder, [Int])] -> ([Builder], [[Int]]))
-> [(Builder, [Int])] -> ([Builder], [[Int]])
forall a b. (a -> b) -> a -> b
$ (BalanceReportItem -> (Builder, [Int]))
-> [BalanceReportItem] -> [(Builder, [Int])]
forall a b. (a -> b) -> [a] -> [b]
map (ReportOpts -> BalanceReportItem -> (Builder, [Int])
balanceReportItemAsText ReportOpts
opts) [BalanceReportItem]
items
    -- abuse renderBalanceReportItem to render the total with similar format
    (Builder
totalLines, [Int]
_) = ReportOpts -> (Text, Int, Change) -> (Builder, [Int])
renderBalanceReportItem ReportOpts
opts (Text
"",Int
0,Change
total)
    -- with a custom format, extend the line to the full report width;
    -- otherwise show the usual 20-char line for compatibility
    iscustom :: Bool
iscustom = case ReportOpts -> StringFormat
format_ ReportOpts
opts of
        OneLine       ((FormatField Bool
_ Maybe Int
_ Maybe Int
_ ReportItemField
TotalField):[StringFormatComponent]
_) -> Bool
False
        TopAligned    ((FormatField Bool
_ Maybe Int
_ Maybe Int
_ ReportItemField
TotalField):[StringFormatComponent]
_) -> Bool
False
        BottomAligned ((FormatField Bool
_ Maybe Int
_ Maybe Int
_ ReportItemField
TotalField):[StringFormatComponent]
_) -> Bool
False
        StringFormat
_ -> Bool
True
    overlinewidth :: Int
overlinewidth = if Bool
iscustom then [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (([Int] -> Int) -> [[Int]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Int
forall a. Integral a => [a] -> a
maximum' ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [[Int]]
forall a. [[a]] -> [[a]]
transpose [[Int]]
sizes) else Int
20
    overline :: Builder
overline   = Text -> Builder
TB.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
overlinewidth Text
"-"

-- | Render a single-column balance report as plain text with a separate commodity column (--layout=bare)
bareLayoutBalanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder
bareLayoutBalanceReportAsText :: ReportOpts -> BalanceReport -> Builder
bareLayoutBalanceReportAsText ReportOpts
opts ([BalanceReportItem]
items, Change
total) =
  [Builder] -> Builder
unlinesB ([Builder] -> Builder)
-> ([[Cell]] -> [Builder]) -> [[Cell]] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ([Cell] -> Builder) -> [[Cell]] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map
    (TableOpts -> [Int] -> Header Cell -> Builder
renderColumns TableOpts
forall a. Default a => a
def{tableBorders=singleColumnTableOuterBorder} [Int]
sizes (Header Cell -> Builder)
-> ([Cell] -> Header Cell) -> [Cell] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     Properties -> [Header Cell] -> Header Cell
forall h. Properties -> [Header h] -> Header h
Group Properties
singleColumnTableInterColumnBorder ([Header Cell] -> Header Cell)
-> ([Cell] -> [Header Cell]) -> [Cell] -> Header Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cell -> Header Cell) -> [Cell] -> [Header Cell]
forall a b. (a -> b) -> [a] -> [b]
map Cell -> Header Cell
forall h. h -> Header h
Header) ([[Cell]] -> Builder) -> [[Cell]] -> Builder
forall a b. (a -> b) -> a -> b
$
  [[Cell]]
ls [[Cell]] -> [[Cell]] -> [[Cell]]
forall a. [a] -> [a] -> [a]
++ [[[Cell]]] -> [[Cell]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Cell
overline], [Cell]
totalline] | Bool -> Bool
not (ReportOpts -> Bool
no_total_ ReportOpts
opts)]
  where
    render :: (a, Text, Int, Change) -> [Cell]
render (a
_, Text
acctname, Int
dep, Change
amt) =
        [ Align -> [WideBuilder] -> Cell
Cell Align
TopRight [WideBuilder]
damts
        , Align -> [WideBuilder] -> Cell
Cell Align
TopLeft ((Text -> WideBuilder) -> [Text] -> [WideBuilder]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> WideBuilder
wbFromText [Text]
cs)
        , Align -> [WideBuilder] -> Cell
Cell Align
TopLeft (Int -> WideBuilder -> [WideBuilder]
forall a. Int -> a -> [a]
replicate ([WideBuilder] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WideBuilder]
damts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) WideBuilder
forall a. Monoid a => a
mempty [WideBuilder] -> [WideBuilder] -> [WideBuilder]
forall a. [a] -> [a] -> [a]
++ [Text -> WideBuilder
wbFromText Text
dispname]) ]
      where dopts :: AmountFormat
dopts = AmountFormat
oneLineNoCostFmt{displayCommodity=layout_ opts /= LayoutBare, displayCommodityOrder=Just cs, displayColour=color_ opts}
            cs :: [Text]
cs    = if Change -> Bool
mixedAmountLooksZero Change
amt then [Text
""] else Set Text -> [Text]
forall a. Set a -> [a]
S.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Change -> Set Text
maCommodities Change
amt
            dispname :: Text
dispname = Int -> Text -> Text
T.replicate ((Int
dep Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
acctname
            damts :: [WideBuilder]
damts = AmountFormat -> Change -> [WideBuilder]
showMixedAmountLinesB AmountFormat
dopts Change
amt
    ls :: [[Cell]]
ls = (BalanceReportItem -> [Cell]) -> [BalanceReportItem] -> [[Cell]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BalanceReportItem -> [Cell]
forall {a}. (a, Text, Int, Change) -> [Cell]
render [BalanceReportItem]
items
    totalline :: [Cell]
totalline = (CommandHelpStr, Text, Int, Change) -> [Cell]
forall {a}. (a, Text, Int, Change) -> [Cell]
render (CommandHelpStr
"", Text
"", Int
0, Change
total)
    sizes :: [Int]
sizes = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> ([Cell] -> Maybe Int) -> [Cell] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe Int
forall a. Ord a => [a] -> Maybe a
maximumMay ([Int] -> Maybe Int) -> ([Cell] -> [Int]) -> [Cell] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cell -> Int) -> [Cell] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Cell -> Int
cellWidth ([Cell] -> Int) -> [[Cell]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        [[Cell]] -> [[Cell]]
forall a. [[a]] -> [[a]]
transpose ([[Cell]
totalline | Bool -> Bool
not (ReportOpts -> Bool
no_total_ ReportOpts
opts)] [[Cell]] -> [[Cell]] -> [[Cell]]
forall a. [a] -> [a] -> [a]
++ [[Cell]]
ls)
    overline :: Cell
overline = Align -> [WideBuilder] -> Cell
Cell Align
TopLeft ([WideBuilder] -> Cell)
-> (Maybe Int -> [WideBuilder]) -> Maybe Int -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WideBuilder -> [WideBuilder]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WideBuilder -> [WideBuilder])
-> (Maybe Int -> WideBuilder) -> Maybe Int -> [WideBuilder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> WideBuilder
wbFromText (Text -> WideBuilder)
-> (Maybe Int -> Text) -> Maybe Int -> WideBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Text -> Text) -> Text -> Int -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Text -> Text
T.replicate Text
"-" (Int -> Text) -> (Maybe Int -> Int) -> Maybe Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Cell) -> Maybe Int -> Cell
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe Int
forall a. [a] -> Maybe a
headMay [Int]
sizes
    singleColumnTableOuterBorder :: Bool
singleColumnTableOuterBorder       = ReportOpts -> Bool
pretty_ ReportOpts
opts
    singleColumnTableInterColumnBorder :: Properties
singleColumnTableInterColumnBorder = if ReportOpts -> Bool
pretty_ ReportOpts
opts then Properties
SingleLine else Properties
NoLine

{-
This implementation turned out to be a bit convoluted but implements the following algorithm for formatting:

- If there is a single amount, print it with the account name directly:
- Otherwise, only print the account name on the last line.

    a         USD 1   ; Account 'a' has a single amount
              EUR -1
    b         USD -1  ; Account 'b' has two amounts. The account name is printed on the last line.
-}
-- | Render one balance report line item as plain text suitable for console output (or
-- whatever string format is specified). Note, prices will not be rendered, and
-- differently-priced quantities of the same commodity will appear merged.
-- The output will be one or more lines depending on the format and number of commodities.
balanceReportItemAsText :: ReportOpts -> BalanceReportItem -> (TB.Builder, [Int])
balanceReportItemAsText :: ReportOpts -> BalanceReportItem -> (Builder, [Int])
balanceReportItemAsText ReportOpts
opts (Text
_, Text
accountName, Int
dep, Change
amt) =
  ReportOpts -> (Text, Int, Change) -> (Builder, [Int])
renderBalanceReportItem ReportOpts
opts (Text
accountName, Int
dep, Change
amt)

-- | Render a balance report item, using the StringFormat specified by --format.
--
renderBalanceReportItem :: ReportOpts -> (AccountName, Int, MixedAmount) -> (TB.Builder, [Int])
renderBalanceReportItem :: ReportOpts -> (Text, Int, Change) -> (Builder, [Int])
renderBalanceReportItem ReportOpts
opts (Text
acctname, Int
dep, Change
total) =
  case ReportOpts -> StringFormat
format_ ReportOpts
opts of
      OneLine       [StringFormatComponent]
comps -> [Cell] -> (Builder, [Int])
renderRowFromComponents ([Cell] -> (Builder, [Int])) -> [Cell] -> (Builder, [Int])
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> [StringFormatComponent] -> [Cell]
renderComponents Bool
True  Bool
True  [StringFormatComponent]
comps
      TopAligned    [StringFormatComponent]
comps -> [Cell] -> (Builder, [Int])
renderRowFromComponents ([Cell] -> (Builder, [Int])) -> [Cell] -> (Builder, [Int])
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> [StringFormatComponent] -> [Cell]
renderComponents Bool
True  Bool
False [StringFormatComponent]
comps
      BottomAligned [StringFormatComponent]
comps -> [Cell] -> (Builder, [Int])
renderRowFromComponents ([Cell] -> (Builder, [Int])) -> [Cell] -> (Builder, [Int])
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> [StringFormatComponent] -> [Cell]
renderComponents Bool
False Bool
False [StringFormatComponent]
comps

  where
    -- Combine the rendered component cells horizontally, as a possibly multi-line text (builder),
    -- aligned in borderless columns (? XXX). Also returns the rendered width of each cell.
    renderRowFromComponents :: [Cell] -> (TB.Builder, [Int])
    renderRowFromComponents :: [Cell] -> (Builder, [Int])
renderRowFromComponents [Cell]
cs =
      ( TableOpts -> Header Cell -> Builder
renderRowB TableOpts
forall a. Default a => a
def{tableBorders=False, borderSpaces=False} (Header Cell -> Builder)
-> ([Header Cell] -> Header Cell) -> [Header Cell] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Properties -> [Header Cell] -> Header Cell
forall h. Properties -> [Header h] -> Header h
Group Properties
NoLine ([Header Cell] -> Builder) -> [Header Cell] -> Builder
forall a b. (a -> b) -> a -> b
$ (Cell -> Header Cell) -> [Cell] -> [Header Cell]
forall a b. (a -> b) -> [a] -> [b]
map Cell -> Header Cell
forall h. h -> Header h
Header [Cell]
cs
      , (Cell -> Int) -> [Cell] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Cell -> Int
cellWidth [Cell]
cs
      )

    -- Render each of the given StringFormat components for the balance report item,
    -- returning each as a Cell.
    renderComponents :: Bool -> Bool -> [StringFormatComponent] -> [Cell]
    renderComponents :: Bool -> Bool -> [StringFormatComponent] -> [Cell]
renderComponents Bool
topaligned Bool
oneline = (StringFormatComponent -> Cell)
-> [StringFormatComponent] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Bool
-> ReportOpts
-> (Text, Int, Change)
-> StringFormatComponent
-> Cell
renderComponent Bool
topaligned Bool
oneline ReportOpts
opts (Text
acctname, Int
dep, Change
total))

-- Render one StringFormat component for a balance report item.
-- Returns a Cell, containing 0 or more lines of text (as builders).
renderComponent :: Bool -> Bool -> ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> Cell
renderComponent :: Bool
-> Bool
-> ReportOpts
-> (Text, Int, Change)
-> StringFormatComponent
-> Cell
renderComponent Bool
_ Bool
_ ReportOpts
_ (Text, Int, Change)
_ (FormatLiteral Text
s) = Align -> Text -> Cell
textCell Align
TopLeft Text
s
renderComponent Bool
topaligned Bool
oneline ReportOpts
opts (Text
acctname, Int
dep, Change
total) (FormatField Bool
ljust Maybe Int
mmin Maybe Int
mmax ReportItemField
field) = case ReportItemField
field of
    ReportItemField
DepthSpacerField -> Align -> [WideBuilder] -> Cell
Cell Align
align [Builder -> Int -> WideBuilder
WideBuilder (Text -> Builder
TB.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
d Text
" ") Int
d]
                        where d :: Int
d = (Int -> Int) -> (Int -> Int -> Int) -> Maybe Int -> Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int -> Int
forall a. a -> a
id Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Maybe Int
mmax (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
dep Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 Maybe Int
mmin
    ReportItemField
AccountField     -> Align -> Text -> Cell
textCell Align
align (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Int -> Maybe Int -> Text -> Text
formatText Bool
ljust Maybe Int
mmin Maybe Int
mmax Text
acctname
    ReportItemField
TotalField       -> Align -> [WideBuilder] -> Cell
Cell Align
align ([WideBuilder] -> Cell)
-> (WideBuilder -> [WideBuilder]) -> WideBuilder -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WideBuilder -> [WideBuilder]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WideBuilder -> Cell) -> WideBuilder -> Cell
forall a b. (a -> b) -> a -> b
$ AmountFormat -> Change -> WideBuilder
showMixedAmountB AmountFormat
dopts Change
total
    ReportItemField
_                -> Align -> [WideBuilder] -> Cell
Cell Align
align [WideBuilder
forall a. Monoid a => a
mempty]
  where
    align :: Align
align | Bool
topaligned Bool -> Bool -> Bool
&& Bool
ljust = Align
TopLeft
          | Bool
topaligned          = Align
TopRight
          | Bool
ljust               = Align
BottomLeft
          | Bool
otherwise           = Align
BottomRight
    dopts :: AmountFormat
dopts = AmountFormat
noCostFmt{displayCommodity = layout_ opts /= LayoutBare
                  ,displayOneLine   = oneline
                  ,displayMinWidth  = mmin
                  ,displayMaxWidth  = mmax
                  ,displayColour    = color_ opts
                  }


simpleDateSpanCell :: DateSpan -> Ods.Cell Ods.NumLines Text
simpleDateSpanCell :: DateSpan -> Cell NumLines Text
simpleDateSpanCell = Text -> Cell NumLines Text
forall border text. Lines border => text -> Cell border text
Ods.defaultCell (Text -> Cell NumLines Text)
-> (DateSpan -> Text) -> DateSpan -> Cell NumLines Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateSpan -> Text
showDateSpan

addTotalBorders :: [[Ods.Cell border text]] -> [[Ods.Cell Ods.NumLines text]]
addTotalBorders :: forall border text. [[Cell border text]] -> [[Cell NumLines text]]
addTotalBorders =
    (NumLines -> [Cell border text] -> [Cell NumLines text])
-> [NumLines] -> [[Cell border text]] -> [[Cell NumLines text]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        (\NumLines
border ->
            (Cell border text -> Cell NumLines text)
-> [Cell border text] -> [Cell NumLines text]
forall a b. (a -> b) -> [a] -> [b]
map (\Cell border text
c -> Cell border text
c {
                    Ods.cellStyle = Ods.Body Ods.Total,
                    Ods.cellBorder = Ods.noBorder {Ods.borderTop = border}}))
        (NumLines
Ods.DoubleLine NumLines -> [NumLines] -> [NumLines]
forall a. a -> [a] -> [a]
: NumLines -> [NumLines]
forall a. a -> [a]
repeat NumLines
Ods.NoLine)


-- | Render a single-column balance report as FODS.
balanceReportAsSpreadsheet ::
    ReportOpts -> BalanceReport -> [[Ods.Cell Ods.NumLines Text]]
balanceReportAsSpreadsheet :: ReportOpts -> BalanceReport -> [[Cell NumLines Text]]
balanceReportAsSpreadsheet ReportOpts
opts ([BalanceReportItem]
items, Change
total) =
    (if ReportOpts -> Bool
transpose_ ReportOpts
opts then [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall border text. [[Cell border text]] -> [[Cell border text]]
Ods.transpose else [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. a -> a
id) ([[Cell NumLines Text]] -> [[Cell NumLines Text]])
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a b. (a -> b) -> a -> b
$
    [Cell NumLines Text]
headers [Cell NumLines Text]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. a -> [a] -> [a]
:
    (BalanceReportItem -> [[Cell NumLines Text]])
-> [BalanceReportItem] -> [[Cell NumLines Text]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (RowClass -> BalanceReportItem -> [[Cell NumLines Text]]
rows RowClass
Value) [BalanceReportItem]
items [[Cell NumLines Text]]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. [a] -> [a] -> [a]
++
    if ReportOpts -> Bool
no_total_ ReportOpts
opts then []
      else [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall border text. [[Cell border text]] -> [[Cell NumLines text]]
addTotalBorders ([[Cell NumLines Text]] -> [[Cell NumLines Text]])
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a b. (a -> b) -> a -> b
$
           RowClass -> BalanceReportItem -> [[Cell NumLines Text]]
rows RowClass
Total (Text
totalRowHeadingSpreadsheet, Text
totalRowHeadingSpreadsheet, Int
0, Change
total)
  where
    cell :: text -> Cell NumLines text
cell = text -> Cell NumLines text
forall border text. Lines border => text -> Cell border text
Ods.defaultCell
    headers :: [Cell NumLines Text]
headers =
      [Cell () Text] -> [Cell NumLines Text]
forall text. [Cell () text] -> [Cell NumLines text]
addHeaderBorders ([Cell () Text] -> [Cell NumLines Text])
-> [Cell () Text] -> [Cell NumLines Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Cell () Text) -> [Text] -> [Cell () Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Cell () Text
forall borders. Lines borders => Text -> Cell borders Text
headerCell ([Text] -> [Cell () Text]) -> [Text] -> [Cell () Text]
forall a b. (a -> b) -> a -> b
$
      Text
"account" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: case ReportOpts -> Layout
layout_ ReportOpts
opts of
        Layout
LayoutBare -> [Text
"commodity", Text
"balance"]
        Layout
_          -> [Text
"balance"]
    rows ::
        RowClass -> BalanceReportItem ->
        [[Ods.Cell Ods.NumLines Text]]
    rows :: RowClass -> BalanceReportItem -> [[Cell NumLines Text]]
rows RowClass
rc (Text
name, Text
dispName, Int
dep, Change
ma) =
      let accountCell :: Cell NumLines Text
accountCell =
              Maybe Text
-> [Text] -> Text -> Cell NumLines Text -> Cell NumLines Text
forall border text.
Maybe Text
-> [Text] -> Text -> Cell border text -> Cell border text
setAccountAnchor
                  (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RowClass
rcRowClass -> RowClass -> Bool
forall a. Eq a => a -> a -> Bool
==RowClass
Value) Maybe () -> Maybe Text -> Maybe Text
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReportOpts -> Maybe Text
balance_base_url_ ReportOpts
opts)
                  (ReportOpts -> [Text]
querystring_ ReportOpts
opts) Text
name (Cell NumLines Text -> Cell NumLines Text)
-> Cell NumLines Text -> Cell NumLines Text
forall a b. (a -> b) -> a -> b
$
              Text -> Cell NumLines Text
forall {text}. text -> Cell NumLines text
cell (Text -> Cell NumLines Text) -> Text -> Cell NumLines Text
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Text -> (Text, Text, Int) -> Text
renderBalanceAcct ReportOpts
opts Text
nbsp (Text
name, Text
dispName, Int
dep) in
      Cell NumLines Text
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall border text.
Cell border text -> [[Cell border text]] -> [[Cell border text]]
addRowSpanHeader Cell NumLines Text
accountCell ([[Cell NumLines Text]] -> [[Cell NumLines Text]])
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a b. (a -> b) -> a -> b
$
      case ReportOpts -> Layout
layout_ ReportOpts
opts of
      Layout
LayoutBare ->
          (Amount -> [Cell NumLines Text])
-> [Amount] -> [[Cell NumLines Text]]
forall a b. (a -> b) -> [a] -> [b]
map (\Amount
a -> [Text -> Cell NumLines Text
forall {text}. text -> Cell NumLines text
cell (Text -> Cell NumLines Text) -> Text -> Cell NumLines Text
forall a b. (a -> b) -> a -> b
$ Amount -> Text
acommodity Amount
a, RowClass -> Change -> Cell NumLines Text
forall {border}.
Lines border =>
RowClass -> Change -> Cell border Text
renderAmount RowClass
rc (Change -> Cell NumLines Text) -> Change -> Cell NumLines Text
forall a b. (a -> b) -> a -> b
$ Amount -> Change
mixedAmount Amount
a])
          ([Amount] -> [[Cell NumLines Text]])
-> (Change -> [Amount]) -> Change -> [[Cell NumLines Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Change -> [Amount]
amounts (Change -> [[Cell NumLines Text]])
-> Change -> [[Cell NumLines Text]]
forall a b. (a -> b) -> a -> b
$ Change -> Change
mixedAmountStripCosts Change
ma
      Layout
_ -> [[RowClass -> Change -> Cell NumLines Text
forall {border}.
Lines border =>
RowClass -> Change -> Cell border Text
renderAmount RowClass
rc Change
ma]]

    renderAmount :: RowClass -> Change -> Cell border Text
renderAmount RowClass
rc Change
mixedAmt =
        WideBuilder -> Text
wbToText (WideBuilder -> Text)
-> Cell border WideBuilder -> Cell border Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AmountFormat -> (Class, Change) -> Cell border WideBuilder
forall border.
Lines border =>
AmountFormat -> (Class, Change) -> Cell border WideBuilder
cellFromMixedAmount AmountFormat
bopts (RowClass -> Class
amountClass RowClass
rc, Change
mixedAmt)
      where
        bopts :: AmountFormat
bopts = AmountFormat
machineFmt{displayCommodity=showcomm, displayCommodityOrder = commorder}
        (Bool
showcomm, Maybe [Text]
commorder)
          | ReportOpts -> Layout
layout_ ReportOpts
opts Layout -> Layout -> Bool
forall a. Eq a => a -> a -> Bool
== Layout
LayoutBare = (Bool
False, [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ Set Text -> [Text]
forall a. Set a -> [a]
S.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Change -> Set Text
maCommodities Change
mixedAmt)
          | Bool
otherwise                  = (Bool
True, Maybe [Text]
forall a. Maybe a
Nothing)



-- Multi-column balance reports

-- | Render a multi-column balance report as CSV.
-- The CSV will always include the initial headings row,
-- and will include the final totals row unless --no-total is set.
multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV
multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV
multiBalanceReportAsCsv opts :: ReportOpts
opts@ReportOpts{Bool
Int
[Text]
[Status]
SortSpec
Maybe Text
Maybe NormalSign
Maybe ValuationType
Maybe ConversionOp
DepthSpec
Interval
Period
StringFormat
Layout
AccountListMode
BalanceAccumulation
BalanceCalculation
balancecalc_ :: ReportOpts -> BalanceCalculation
no_total_ :: ReportOpts -> Bool
layout_ :: ReportOpts -> Layout
interval_ :: ReportOpts -> Interval
format_ :: ReportOpts -> StringFormat
color_ :: ReportOpts -> Bool
pretty_ :: ReportOpts -> Bool
transpose_ :: ReportOpts -> Bool
balance_base_url_ :: ReportOpts -> Maybe Text
querystring_ :: ReportOpts -> [Text]
period_ :: Period
interval_ :: Interval
statuses_ :: [Status]
conversionop_ :: Maybe ConversionOp
value_ :: Maybe ValuationType
infer_prices_ :: Bool
depth_ :: DepthSpec
date2_ :: Bool
empty_ :: Bool
no_elide_ :: Bool
real_ :: Bool
format_ :: StringFormat
balance_base_url_ :: Maybe Text
pretty_ :: Bool
querystring_ :: [Text]
average_ :: Bool
related_ :: Bool
sortspec_ :: SortSpec
txn_dates_ :: Bool
balancecalc_ :: BalanceCalculation
balanceaccum_ :: BalanceAccumulation
budgetpat_ :: Maybe Text
accountlistmode_ :: AccountListMode
drop_ :: Int
declared_ :: Bool
row_total_ :: Bool
no_total_ :: Bool
summary_only_ :: Bool
show_costs_ :: Bool
sort_amount_ :: Bool
percent_ :: Bool
invert_ :: Bool
normalbalance_ :: Maybe NormalSign
color_ :: Bool
transpose_ :: Bool
layout_ :: Layout
normalbalance_ :: ReportOpts -> Maybe NormalSign
invert_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
show_costs_ :: ReportOpts -> Bool
summary_only_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
declared_ :: ReportOpts -> Bool
drop_ :: ReportOpts -> Int
accountlistmode_ :: ReportOpts -> AccountListMode
budgetpat_ :: ReportOpts -> Maybe Text
balanceaccum_ :: ReportOpts -> BalanceAccumulation
txn_dates_ :: ReportOpts -> Bool
sortspec_ :: ReportOpts -> SortSpec
related_ :: ReportOpts -> Bool
average_ :: ReportOpts -> Bool
real_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
date2_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> DepthSpec
infer_prices_ :: ReportOpts -> Bool
value_ :: ReportOpts -> Maybe ValuationType
conversionop_ :: ReportOpts -> Maybe ConversionOp
statuses_ :: ReportOpts -> [Status]
period_ :: ReportOpts -> Period
..} MultiBalanceReport
report =
    (if Bool
transpose_ then CSV -> CSV
forall a. [[a]] -> [[a]]
transpose else CSV -> CSV
forall a. a -> a
id) (CSV -> CSV) -> CSV -> CSV
forall a b. (a -> b) -> a -> b
$
    [[Cell NumLines Text]] -> CSV
forall border text. [[Cell border text]] -> [[text]]
rawTableContent ([[Cell NumLines Text]] -> CSV) -> [[Cell NumLines Text]] -> CSV
forall a b. (a -> b) -> a -> b
$ [Cell NumLines Text]
header [Cell NumLines Text]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. a -> [a] -> [a]
: [[Cell NumLines Text]]
body [[Cell NumLines Text]]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. [a] -> [a] -> [a]
++ [[Cell NumLines Text]]
totals
  where
    ([Cell NumLines Text]
header, [[Cell NumLines Text]]
body, [[Cell NumLines Text]]
totals) =
        AmountFormat
-> ReportOpts
-> MultiBalanceReport
-> ([Cell NumLines Text], [[Cell NumLines Text]],
    [[Cell NumLines Text]])
multiBalanceReportAsSpreadsheetParts AmountFormat
machineFmt ReportOpts
opts MultiBalanceReport
report

-- | Render the Spreadsheet table rows (CSV, ODS, HTML) for a MultiBalanceReport.
-- Returns the heading row, 0 or more body rows, and the totals row if enabled.
multiBalanceReportAsSpreadsheetParts ::
    AmountFormat -> ReportOpts -> MultiBalanceReport ->
    ([Ods.Cell Ods.NumLines Text],
     [[Ods.Cell Ods.NumLines Text]],
     [[Ods.Cell Ods.NumLines Text]])
multiBalanceReportAsSpreadsheetParts :: AmountFormat
-> ReportOpts
-> MultiBalanceReport
-> ([Cell NumLines Text], [[Cell NumLines Text]],
    [[Cell NumLines Text]])
multiBalanceReportAsSpreadsheetParts AmountFormat
fmt opts :: ReportOpts
opts@ReportOpts{Bool
Int
[Text]
[Status]
SortSpec
Maybe Text
Maybe NormalSign
Maybe ValuationType
Maybe ConversionOp
DepthSpec
Interval
Period
StringFormat
Layout
AccountListMode
BalanceAccumulation
BalanceCalculation
balancecalc_ :: ReportOpts -> BalanceCalculation
no_total_ :: ReportOpts -> Bool
layout_ :: ReportOpts -> Layout
interval_ :: ReportOpts -> Interval
format_ :: ReportOpts -> StringFormat
color_ :: ReportOpts -> Bool
pretty_ :: ReportOpts -> Bool
transpose_ :: ReportOpts -> Bool
balance_base_url_ :: ReportOpts -> Maybe Text
querystring_ :: ReportOpts -> [Text]
normalbalance_ :: ReportOpts -> Maybe NormalSign
invert_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
show_costs_ :: ReportOpts -> Bool
summary_only_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
declared_ :: ReportOpts -> Bool
drop_ :: ReportOpts -> Int
accountlistmode_ :: ReportOpts -> AccountListMode
budgetpat_ :: ReportOpts -> Maybe Text
balanceaccum_ :: ReportOpts -> BalanceAccumulation
txn_dates_ :: ReportOpts -> Bool
sortspec_ :: ReportOpts -> SortSpec
related_ :: ReportOpts -> Bool
average_ :: ReportOpts -> Bool
real_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
date2_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> DepthSpec
infer_prices_ :: ReportOpts -> Bool
value_ :: ReportOpts -> Maybe ValuationType
conversionop_ :: ReportOpts -> Maybe ConversionOp
statuses_ :: ReportOpts -> [Status]
period_ :: ReportOpts -> Period
period_ :: Period
interval_ :: Interval
statuses_ :: [Status]
conversionop_ :: Maybe ConversionOp
value_ :: Maybe ValuationType
infer_prices_ :: Bool
depth_ :: DepthSpec
date2_ :: Bool
empty_ :: Bool
no_elide_ :: Bool
real_ :: Bool
format_ :: StringFormat
balance_base_url_ :: Maybe Text
pretty_ :: Bool
querystring_ :: [Text]
average_ :: Bool
related_ :: Bool
sortspec_ :: SortSpec
txn_dates_ :: Bool
balancecalc_ :: BalanceCalculation
balanceaccum_ :: BalanceAccumulation
budgetpat_ :: Maybe Text
accountlistmode_ :: AccountListMode
drop_ :: Int
declared_ :: Bool
row_total_ :: Bool
no_total_ :: Bool
summary_only_ :: Bool
show_costs_ :: Bool
sort_amount_ :: Bool
percent_ :: Bool
invert_ :: Bool
normalbalance_ :: Maybe NormalSign
color_ :: Bool
transpose_ :: Bool
layout_ :: Layout
..} (PeriodicReport [DateSpan]
colspans [PeriodicReportRow DisplayName Change]
items PeriodicReportRow () Change
tr) =
    ([Cell NumLines Text]
headers, (PeriodicReportRow DisplayName Change -> [[Cell NumLines Text]])
-> [PeriodicReportRow DisplayName Change] -> [[Cell NumLines Text]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PeriodicReportRow DisplayName Change -> [[Cell NumLines Text]]
fullRowAsTexts [PeriodicReportRow DisplayName Change]
items, [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall border text. [[Cell border text]] -> [[Cell NumLines text]]
addTotalBorders [[Cell NumLines Text]]
totalrows)
  where
    accountCell :: text -> Cell border text
accountCell text
label =
        (text -> Cell border text
forall border text. Lines border => text -> Cell border text
Ods.defaultCell text
label) {Ods.cellClass = Ods.Class "account"}
    hCell :: Text -> Text -> Cell border Text
hCell Text
cls Text
label = (Text -> Cell border Text
forall borders. Lines borders => Text -> Cell borders Text
headerCell Text
label) {Ods.cellClass = Ods.Class cls}
    headers :: [Cell NumLines Text]
headers =
      [Cell () Text] -> [Cell NumLines Text]
forall text. [Cell () text] -> [Cell NumLines text]
addHeaderBorders ([Cell () Text] -> [Cell NumLines Text])
-> [Cell () Text] -> [Cell NumLines Text]
forall a b. (a -> b) -> a -> b
$
      Text -> Text -> Cell () Text
forall {border}. Lines border => Text -> Text -> Cell border Text
hCell Text
"account" Text
"account" Cell () Text -> [Cell () Text] -> [Cell () Text]
forall a. a -> [a] -> [a]
:
      case Layout
layout_ of
      Layout
LayoutTidy -> (Text -> Cell () Text) -> [Text] -> [Cell () Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Cell () Text
forall borders. Lines borders => Text -> Cell borders Text
headerCell [Text]
tidyColumnLabels
      Layout
LayoutBare -> Text -> Cell () Text
forall borders. Lines borders => Text -> Cell borders Text
headerCell Text
"commodity" Cell () Text -> [Cell () Text] -> [Cell () Text]
forall a. a -> [a] -> [a]
: [Cell () Text]
dateHeaders
      Layout
_          -> [Cell () Text]
dateHeaders
    dateHeaders :: [Cell () Text]
dateHeaders =
      (DateSpan -> Cell () Text) -> [DateSpan] -> [Cell () Text]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Text -> [Text] -> DateSpan -> Cell () Text
headerDateSpanCell Maybe Text
balance_base_url_ [Text]
querystring_) [DateSpan]
colspans [Cell () Text] -> [Cell () Text] -> [Cell () Text]
forall a. [a] -> [a] -> [a]
++
      [Text -> Text -> Cell () Text
forall {border}. Lines border => Text -> Text -> Cell border Text
hCell Text
"rowtotal" Text
"total" | ReportOpts -> Bool
multiBalanceHasTotalsColumn ReportOpts
opts] [Cell () Text] -> [Cell () Text] -> [Cell () Text]
forall a. [a] -> [a] -> [a]
++
      [Text -> Text -> Cell () Text
forall {border}. Lines border => Text -> Text -> Cell border Text
hCell Text
"rowaverage" Text
"average" | Bool
average_]
    fullRowAsTexts :: PeriodicReportRow DisplayName Change -> [[Cell NumLines Text]]
fullRowAsTexts PeriodicReportRow DisplayName Change
row =
        Cell NumLines Text
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall border text.
Cell border text -> [[Cell border text]] -> [[Cell border text]]
addRowSpanHeader Cell NumLines Text
anchorCell ([[Cell NumLines Text]] -> [[Cell NumLines Text]])
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a b. (a -> b) -> a -> b
$
        RowClass
-> (DateSpan -> Cell NumLines Text)
-> PeriodicReportRow DisplayName Change
-> [[Cell NumLines Text]]
forall {a}.
RowClass
-> (DateSpan -> Cell NumLines Text)
-> PeriodicReportRow a Change
-> [[Cell NumLines Text]]
rowAsText RowClass
Value (Maybe Text -> [Text] -> Text -> DateSpan -> Cell NumLines Text
forall border.
Lines border =>
Maybe Text -> [Text] -> Text -> DateSpan -> Cell border Text
dateSpanCell Maybe Text
balance_base_url_ [Text]
querystring_ Text
acctName) PeriodicReportRow DisplayName Change
row
      where acctName :: Text
acctName = PeriodicReportRow DisplayName Change -> Text
forall a. PeriodicReportRow DisplayName a -> Text
prrFullName PeriodicReportRow DisplayName Change
row
            anchorCell :: Cell NumLines Text
anchorCell =
              Maybe Text
-> [Text] -> Text -> Cell NumLines Text -> Cell NumLines Text
forall border text.
Maybe Text
-> [Text] -> Text -> Cell border text -> Cell border text
setAccountAnchor Maybe Text
balance_base_url_ [Text]
querystring_ Text
acctName (Cell NumLines Text -> Cell NumLines Text)
-> Cell NumLines Text -> Cell NumLines Text
forall a b. (a -> b) -> a -> b
$
              Text -> Cell NumLines Text
forall border text. Lines border => text -> Cell border text
accountCell (Text -> Cell NumLines Text) -> Text -> Cell NumLines Text
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Text -> PeriodicReportRow DisplayName Change -> Text
forall a.
ReportOpts -> Text -> PeriodicReportRow DisplayName a -> Text
renderPeriodicAcct ReportOpts
opts Text
nbsp PeriodicReportRow DisplayName Change
row
    totalrows :: [[Cell NumLines Text]]
totalrows =
      if Bool
no_total_
        then []
        else Cell NumLines Text
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall border text.
Cell border text -> [[Cell border text]] -> [[Cell border text]]
addRowSpanHeader (Text -> Cell NumLines Text
forall border text. Lines border => text -> Cell border text
accountCell Text
totalRowHeadingSpreadsheet) ([[Cell NumLines Text]] -> [[Cell NumLines Text]])
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a b. (a -> b) -> a -> b
$
                RowClass
-> (DateSpan -> Cell NumLines Text)
-> PeriodicReportRow () Change
-> [[Cell NumLines Text]]
forall {a}.
RowClass
-> (DateSpan -> Cell NumLines Text)
-> PeriodicReportRow a Change
-> [[Cell NumLines Text]]
rowAsText RowClass
Total DateSpan -> Cell NumLines Text
simpleDateSpanCell PeriodicReportRow () Change
tr
    rowAsText :: RowClass
-> (DateSpan -> Cell NumLines Text)
-> PeriodicReportRow a Change
-> [[Cell NumLines Text]]
rowAsText RowClass
rc DateSpan -> Cell NumLines Text
dsCell =
        ([Cell NumLines WideBuilder] -> [Cell NumLines Text])
-> [[Cell NumLines WideBuilder]] -> [[Cell NumLines Text]]
forall a b. (a -> b) -> [a] -> [b]
map ((Cell NumLines WideBuilder -> Cell NumLines Text)
-> [Cell NumLines WideBuilder] -> [Cell NumLines Text]
forall a b. (a -> b) -> [a] -> [b]
map ((WideBuilder -> Text)
-> Cell NumLines WideBuilder -> Cell NumLines Text
forall a b. (a -> b) -> Cell NumLines a -> Cell NumLines b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WideBuilder -> Text
wbToText)) ([[Cell NumLines WideBuilder]] -> [[Cell NumLines Text]])
-> (PeriodicReportRow a Change -> [[Cell NumLines WideBuilder]])
-> PeriodicReportRow a Change
-> [[Cell NumLines Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        AmountFormat
-> ReportOpts
-> [DateSpan]
-> RowClass
-> (DateSpan -> Cell NumLines Text)
-> PeriodicReportRow a Change
-> [[Cell NumLines WideBuilder]]
forall a.
AmountFormat
-> ReportOpts
-> [DateSpan]
-> RowClass
-> (DateSpan -> Cell NumLines Text)
-> PeriodicReportRow a Change
-> [[Cell NumLines WideBuilder]]
multiBalanceRowAsCellBuilders AmountFormat
fmt ReportOpts
opts [DateSpan]
colspans RowClass
rc DateSpan -> Cell NumLines Text
dsCell

tidyColumnLabels :: [Text]
tidyColumnLabels :: [Text]
tidyColumnLabels =
    [Text
"period", Text
"start_date", Text
"end_date", Text
"commodity", Text
"value"]


-- | Render a multi-column balance report as HTML.
multiBalanceReportAsHtml :: ReportOpts -> MultiBalanceReport -> Html
multiBalanceReportAsHtml :: ReportOpts -> MultiBalanceReport -> Html
multiBalanceReportAsHtml ReportOpts
ropts MultiBalanceReport
mbr =
  [[Cell NumLines Html]] -> Html
forall border. Lines border => [[Cell border Html]] -> Html
styledTableHtml ([[Cell NumLines Html]] -> Html)
-> ([[Cell NumLines Text]] -> [[Cell NumLines Html]])
-> [[Cell NumLines Text]]
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Cell NumLines Text] -> [Cell NumLines Html])
-> [[Cell NumLines Text]] -> [[Cell NumLines Html]]
forall a b. (a -> b) -> [a] -> [b]
map ((Cell NumLines Text -> Cell NumLines Html)
-> [Cell NumLines Text] -> [Cell NumLines Html]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Html) -> Cell NumLines Text -> Cell NumLines Html
forall a b. (a -> b) -> Cell NumLines a -> Cell NumLines b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Html
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml)) ([[Cell NumLines Text]] -> Html) -> [[Cell NumLines Text]] -> Html
forall a b. (a -> b) -> a -> b
$
    ((Int, Int), [[Cell NumLines Text]]) -> [[Cell NumLines Text]]
forall a b. (a, b) -> b
snd (((Int, Int), [[Cell NumLines Text]]) -> [[Cell NumLines Text]])
-> ((Int, Int), [[Cell NumLines Text]]) -> [[Cell NumLines Text]]
forall a b. (a -> b) -> a -> b
$ ReportOpts
-> MultiBalanceReport -> ((Int, Int), [[Cell NumLines Text]])
multiBalanceReportAsSpreadsheet ReportOpts
ropts MultiBalanceReport
mbr

-- | Render the ODS table rows for a MultiBalanceReport.
-- Returns the heading row, 0 or more body rows, and the totals row if enabled.
multiBalanceReportAsSpreadsheet ::
  ReportOpts -> MultiBalanceReport ->
  ((Int, Int), [[Ods.Cell Ods.NumLines Text]])
multiBalanceReportAsSpreadsheet :: ReportOpts
-> MultiBalanceReport -> ((Int, Int), [[Cell NumLines Text]])
multiBalanceReportAsSpreadsheet ReportOpts
ropts MultiBalanceReport
mbr =
  let ([Cell NumLines Text]
header,[[Cell NumLines Text]]
body,[[Cell NumLines Text]]
total) =
            AmountFormat
-> ReportOpts
-> MultiBalanceReport
-> ([Cell NumLines Text], [[Cell NumLines Text]],
    [[Cell NumLines Text]])
multiBalanceReportAsSpreadsheetParts AmountFormat
oneLineNoCostFmt ReportOpts
ropts MultiBalanceReport
mbr
  in  (if ReportOpts -> Bool
transpose_ ReportOpts
ropts then (Int, Int) -> (Int, Int)
forall a b. (a, b) -> (b, a)
swap ((Int, Int) -> (Int, Int))
-> ([[Cell NumLines Text]] -> [[Cell NumLines Text]])
-> ((Int, Int), [[Cell NumLines Text]])
-> ((Int, Int), [[Cell NumLines Text]])
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall border text. [[Cell border text]] -> [[Cell border text]]
Ods.transpose else ((Int, Int), [[Cell NumLines Text]])
-> ((Int, Int), [[Cell NumLines Text]])
forall a. a -> a
id) (((Int, Int), [[Cell NumLines Text]])
 -> ((Int, Int), [[Cell NumLines Text]]))
-> ((Int, Int), [[Cell NumLines Text]])
-> ((Int, Int), [[Cell NumLines Text]])
forall a b. (a -> b) -> a -> b
$
      ((Int
1, case ReportOpts -> Layout
layout_ ReportOpts
ropts of LayoutWide Maybe Int
_ -> Int
1; Layout
_ -> Int
0),
            [Cell NumLines Text]
header [Cell NumLines Text]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. a -> [a] -> [a]
: [[Cell NumLines Text]]
body [[Cell NumLines Text]]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. [a] -> [a] -> [a]
++ [[Cell NumLines Text]]
total)


-- | Render a multi-column balance report as plain text suitable for console output.
multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> TL.Text
multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> Text
multiBalanceReportAsText ropts :: ReportOpts
ropts@ReportOpts{Bool
Int
[Text]
[Status]
SortSpec
Maybe Text
Maybe NormalSign
Maybe ValuationType
Maybe ConversionOp
DepthSpec
Interval
Period
StringFormat
Layout
AccountListMode
BalanceAccumulation
BalanceCalculation
balancecalc_ :: ReportOpts -> BalanceCalculation
no_total_ :: ReportOpts -> Bool
layout_ :: ReportOpts -> Layout
interval_ :: ReportOpts -> Interval
format_ :: ReportOpts -> StringFormat
color_ :: ReportOpts -> Bool
pretty_ :: ReportOpts -> Bool
transpose_ :: ReportOpts -> Bool
balance_base_url_ :: ReportOpts -> Maybe Text
querystring_ :: ReportOpts -> [Text]
normalbalance_ :: ReportOpts -> Maybe NormalSign
invert_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
show_costs_ :: ReportOpts -> Bool
summary_only_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
declared_ :: ReportOpts -> Bool
drop_ :: ReportOpts -> Int
accountlistmode_ :: ReportOpts -> AccountListMode
budgetpat_ :: ReportOpts -> Maybe Text
balanceaccum_ :: ReportOpts -> BalanceAccumulation
txn_dates_ :: ReportOpts -> Bool
sortspec_ :: ReportOpts -> SortSpec
related_ :: ReportOpts -> Bool
average_ :: ReportOpts -> Bool
real_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
date2_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> DepthSpec
infer_prices_ :: ReportOpts -> Bool
value_ :: ReportOpts -> Maybe ValuationType
conversionop_ :: ReportOpts -> Maybe ConversionOp
statuses_ :: ReportOpts -> [Status]
period_ :: ReportOpts -> Period
period_ :: Period
interval_ :: Interval
statuses_ :: [Status]
conversionop_ :: Maybe ConversionOp
value_ :: Maybe ValuationType
infer_prices_ :: Bool
depth_ :: DepthSpec
date2_ :: Bool
empty_ :: Bool
no_elide_ :: Bool
real_ :: Bool
format_ :: StringFormat
balance_base_url_ :: Maybe Text
pretty_ :: Bool
querystring_ :: [Text]
average_ :: Bool
related_ :: Bool
sortspec_ :: SortSpec
txn_dates_ :: Bool
balancecalc_ :: BalanceCalculation
balanceaccum_ :: BalanceAccumulation
budgetpat_ :: Maybe Text
accountlistmode_ :: AccountListMode
drop_ :: Int
declared_ :: Bool
row_total_ :: Bool
no_total_ :: Bool
summary_only_ :: Bool
show_costs_ :: Bool
sort_amount_ :: Bool
percent_ :: Bool
invert_ :: Bool
normalbalance_ :: Maybe NormalSign
color_ :: Bool
transpose_ :: Bool
layout_ :: Layout
..} MultiBalanceReport
r = Builder -> Text
TB.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$
    Text -> Builder
TB.fromText Text
title
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TB.fromText Text
"\n\n"
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ReportOpts -> Table Text Text WideBuilder -> Builder
multiBalanceReportTableAsText ReportOpts
ropts (ReportOpts -> MultiBalanceReport -> Table Text Text WideBuilder
multiBalanceReportAsTable ReportOpts
ropts MultiBalanceReport
r)
  where
    title :: Text
title = Text
mtitle Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DateSpan -> Text
showDateSpan (MultiBalanceReport -> DateSpan
forall a b. PeriodicReport a b -> DateSpan
periodicReportSpan MultiBalanceReport
r) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
valuationdesc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"

    mtitle :: Text
mtitle = case (BalanceCalculation
balancecalc_, BalanceAccumulation
balanceaccum_) of
        (BalanceCalculation
CalcValueChange, BalanceAccumulation
PerPeriod  ) -> Text
"Period-end value changes"
        (BalanceCalculation
CalcValueChange, BalanceAccumulation
Cumulative ) -> Text
"Cumulative period-end value changes"
        (BalanceCalculation
CalcGain,        BalanceAccumulation
PerPeriod  ) -> Text
"Incremental gain"
        (BalanceCalculation
CalcGain,        BalanceAccumulation
Cumulative ) -> Text
"Cumulative gain"
        (BalanceCalculation
CalcGain,        BalanceAccumulation
Historical ) -> Text
"Historical gain"
        (BalanceCalculation
_,               BalanceAccumulation
PerPeriod  ) -> Text
"Balance changes"
        (BalanceCalculation
_,               BalanceAccumulation
Cumulative ) -> Text
"Ending balances (cumulative)"
        (BalanceCalculation
_,               BalanceAccumulation
Historical)  -> Text
"Ending balances (historical)"
    valuationdesc :: Text
valuationdesc =
        (case Maybe ConversionOp
conversionop_ of
            Just ConversionOp
ToCost -> Text
", converted to cost"
            Maybe ConversionOp
_           -> Text
"")
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (case Maybe ValuationType
value_ of
            Just (AtThen Maybe Text
_mc)    -> Text
", valued at posting date"
            Just (AtEnd Maybe Text
_mc) | Bool
changingValuation -> Text
""
            Just (AtEnd Maybe Text
_mc)     -> Text
", valued at period ends"
            Just (AtNow Maybe Text
_mc)     -> Text
", current value"
            Just (AtDate Day
d Maybe Text
_mc)  -> Text
", valued at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Day -> Text
showDate Day
d
            Maybe ValuationType
Nothing              -> Text
"")

    changingValuation :: Bool
changingValuation = case (BalanceCalculation
balancecalc_, BalanceAccumulation
balanceaccum_) of
        (BalanceCalculation
CalcValueChange, BalanceAccumulation
PerPeriod)  -> Bool
True
        (BalanceCalculation
CalcValueChange, BalanceAccumulation
Cumulative) -> Bool
True
        (BalanceCalculation, BalanceAccumulation)
_                                     -> Bool
False

-- | Given a table representing a multi-column balance report,
-- render it in a format suitable for console output.
-- Amounts with more than two commodities will be elided unless --no-elide is used.
multiBalanceReportTableAsText :: ReportOpts -> Table T.Text T.Text WideBuilder -> TB.Builder
multiBalanceReportTableAsText :: ReportOpts -> Table Text Text WideBuilder -> Builder
multiBalanceReportTableAsText ReportOpts{Bool
Int
[Text]
[Status]
SortSpec
Maybe Text
Maybe NormalSign
Maybe ValuationType
Maybe ConversionOp
DepthSpec
Interval
Period
StringFormat
Layout
AccountListMode
BalanceAccumulation
BalanceCalculation
balancecalc_ :: ReportOpts -> BalanceCalculation
no_total_ :: ReportOpts -> Bool
layout_ :: ReportOpts -> Layout
interval_ :: ReportOpts -> Interval
format_ :: ReportOpts -> StringFormat
color_ :: ReportOpts -> Bool
pretty_ :: ReportOpts -> Bool
transpose_ :: ReportOpts -> Bool
balance_base_url_ :: ReportOpts -> Maybe Text
querystring_ :: ReportOpts -> [Text]
normalbalance_ :: ReportOpts -> Maybe NormalSign
invert_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
show_costs_ :: ReportOpts -> Bool
summary_only_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
declared_ :: ReportOpts -> Bool
drop_ :: ReportOpts -> Int
accountlistmode_ :: ReportOpts -> AccountListMode
budgetpat_ :: ReportOpts -> Maybe Text
balanceaccum_ :: ReportOpts -> BalanceAccumulation
txn_dates_ :: ReportOpts -> Bool
sortspec_ :: ReportOpts -> SortSpec
related_ :: ReportOpts -> Bool
average_ :: ReportOpts -> Bool
real_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
date2_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> DepthSpec
infer_prices_ :: ReportOpts -> Bool
value_ :: ReportOpts -> Maybe ValuationType
conversionop_ :: ReportOpts -> Maybe ConversionOp
statuses_ :: ReportOpts -> [Status]
period_ :: ReportOpts -> Period
period_ :: Period
interval_ :: Interval
statuses_ :: [Status]
conversionop_ :: Maybe ConversionOp
value_ :: Maybe ValuationType
infer_prices_ :: Bool
depth_ :: DepthSpec
date2_ :: Bool
empty_ :: Bool
no_elide_ :: Bool
real_ :: Bool
format_ :: StringFormat
balance_base_url_ :: Maybe Text
pretty_ :: Bool
querystring_ :: [Text]
average_ :: Bool
related_ :: Bool
sortspec_ :: SortSpec
txn_dates_ :: Bool
balancecalc_ :: BalanceCalculation
balanceaccum_ :: BalanceAccumulation
budgetpat_ :: Maybe Text
accountlistmode_ :: AccountListMode
drop_ :: Int
declared_ :: Bool
row_total_ :: Bool
no_total_ :: Bool
summary_only_ :: Bool
show_costs_ :: Bool
sort_amount_ :: Bool
percent_ :: Bool
invert_ :: Bool
normalbalance_ :: Maybe NormalSign
color_ :: Bool
transpose_ :: Bool
layout_ :: Layout
..} = TableOpts
-> ([Text] -> [Cell])
-> ((Text, [WideBuilder]) -> (Cell, [Cell]))
-> Table Text Text WideBuilder
-> Builder
forall a ch rh.
Show a =>
TableOpts
-> ([ch] -> [Cell])
-> ((rh, [a]) -> (Cell, [Cell]))
-> Table rh ch a
-> Builder
renderTableByRowsB TableOpts
tableopts [Text] -> [Cell]
renderCh (Text, [WideBuilder]) -> (Cell, [Cell])
renderRow
  where
    tableopts :: TableOpts
tableopts = TableOpts
forall a. Default a => a
def{tableBorders=multiColumnTableOuterBorder, prettyTable=pretty_}
    multiColumnTableOuterBorder :: Bool
multiColumnTableOuterBorder = Bool
pretty_

    renderCh :: [Text] -> [Cell]
    renderCh :: [Text] -> [Cell]
renderCh
      | Layout
layout_ Layout -> Layout -> Bool
forall a. Eq a => a -> a -> Bool
/= Layout
LayoutBare Bool -> Bool -> Bool
|| Bool
transpose_ = (Text -> Cell) -> [Text] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Align -> Text -> Cell
textCell Align
TopRight)
      | Bool
otherwise = ((Text -> Cell) -> Text -> Cell)
-> [Text -> Cell] -> [Text] -> [Cell]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Text -> Cell) -> Text -> Cell
forall a b. (a -> b) -> a -> b
($) (Align -> Text -> Cell
textCell Align
TopLeft (Text -> Cell) -> [Text -> Cell] -> [Text -> Cell]
forall a. a -> [a] -> [a]
: (Text -> Cell) -> [Text -> Cell]
forall a. a -> [a]
repeat (Align -> Text -> Cell
textCell Align
TopRight))

    renderRow :: (Text, [WideBuilder]) -> (Cell, [Cell])
    renderRow :: (Text, [WideBuilder]) -> (Cell, [Cell])
renderRow (Text
rh, [WideBuilder]
row)
      | Layout
layout_ Layout -> Layout -> Bool
forall a. Eq a => a -> a -> Bool
/= Layout
LayoutBare Bool -> Bool -> Bool
|| Bool
transpose_ =
          (Align -> Text -> Cell
textCell Align
TopLeft Text
rh, (WideBuilder -> Cell) -> [WideBuilder] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Align -> [WideBuilder] -> Cell
Cell Align
TopRight ([WideBuilder] -> Cell)
-> (WideBuilder -> [WideBuilder]) -> WideBuilder -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WideBuilder -> [WideBuilder]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) [WideBuilder]
row)
      | Bool
otherwise =
          (Align -> Text -> Cell
textCell Align
TopLeft Text
rh, (([WideBuilder] -> Cell) -> [WideBuilder] -> Cell)
-> [[WideBuilder] -> Cell] -> [[WideBuilder]] -> [Cell]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([WideBuilder] -> Cell) -> [WideBuilder] -> Cell
forall a b. (a -> b) -> a -> b
($) (Align -> [WideBuilder] -> Cell
Cell Align
TopLeft ([WideBuilder] -> Cell)
-> [[WideBuilder] -> Cell] -> [[WideBuilder] -> Cell]
forall a. a -> [a] -> [a]
: ([WideBuilder] -> Cell) -> [[WideBuilder] -> Cell]
forall a. a -> [a]
repeat (Align -> [WideBuilder] -> Cell
Cell Align
TopRight)) ((WideBuilder -> [WideBuilder]) -> [WideBuilder] -> [[WideBuilder]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WideBuilder -> [WideBuilder]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [WideBuilder]
row))

-- | Build a 'Table' from a multi-column balance report.
multiBalanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table T.Text T.Text WideBuilder
multiBalanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table Text Text WideBuilder
multiBalanceReportAsTable opts :: ReportOpts
opts@ReportOpts{Bool
summary_only_ :: ReportOpts -> Bool
summary_only_ :: Bool
summary_only_, Bool
average_ :: ReportOpts -> Bool
average_ :: Bool
average_, BalanceAccumulation
balanceaccum_ :: ReportOpts -> BalanceAccumulation
balanceaccum_ :: BalanceAccumulation
balanceaccum_}
    (PeriodicReport [DateSpan]
spans [PeriodicReportRow DisplayName Change]
items PeriodicReportRow () Change
tr) =
   Table Text Text WideBuilder -> Table Text Text WideBuilder
forall {rh} {a}. Table rh rh a -> Table rh rh a
maybetranspose (Table Text Text WideBuilder -> Table Text Text WideBuilder)
-> Table Text Text WideBuilder -> Table Text Text WideBuilder
forall a b. (a -> b) -> a -> b
$
   Table Text Text WideBuilder -> Table Text Text WideBuilder
forall {ch}. Table Text ch WideBuilder -> Table Text ch WideBuilder
addtotalrow (Table Text Text WideBuilder -> Table Text Text WideBuilder)
-> Table Text Text WideBuilder -> Table Text Text WideBuilder
forall a b. (a -> b) -> a -> b
$
   Header Text
-> Header Text -> [[WideBuilder]] -> Table Text Text WideBuilder
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table
     (Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Group Properties
multiColumnTableInterRowBorder    ([Header Text] -> Header Text) -> [Header Text] -> Header Text
forall a b. (a -> b) -> a -> b
$ (Text -> Header Text) -> [Text] -> [Header Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Header Text
forall h. h -> Header h
Header ([Text] -> [Header Text]) -> [Text] -> [Header Text]
forall a b. (a -> b) -> a -> b
$ CSV -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat CSV
accts)
     (Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Group Properties
multiColumnTableInterColumnBorder ([Header Text] -> Header Text) -> [Header Text] -> Header Text
forall a b. (a -> b) -> a -> b
$ (Text -> Header Text) -> [Text] -> [Header Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Header Text
forall h. h -> Header h
Header [Text]
colheadings)
     ([[[WideBuilder]]] -> [[WideBuilder]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[WideBuilder]]]
rows)
  where
    colheadings :: [Text]
colheadings = [Text
"Commodity" | ReportOpts -> Layout
layout_ ReportOpts
opts Layout -> Layout -> Bool
forall a. Eq a => a -> a -> Bool
== Layout
LayoutBare]
                  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (if Bool -> Bool
not Bool
summary_only_ then (DateSpan -> Text) -> [DateSpan] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (BalanceAccumulation -> [DateSpan] -> DateSpan -> Text
reportPeriodName BalanceAccumulation
balanceaccum_ [DateSpan]
spans) [DateSpan]
spans else [])
                  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"  Total" | ReportOpts -> Bool
multiBalanceHasTotalsColumn ReportOpts
opts]
                  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"Average" | Bool
average_]
    (CSV
accts, [[[WideBuilder]]]
rows) = [([Text], [[WideBuilder]])] -> (CSV, [[[WideBuilder]]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([Text], [[WideBuilder]])] -> (CSV, [[[WideBuilder]]]))
-> [([Text], [[WideBuilder]])] -> (CSV, [[[WideBuilder]]])
forall a b. (a -> b) -> a -> b
$ (PeriodicReportRow DisplayName Change -> ([Text], [[WideBuilder]]))
-> [PeriodicReportRow DisplayName Change]
-> [([Text], [[WideBuilder]])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PeriodicReportRow DisplayName Change -> ([Text], [[WideBuilder]])
fullRowAsTexts [PeriodicReportRow DisplayName Change]
items
      where
        fullRowAsTexts :: PeriodicReportRow DisplayName Change -> ([Text], [[WideBuilder]])
fullRowAsTexts PeriodicReportRow DisplayName Change
row = (Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate ([[WideBuilder]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[WideBuilder]]
rs) (PeriodicReportRow DisplayName Change -> Text
forall a. PeriodicReportRow DisplayName a -> Text
renderacct PeriodicReportRow DisplayName Change
row), [[WideBuilder]]
rs)
          where
            rs :: [[WideBuilder]]
rs = ReportOpts
-> PeriodicReportRow DisplayName Change -> [[WideBuilder]]
forall a.
ReportOpts -> PeriodicReportRow a Change -> [[WideBuilder]]
multiBalanceRowAsText ReportOpts
opts PeriodicReportRow DisplayName Change
row
            renderacct :: PeriodicReportRow DisplayName a -> Text
renderacct PeriodicReportRow DisplayName a
row' = Int -> Text -> Text
T.replicate (PeriodicReportRow DisplayName a -> Int
forall a. PeriodicReportRow DisplayName a -> Int
prrIndent PeriodicReportRow DisplayName a
row' Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PeriodicReportRow DisplayName a -> Text
forall a. PeriodicReportRow DisplayName a -> Text
prrDisplayName PeriodicReportRow DisplayName a
row'
    addtotalrow :: Table Text ch WideBuilder -> Table Text ch WideBuilder
addtotalrow
      | ReportOpts -> Bool
no_total_ ReportOpts
opts = Table Text ch WideBuilder -> Table Text ch WideBuilder
forall a. a -> a
id
      | Bool
otherwise =
        let totalrows :: [[WideBuilder]]
totalrows = ReportOpts -> PeriodicReportRow () Change -> [[WideBuilder]]
forall a.
ReportOpts -> PeriodicReportRow a Change -> [[WideBuilder]]
multiBalanceRowAsText ReportOpts
opts PeriodicReportRow () Change
tr
            rowhdrs :: Header Text
rowhdrs = Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Group Properties
NoLine ([Header Text] -> Header Text) -> [Header Text] -> Header Text
forall a b. (a -> b) -> a -> b
$ (Text -> Header Text) -> [Text] -> [Header Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Header Text
forall h. h -> Header h
Header ([Text] -> [Header Text]) -> [Text] -> [Header Text]
forall a b. (a -> b) -> a -> b
$ Text
totalRowHeadingText Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate ([[WideBuilder]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[WideBuilder]]
totalrows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
""
            colhdrs :: Header [a]
colhdrs = [a] -> Header [a]
forall h. h -> Header h
Header [] -- unused, concatTables will discard
        in ((Table Text ch WideBuilder
 -> Table Text [Any] WideBuilder -> Table Text ch WideBuilder)
-> Table Text [Any] WideBuilder
-> Table Text ch WideBuilder
-> Table Text ch WideBuilder
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Properties
-> Table Text ch WideBuilder
-> Table Text [Any] WideBuilder
-> Table Text ch WideBuilder
forall rh ch a ch2.
Properties -> Table rh ch a -> Table rh ch2 a -> Table rh ch a
concatTables Properties
SingleLine) (Table Text [Any] WideBuilder
 -> Table Text ch WideBuilder -> Table Text ch WideBuilder)
-> Table Text [Any] WideBuilder
-> Table Text ch WideBuilder
-> Table Text ch WideBuilder
forall a b. (a -> b) -> a -> b
$ Header Text
-> Header [Any] -> [[WideBuilder]] -> Table Text [Any] WideBuilder
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table Header Text
rowhdrs Header [Any]
forall {a}. Header [a]
colhdrs [[WideBuilder]]
totalrows)
    maybetranspose :: Table rh rh a -> Table rh rh a
maybetranspose | ReportOpts -> Bool
transpose_ ReportOpts
opts = \(Table Header rh
rh Header rh
ch [[a]]
vals) -> Header rh -> Header rh -> [[a]] -> Table rh rh a
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table Header rh
ch Header rh
rh ([[a]] -> [[a]]
forall a. [[a]] -> [[a]]
transpose [[a]]
vals)
                   | Bool
otherwise       = Table rh rh a -> Table rh rh a
forall a. a -> a
id
    multiColumnTableInterRowBorder :: Properties
multiColumnTableInterRowBorder    = Properties
NoLine
    multiColumnTableInterColumnBorder :: Properties
multiColumnTableInterColumnBorder = if ReportOpts -> Bool
pretty_ ReportOpts
opts then Properties
SingleLine else Properties
NoLine

multiBalanceRowAsCellBuilders ::
    AmountFormat -> ReportOpts -> [DateSpan] ->
    RowClass -> (DateSpan -> Ods.Cell Ods.NumLines Text) ->
    PeriodicReportRow a MixedAmount ->
    [[Ods.Cell Ods.NumLines WideBuilder]]
multiBalanceRowAsCellBuilders :: forall a.
AmountFormat
-> ReportOpts
-> [DateSpan]
-> RowClass
-> (DateSpan -> Cell NumLines Text)
-> PeriodicReportRow a Change
-> [[Cell NumLines WideBuilder]]
multiBalanceRowAsCellBuilders AmountFormat
bopts ropts :: ReportOpts
ropts@ReportOpts{Bool
Int
[Text]
[Status]
SortSpec
Maybe Text
Maybe NormalSign
Maybe ValuationType
Maybe ConversionOp
DepthSpec
Interval
Period
StringFormat
Layout
AccountListMode
BalanceAccumulation
BalanceCalculation
balancecalc_ :: ReportOpts -> BalanceCalculation
no_total_ :: ReportOpts -> Bool
layout_ :: ReportOpts -> Layout
interval_ :: ReportOpts -> Interval
format_ :: ReportOpts -> StringFormat
color_ :: ReportOpts -> Bool
pretty_ :: ReportOpts -> Bool
transpose_ :: ReportOpts -> Bool
balance_base_url_ :: ReportOpts -> Maybe Text
querystring_ :: ReportOpts -> [Text]
normalbalance_ :: ReportOpts -> Maybe NormalSign
invert_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
show_costs_ :: ReportOpts -> Bool
summary_only_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
declared_ :: ReportOpts -> Bool
drop_ :: ReportOpts -> Int
accountlistmode_ :: ReportOpts -> AccountListMode
budgetpat_ :: ReportOpts -> Maybe Text
balanceaccum_ :: ReportOpts -> BalanceAccumulation
txn_dates_ :: ReportOpts -> Bool
sortspec_ :: ReportOpts -> SortSpec
related_ :: ReportOpts -> Bool
average_ :: ReportOpts -> Bool
real_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
date2_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> DepthSpec
infer_prices_ :: ReportOpts -> Bool
value_ :: ReportOpts -> Maybe ValuationType
conversionop_ :: ReportOpts -> Maybe ConversionOp
statuses_ :: ReportOpts -> [Status]
period_ :: ReportOpts -> Period
period_ :: Period
interval_ :: Interval
statuses_ :: [Status]
conversionop_ :: Maybe ConversionOp
value_ :: Maybe ValuationType
infer_prices_ :: Bool
depth_ :: DepthSpec
date2_ :: Bool
empty_ :: Bool
no_elide_ :: Bool
real_ :: Bool
format_ :: StringFormat
balance_base_url_ :: Maybe Text
pretty_ :: Bool
querystring_ :: [Text]
average_ :: Bool
related_ :: Bool
sortspec_ :: SortSpec
txn_dates_ :: Bool
balancecalc_ :: BalanceCalculation
balanceaccum_ :: BalanceAccumulation
budgetpat_ :: Maybe Text
accountlistmode_ :: AccountListMode
drop_ :: Int
declared_ :: Bool
row_total_ :: Bool
no_total_ :: Bool
summary_only_ :: Bool
show_costs_ :: Bool
sort_amount_ :: Bool
percent_ :: Bool
invert_ :: Bool
normalbalance_ :: Maybe NormalSign
color_ :: Bool
transpose_ :: Bool
layout_ :: Layout
..} [DateSpan]
colspans
      RowClass
rc DateSpan -> Cell NumLines Text
renderDateSpanCell (PeriodicReportRow a
_acct [Change]
as Change
rowtot Change
rowavg) =
    case Layout
layout_ of
      LayoutWide Maybe Int
width -> [((Class, Change) -> Cell NumLines WideBuilder)
-> [(Class, Change)] -> [Cell NumLines WideBuilder]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AmountFormat -> (Class, Change) -> Cell NumLines WideBuilder
forall border.
Lines border =>
AmountFormat -> (Class, Change) -> Cell border WideBuilder
cellFromMixedAmount AmountFormat
bopts{displayMaxWidth=width}) [(Class, Change)]
clsamts]
      Layout
LayoutTall       -> Cell NumLines WideBuilder
-> [[Cell NumLines WideBuilder]] -> [[Cell NumLines WideBuilder]]
forall a. a -> [[a]] -> [[a]]
paddedTranspose Cell NumLines WideBuilder
forall border text. (Lines border, Monoid text) => Cell border text
Ods.emptyCell
                           ([[Cell NumLines WideBuilder]] -> [[Cell NumLines WideBuilder]])
-> ([(Class, Change)] -> [[Cell NumLines WideBuilder]])
-> [(Class, Change)]
-> [[Cell NumLines WideBuilder]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Class, Change) -> [Cell NumLines WideBuilder])
-> [(Class, Change)] -> [[Cell NumLines WideBuilder]]
forall a b. (a -> b) -> [a] -> [b]
map (AmountFormat -> (Class, Change) -> [Cell NumLines WideBuilder]
forall border.
Lines border =>
AmountFormat -> (Class, Change) -> [Cell border WideBuilder]
cellsFromMixedAmount AmountFormat
bopts{displayMaxWidth=Nothing})
                           ([(Class, Change)] -> [[Cell NumLines WideBuilder]])
-> [(Class, Change)] -> [[Cell NumLines WideBuilder]]
forall a b. (a -> b) -> a -> b
$ [(Class, Change)]
clsamts
      Layout
LayoutBare       -> (Cell NumLines WideBuilder
 -> [Cell NumLines WideBuilder] -> [Cell NumLines WideBuilder])
-> [Cell NumLines WideBuilder]
-> [[Cell NumLines WideBuilder]]
-> [[Cell NumLines WideBuilder]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (:) ((Text -> Cell NumLines WideBuilder)
-> [Text] -> [Cell NumLines WideBuilder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Cell NumLines WideBuilder
wbCell [Text]
cs)  -- add symbols
                           ([[Cell NumLines WideBuilder]] -> [[Cell NumLines WideBuilder]])
-> ([(Class, Change)] -> [[Cell NumLines WideBuilder]])
-> [(Class, Change)]
-> [[Cell NumLines WideBuilder]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Cell NumLines WideBuilder]] -> [[Cell NumLines WideBuilder]]
forall a. [[a]] -> [[a]]
transpose                         -- each row becomes a list of Text quantities
                           ([[Cell NumLines WideBuilder]] -> [[Cell NumLines WideBuilder]])
-> ([(Class, Change)] -> [[Cell NumLines WideBuilder]])
-> [(Class, Change)]
-> [[Cell NumLines WideBuilder]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Class, Change) -> [Cell NumLines WideBuilder])
-> [(Class, Change)] -> [[Cell NumLines WideBuilder]]
forall a b. (a -> b) -> [a] -> [b]
map (AmountFormat -> (Class, Change) -> [Cell NumLines WideBuilder]
forall border.
Lines border =>
AmountFormat -> (Class, Change) -> [Cell border WideBuilder]
cellsFromMixedAmount AmountFormat
bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing})
                           ([(Class, Change)] -> [[Cell NumLines WideBuilder]])
-> [(Class, Change)] -> [[Cell NumLines WideBuilder]]
forall a b. (a -> b) -> a -> b
$ [(Class, Change)]
clsamts
      Layout
LayoutTidy       -> [[[Cell NumLines WideBuilder]]] -> [[Cell NumLines WideBuilder]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                           ([[[Cell NumLines WideBuilder]]] -> [[Cell NumLines WideBuilder]])
-> ([(Class, Change)] -> [[[Cell NumLines WideBuilder]]])
-> [(Class, Change)]
-> [[Cell NumLines WideBuilder]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateSpan
 -> [[Cell NumLines WideBuilder]] -> [[Cell NumLines WideBuilder]])
-> [DateSpan]
-> [[[Cell NumLines WideBuilder]]]
-> [[[Cell NumLines WideBuilder]]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (([Cell NumLines WideBuilder] -> [Cell NumLines WideBuilder])
-> [[Cell NumLines WideBuilder]] -> [[Cell NumLines WideBuilder]]
forall a b. (a -> b) -> [a] -> [b]
map (([Cell NumLines WideBuilder] -> [Cell NumLines WideBuilder])
 -> [[Cell NumLines WideBuilder]] -> [[Cell NumLines WideBuilder]])
-> (DateSpan
    -> [Cell NumLines WideBuilder] -> [Cell NumLines WideBuilder])
-> DateSpan
-> [[Cell NumLines WideBuilder]]
-> [[Cell NumLines WideBuilder]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateSpan
-> [Cell NumLines WideBuilder] -> [Cell NumLines WideBuilder]
addDateColumns) [DateSpan]
colspans
                           ([[[Cell NumLines WideBuilder]]]
 -> [[[Cell NumLines WideBuilder]]])
-> ([(Class, Change)] -> [[[Cell NumLines WideBuilder]]])
-> [(Class, Change)]
-> [[[Cell NumLines WideBuilder]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Class, Change) -> [[Cell NumLines WideBuilder]])
-> [(Class, Change)] -> [[[Cell NumLines WideBuilder]]]
forall a b. (a -> b) -> [a] -> [b]
map ( (Text -> Cell NumLines WideBuilder -> [Cell NumLines WideBuilder])
-> [Text]
-> [Cell NumLines WideBuilder]
-> [[Cell NumLines WideBuilder]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
c Cell NumLines WideBuilder
a -> [Text -> Cell NumLines WideBuilder
wbCell Text
c, Cell NumLines WideBuilder
a]) [Text]
cs
                                  ([Cell NumLines WideBuilder] -> [[Cell NumLines WideBuilder]])
-> ((Class, Change) -> [Cell NumLines WideBuilder])
-> (Class, Change)
-> [[Cell NumLines WideBuilder]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> (Class, Change) -> [Cell NumLines WideBuilder]
forall border.
Lines border =>
AmountFormat -> (Class, Change) -> [Cell border WideBuilder]
cellsFromMixedAmount AmountFormat
bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing})
                           ([(Class, Change)] -> [[Cell NumLines WideBuilder]])
-> [(Class, Change)] -> [[Cell NumLines WideBuilder]]
forall a b. (a -> b) -> a -> b
$ [(Class, Change)]
classified
                                 -- Do not include totals column or average for tidy output, as this
                                 -- complicates the data representation and can be easily calculated
  where
    wbCell :: Text -> Cell NumLines WideBuilder
wbCell = WideBuilder -> Cell NumLines WideBuilder
forall border text. Lines border => text -> Cell border text
Ods.defaultCell (WideBuilder -> Cell NumLines WideBuilder)
-> (Text -> WideBuilder) -> Text -> Cell NumLines WideBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> WideBuilder
wbFromText
    wbDate :: Text -> Cell NumLines WideBuilder
wbDate Text
content = (Text -> Cell NumLines WideBuilder
wbCell Text
content) {Ods.cellType = Ods.TypeDate}
    cs :: [Text]
cs = if (Change -> Bool) -> [Change] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Change -> Bool
mixedAmountLooksZero [Change]
allamts then [Text
""] else Set Text -> [Text]
forall a. Set a -> [a]
S.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ (Change -> Set Text) -> [Change] -> Set Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Change -> Set Text
maCommodities [Change]
allamts
    classified :: [(Class, Change)]
classified = (Change -> (Class, Change)) -> [Change] -> [(Class, Change)]
forall a b. (a -> b) -> [a] -> [b]
map ((,) (RowClass -> Class
amountClass RowClass
rc)) [Change]
as
    allamts :: [Change]
allamts = ((Class, Change) -> Change) -> [(Class, Change)] -> [Change]
forall a b. (a -> b) -> [a] -> [b]
map (Class, Change) -> Change
forall a b. (a, b) -> b
snd [(Class, Change)]
clsamts
    clsamts :: [(Class, Change)]
clsamts = (if Bool -> Bool
not Bool
summary_only_ then [(Class, Change)]
classified else []) [(Class, Change)] -> [(Class, Change)] -> [(Class, Change)]
forall a. [a] -> [a] -> [a]
++
                [(RowClass -> Class
rowTotalClass RowClass
rc, Change
rowtot) |
                    ReportOpts -> Bool
multiBalanceHasTotalsColumn ReportOpts
ropts Bool -> Bool -> Bool
&& Bool -> Bool
not ([Change] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Change]
as)] [(Class, Change)] -> [(Class, Change)] -> [(Class, Change)]
forall a. [a] -> [a] -> [a]
++
                [(RowClass -> Class
rowAverageClass RowClass
rc, Change
rowavg) | Bool
average_ Bool -> Bool -> Bool
&& Bool -> Bool
not ([Change] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Change]
as)]
    addDateColumns :: DateSpan
-> [Cell NumLines WideBuilder] -> [Cell NumLines WideBuilder]
addDateColumns spn :: DateSpan
spn@(DateSpan Maybe EFDay
s Maybe EFDay
e) [Cell NumLines WideBuilder]
remCols =
        (Text -> WideBuilder
wbFromText (Text -> WideBuilder)
-> Cell NumLines Text -> Cell NumLines WideBuilder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DateSpan -> Cell NumLines Text
renderDateSpanCell DateSpan
spn) Cell NumLines WideBuilder
-> [Cell NumLines WideBuilder] -> [Cell NumLines WideBuilder]
forall a. a -> [a] -> [a]
:
        Text -> Cell NumLines WideBuilder
wbDate (Text -> (EFDay -> Text) -> Maybe EFDay -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" EFDay -> Text
showEFDate Maybe EFDay
s) Cell NumLines WideBuilder
-> [Cell NumLines WideBuilder] -> [Cell NumLines WideBuilder]
forall a. a -> [a] -> [a]
:
        Text -> Cell NumLines WideBuilder
wbDate (Text -> (EFDay -> Text) -> Maybe EFDay -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (EFDay -> Text
showEFDate (EFDay -> Text) -> (EFDay -> EFDay) -> EFDay -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Day -> Day) -> EFDay -> EFDay
modifyEFDay (Integer -> Day -> Day
addDays (-Integer
1))) Maybe EFDay
e) Cell NumLines WideBuilder
-> [Cell NumLines WideBuilder] -> [Cell NumLines WideBuilder]
forall a. a -> [a] -> [a]
:
        [Cell NumLines WideBuilder]
remCols

    paddedTranspose :: a -> [[a]] -> [[a]]
    paddedTranspose :: forall a. a -> [[a]] -> [[a]]
paddedTranspose a
_ [] = [[]]
    paddedTranspose a
n [[a]]
as1 = Int -> [[a]] -> [[a]]
forall a. Int -> [a] -> [a]
take ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([[a]] -> [Int]) -> [[a]] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Int) -> [[a]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[a]] -> Int) -> [[a]] -> Int
forall a b. (a -> b) -> a -> b
$ [[a]]
as1) ([[a]] -> [[a]]) -> ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
trans ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [[a]]
as1
        where
          trans :: [[a]] -> [[a]]
trans ([] : [[a]]
xss)  = (a
n a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
h [[a]]
xss) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:  [[a]] -> [[a]]
trans ([a
n] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
t [[a]]
xss)
          trans ((a
x : [a]
xs) : [[a]]
xss) = (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
h [[a]]
xss) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
trans ([a] -> [a]
m [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
t [[a]]
xss)
          trans [] = []
          h :: [a] -> a
h (a
x:[a]
_) = a
x
          h [] = a
n
          t :: [a] -> [a]
t (a
_:[a]
xs) = [a]
xs
          t [] = [a
n]
          m :: [a] -> [a]
m (a
x:[a]
xs) = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs
          m [] = [a
n]


multiBalanceHasTotalsColumn :: ReportOpts -> Bool
multiBalanceHasTotalsColumn :: ReportOpts -> Bool
multiBalanceHasTotalsColumn ReportOpts
ropts =
    ReportOpts -> Bool
row_total_ ReportOpts
ropts Bool -> Bool -> Bool
&& ReportOpts -> BalanceAccumulation
balanceaccum_ ReportOpts
ropts BalanceAccumulation -> [BalanceAccumulation] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [BalanceAccumulation
Cumulative, BalanceAccumulation
Historical]

multiBalanceRowAsText :: ReportOpts -> PeriodicReportRow a MixedAmount -> [[WideBuilder]]
multiBalanceRowAsText :: forall a.
ReportOpts -> PeriodicReportRow a Change -> [[WideBuilder]]
multiBalanceRowAsText ReportOpts
opts =
    [[Cell NumLines WideBuilder]] -> [[WideBuilder]]
forall border text. [[Cell border text]] -> [[text]]
rawTableContent ([[Cell NumLines WideBuilder]] -> [[WideBuilder]])
-> (PeriodicReportRow a Change -> [[Cell NumLines WideBuilder]])
-> PeriodicReportRow a Change
-> [[WideBuilder]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    AmountFormat
-> ReportOpts
-> [DateSpan]
-> RowClass
-> (DateSpan -> Cell NumLines Text)
-> PeriodicReportRow a Change
-> [[Cell NumLines WideBuilder]]
forall a.
AmountFormat
-> ReportOpts
-> [DateSpan]
-> RowClass
-> (DateSpan -> Cell NumLines Text)
-> PeriodicReportRow a Change
-> [[Cell NumLines WideBuilder]]
multiBalanceRowAsCellBuilders AmountFormat
oneLineNoCostFmt{displayColour=color_ opts} ReportOpts
opts []
        RowClass
Value DateSpan -> Cell NumLines Text
simpleDateSpanCell

multiBalanceRowAsCsvText :: ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[T.Text]]
multiBalanceRowAsCsvText :: forall a.
ReportOpts -> [DateSpan] -> PeriodicReportRow a Change -> CSV
multiBalanceRowAsCsvText ReportOpts
opts [DateSpan]
colspans =
    ([Cell NumLines WideBuilder] -> [Text])
-> [[Cell NumLines WideBuilder]] -> CSV
forall a b. (a -> b) -> [a] -> [b]
map ((Cell NumLines WideBuilder -> Text)
-> [Cell NumLines WideBuilder] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (WideBuilder -> Text
wbToText (WideBuilder -> Text)
-> (Cell NumLines WideBuilder -> WideBuilder)
-> Cell NumLines WideBuilder
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cell NumLines WideBuilder -> WideBuilder
forall border text. Cell border text -> text
Ods.cellContent)) ([[Cell NumLines WideBuilder]] -> CSV)
-> (PeriodicReportRow a Change -> [[Cell NumLines WideBuilder]])
-> PeriodicReportRow a Change
-> CSV
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    AmountFormat
-> ReportOpts
-> [DateSpan]
-> RowClass
-> (DateSpan -> Cell NumLines Text)
-> PeriodicReportRow a Change
-> [[Cell NumLines WideBuilder]]
forall a.
AmountFormat
-> ReportOpts
-> [DateSpan]
-> RowClass
-> (DateSpan -> Cell NumLines Text)
-> PeriodicReportRow a Change
-> [[Cell NumLines WideBuilder]]
multiBalanceRowAsCellBuilders AmountFormat
machineFmt ReportOpts
opts [DateSpan]
colspans
        RowClass
Value DateSpan -> Cell NumLines Text
simpleDateSpanCell


-- Budget reports

-- A BudgetCell's data values rendered for display - the actual change amount,
-- the budget goal amount if any, and the corresponding goal percentage if possible.
type BudgetDisplayCell = (WideBuilder, Maybe (WideBuilder, Maybe WideBuilder))

-- | A row of rendered budget data cells.
type BudgetDisplayRow  = [BudgetDisplayCell]

-- | An amount render helper for the budget report. Renders each commodity separately.
type BudgetShowAmountsFn   = MixedAmount -> [WideBuilder]

-- | A goal percentage calculating helper for the budget report.
type BudgetCalcPercentagesFn  = Change -> BudgetGoal -> [Maybe Percentage]

-- | Render a budget report as plain text suitable for console output.
budgetReportAsText :: ReportOpts -> BudgetReport -> TL.Text
budgetReportAsText :: ReportOpts -> BudgetReport -> Text
budgetReportAsText ropts :: ReportOpts
ropts@ReportOpts{Bool
Int
[Text]
[Status]
SortSpec
Maybe Text
Maybe NormalSign
Maybe ValuationType
Maybe ConversionOp
DepthSpec
Interval
Period
StringFormat
Layout
AccountListMode
BalanceAccumulation
BalanceCalculation
balancecalc_ :: ReportOpts -> BalanceCalculation
no_total_ :: ReportOpts -> Bool
layout_ :: ReportOpts -> Layout
interval_ :: ReportOpts -> Interval
format_ :: ReportOpts -> StringFormat
color_ :: ReportOpts -> Bool
pretty_ :: ReportOpts -> Bool
transpose_ :: ReportOpts -> Bool
balance_base_url_ :: ReportOpts -> Maybe Text
querystring_ :: ReportOpts -> [Text]
normalbalance_ :: ReportOpts -> Maybe NormalSign
invert_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
show_costs_ :: ReportOpts -> Bool
summary_only_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
declared_ :: ReportOpts -> Bool
drop_ :: ReportOpts -> Int
accountlistmode_ :: ReportOpts -> AccountListMode
budgetpat_ :: ReportOpts -> Maybe Text
balanceaccum_ :: ReportOpts -> BalanceAccumulation
txn_dates_ :: ReportOpts -> Bool
sortspec_ :: ReportOpts -> SortSpec
related_ :: ReportOpts -> Bool
average_ :: ReportOpts -> Bool
real_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
date2_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> DepthSpec
infer_prices_ :: ReportOpts -> Bool
value_ :: ReportOpts -> Maybe ValuationType
conversionop_ :: ReportOpts -> Maybe ConversionOp
statuses_ :: ReportOpts -> [Status]
period_ :: ReportOpts -> Period
period_ :: Period
interval_ :: Interval
statuses_ :: [Status]
conversionop_ :: Maybe ConversionOp
value_ :: Maybe ValuationType
infer_prices_ :: Bool
depth_ :: DepthSpec
date2_ :: Bool
empty_ :: Bool
no_elide_ :: Bool
real_ :: Bool
format_ :: StringFormat
balance_base_url_ :: Maybe Text
pretty_ :: Bool
querystring_ :: [Text]
average_ :: Bool
related_ :: Bool
sortspec_ :: SortSpec
txn_dates_ :: Bool
balancecalc_ :: BalanceCalculation
balanceaccum_ :: BalanceAccumulation
budgetpat_ :: Maybe Text
accountlistmode_ :: AccountListMode
drop_ :: Int
declared_ :: Bool
row_total_ :: Bool
no_total_ :: Bool
summary_only_ :: Bool
show_costs_ :: Bool
sort_amount_ :: Bool
percent_ :: Bool
invert_ :: Bool
normalbalance_ :: Maybe NormalSign
color_ :: Bool
transpose_ :: Bool
layout_ :: Layout
..} BudgetReport
budgetr = Builder -> Text
TB.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$
    Text -> Builder
TB.fromText Text
title Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TB.fromText Text
"\n\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      ReportOpts -> Table Text Text WideBuilder -> Builder
multiBalanceReportTableAsText ReportOpts
ropts (ReportOpts -> BudgetReport -> Table Text Text WideBuilder
budgetReportAsTable ReportOpts
ropts BudgetReport
budgetr)
  where
    title :: Text
title = Text
"Budget performance in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DateSpan -> Text
showDateSpan (BudgetReport -> DateSpan
forall a b. PeriodicReport a b -> DateSpan
periodicReportSpan BudgetReport
budgetr)
           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (case Maybe ConversionOp
conversionop_ of
                 Just ConversionOp
ToCost -> Text
", converted to cost"
                 Maybe ConversionOp
_           -> Text
"")
           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (case Maybe ValuationType
value_ of
                 Just (AtThen Maybe Text
_mc)   -> Text
", valued at posting date"
                 Just (AtEnd Maybe Text
_mc)    -> Text
", valued at period ends"
                 Just (AtNow Maybe Text
_mc)    -> Text
", current value"
                 Just (AtDate Day
d Maybe Text
_mc) -> Text
", valued at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Day -> Text
showDate Day
d
                 Maybe ValuationType
Nothing             -> Text
"")
           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"

-- | Build a 'Table' from a multi-column balance report.
budgetReportAsTable :: ReportOpts -> BudgetReport -> Table Text Text WideBuilder
budgetReportAsTable :: ReportOpts -> BudgetReport -> Table Text Text WideBuilder
budgetReportAsTable ropts :: ReportOpts
ropts@ReportOpts{Bool
Int
[Text]
[Status]
SortSpec
Maybe Text
Maybe NormalSign
Maybe ValuationType
Maybe ConversionOp
DepthSpec
Interval
Period
StringFormat
Layout
AccountListMode
BalanceAccumulation
BalanceCalculation
balancecalc_ :: ReportOpts -> BalanceCalculation
no_total_ :: ReportOpts -> Bool
layout_ :: ReportOpts -> Layout
interval_ :: ReportOpts -> Interval
format_ :: ReportOpts -> StringFormat
color_ :: ReportOpts -> Bool
pretty_ :: ReportOpts -> Bool
transpose_ :: ReportOpts -> Bool
balance_base_url_ :: ReportOpts -> Maybe Text
querystring_ :: ReportOpts -> [Text]
normalbalance_ :: ReportOpts -> Maybe NormalSign
invert_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
show_costs_ :: ReportOpts -> Bool
summary_only_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
declared_ :: ReportOpts -> Bool
drop_ :: ReportOpts -> Int
accountlistmode_ :: ReportOpts -> AccountListMode
budgetpat_ :: ReportOpts -> Maybe Text
balanceaccum_ :: ReportOpts -> BalanceAccumulation
txn_dates_ :: ReportOpts -> Bool
sortspec_ :: ReportOpts -> SortSpec
related_ :: ReportOpts -> Bool
average_ :: ReportOpts -> Bool
real_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
date2_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> DepthSpec
infer_prices_ :: ReportOpts -> Bool
value_ :: ReportOpts -> Maybe ValuationType
conversionop_ :: ReportOpts -> Maybe ConversionOp
statuses_ :: ReportOpts -> [Status]
period_ :: ReportOpts -> Period
period_ :: Period
interval_ :: Interval
statuses_ :: [Status]
conversionop_ :: Maybe ConversionOp
value_ :: Maybe ValuationType
infer_prices_ :: Bool
depth_ :: DepthSpec
date2_ :: Bool
empty_ :: Bool
no_elide_ :: Bool
real_ :: Bool
format_ :: StringFormat
balance_base_url_ :: Maybe Text
pretty_ :: Bool
querystring_ :: [Text]
average_ :: Bool
related_ :: Bool
sortspec_ :: SortSpec
txn_dates_ :: Bool
balancecalc_ :: BalanceCalculation
balanceaccum_ :: BalanceAccumulation
budgetpat_ :: Maybe Text
accountlistmode_ :: AccountListMode
drop_ :: Int
declared_ :: Bool
row_total_ :: Bool
no_total_ :: Bool
summary_only_ :: Bool
show_costs_ :: Bool
sort_amount_ :: Bool
percent_ :: Bool
invert_ :: Bool
normalbalance_ :: Maybe NormalSign
color_ :: Bool
transpose_ :: Bool
layout_ :: Layout
..} (PeriodicReport [DateSpan]
spans [PeriodicReportRow DisplayName (Maybe Change, Maybe Change)]
items PeriodicReportRow () (Maybe Change, Maybe Change)
totrow) =
  Table Text Text WideBuilder -> Table Text Text WideBuilder
forall {rh} {a}. Table rh rh a -> Table rh rh a
maybetransposetable (Table Text Text WideBuilder -> Table Text Text WideBuilder)
-> Table Text Text WideBuilder -> Table Text Text WideBuilder
forall a b. (a -> b) -> a -> b
$
  Table Text Text WideBuilder -> Table Text Text WideBuilder
forall {ch}. Table Text ch WideBuilder -> Table Text ch WideBuilder
addtotalrow (Table Text Text WideBuilder -> Table Text Text WideBuilder)
-> Table Text Text WideBuilder -> Table Text Text WideBuilder
forall a b. (a -> b) -> a -> b
$
    Header Text
-> Header Text -> [[WideBuilder]] -> Table Text Text WideBuilder
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table
      (Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Group Properties
budgetTableInterRowBorder    ([Header Text] -> Header Text) -> [Header Text] -> Header Text
forall a b. (a -> b) -> a -> b
$ (Text -> Header Text) -> [Text] -> [Header Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Header Text
forall h. h -> Header h
Header [Text]
accts)
      (Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Group Properties
budgetTableInterColumnBorder ([Header Text] -> Header Text) -> [Header Text] -> Header Text
forall a b. (a -> b) -> a -> b
$ (Text -> Header Text) -> [Text] -> [Header Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Header Text
forall h. h -> Header h
Header [Text]
colheadings)
      [[WideBuilder]]
rows
  where
    budgetTableInterRowBorder :: Properties
budgetTableInterRowBorder    = Properties
NoLine
    budgetTableInterColumnBorder :: Properties
budgetTableInterColumnBorder = if Bool
pretty_ then Properties
SingleLine else Properties
NoLine

    maybetransposetable :: Table rh rh a -> Table rh rh a
maybetransposetable
      | Bool
transpose_ = \(Table Header rh
rh Header rh
ch [[a]]
vals) -> Header rh -> Header rh -> [[a]] -> Table rh rh a
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table Header rh
ch Header rh
rh ([[a]] -> [[a]]
forall a. [[a]] -> [[a]]
transpose [[a]]
vals)
      | Bool
otherwise  = Table rh rh a -> Table rh rh a
forall a. a -> a
id

    addtotalrow :: Table Text ch WideBuilder -> Table Text ch WideBuilder
addtotalrow
      | Bool
no_total_ = Table Text ch WideBuilder -> Table Text ch WideBuilder
forall a. a -> a
id
      | Bool
otherwise =
        let
          rowhdrs :: Header Text
rowhdrs = Properties -> [Header Text] -> Header Text
forall h. Properties -> [Header h] -> Header h
Group Properties
NoLine ([Header Text] -> Header Text) -> [Header Text] -> Header Text
forall a b. (a -> b) -> a -> b
$ (Text -> Header Text) -> [Text] -> [Header Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Header Text
forall h. h -> Header h
Header ([Text] -> [Header Text]) -> [Text] -> [Header Text]
forall a b. (a -> b) -> a -> b
$ Text
totalRowHeadingBudgetText Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate ([[WideBuilder]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[WideBuilder]]
totalrows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
""
          colhdrs :: Header [a]
colhdrs = [a] -> Header [a]
forall h. h -> Header h
Header [] -- ignored by concatTables
        in
          ((Table Text ch WideBuilder
 -> Table Text [Any] WideBuilder -> Table Text ch WideBuilder)
-> Table Text [Any] WideBuilder
-> Table Text ch WideBuilder
-> Table Text ch WideBuilder
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Properties
-> Table Text ch WideBuilder
-> Table Text [Any] WideBuilder
-> Table Text ch WideBuilder
forall rh ch a ch2.
Properties -> Table rh ch a -> Table rh ch2 a -> Table rh ch a
concatTables Properties
SingleLine) (Table Text [Any] WideBuilder
 -> Table Text ch WideBuilder -> Table Text ch WideBuilder)
-> Table Text [Any] WideBuilder
-> Table Text ch WideBuilder
-> Table Text ch WideBuilder
forall a b. (a -> b) -> a -> b
$ Header Text
-> Header [Any] -> [[WideBuilder]] -> Table Text [Any] WideBuilder
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table Header Text
rowhdrs Header [Any]
forall {a}. Header [a]
colhdrs [[WideBuilder]]
totalrows)  -- XXX ?

    colheadings :: [Text]
colheadings = [Text
"Commodity" | Layout
layout_ Layout -> Layout -> Bool
forall a. Eq a => a -> a -> Bool
== Layout
LayoutBare]
                  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (DateSpan -> Text) -> [DateSpan] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (BalanceAccumulation -> [DateSpan] -> DateSpan -> Text
reportPeriodName BalanceAccumulation
balanceaccum_ [DateSpan]
spans) [DateSpan]
spans
                  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"  Total" | Bool
row_total_]
                  [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"Average" | Bool
average_]

    ([Text]
accts, [[WideBuilder]]
rows, [[WideBuilder]]
totalrows) =
      ([Text]
accts'
      ,[WideBuilder] -> [[WideBuilder]] -> [[WideBuilder]]
maybecommcol [WideBuilder]
itemscs  ([[WideBuilder]] -> [[WideBuilder]])
-> [[WideBuilder]] -> [[WideBuilder]]
forall a b. (a -> b) -> a -> b
$ [[BudgetDisplayCell]] -> [[WideBuilder]]
showcells  [[BudgetDisplayCell]]
texts
      ,[WideBuilder] -> [[WideBuilder]] -> [[WideBuilder]]
maybecommcol [WideBuilder]
totrowcs ([[WideBuilder]] -> [[WideBuilder]])
-> [[WideBuilder]] -> [[WideBuilder]]
forall a b. (a -> b) -> a -> b
$ [[BudgetDisplayCell]] -> [[WideBuilder]]
showtotrow [[BudgetDisplayCell]]
totrowtexts)
      where
        -- If --layout=bare, prepend a commodities column.
        maybecommcol :: [WideBuilder] -> [[WideBuilder]] -> [[WideBuilder]]
        maybecommcol :: [WideBuilder] -> [[WideBuilder]] -> [[WideBuilder]]
maybecommcol [WideBuilder]
cs
          | Layout
layout_ Layout -> Layout -> Bool
forall a. Eq a => a -> a -> Bool
== Layout
LayoutBare = (WideBuilder -> [WideBuilder] -> [WideBuilder])
-> [WideBuilder] -> [[WideBuilder]] -> [[WideBuilder]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (:) [WideBuilder]
cs
          | Bool
otherwise             = [[WideBuilder]] -> [[WideBuilder]]
forall a. a -> a
id

        showcells, showtotrow :: [[BudgetDisplayCell]] -> [[WideBuilder]]
        ([[BudgetDisplayCell]] -> [[WideBuilder]]
showcells, [[BudgetDisplayCell]] -> [[WideBuilder]]
showtotrow) =
          ([[WideBuilder]] -> [[WideBuilder]]
forall a. [[a]] -> [[a]]
maybetranspose ([[WideBuilder]] -> [[WideBuilder]])
-> ([[BudgetDisplayCell]] -> [[WideBuilder]])
-> [[BudgetDisplayCell]]
-> [[WideBuilder]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([BudgetDisplayCell] -> [WideBuilder])
-> [[BudgetDisplayCell]] -> [[WideBuilder]]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, Int, Int) -> BudgetDisplayCell -> WideBuilder)
-> [(Int, Int, Int)] -> [BudgetDisplayCell] -> [WideBuilder]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int, Int, Int) -> BudgetDisplayCell -> WideBuilder
showBudgetDisplayCell [(Int, Int, Int)]
widths)       ([[BudgetDisplayCell]] -> [[WideBuilder]])
-> ([[BudgetDisplayCell]] -> [[BudgetDisplayCell]])
-> [[BudgetDisplayCell]]
-> [[WideBuilder]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[BudgetDisplayCell]] -> [[BudgetDisplayCell]]
forall a. [[a]] -> [[a]]
maybetranspose
          ,[[WideBuilder]] -> [[WideBuilder]]
forall a. [[a]] -> [[a]]
maybetranspose ([[WideBuilder]] -> [[WideBuilder]])
-> ([[BudgetDisplayCell]] -> [[WideBuilder]])
-> [[BudgetDisplayCell]]
-> [[WideBuilder]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([BudgetDisplayCell] -> [WideBuilder])
-> [[BudgetDisplayCell]] -> [[WideBuilder]]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, Int, Int) -> BudgetDisplayCell -> WideBuilder)
-> [(Int, Int, Int)] -> [BudgetDisplayCell] -> [WideBuilder]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int, Int, Int) -> BudgetDisplayCell -> WideBuilder
showBudgetDisplayCell [(Int, Int, Int)]
totrowwidths) ([[BudgetDisplayCell]] -> [[WideBuilder]])
-> ([[BudgetDisplayCell]] -> [[BudgetDisplayCell]])
-> [[BudgetDisplayCell]]
-> [[WideBuilder]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[BudgetDisplayCell]] -> [[BudgetDisplayCell]]
forall a. [[a]] -> [[a]]
maybetranspose)
          where
            -- | Combine a BudgetDisplayCell's rendered values into a "[PERCENT of GOAL]" rendering,
            -- respecting the given widths.
            showBudgetDisplayCell :: (Int, Int, Int) -> BudgetDisplayCell -> WideBuilder
            showBudgetDisplayCell :: (Int, Int, Int) -> BudgetDisplayCell -> WideBuilder
showBudgetDisplayCell (Int
actualwidth, Int
budgetwidth, Int
percentwidth) (WideBuilder
actual, Maybe (WideBuilder, Maybe WideBuilder)
mbudget) =
              (Builder -> Int -> WideBuilder) -> Int -> Builder -> WideBuilder
forall a b c. (a -> b -> c) -> b -> a -> c
flip Builder -> Int -> WideBuilder
WideBuilder (Int
actualwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
totalbudgetwidth) (Builder -> WideBuilder) -> Builder -> WideBuilder
forall a b. (a -> b) -> a -> b
$
                WideBuilder -> Builder
toPadded WideBuilder
actual Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
-> ((WideBuilder, Maybe WideBuilder) -> Builder)
-> Maybe (WideBuilder, Maybe WideBuilder)
-> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
emptycell (WideBuilder, Maybe WideBuilder) -> Builder
showBudgetGoalAndPercentage Maybe (WideBuilder, Maybe WideBuilder)
mbudget

              where
                toPadded :: WideBuilder -> Builder
toPadded (WideBuilder Builder
b Int
w) = (Text -> Builder
TB.fromText (Text -> Builder) -> (Int -> Text) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Text -> Text) -> Text -> Int -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Text -> Text
T.replicate Text
" " (Int -> Builder) -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ Int
actualwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b

                (Int
totalpercentwidth, Int
totalbudgetwidth) =
                  let totalpercentwidth' :: Int
totalpercentwidth' = if Int
percentwidth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int
percentwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5
                   in ( Int
totalpercentwidth'
                      , if Int
budgetwidth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int
budgetwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
totalpercentwidth' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3
                      )

                emptycell :: TB.Builder
                emptycell :: Builder
emptycell = Text -> Builder
TB.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
totalbudgetwidth Text
" "

                showBudgetGoalAndPercentage :: (WideBuilder, Maybe WideBuilder) -> TB.Builder
                showBudgetGoalAndPercentage :: (WideBuilder, Maybe WideBuilder) -> Builder
showBudgetGoalAndPercentage (WideBuilder
goal, Maybe WideBuilder
perc) =
                  let perct :: Text
perct = case Maybe WideBuilder
perc of
                        Maybe WideBuilder
Nothing  -> Int -> Text -> Text
T.replicate Int
totalpercentwidth Text
" "
                        Just WideBuilder
pct -> Int -> Text -> Text
T.replicate (Int
percentwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth WideBuilder
pct) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WideBuilder -> Text
wbToText WideBuilder
pct Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"% of "
                   in Text -> Builder
TB.fromText (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Text
" [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
perct Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
budgetwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- WideBuilder -> Int
wbWidth WideBuilder
goal) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> WideBuilder -> Text
wbToText WideBuilder
goal Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"

            -- | Build a list of widths for each column.
            -- When --transpose is used, the totals row must be included in this list.
            widths :: [(Int, Int, Int)]
            widths :: [(Int, Int, Int)]
widths = [Int] -> [Int] -> [Int] -> [(Int, Int, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int]
actualwidths [Int]
budgetwidths [Int]
percentwidths
              where
                actualwidths :: [Int]
actualwidths  = ([(Int, Int, Int)] -> Int) -> [[(Int, Int, Int)]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall a. Integral a => [a] -> a
maximum' ([Int] -> Int)
-> ([(Int, Int, Int)] -> [Int]) -> [(Int, Int, Int)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int, Int) -> Int) -> [(Int, Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int, Int) -> Int
forall {a} {b} {c}. (a, b, c) -> a
first3 ) ([[(Int, Int, Int)]] -> [Int]) -> [[(Int, Int, Int)]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[(Int, Int, Int)]]
cols
                budgetwidths :: [Int]
budgetwidths  = ([(Int, Int, Int)] -> Int) -> [[(Int, Int, Int)]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall a. Integral a => [a] -> a
maximum' ([Int] -> Int)
-> ([(Int, Int, Int)] -> [Int]) -> [(Int, Int, Int)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int, Int) -> Int) -> [(Int, Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int, Int) -> Int
forall {a} {b} {c}. (a, b, c) -> b
second3) ([[(Int, Int, Int)]] -> [Int]) -> [[(Int, Int, Int)]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[(Int, Int, Int)]]
cols
                percentwidths :: [Int]
percentwidths = ([(Int, Int, Int)] -> Int) -> [[(Int, Int, Int)]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall a. Integral a => [a] -> a
maximum' ([Int] -> Int)
-> ([(Int, Int, Int)] -> [Int]) -> [(Int, Int, Int)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int, Int) -> Int) -> [(Int, Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int, Int) -> Int
forall {a} {b} {c}. (a, b, c) -> c
third3 ) ([[(Int, Int, Int)]] -> [Int]) -> [[(Int, Int, Int)]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[(Int, Int, Int)]]
cols
                catcolumnwidths :: [[[a]]] -> [[a]]
catcolumnwidths = ([[a]] -> [[a]] -> [[a]]) -> [[a]] -> [[[a]]] -> [[a]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (([a] -> [a] -> [a]) -> [[a]] -> [[a]] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)) ([[a]] -> [[[a]]] -> [[a]]) -> [[a]] -> [[[a]]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]]
forall a. a -> [a]
repeat []
                cols :: [[(Int, Int, Int)]]
cols = [[(Int, Int, Int)]] -> [[(Int, Int, Int)]]
forall a. [[a]] -> [[a]]
maybetranspose ([[(Int, Int, Int)]] -> [[(Int, Int, Int)]])
-> [[(Int, Int, Int)]] -> [[(Int, Int, Int)]]
forall a b. (a -> b) -> a -> b
$ [[[(Int, Int, Int)]]] -> [[(Int, Int, Int)]]
forall {a}. [[[a]]] -> [[a]]
catcolumnwidths ([[[(Int, Int, Int)]]] -> [[(Int, Int, Int)]])
-> [[[(Int, Int, Int)]]] -> [[(Int, Int, Int)]]
forall a b. (a -> b) -> a -> b
$ (PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
 -> [[(Int, Int, Int)]])
-> [PeriodicReportRow DisplayName (Maybe Change, Maybe Change)]
-> [[[(Int, Int, Int)]]]
forall a b. (a -> b) -> [a] -> [b]
map ([(Maybe Change, Maybe Change)] -> [[(Int, Int, Int)]]
cellswidth ([(Maybe Change, Maybe Change)] -> [[(Int, Int, Int)]])
-> (PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
    -> [(Maybe Change, Maybe Change)])
-> PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
-> [[(Int, Int, Int)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
-> [(Maybe Change, Maybe Change)]
forall a.
PeriodicReportRow a (Maybe Change, Maybe Change)
-> [(Maybe Change, Maybe Change)]
rowToBudgetCells) [PeriodicReportRow DisplayName (Maybe Change, Maybe Change)]
items [[[(Int, Int, Int)]]]
-> [[[(Int, Int, Int)]]] -> [[[(Int, Int, Int)]]]
forall a. [a] -> [a] -> [a]
++ [[(Maybe Change, Maybe Change)] -> [[(Int, Int, Int)]]
cellswidth ([(Maybe Change, Maybe Change)] -> [[(Int, Int, Int)]])
-> [(Maybe Change, Maybe Change)] -> [[(Int, Int, Int)]]
forall a b. (a -> b) -> a -> b
$ PeriodicReportRow () (Maybe Change, Maybe Change)
-> [(Maybe Change, Maybe Change)]
forall a.
PeriodicReportRow a (Maybe Change, Maybe Change)
-> [(Maybe Change, Maybe Change)]
rowToBudgetCells PeriodicReportRow () (Maybe Change, Maybe Change)
totrow]

                cellswidth :: [BudgetCell] -> [[(Int, Int, Int)]]
                cellswidth :: [(Maybe Change, Maybe Change)] -> [[(Int, Int, Int)]]
cellswidth [(Maybe Change, Maybe Change)]
row =
                  let cs :: [Text]
cs = [(Maybe Change, Maybe Change)] -> [Text]
budgetCellsCommodities [(Maybe Change, Maybe Change)]
row
                      (Change -> [WideBuilder]
showmixed, BudgetCalcPercentagesFn
percbudget) = [Text] -> (Change -> [WideBuilder], BudgetCalcPercentagesFn)
mkBudgetDisplayFns [Text]
cs
                      disp :: (Maybe Change, Maybe Change) -> [BudgetDisplayCell]
disp = (Change -> [WideBuilder])
-> BudgetCalcPercentagesFn
-> (Maybe Change, Maybe Change)
-> [BudgetDisplayCell]
showcell Change -> [WideBuilder]
showmixed BudgetCalcPercentagesFn
percbudget
                      budgetpercwidth :: (WideBuilder, Maybe WideBuilder) -> (Int, Int)
budgetpercwidth = WideBuilder -> Int
wbWidth (WideBuilder -> Int)
-> (Maybe WideBuilder -> Int)
-> (WideBuilder, Maybe WideBuilder)
-> (Int, Int)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Int -> (WideBuilder -> Int) -> Maybe WideBuilder -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 WideBuilder -> Int
wbWidth
                      cellwidth :: BudgetDisplayCell -> (Int, Int, Int)
cellwidth (WideBuilder
am, Maybe (WideBuilder, Maybe WideBuilder)
bm) = let (Int
bw, Int
pw) = (Int, Int)
-> ((WideBuilder, Maybe WideBuilder) -> (Int, Int))
-> Maybe (WideBuilder, Maybe WideBuilder)
-> (Int, Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int
0, Int
0) (WideBuilder, Maybe WideBuilder) -> (Int, Int)
budgetpercwidth Maybe (WideBuilder, Maybe WideBuilder)
bm in (WideBuilder -> Int
wbWidth WideBuilder
am, Int
bw, Int
pw)
                   in ((Maybe Change, Maybe Change) -> [(Int, Int, Int)])
-> [(Maybe Change, Maybe Change)] -> [[(Int, Int, Int)]]
forall a b. (a -> b) -> [a] -> [b]
map ((BudgetDisplayCell -> (Int, Int, Int))
-> [BudgetDisplayCell] -> [(Int, Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map BudgetDisplayCell -> (Int, Int, Int)
cellwidth ([BudgetDisplayCell] -> [(Int, Int, Int)])
-> ((Maybe Change, Maybe Change) -> [BudgetDisplayCell])
-> (Maybe Change, Maybe Change)
-> [(Int, Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Change, Maybe Change) -> [BudgetDisplayCell]
disp) [(Maybe Change, Maybe Change)]
row

            totrowwidths :: [(Int, Int, Int)]
            totrowwidths :: [(Int, Int, Int)]
totrowwidths
              | Bool
transpose_ = Int -> [(Int, Int, Int)] -> [(Int, Int, Int)]
forall a. Int -> [a] -> [a]
drop ([[BudgetDisplayCell]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[BudgetDisplayCell]]
texts) [(Int, Int, Int)]
widths
              | Bool
otherwise = [(Int, Int, Int)]
widths

            maybetranspose :: [[a]] -> [[a]]
maybetranspose
              | Bool
transpose_ = [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
transpose
              | Bool
otherwise  = [[a]] -> [[a]]
forall a. a -> a
id

        ([Text]
accts', [WideBuilder]
itemscs, [[BudgetDisplayCell]]
texts) = [(Text, WideBuilder, [BudgetDisplayCell])]
-> ([Text], [WideBuilder], [[BudgetDisplayCell]])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(Text, WideBuilder, [BudgetDisplayCell])]
 -> ([Text], [WideBuilder], [[BudgetDisplayCell]]))
-> [(Text, WideBuilder, [BudgetDisplayCell])]
-> ([Text], [WideBuilder], [[BudgetDisplayCell]])
forall a b. (a -> b) -> a -> b
$ [[(Text, WideBuilder, [BudgetDisplayCell])]]
-> [(Text, WideBuilder, [BudgetDisplayCell])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Text, WideBuilder, [BudgetDisplayCell])]]
shownitems
          where
            shownitems :: [[(AccountName, WideBuilder, BudgetDisplayRow)]]
            shownitems :: [[(Text, WideBuilder, [BudgetDisplayCell])]]
shownitems =
              (PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
 -> [(Text, WideBuilder, [BudgetDisplayCell])])
-> [PeriodicReportRow DisplayName (Maybe Change, Maybe Change)]
-> [[(Text, WideBuilder, [BudgetDisplayCell])]]
forall a b. (a -> b) -> [a] -> [b]
map (\PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
i ->
                let
                  addacctcolumn :: [(b, c)] -> [(Text, b, c)]
addacctcolumn = ((b, c) -> (Text, b, c)) -> [(b, c)] -> [(Text, b, c)]
forall a b. (a -> b) -> [a] -> [b]
map (\(b
cs, c
cvals) -> (ReportOpts
-> Text
-> PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
-> Text
forall a.
ReportOpts -> Text -> PeriodicReportRow DisplayName a -> Text
renderPeriodicAcct ReportOpts
ropts Text
" " PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
i, b
cs, c
cvals))
                  isunbudgetedrow :: Bool
isunbudgetedrow = DisplayName -> Text
displayFull (PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
-> DisplayName
forall a b. PeriodicReportRow a b -> a
prrName PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
i) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
unbudgetedAccountName
                in [(WideBuilder, [BudgetDisplayCell])]
-> [(Text, WideBuilder, [BudgetDisplayCell])]
forall {b} {c}. [(b, c)] -> [(Text, b, c)]
addacctcolumn ([(WideBuilder, [BudgetDisplayCell])]
 -> [(Text, WideBuilder, [BudgetDisplayCell])])
-> [(WideBuilder, [BudgetDisplayCell])]
-> [(Text, WideBuilder, [BudgetDisplayCell])]
forall a b. (a -> b) -> a -> b
$ Bool
-> [(Maybe Change, Maybe Change)]
-> [(WideBuilder, [BudgetDisplayCell])]
showrow Bool
isunbudgetedrow ([(Maybe Change, Maybe Change)]
 -> [(WideBuilder, [BudgetDisplayCell])])
-> [(Maybe Change, Maybe Change)]
-> [(WideBuilder, [BudgetDisplayCell])]
forall a b. (a -> b) -> a -> b
$ PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
-> [(Maybe Change, Maybe Change)]
forall a.
PeriodicReportRow a (Maybe Change, Maybe Change)
-> [(Maybe Change, Maybe Change)]
rowToBudgetCells PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
i)
              [PeriodicReportRow DisplayName (Maybe Change, Maybe Change)]
items

        ([WideBuilder]
totrowcs, [[BudgetDisplayCell]]
totrowtexts)  = [(WideBuilder, [BudgetDisplayCell])]
-> ([WideBuilder], [[BudgetDisplayCell]])
forall a b. [(a, b)] -> ([a], [b])
unzip  ([(WideBuilder, [BudgetDisplayCell])]
 -> ([WideBuilder], [[BudgetDisplayCell]]))
-> [(WideBuilder, [BudgetDisplayCell])]
-> ([WideBuilder], [[BudgetDisplayCell]])
forall a b. (a -> b) -> a -> b
$ [[(WideBuilder, [BudgetDisplayCell])]]
-> [(WideBuilder, [BudgetDisplayCell])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(WideBuilder, [BudgetDisplayCell])]]
showntotrow
          where
            showntotrow :: [[(WideBuilder, BudgetDisplayRow)]]
            showntotrow :: [[(WideBuilder, [BudgetDisplayCell])]]
showntotrow = [Bool
-> [(Maybe Change, Maybe Change)]
-> [(WideBuilder, [BudgetDisplayCell])]
showrow Bool
False ([(Maybe Change, Maybe Change)]
 -> [(WideBuilder, [BudgetDisplayCell])])
-> [(Maybe Change, Maybe Change)]
-> [(WideBuilder, [BudgetDisplayCell])]
forall a b. (a -> b) -> a -> b
$ PeriodicReportRow () (Maybe Change, Maybe Change)
-> [(Maybe Change, Maybe Change)]
forall a.
PeriodicReportRow a (Maybe Change, Maybe Change)
-> [(Maybe Change, Maybe Change)]
rowToBudgetCells PeriodicReportRow () (Maybe Change, Maybe Change)
totrow]

        -- | Get the data cells from a row or totals row, maybe adding
        -- the row total and/or row average depending on options.
        rowToBudgetCells :: PeriodicReportRow a BudgetCell -> [BudgetCell]
        rowToBudgetCells :: forall a.
PeriodicReportRow a (Maybe Change, Maybe Change)
-> [(Maybe Change, Maybe Change)]
rowToBudgetCells (PeriodicReportRow a
_ [(Maybe Change, Maybe Change)]
as (Maybe Change, Maybe Change)
rowtot (Maybe Change, Maybe Change)
rowavg) = [(Maybe Change, Maybe Change)]
as
            [(Maybe Change, Maybe Change)]
-> [(Maybe Change, Maybe Change)] -> [(Maybe Change, Maybe Change)]
forall a. [a] -> [a] -> [a]
++ [(Maybe Change, Maybe Change)
rowtot | Bool
row_total_ Bool -> Bool -> Bool
&& Bool -> Bool
not ([(Maybe Change, Maybe Change)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Maybe Change, Maybe Change)]
as)]
            [(Maybe Change, Maybe Change)]
-> [(Maybe Change, Maybe Change)] -> [(Maybe Change, Maybe Change)]
forall a. [a] -> [a] -> [a]
++ [(Maybe Change, Maybe Change)
rowavg | Bool
average_   Bool -> Bool -> Bool
&& Bool -> Bool
not ([(Maybe Change, Maybe Change)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Maybe Change, Maybe Change)]
as)]

        -- | Render a row's data cells as "BudgetDisplayCell"s, and a rendered list of commodity symbols.
        -- Also requires a flag indicating whether this is the special <unbudgeted> row.
        -- (The types make that hard to check here.)
        showrow :: Bool -> [BudgetCell] -> [(WideBuilder, BudgetDisplayRow)]
        showrow :: Bool
-> [(Maybe Change, Maybe Change)]
-> [(WideBuilder, [BudgetDisplayCell])]
showrow Bool
isunbudgetedrow [(Maybe Change, Maybe Change)]
cells =
          let
            cs :: [Text]
cs = [(Maybe Change, Maybe Change)] -> [Text]
budgetCellsCommodities [(Maybe Change, Maybe Change)]
cells
            -- #2071 If there are no commodities - because there are no actual or goal amounts -
            -- the zipped list would be empty, causing this row not to be shown.
            -- But rows like this sometimes need to be shown to preserve the account tree structure.
            -- So, ensure 0 will be shown as actual amount(s).
            -- Unfortunately this disables boring parent eliding, as if --no-elide had been used.
            -- (Just turning on --no-elide higher up doesn't work right.)
            -- Note, no goal amount will be shown for these rows,
            -- whereas --no-elide is likely to show a goal amount aggregated from children.
            cs1 :: [Text]
cs1 = if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cs Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isunbudgetedrow then [Text
""] else [Text]
cs
            (Change -> [WideBuilder]
showmixed, BudgetCalcPercentagesFn
percbudget) = [Text] -> (Change -> [WideBuilder], BudgetCalcPercentagesFn)
mkBudgetDisplayFns [Text]
cs1
          in
            [WideBuilder]
-> [[BudgetDisplayCell]] -> [(WideBuilder, [BudgetDisplayCell])]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Text -> WideBuilder) -> [Text] -> [WideBuilder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> WideBuilder
wbFromText [Text]
cs1) ([[BudgetDisplayCell]] -> [(WideBuilder, [BudgetDisplayCell])])
-> [[BudgetDisplayCell]] -> [(WideBuilder, [BudgetDisplayCell])]
forall a b. (a -> b) -> a -> b
$
            [[BudgetDisplayCell]] -> [[BudgetDisplayCell]]
forall a. [[a]] -> [[a]]
transpose ([[BudgetDisplayCell]] -> [[BudgetDisplayCell]])
-> [[BudgetDisplayCell]] -> [[BudgetDisplayCell]]
forall a b. (a -> b) -> a -> b
$
            ((Maybe Change, Maybe Change) -> [BudgetDisplayCell])
-> [(Maybe Change, Maybe Change)] -> [[BudgetDisplayCell]]
forall a b. (a -> b) -> [a] -> [b]
map ((Change -> [WideBuilder])
-> BudgetCalcPercentagesFn
-> (Maybe Change, Maybe Change)
-> [BudgetDisplayCell]
showcell Change -> [WideBuilder]
showmixed BudgetCalcPercentagesFn
percbudget)
            [(Maybe Change, Maybe Change)]
cells

        budgetCellsCommodities :: [BudgetCell] -> [CommoditySymbol]
        budgetCellsCommodities :: [(Maybe Change, Maybe Change)] -> [Text]
budgetCellsCommodities = Set Text -> [Text]
forall a. Set a -> [a]
S.toList (Set Text -> [Text])
-> ([(Maybe Change, Maybe Change)] -> Set Text)
-> [(Maybe Change, Maybe Change)]
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Text -> Set Text -> Set Text)
-> Set Text -> [Set Text] -> Set Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
S.union Set Text
forall a. Monoid a => a
mempty ([Set Text] -> Set Text)
-> ([(Maybe Change, Maybe Change)] -> [Set Text])
-> [(Maybe Change, Maybe Change)]
-> Set Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe Change, Maybe Change) -> Set Text)
-> [(Maybe Change, Maybe Change)] -> [Set Text]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Change, Maybe Change) -> Set Text
budgetCellCommodities
          where
            budgetCellCommodities :: BudgetCell -> S.Set CommoditySymbol
            budgetCellCommodities :: (Maybe Change, Maybe Change) -> Set Text
budgetCellCommodities (Maybe Change
am, Maybe Change
bm) = Maybe Change -> Set Text
f Maybe Change
am Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Maybe Change -> Set Text
f Maybe Change
bm
              where f :: Maybe Change -> Set Text
f = Set Text -> (Change -> Set Text) -> Maybe Change -> Set Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set Text
forall a. Monoid a => a
mempty Change -> Set Text
maCommodities

        -- | Render a "BudgetCell"'s amounts as "BudgetDisplayCell"s (one per commodity).
        showcell :: BudgetShowAmountsFn -> BudgetCalcPercentagesFn -> BudgetCell -> BudgetDisplayRow
        showcell :: (Change -> [WideBuilder])
-> BudgetCalcPercentagesFn
-> (Maybe Change, Maybe Change)
-> [BudgetDisplayCell]
showcell Change -> [WideBuilder]
showCommodityAmounts BudgetCalcPercentagesFn
calcCommodityPercentages (Maybe Change
mactual, Maybe Change
mbudget) =
          [WideBuilder]
-> [Maybe (WideBuilder, Maybe WideBuilder)] -> [BudgetDisplayCell]
forall a b. [a] -> [b] -> [(a, b)]
zip [WideBuilder]
actualamts [Maybe (WideBuilder, Maybe WideBuilder)]
budgetinfos
          where
            actual :: Change
actual = Change -> Maybe Change -> Change
forall a. a -> Maybe a -> a
fromMaybe Change
nullmixedamt Maybe Change
mactual
            actualamts :: [WideBuilder]
actualamts = Change -> [WideBuilder]
showCommodityAmounts Change
actual
            budgetinfos :: [Maybe (WideBuilder, Maybe WideBuilder)]
budgetinfos =
              case Maybe Change
mbudget of
                Maybe Change
Nothing   -> Maybe (WideBuilder, Maybe WideBuilder)
-> [Maybe (WideBuilder, Maybe WideBuilder)]
forall a. a -> [a]
repeat Maybe (WideBuilder, Maybe WideBuilder)
forall a. Maybe a
Nothing
                Just Change
goal -> ((WideBuilder, Maybe WideBuilder)
 -> Maybe (WideBuilder, Maybe WideBuilder))
-> [(WideBuilder, Maybe WideBuilder)]
-> [Maybe (WideBuilder, Maybe WideBuilder)]
forall a b. (a -> b) -> [a] -> [b]
map (WideBuilder, Maybe WideBuilder)
-> Maybe (WideBuilder, Maybe WideBuilder)
forall a. a -> Maybe a
Just ([(WideBuilder, Maybe WideBuilder)]
 -> [Maybe (WideBuilder, Maybe WideBuilder)])
-> [(WideBuilder, Maybe WideBuilder)]
-> [Maybe (WideBuilder, Maybe WideBuilder)]
forall a b. (a -> b) -> a -> b
$ Change -> [(WideBuilder, Maybe WideBuilder)]
showGoalAmountsAndPercentages Change
goal
                where
                  showGoalAmountsAndPercentages :: MixedAmount -> [(WideBuilder, Maybe WideBuilder)]
                  showGoalAmountsAndPercentages :: Change -> [(WideBuilder, Maybe WideBuilder)]
showGoalAmountsAndPercentages Change
goal = [WideBuilder]
-> [Maybe WideBuilder] -> [(WideBuilder, Maybe WideBuilder)]
forall a b. [a] -> [b] -> [(a, b)]
zip [WideBuilder]
amts [Maybe WideBuilder]
mpcts
                    where
                      amts :: [WideBuilder]
amts  = Change -> [WideBuilder]
showCommodityAmounts Change
goal
                      mpcts :: [Maybe WideBuilder]
mpcts = (Maybe Percentage -> Maybe WideBuilder)
-> [Maybe Percentage] -> [Maybe WideBuilder]
forall a b. (a -> b) -> [a] -> [b]
map (Percentage -> WideBuilder
showrounded (Percentage -> WideBuilder)
-> Maybe Percentage -> Maybe WideBuilder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Maybe Percentage] -> [Maybe WideBuilder])
-> [Maybe Percentage] -> [Maybe WideBuilder]
forall a b. (a -> b) -> a -> b
$ BudgetCalcPercentagesFn
calcCommodityPercentages Change
actual Change
goal
                        where showrounded :: Percentage -> WideBuilder
showrounded = Text -> WideBuilder
wbFromText (Text -> WideBuilder)
-> (Percentage -> Text) -> Percentage -> WideBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandHelpStr -> Text
T.pack (CommandHelpStr -> Text)
-> (Percentage -> CommandHelpStr) -> Percentage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Percentage -> CommandHelpStr
forall a. Show a => a -> CommandHelpStr
show (Percentage -> CommandHelpStr)
-> (Percentage -> Percentage) -> Percentage -> CommandHelpStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Percentage -> Percentage
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
0

        -- | Make budget info display helpers that adapt to --layout=wide.
        mkBudgetDisplayFns :: [CommoditySymbol] -> (BudgetShowAmountsFn, BudgetCalcPercentagesFn)
        mkBudgetDisplayFns :: [Text] -> (Change -> [WideBuilder], BudgetCalcPercentagesFn)
mkBudgetDisplayFns [Text]
cs = case Layout
layout_ of
          LayoutWide Maybe Int
width ->
               ( WideBuilder -> [WideBuilder]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WideBuilder -> [WideBuilder])
-> (Change -> WideBuilder) -> Change -> [WideBuilder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> Change -> WideBuilder
showMixedAmountB AmountFormat
oneLineNoCostFmt{displayMaxWidth=width, displayColour=color_}
               , \Change
a -> Maybe Percentage -> [Maybe Percentage]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Percentage -> [Maybe Percentage])
-> (Change -> Maybe Percentage) -> Change -> [Maybe Percentage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Change -> Change -> Maybe Percentage
percentage Change
a)
          Layout
_ -> ( AmountFormat -> Change -> [WideBuilder]
showMixedAmountLinesB AmountFormat
noCostFmt{displayCommodity=layout_/=LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing, displayColour=color_}
               , \Change
a Change
b -> (Text -> Maybe Percentage) -> [Text] -> [Maybe Percentage]
forall a b. (a -> b) -> [a] -> [b]
map (Change -> Change -> Text -> Maybe Percentage
percentage' Change
a Change
b) [Text]
cs)
          where
            -- | Calculate the percentage of actual change to budget goal to show, if any.
            -- If valuing at cost, both amounts are converted to cost before comparing.
            -- A percentage will not be shown if:
            --
            -- - actual or goal are not the same, single, commodity
            --
            -- - the goal is zero
            --
            percentage :: Change -> BudgetGoal -> Maybe Percentage
            percentage :: Change -> Change -> Maybe Percentage
percentage Change
actual Change
budget =
              case (Change -> [Amount]
costedAmounts Change
actual, Change -> [Amount]
costedAmounts Change
budget) of
                ([Amount
a], [Amount
b]) | (Amount -> Text
acommodity Amount
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> Text
acommodity Amount
b Bool -> Bool -> Bool
|| Amount -> Bool
amountLooksZero Amount
a) Bool -> Bool -> Bool
&& Bool -> Bool
not (Amount -> Bool
amountLooksZero Amount
b)
                    -> Percentage -> Maybe Percentage
forall a. a -> Maybe a
Just (Percentage -> Maybe Percentage) -> Percentage -> Maybe Percentage
forall a b. (a -> b) -> a -> b
$ Percentage
100 Percentage -> Percentage -> Percentage
forall a. Num a => a -> a -> a
* Amount -> Percentage
aquantity Amount
a Percentage -> Percentage -> Percentage
forall a. Fractional a => a -> a -> a
/ Amount -> Percentage
aquantity Amount
b
                ([Amount], [Amount])
_   -> Maybe Percentage
forall a. Maybe a
Nothing
              where
                costedAmounts :: Change -> [Amount]
costedAmounts = case Maybe ConversionOp
conversionop_ of
                    Just ConversionOp
ToCost -> Change -> [Amount]
amounts (Change -> [Amount]) -> (Change -> Change) -> Change -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Change -> Change
mixedAmountCost
                    Maybe ConversionOp
_           -> Change -> [Amount]
amounts (Change -> [Amount]) -> (Change -> Change) -> Change -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Change -> Change
mixedAmountStripCosts  -- strip any lingering cost info that would prevent unification

            -- | Like percentage, but accept multicommodity actual and budget amounts,
            -- and extract the specified commodity from both.
            percentage' :: Change -> BudgetGoal -> CommoditySymbol -> Maybe Percentage
            percentage' :: Change -> Change -> Text -> Maybe Percentage
percentage' Change
am Change
bm Text
c = case ((,) (Maybe Amount -> Maybe Amount -> (Maybe Amount, Maybe Amount))
-> (Change -> Maybe Amount)
-> Change
-> Change
-> (Maybe Amount, Maybe Amount)
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Amount -> Bool) -> [Amount] -> Maybe Amount
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) Text
c (Text -> Bool) -> (Amount -> Text) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Text
acommodity) ([Amount] -> Maybe Amount)
-> (Change -> [Amount]) -> Change -> Maybe Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Change -> [Amount]
amounts) Change
am Change
bm of
                (Just Amount
a, Just Amount
b) -> Change -> Change -> Maybe Percentage
percentage (Amount -> Change
mixedAmount Amount
a) (Amount -> Change
mixedAmount Amount
b)
                (Maybe Amount, Maybe Amount)
_                -> Maybe Percentage
forall a. Maybe a
Nothing

-- XXX generalise this with multiBalanceReportAsCsv ?
-- | Render a budget report as CSV. Like multiBalanceReportAsCsv,
-- but includes alternating actual and budget amount columns.
budgetReportAsCsv :: ReportOpts -> BudgetReport -> [[Text]]
budgetReportAsCsv :: ReportOpts -> BudgetReport -> CSV
budgetReportAsCsv ReportOpts
ropts BudgetReport
report
  = [[Cell NumLines Text]] -> CSV
forall border text. [[Cell border text]] -> [[text]]
rawTableContent ([[Cell NumLines Text]] -> CSV) -> [[Cell NumLines Text]] -> CSV
forall a b. (a -> b) -> a -> b
$
    ReportOpts -> BudgetReport -> [[Cell NumLines Text]]
budgetReportAsSpreadsheet ReportOpts
ropts BudgetReport
report

budgetReportAsSpreadsheet ::
  ReportOpts -> BudgetReport -> [[Ods.Cell Ods.NumLines Text]]
budgetReportAsSpreadsheet :: ReportOpts -> BudgetReport -> [[Cell NumLines Text]]
budgetReportAsSpreadsheet
  ropts :: ReportOpts
ropts@ReportOpts{Bool
Int
[Text]
[Status]
SortSpec
Maybe Text
Maybe NormalSign
Maybe ValuationType
Maybe ConversionOp
DepthSpec
Interval
Period
StringFormat
Layout
AccountListMode
BalanceAccumulation
BalanceCalculation
balancecalc_ :: ReportOpts -> BalanceCalculation
no_total_ :: ReportOpts -> Bool
layout_ :: ReportOpts -> Layout
interval_ :: ReportOpts -> Interval
format_ :: ReportOpts -> StringFormat
color_ :: ReportOpts -> Bool
pretty_ :: ReportOpts -> Bool
transpose_ :: ReportOpts -> Bool
balance_base_url_ :: ReportOpts -> Maybe Text
querystring_ :: ReportOpts -> [Text]
normalbalance_ :: ReportOpts -> Maybe NormalSign
invert_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
show_costs_ :: ReportOpts -> Bool
summary_only_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
declared_ :: ReportOpts -> Bool
drop_ :: ReportOpts -> Int
accountlistmode_ :: ReportOpts -> AccountListMode
budgetpat_ :: ReportOpts -> Maybe Text
balanceaccum_ :: ReportOpts -> BalanceAccumulation
txn_dates_ :: ReportOpts -> Bool
sortspec_ :: ReportOpts -> SortSpec
related_ :: ReportOpts -> Bool
average_ :: ReportOpts -> Bool
real_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
date2_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> DepthSpec
infer_prices_ :: ReportOpts -> Bool
value_ :: ReportOpts -> Maybe ValuationType
conversionop_ :: ReportOpts -> Maybe ConversionOp
statuses_ :: ReportOpts -> [Status]
period_ :: ReportOpts -> Period
period_ :: Period
interval_ :: Interval
statuses_ :: [Status]
conversionop_ :: Maybe ConversionOp
value_ :: Maybe ValuationType
infer_prices_ :: Bool
depth_ :: DepthSpec
date2_ :: Bool
empty_ :: Bool
no_elide_ :: Bool
real_ :: Bool
format_ :: StringFormat
balance_base_url_ :: Maybe Text
pretty_ :: Bool
querystring_ :: [Text]
average_ :: Bool
related_ :: Bool
sortspec_ :: SortSpec
txn_dates_ :: Bool
balancecalc_ :: BalanceCalculation
balanceaccum_ :: BalanceAccumulation
budgetpat_ :: Maybe Text
accountlistmode_ :: AccountListMode
drop_ :: Int
declared_ :: Bool
row_total_ :: Bool
no_total_ :: Bool
summary_only_ :: Bool
show_costs_ :: Bool
sort_amount_ :: Bool
percent_ :: Bool
invert_ :: Bool
normalbalance_ :: Maybe NormalSign
color_ :: Bool
transpose_ :: Bool
layout_ :: Layout
..}
  (PeriodicReport [DateSpan]
colspans [PeriodicReportRow DisplayName (Maybe Change, Maybe Change)]
items PeriodicReportRow () (Maybe Change, Maybe Change)
totrow)
  = (if Bool
transpose_ then [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall border text. [[Cell border text]] -> [[Cell border text]]
Ods.transpose else [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. a -> a
id) ([[Cell NumLines Text]] -> [[Cell NumLines Text]])
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a b. (a -> b) -> a -> b
$

  -- heading row
  ([Cell () Text] -> [Cell NumLines Text]
forall text. [Cell () text] -> [Cell NumLines text]
addHeaderBorders ([Cell () Text] -> [Cell NumLines Text])
-> [Cell () Text] -> [Cell NumLines Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Cell () Text) -> [Text] -> [Cell () Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Cell () Text
forall borders. Lines borders => Text -> Cell borders Text
headerCell ([Text] -> [Cell () Text]) -> [Text] -> [Cell () Text]
forall a b. (a -> b) -> a -> b
$
  Text
"Account" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
  [Text
"Commodity" | Layout
layout_ Layout -> Layout -> Bool
forall a. Eq a => a -> a -> Bool
== Layout
LayoutBare ]
   [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (DateSpan -> [Text]) -> [DateSpan] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\DateSpan
spn -> [DateSpan -> Text
showDateSpan DateSpan
spn, Text
"budget"]) [DateSpan]
colspans
   [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ CSV -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text
"Total"  ,Text
"budget"] | Bool
row_total_]
   [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ CSV -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Text
"Average",Text
"budget"] | Bool
average_]
  ) [Cell NumLines Text]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. a -> [a] -> [a]
:

  -- account rows
  (PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
 -> [[Cell NumLines Text]])
-> [PeriodicReportRow DisplayName (Maybe Change, Maybe Change)]
-> [[Cell NumLines Text]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
row -> RowClass
-> Cell NumLines Text
-> PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
-> [[Cell NumLines Text]]
forall a.
RowClass
-> Cell NumLines Text
-> PeriodicReportRow a (Maybe Change, Maybe Change)
-> [[Cell NumLines Text]]
rowAsTexts RowClass
Value (PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
-> Cell NumLines Text
forall {a}. PeriodicReportRow DisplayName a -> Cell NumLines Text
accountCell PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
row) PeriodicReportRow DisplayName (Maybe Change, Maybe Change)
row) [PeriodicReportRow DisplayName (Maybe Change, Maybe Change)]
items

  -- totals row
  [[Cell NumLines Text]]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. [a] -> [a] -> [a]
++ [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall border text. [[Cell border text]] -> [[Cell NumLines text]]
addTotalBorders
        ([[[Cell NumLines Text]]] -> [[Cell NumLines Text]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ RowClass
-> Cell NumLines Text
-> PeriodicReportRow () (Maybe Change, Maybe Change)
-> [[Cell NumLines Text]]
forall a.
RowClass
-> Cell NumLines Text
-> PeriodicReportRow a (Maybe Change, Maybe Change)
-> [[Cell NumLines Text]]
rowAsTexts RowClass
Total (Text -> Cell NumLines Text
forall {text}. text -> Cell NumLines text
cell Text
totalRowHeadingBudgetCsv) PeriodicReportRow () (Maybe Change, Maybe Change)
totrow | Bool -> Bool
not Bool
no_total_ ])

  where
    cell :: text -> Cell NumLines text
cell = text -> Cell NumLines text
forall border text. Lines border => text -> Cell border text
Ods.defaultCell
    accountCell :: PeriodicReportRow DisplayName a -> Cell NumLines Text
accountCell PeriodicReportRow DisplayName a
row =
        let name :: Text
name = PeriodicReportRow DisplayName a -> Text
forall a. PeriodicReportRow DisplayName a -> Text
prrFullName PeriodicReportRow DisplayName a
row in
        Maybe Text
-> [Text] -> Text -> Cell NumLines Text -> Cell NumLines Text
forall border text.
Maybe Text
-> [Text] -> Text -> Cell border text -> Cell border text
setAccountAnchor (Maybe Text
balance_base_url_) [Text]
querystring_ Text
name (Cell NumLines Text -> Cell NumLines Text)
-> Cell NumLines Text -> Cell NumLines Text
forall a b. (a -> b) -> a -> b
$
        Text -> Cell NumLines Text
forall {text}. text -> Cell NumLines text
cell (Text -> Cell NumLines Text) -> Text -> Cell NumLines Text
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Text -> PeriodicReportRow DisplayName a -> Text
forall a.
ReportOpts -> Text -> PeriodicReportRow DisplayName a -> Text
renderPeriodicAcct ReportOpts
ropts Text
nbsp PeriodicReportRow DisplayName a
row
    {-
    ToDo: The chosen HTML cell class names are not put in stone.
    If you find you need more systematic names,
    feel free to develop a more sophisticated scheme.
    -}
    flattentuples :: RowClass -> [(b, b)] -> [(Class, b)]
flattentuples RowClass
rc [(b, b)]
tups =
        [[(Class, b)]] -> [(Class, b)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(RowClass -> Class
amountClass RowClass
rc, b
a),(RowClass -> Class
budgetClass RowClass
rc, b
b)] | (b
a,b
b) <- [(b, b)]
tups]
    showNorm :: (Class, Maybe Change) -> Cell border Text
showNorm (Class
cls,Maybe Change
mval) =
        Cell border Text
-> (Change -> Cell border Text) -> Maybe Change -> Cell border Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Cell border Text
forall border text. (Lines border, Monoid text) => Cell border text
Ods.emptyCell ((WideBuilder -> Text)
-> Cell border WideBuilder -> Cell border Text
forall a b. (a -> b) -> Cell border a -> Cell border b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WideBuilder -> Text
wbToText (Cell border WideBuilder -> Cell border Text)
-> (Change -> Cell border WideBuilder)
-> Change
-> Cell border Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Class, Change) -> Cell border WideBuilder)
-> Class -> Change -> Cell border WideBuilder
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (AmountFormat -> (Class, Change) -> Cell border WideBuilder
forall border.
Lines border =>
AmountFormat -> (Class, Change) -> Cell border WideBuilder
cellFromMixedAmount AmountFormat
oneLineNoCostFmt) Class
cls) Maybe Change
mval

    rowAsTexts :: RowClass
               -> Ods.Cell Ods.NumLines Text
               -> PeriodicReportRow a BudgetCell
               -> [[Ods.Cell Ods.NumLines Text]]
    rowAsTexts :: forall a.
RowClass
-> Cell NumLines Text
-> PeriodicReportRow a (Maybe Change, Maybe Change)
-> [[Cell NumLines Text]]
rowAsTexts RowClass
rc Cell NumLines Text
acctCell (PeriodicReportRow a
_ [(Maybe Change, Maybe Change)]
as (Maybe Change
rowtot,Maybe Change
budgettot) (Maybe Change
rowavg, Maybe Change
budgetavg)) =
      Cell NumLines Text
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall border text.
Cell border text -> [[Cell border text]] -> [[Cell border text]]
addRowSpanHeader Cell NumLines Text
acctCell ([[Cell NumLines Text]] -> [[Cell NumLines Text]])
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a b. (a -> b) -> a -> b
$
      case Layout
layout_ of
        Layout
LayoutBare ->
            (Cell NumLines Text
 -> [Cell NumLines Text] -> [Cell NumLines Text])
-> [Cell NumLines Text]
-> [[Cell NumLines Text]]
-> [[Cell NumLines Text]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (:) ((Text -> Cell NumLines Text) -> [Text] -> [Cell NumLines Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Cell NumLines Text
forall {text}. text -> Cell NumLines text
cell [Text]
cs)   -- add symbols
          ([[Cell NumLines Text]] -> [[Cell NumLines Text]])
-> ([(Class, Maybe Change)] -> [[Cell NumLines Text]])
-> [(Class, Maybe Change)]
-> [[Cell NumLines Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. [[a]] -> [[a]]
transpose                   -- each row becomes a list of Text quantities
          ([[Cell NumLines Text]] -> [[Cell NumLines Text]])
-> ([(Class, Maybe Change)] -> [[Cell NumLines Text]])
-> [(Class, Maybe Change)]
-> [[Cell NumLines Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Class, Maybe Change) -> [Cell NumLines Text])
-> [(Class, Maybe Change)] -> [[Cell NumLines Text]]
forall a b. (a -> b) -> [a] -> [b]
map ((Cell NumLines WideBuilder -> Cell NumLines Text)
-> [Cell NumLines WideBuilder] -> [Cell NumLines Text]
forall a b. (a -> b) -> [a] -> [b]
map ((WideBuilder -> Text)
-> Cell NumLines WideBuilder -> Cell NumLines Text
forall a b. (a -> b) -> Cell NumLines a -> Cell NumLines b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WideBuilder -> Text
wbToText) ([Cell NumLines WideBuilder] -> [Cell NumLines Text])
-> ((Class, Maybe Change) -> [Cell NumLines WideBuilder])
-> (Class, Maybe Change)
-> [Cell NumLines Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AmountFormat -> (Class, Change) -> [Cell NumLines WideBuilder]
forall border.
Lines border =>
AmountFormat -> (Class, Change) -> [Cell border WideBuilder]
cellsFromMixedAmount AmountFormat
dopts ((Class, Change) -> [Cell NumLines WideBuilder])
-> ((Class, Maybe Change) -> (Class, Change))
-> (Class, Maybe Change)
-> [Cell NumLines WideBuilder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Change -> Change)
-> (Class, Maybe Change) -> (Class, Change)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Change -> Maybe Change -> Change
forall a. a -> Maybe a -> a
fromMaybe Change
nullmixedamt))
          ([(Class, Maybe Change)] -> [[Cell NumLines Text]])
-> [(Class, Maybe Change)] -> [[Cell NumLines Text]]
forall a b. (a -> b) -> a -> b
$ [(Class, Maybe Change)]
vals
        Layout
_ -> [((Class, Maybe Change) -> Cell NumLines Text)
-> [(Class, Maybe Change)] -> [Cell NumLines Text]
forall a b. (a -> b) -> [a] -> [b]
map (Class, Maybe Change) -> Cell NumLines Text
forall {border}.
Lines border =>
(Class, Maybe Change) -> Cell border Text
showNorm [(Class, Maybe Change)]
vals]
      where
        cs :: [Text]
cs = Set Text -> [Text]
forall a. Set a -> [a]
S.toList (Set Text -> [Text])
-> ([Change] -> Set Text) -> [Change] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Set Text] -> Set Text
forall a. Monoid a => [a] -> a
mconcat ([Set Text] -> Set Text)
-> ([Change] -> [Set Text]) -> [Change] -> Set Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Change -> Set Text) -> [Change] -> [Set Text]
forall a b. (a -> b) -> [a] -> [b]
map Change -> Set Text
maCommodities ([Change] -> [Text]) -> [Change] -> [Text]
forall a b. (a -> b) -> a -> b
$ ((Class, Maybe Change) -> Maybe Change)
-> [(Class, Maybe Change)] -> [Change]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Class, Maybe Change) -> Maybe Change
forall a b. (a, b) -> b
snd [(Class, Maybe Change)]
vals
        dopts :: AmountFormat
dopts = AmountFormat
oneLineNoCostFmt{displayCommodity=layout_ /= LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing}
        vals :: [(Class, Maybe Change)]
vals = RowClass
-> [(Maybe Change, Maybe Change)] -> [(Class, Maybe Change)]
forall {b}. RowClass -> [(b, b)] -> [(Class, b)]
flattentuples RowClass
rc [(Maybe Change, Maybe Change)]
as
            [(Class, Maybe Change)]
-> [(Class, Maybe Change)] -> [(Class, Maybe Change)]
forall a. [a] -> [a] -> [a]
++ [[(Class, Maybe Change)]] -> [(Class, Maybe Change)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(RowClass -> Class
rowTotalClass RowClass
rc, Maybe Change
rowtot),
                        (RowClass -> Class
budgetTotalClass RowClass
rc, Maybe Change
budgettot)]
                            | Bool
row_total_]
            [(Class, Maybe Change)]
-> [(Class, Maybe Change)] -> [(Class, Maybe Change)]
forall a. [a] -> [a] -> [a]
++ [[(Class, Maybe Change)]] -> [(Class, Maybe Change)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(RowClass -> Class
rowAverageClass RowClass
rc, Maybe Change
rowavg),
                        (RowClass -> Class
budgetAverageClass RowClass
rc, Maybe Change
budgetavg)]
                            | Bool
average_]


nbsp :: Text
nbsp :: Text
nbsp = Text
"\160"

renderBalanceAcct ::
    ReportOpts -> Text -> (AccountName, AccountName, Int) -> Text
renderBalanceAcct :: ReportOpts -> Text -> (Text, Text, Int) -> Text
renderBalanceAcct ReportOpts
opts Text
space (Text
fullName, Text
displayName, Int
dep) =
  case ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
opts of
    AccountListMode
ALTree -> Int -> Text -> Text
T.replicate (Int
depInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) Text
space Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
displayName
    AccountListMode
ALFlat -> Int -> Text -> Text
accountNameDrop (ReportOpts -> Int
drop_ ReportOpts
opts) Text
fullName

-- FIXME. Have to check explicitly for which to render here, since
-- budgetReport sets accountlistmode to ALTree. Find a principled way to do
-- this.
renderPeriodicAcct ::
    ReportOpts -> Text -> PeriodicReportRow DisplayName a -> Text
renderPeriodicAcct :: forall a.
ReportOpts -> Text -> PeriodicReportRow DisplayName a -> Text
renderPeriodicAcct ReportOpts
opts Text
space PeriodicReportRow DisplayName a
row =
    ReportOpts -> Text -> (Text, Text, Int) -> Text
renderBalanceAcct ReportOpts
opts Text
space
        (PeriodicReportRow DisplayName a -> Text
forall a. PeriodicReportRow DisplayName a -> Text
prrFullName PeriodicReportRow DisplayName a
row, PeriodicReportRow DisplayName a -> Text
forall a. PeriodicReportRow DisplayName a -> Text
prrDisplayName PeriodicReportRow DisplayName a
row, PeriodicReportRow DisplayName a -> Int
forall a. PeriodicReportRow DisplayName a -> Int
prrIndent PeriodicReportRow DisplayName a
row)


-- tests

tests_Balance :: TestTree
tests_Balance = CommandHelpStr -> [TestTree] -> TestTree
testGroup CommandHelpStr
"Balance" [

   CommandHelpStr -> [TestTree] -> TestTree
testGroup CommandHelpStr
"balanceReportAsText" [
    CommandHelpStr -> IO () -> TestTree
testCase CommandHelpStr
"unicode in balance layout" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      Journal
j <- Text -> IO Journal
readJournal'' Text
"2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
      let rspec :: ReportSpec
rspec = ReportSpec
defreportspec{_rsReportOpts=defreportopts{no_total_=True}}
      Builder -> Text
TB.toLazyText (ReportOpts -> BalanceReport -> Builder
balanceReportAsText (ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec) (ReportSpec -> Journal -> BalanceReport
balanceReport ReportSpec
rspec{_rsDay=fromGregorian 2008 11 26} Journal
j))
        Text -> Text -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
        [Text] -> Text
TL.unlines
        [Text
"                -100  актив:наличные"
        ,Text
"                 100  расходы:покупки"
        ]
    ]

  ]