{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
module Hledger.Cli.CompoundBalanceCommand (
CompoundBalanceCommandSpec(..)
,compoundBalanceCommandMode
,compoundBalanceCommand
) where
import Data.Maybe (fromMaybe, mapMaybe, maybeToList)
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Bifunctor (second)
import qualified Data.Map as Map
import qualified Data.List as List
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Data.Time.Calendar (Day, addDays)
import System.Console.CmdArgs.Explicit as C (Mode, flagNone, flagReq)
import qualified System.IO as IO
import Hledger.Write.Ods (printFods)
import Hledger.Write.Csv (CSV, printCSV, printTSV)
import Hledger.Write.Html.Lucid (printHtml)
import Hledger.Write.Html.Attribute (stylesheet, tableStyle, alignleft)
import qualified Hledger.Write.Spreadsheet as Spr
import Lucid as L hiding (value_)
import Text.Tabular.AsciiWide as Tabular hiding (render)
import Hledger
import Hledger.Cli.Commands.Balance
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils (unsupportedOutputFormatError, writeOutputLazyText)
import Data.Function ((&))
import Control.Monad (guard)
data CompoundBalanceCommandSpec = CompoundBalanceCommandSpec {
CompoundBalanceCommandSpec -> [Char]
cbcdoc :: CommandHelpStr,
CompoundBalanceCommandSpec -> [Char]
cbctitle :: String,
CompoundBalanceCommandSpec -> [CBCSubreportSpec DisplayName]
cbcqueries :: [CBCSubreportSpec DisplayName],
CompoundBalanceCommandSpec -> BalanceAccumulation
cbcaccum :: BalanceAccumulation
}
compoundBalanceCommandMode :: CompoundBalanceCommandSpec -> Mode RawOpts
compoundBalanceCommandMode :: CompoundBalanceCommandSpec -> Mode RawOpts
compoundBalanceCommandMode CompoundBalanceCommandSpec{[Char]
[CBCSubreportSpec DisplayName]
BalanceAccumulation
cbcdoc :: CompoundBalanceCommandSpec -> [Char]
cbctitle :: CompoundBalanceCommandSpec -> [Char]
cbcqueries :: CompoundBalanceCommandSpec -> [CBCSubreportSpec DisplayName]
cbcaccum :: CompoundBalanceCommandSpec -> BalanceAccumulation
cbcdoc :: [Char]
cbctitle :: [Char]
cbcqueries :: [CBCSubreportSpec DisplayName]
cbcaccum :: BalanceAccumulation
..} =
[Char]
-> [Flag RawOpts]
-> [([Char], [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
[Char]
cbcdoc
([[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"sum"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"sum")
[Char]
"show sum of posting amounts (default)"
,[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"valuechange"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"valuechange")
[Char]
"show total change of period-end historical balance value (caused by deposits, withdrawals, market price fluctuations)"
,[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"gain"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"gain")
[Char]
"show unrealised capital gain/loss (historical balance value minus cost basis)"
,[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"budget"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"budget")
[Char]
"show sum of posting amounts compared to budget goals defined by periodic transactions"
,[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"count"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"count") [Char]
"show the count of postings"
,[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"change"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"change")
([Char]
"accumulate amounts from column start to column end (in multicolumn reports)"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ BalanceAccumulation -> [Char]
defaultMarker BalanceAccumulation
PerPeriod)
,[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"cumulative"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"cumulative")
([Char]
"accumulate amounts from report start (specified by e.g. -b/--begin) to column end"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ BalanceAccumulation -> [Char]
defaultMarker BalanceAccumulation
Cumulative)
,[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"historical",[Char]
"H"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"historical")
([Char]
"accumulate amounts from journal start to column end (includes postings before report start date)"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ BalanceAccumulation -> [Char]
defaultMarker BalanceAccumulation
Historical)
]
[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]
++
[[[Char]] -> Update RawOpts -> [Char] -> [Char] -> Flag RawOpts
forall a. [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
flagReq [[Char]
"drop"] (\[Char]
s RawOpts
opts -> RawOpts -> Either [Char] RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either [Char] RawOpts)
-> RawOpts -> Either [Char] RawOpts
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> RawOpts -> RawOpts
setopt [Char]
"drop" [Char]
s RawOpts
opts) [Char]
"N" [Char]
"flat mode: omit N leading account name parts"
,[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"declared"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"declared") [Char]
"include non-parent declared accounts (best used with -E)"
,[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"average",[Char]
"A"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"average") [Char]
"show a row average column (in multicolumn reports)"
,[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"row-total",[Char]
"T"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"row-total") [Char]
"show a row total column (in multicolumn reports)"
,[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"summary-only"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"summary-only") [Char]
"display only row summaries (e.g. row total, average) (in multicolumn reports)"
,[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"no-total",[Char]
"N"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"no-total") [Char]
"omit the final total row"
,[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"no-elide"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"no-elide") [Char]
"don't squash boring parent accounts (in tree mode)"
,[[Char]] -> Update RawOpts -> [Char] -> [Char] -> Flag RawOpts
forall a. [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
flagReq [[Char]
"format"] (\[Char]
s RawOpts
opts -> RawOpts -> Either [Char] RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either [Char] RawOpts)
-> RawOpts -> Either [Char] RawOpts
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> RawOpts -> RawOpts
setopt [Char]
"format" [Char]
s RawOpts
opts) [Char]
"FORMATSTR" [Char]
"use this custom line format (in simple reports)"
,[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"sort-amount",[Char]
"S"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"sort-amount") [Char]
"sort by amount instead of account code/name"
,[[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"percent", [Char]
"%"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"percent") [Char]
"express values in percentage of each column's total"
,[[Char]] -> Update RawOpts -> [Char] -> [Char] -> Flag RawOpts
forall a. [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
flagReq [[Char]
"layout"] (\[Char]
s RawOpts
opts -> RawOpts -> Either [Char] RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either [Char] RawOpts)
-> RawOpts -> Either [Char] RawOpts
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> RawOpts -> RawOpts
setopt [Char]
"layout" [Char]
s RawOpts
opts) [Char]
"ARG"
([[Char]] -> [Char]
unlines
[[Char]
"how to show multi-commodity amounts:"
,[Char]
"'wide[,WIDTH]': all commodities on one line"
,[Char]
"'tall' : each commodity on a new line"
,[Char]
"'bare' : bare numbers, symbols in a column"
])
,[[Char]] -> Update RawOpts -> [Char] -> [Char] -> Flag RawOpts
forall a. [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
flagReq [[Char]
"base-url"] (\[Char]
s RawOpts
opts -> RawOpts -> Either [Char] RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either [Char] RawOpts)
-> RawOpts -> Either [Char] RawOpts
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> RawOpts -> RawOpts
setopt [Char]
"base-url" [Char]
s RawOpts
opts) [Char]
"URLPREFIX" [Char]
"in html output, generate hyperlinks to hledger-web, with this prefix. (Usually the base url shown by hledger-web; can also be relative.)"
,[[Char]] -> Flag RawOpts
outputFormatFlag [[Char]
"txt",[Char]
"html",[Char]
"csv",[Char]
"tsv",[Char]
"json"]
,Flag RawOpts
outputFileFlag
])
[([Char], [Flag RawOpts])]
cligeneralflagsgroups1
([Flag RawOpts]
hiddenflags [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++
[ [[Char]] -> (RawOpts -> RawOpts) -> [Char] -> Flag RawOpts
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"commodity-column"] ([Char] -> RawOpts -> RawOpts
setboolopt [Char]
"commodity-column")
[Char]
"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
$ [Char] -> Arg RawOpts
argsFlag [Char]
"[QUERY]")
where
defaultMarker :: BalanceAccumulation -> String
defaultMarker :: BalanceAccumulation -> [Char]
defaultMarker BalanceAccumulation
bacc | BalanceAccumulation
bacc BalanceAccumulation -> BalanceAccumulation -> Bool
forall a. Eq a => a -> a -> Bool
== BalanceAccumulation
cbcaccum = [Char]
" (default)"
| Bool
otherwise = [Char]
""
compoundBalanceCommand :: CompoundBalanceCommandSpec -> (CliOpts -> Journal -> IO ())
compoundBalanceCommand :: CompoundBalanceCommandSpec -> CliOpts -> Journal -> IO ()
compoundBalanceCommand CompoundBalanceCommandSpec{[Char]
[CBCSubreportSpec DisplayName]
BalanceAccumulation
cbcdoc :: CompoundBalanceCommandSpec -> [Char]
cbctitle :: CompoundBalanceCommandSpec -> [Char]
cbcqueries :: CompoundBalanceCommandSpec -> [CBCSubreportSpec DisplayName]
cbcaccum :: CompoundBalanceCommandSpec -> BalanceAccumulation
cbcdoc :: [Char]
cbctitle :: [Char]
cbcqueries :: [CBCSubreportSpec DisplayName]
cbcaccum :: BalanceAccumulation
..} opts :: CliOpts
opts@CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec, rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts} Journal
j = do
CliOpts -> Text -> IO ()
writeOutputLazyText CliOpts
opts (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ CompoundPeriodicReport DisplayName MixedAmount -> Text
render (CompoundPeriodicReport DisplayName MixedAmount -> Text)
-> CompoundPeriodicReport DisplayName MixedAmount -> Text
forall a b. (a -> b) -> a -> b
$ Map Text AmountStyle
-> CompoundPeriodicReport DisplayName MixedAmount
-> CompoundPeriodicReport DisplayName MixedAmount
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts Map Text AmountStyle
styles CompoundPeriodicReport DisplayName MixedAmount
cbr
where
styles :: Map Text AmountStyle
styles = Rounding -> Journal -> Map Text AmountStyle
journalCommodityStylesWith Rounding
HardRounding Journal
j
ropts :: ReportOpts
ropts@ReportOpts{Bool
Int
[Text]
[Status]
SortSpec
Maybe Text
Maybe NormalSign
Maybe ConversionOp
Maybe ValuationType
Interval
Period
DepthSpec
StringFormat
AccountListMode
BalanceAccumulation
BalanceCalculation
Layout
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
accountlistmode_ :: ReportOpts -> AccountListMode
average_ :: ReportOpts -> Bool
balance_base_url_ :: ReportOpts -> Maybe Text
balanceaccum_ :: ReportOpts -> BalanceAccumulation
balancecalc_ :: ReportOpts -> BalanceCalculation
budgetpat_ :: ReportOpts -> Maybe Text
color_ :: ReportOpts -> Bool
conversionop_ :: ReportOpts -> Maybe ConversionOp
date2_ :: ReportOpts -> Bool
declared_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> DepthSpec
drop_ :: ReportOpts -> Int
empty_ :: ReportOpts -> Bool
format_ :: ReportOpts -> StringFormat
infer_prices_ :: ReportOpts -> Bool
interval_ :: ReportOpts -> Interval
invert_ :: ReportOpts -> Bool
layout_ :: ReportOpts -> Layout
no_elide_ :: ReportOpts -> Bool
no_total_ :: ReportOpts -> Bool
normalbalance_ :: ReportOpts -> Maybe NormalSign
percent_ :: ReportOpts -> Bool
period_ :: ReportOpts -> Period
pretty_ :: ReportOpts -> Bool
querystring_ :: ReportOpts -> [Text]
real_ :: ReportOpts -> Bool
related_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
show_costs_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
sortspec_ :: ReportOpts -> SortSpec
statuses_ :: ReportOpts -> [Status]
summary_only_ :: ReportOpts -> Bool
transpose_ :: ReportOpts -> Bool
txn_dates_ :: ReportOpts -> Bool
value_ :: ReportOpts -> Maybe ValuationType
..} = ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec
mbalanceAccumulationOverride :: Maybe BalanceAccumulation
mbalanceAccumulationOverride = RawOpts -> Maybe BalanceAccumulation
balanceAccumulationOverride RawOpts
rawopts
balanceaccumulation :: BalanceAccumulation
balanceaccumulation = BalanceAccumulation
-> Maybe BalanceAccumulation -> BalanceAccumulation
forall a. a -> Maybe a -> a
fromMaybe BalanceAccumulation
cbcaccum Maybe BalanceAccumulation
mbalanceAccumulationOverride
ropts' :: ReportOpts
ropts' = ReportOpts
ropts{balanceaccum_=balanceaccumulation}
title :: Text
title =
Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
" ") Maybe Text
mintervalstr
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack [Char]
cbctitle
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
titledatestr
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text
" "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) Maybe Text
mtitleclarification
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
valuationdesc
where
titledatestr :: Text
titledatestr = case BalanceAccumulation
balanceaccumulation of
BalanceAccumulation
Historical -> [Day] -> Text
showEndDates [Day]
enddates
BalanceAccumulation
_ -> DateSpan -> Text
showDateSpan DateSpan
requestedspan
where
enddates :: [Day]
enddates = (Day -> Day) -> [Day] -> [Day]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Day -> Day
addDays (-Integer
1)) ([Day] -> [Day]) -> ([DateSpan] -> [Day]) -> [DateSpan] -> [Day]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateSpan -> Maybe Day) -> [DateSpan] -> [Day]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DateSpan -> Maybe Day
spanEnd ([DateSpan] -> [Day]) -> [DateSpan] -> [Day]
forall a b. (a -> b) -> a -> b
$ CompoundPeriodicReport DisplayName MixedAmount -> [DateSpan]
forall a b. CompoundPeriodicReport a b -> [DateSpan]
cbrDates CompoundPeriodicReport DisplayName MixedAmount
cbr
requestedspan :: DateSpan
requestedspan = (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
mintervalstr :: Maybe Text
mintervalstr = Interval -> Maybe Text
showInterval Interval
interval_
mtitleclarification :: Maybe Text
mtitleclarification = case (BalanceCalculation
balancecalc_, BalanceAccumulation
balanceaccumulation, Maybe BalanceAccumulation
mbalanceAccumulationOverride) of
(BalanceCalculation
CalcValueChange, BalanceAccumulation
PerPeriod, Maybe BalanceAccumulation
_ ) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"(Period-End Value Changes)"
(BalanceCalculation
CalcValueChange, BalanceAccumulation
Cumulative, Maybe BalanceAccumulation
_ ) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"(Cumulative Period-End Value Changes)"
(BalanceCalculation
CalcGain, BalanceAccumulation
PerPeriod, Maybe BalanceAccumulation
_ ) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"(Incremental Gain)"
(BalanceCalculation
CalcGain, BalanceAccumulation
Cumulative, Maybe BalanceAccumulation
_ ) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"(Cumulative Gain)"
(BalanceCalculation
CalcGain, BalanceAccumulation
Historical, Maybe BalanceAccumulation
_ ) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"(Historical Gain)"
(BalanceCalculation
_, BalanceAccumulation
_, Just BalanceAccumulation
PerPeriod ) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"(Balance Changes)"
(BalanceCalculation
_, BalanceAccumulation
_, Just BalanceAccumulation
Cumulative) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"(Cumulative Ending Balances)"
(BalanceCalculation
_, BalanceAccumulation
_, Just BalanceAccumulation
Historical) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"(Historical Ending Balances)"
(BalanceCalculation, BalanceAccumulation,
Maybe BalanceAccumulation)
_ -> Maybe Text
forall a. Maybe a
Nothing
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
today Maybe Text
_mc) -> Text
", valued at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Day -> Text
showDate Day
today
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
cbr' :: CompoundPeriodicReport DisplayName MixedAmount
cbr' = ReportSpec
-> Journal
-> [CBCSubreportSpec DisplayName]
-> CompoundPeriodicReport DisplayName MixedAmount
forall a.
ReportSpec
-> Journal
-> [CBCSubreportSpec a]
-> CompoundPeriodicReport a MixedAmount
compoundBalanceReport ReportSpec
rspec{_rsReportOpts=ropts'} Journal
j [CBCSubreportSpec DisplayName]
cbcqueries
cbr :: CompoundPeriodicReport DisplayName MixedAmount
cbr = CompoundPeriodicReport DisplayName MixedAmount
cbr'{cbrTitle=title}
render :: CompoundPeriodicReport DisplayName MixedAmount -> Text
render = case CliOpts -> [Char]
outputFormatFromOpts CliOpts
opts of
[Char]
"txt" -> ReportOpts
-> CompoundPeriodicReport DisplayName MixedAmount -> Text
compoundBalanceReportAsText ReportOpts
ropts'
[Char]
"csv" -> CSV -> Text
printCSV (CSV -> Text)
-> (CompoundPeriodicReport DisplayName MixedAmount -> CSV)
-> CompoundPeriodicReport DisplayName MixedAmount
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> CSV
compoundBalanceReportAsCsv ReportOpts
ropts'
[Char]
"tsv" -> CSV -> Text
printTSV (CSV -> Text)
-> (CompoundPeriodicReport DisplayName MixedAmount -> CSV)
-> CompoundPeriodicReport DisplayName MixedAmount
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> CSV
compoundBalanceReportAsCsv ReportOpts
ropts'
[Char]
"html" -> HtmlT Identity () -> Text
forall a. Html a -> Text
L.renderText (HtmlT Identity () -> Text)
-> (CompoundPeriodicReport DisplayName MixedAmount
-> HtmlT Identity ())
-> CompoundPeriodicReport DisplayName MixedAmount
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts
-> CompoundPeriodicReport DisplayName MixedAmount
-> HtmlT Identity ()
compoundBalanceReportAsHtml ReportOpts
ropts'
[Char]
"fods" -> TextEncoding
-> Map Text ((Int, Int), [[Cell NumLines Text]]) -> Text
printFods TextEncoding
IO.localeEncoding (Map Text ((Int, Int), [[Cell NumLines Text]]) -> Text)
-> (CompoundPeriodicReport DisplayName MixedAmount
-> Map Text ((Int, Int), [[Cell NumLines Text]]))
-> CompoundPeriodicReport DisplayName MixedAmount
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(((Int, Int), NonEmpty [Cell NumLines Text])
-> ((Int, Int), [[Cell NumLines Text]]))
-> Map Text ((Int, Int), NonEmpty [Cell NumLines Text])
-> Map Text ((Int, Int), [[Cell NumLines Text]])
forall a b. (a -> b) -> Map Text a -> Map Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NonEmpty [Cell NumLines Text] -> [[Cell NumLines Text]])
-> ((Int, Int), NonEmpty [Cell NumLines Text])
-> ((Int, Int), [[Cell NumLines Text]])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second NonEmpty [Cell NumLines Text] -> [[Cell NumLines Text]]
forall a. NonEmpty a -> [a]
NonEmpty.toList) (Map Text ((Int, Int), NonEmpty [Cell NumLines Text])
-> Map Text ((Int, Int), [[Cell NumLines Text]]))
-> (CompoundPeriodicReport DisplayName MixedAmount
-> Map Text ((Int, Int), NonEmpty [Cell NumLines Text]))
-> CompoundPeriodicReport DisplayName MixedAmount
-> Map Text ((Int, Int), [[Cell NumLines Text]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
-> ((Int, Int), NonEmpty [Cell NumLines Text])
-> Map Text ((Int, Int), NonEmpty [Cell NumLines Text]))
-> (Text, ((Int, Int), NonEmpty [Cell NumLines Text]))
-> Map Text ((Int, Int), NonEmpty [Cell NumLines Text])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text
-> ((Int, Int), NonEmpty [Cell NumLines Text])
-> Map Text ((Int, Int), NonEmpty [Cell NumLines Text])
forall k a. k -> a -> Map k a
Map.singleton ((Text, ((Int, Int), NonEmpty [Cell NumLines Text]))
-> Map Text ((Int, Int), NonEmpty [Cell NumLines Text]))
-> (CompoundPeriodicReport DisplayName MixedAmount
-> (Text, ((Int, Int), NonEmpty [Cell NumLines Text])))
-> CompoundPeriodicReport DisplayName MixedAmount
-> Map Text ((Int, Int), NonEmpty [Cell NumLines Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
AmountFormat
-> Text
-> Maybe Text
-> ReportOpts
-> CompoundPeriodicReport DisplayName MixedAmount
-> (Text, ((Int, Int), NonEmpty [Cell NumLines Text]))
compoundBalanceReportAsSpreadsheet
AmountFormat
oneLineNoCostFmt Text
"Account" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"") ReportOpts
ropts'
[Char]
"json" -> CompoundPeriodicReport DisplayName MixedAmount -> Text
forall a. ToJSON a => a -> Text
toJsonText
[Char]
x -> [Char] -> CompoundPeriodicReport DisplayName MixedAmount -> Text
forall a. [Char] -> a
error' ([Char] -> CompoundPeriodicReport DisplayName MixedAmount -> Text)
-> [Char] -> CompoundPeriodicReport DisplayName MixedAmount -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
unsupportedOutputFormatError [Char]
x
showInterval :: Interval -> Maybe T.Text
showInterval :: Interval -> Maybe Text
showInterval = \case
Interval
NoInterval -> Maybe Text
forall a. Maybe a
Nothing
Days Int
1 -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Daily"
Weeks Int
1 -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Weekly"
Weeks Int
2 -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Biweekly"
Months Int
1 -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Monthly"
Months Int
2 -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Bimonthly"
Months Int
3 -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Quarterly"
Months Int
6 -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Half-yearly"
Months Int
12 -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Yearly"
Quarters Int
1 -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Quarterly"
Quarters Int
2 -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Half-yearly"
Years Int
1 -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Yearly"
Years Int
2 -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Biannual"
Interval
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Periodic"
showEndDates :: [Day] -> T.Text
showEndDates :: [Day] -> Text
showEndDates [Day]
es = case [Day]
es of
(Day
e:Day
_:[Day]
_) -> Day -> Text
showDate Day
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Day -> Text
showDate ([Day] -> Day
forall a. HasCallStack => [a] -> a
last [Day]
es)
[Day
e] -> Day -> Text
showDate Day
e
[] -> Text
""
compoundBalanceReportAsText :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> TL.Text
compoundBalanceReportAsText :: ReportOpts
-> CompoundPeriodicReport DisplayName MixedAmount -> Text
compoundBalanceReportAsText ReportOpts
ropts (CompoundPeriodicReport Text
title [DateSpan]
_colspans [(Text, PeriodicReport DisplayName MixedAmount, Bool)]
subreports PeriodicReportRow () MixedAmount
totalsrow) =
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 Table Text Text WideBuilder
bigtablewithtotalsrow
where
bigtable :: Table Text Text WideBuilder
bigtable =
case ((Text, PeriodicReport DisplayName MixedAmount, Bool)
-> Table Text Text WideBuilder)
-> [(Text, PeriodicReport DisplayName MixedAmount, Bool)]
-> [Table Text Text WideBuilder]
forall a b. (a -> b) -> [a] -> [b]
map (ReportOpts
-> (Text, PeriodicReport DisplayName MixedAmount, Bool)
-> Table Text Text WideBuilder
forall {c}.
ReportOpts
-> (Text, PeriodicReport DisplayName MixedAmount, c)
-> Table Text Text WideBuilder
subreportAsTable ReportOpts
ropts) [(Text, PeriodicReport DisplayName MixedAmount, Bool)]
subreports of
[] -> Table Text Text WideBuilder
forall rh ch a. Table rh ch a
Tabular.empty
Table Text Text WideBuilder
r:[Table Text Text WideBuilder]
rs -> (Table Text Text WideBuilder
-> Table Text Text WideBuilder -> Table Text Text WideBuilder)
-> Table Text Text WideBuilder
-> [Table Text Text WideBuilder]
-> Table Text Text WideBuilder
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (Properties
-> Table Text Text WideBuilder
-> Table Text Text WideBuilder
-> Table Text Text WideBuilder
forall rh ch a ch2.
Properties -> Table rh ch a -> Table rh ch2 a -> Table rh ch a
concatTables Properties
tableInterSubreportBorder) Table Text Text WideBuilder
r [Table Text Text WideBuilder]
rs
bigtablewithtotalsrow :: Table Text Text WideBuilder
bigtablewithtotalsrow =
if ReportOpts -> Bool
no_total_ ReportOpts
ropts Bool -> Bool -> Bool
|| [(Text, PeriodicReport DisplayName MixedAmount, Bool)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, PeriodicReport DisplayName MixedAmount, Bool)]
subreports Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then Table Text Text WideBuilder
bigtable
else Properties
-> Table Text Text WideBuilder
-> Table Text [Any] WideBuilder
-> Table Text Text WideBuilder
forall rh ch a ch2.
Properties -> Table rh ch a -> Table rh ch2 a -> Table rh ch a
concatTables Properties
tableGrandTotalsTopBorder Table Text Text WideBuilder
bigtable Table Text [Any] WideBuilder
forall {a}. Table Text [a] WideBuilder
totalstable
where
coltotalslines :: [[WideBuilder]]
coltotalslines = ReportOpts -> PeriodicReportRow () MixedAmount -> [[WideBuilder]]
forall a.
ReportOpts -> PeriodicReportRow a MixedAmount -> [[WideBuilder]]
multiBalanceRowAsText ReportOpts
ropts PeriodicReportRow () MixedAmount
totalsrow
totalstable :: Table Text [a] WideBuilder
totalstable = Header Text
-> Header [a] -> [[WideBuilder]] -> Table Text [a] 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
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
"Net:" 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]]
coltotalslines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
"")
([a] -> Header [a]
forall h. h -> Header h
Header [])
[[WideBuilder]]
coltotalslines
subreportAsTable :: ReportOpts
-> (Text, PeriodicReport DisplayName MixedAmount, c)
-> Table Text Text WideBuilder
subreportAsTable ReportOpts
ropts1 (Text
title1, PeriodicReport DisplayName MixedAmount
r, c
_) = Table Text Text WideBuilder
tablewithtitle
where
tablewithtitle :: Table Text Text WideBuilder
tablewithtitle = 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
tableSubreportTitleBottomBorder [Text -> Header Text
forall h. h -> Header h
Header Text
title1, Header Text
lefthdrs])
Header Text
tophdrs
([][WideBuilder] -> [[WideBuilder]] -> [[WideBuilder]]
forall a. a -> [a] -> [a]
:[[WideBuilder]]
cells)
where
Table Header Text
lefthdrs Header Text
tophdrs [[WideBuilder]]
cells = ReportOpts
-> PeriodicReport DisplayName MixedAmount
-> Table Text Text WideBuilder
multiBalanceReportAsTable ReportOpts
ropts1 PeriodicReport DisplayName MixedAmount
r
tableSubreportTitleBottomBorder :: Properties
tableSubreportTitleBottomBorder = Properties
SingleLine
tableInterSubreportBorder :: Properties
tableInterSubreportBorder = Properties
DoubleLine
tableGrandTotalsTopBorder :: Properties
tableGrandTotalsTopBorder = Properties
DoubleLine
compoundBalanceReportAsCsv :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> CSV
compoundBalanceReportAsCsv :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> CSV
compoundBalanceReportAsCsv ReportOpts
ropts CompoundPeriodicReport DisplayName MixedAmount
cbr =
let spreadsheet :: NonEmpty [Cell NumLines Text]
spreadsheet =
((Int, Int), NonEmpty [Cell NumLines Text])
-> NonEmpty [Cell NumLines Text]
forall a b. (a, b) -> b
snd (((Int, Int), NonEmpty [Cell NumLines Text])
-> NonEmpty [Cell NumLines Text])
-> ((Int, Int), NonEmpty [Cell NumLines Text])
-> NonEmpty [Cell NumLines Text]
forall a b. (a -> b) -> a -> b
$ (Text, ((Int, Int), NonEmpty [Cell NumLines Text]))
-> ((Int, Int), NonEmpty [Cell NumLines Text])
forall a b. (a, b) -> b
snd ((Text, ((Int, Int), NonEmpty [Cell NumLines Text]))
-> ((Int, Int), NonEmpty [Cell NumLines Text]))
-> (Text, ((Int, Int), NonEmpty [Cell NumLines Text]))
-> ((Int, Int), NonEmpty [Cell NumLines Text])
forall a b. (a -> b) -> a -> b
$
AmountFormat
-> Text
-> Maybe Text
-> ReportOpts
-> CompoundPeriodicReport DisplayName MixedAmount
-> (Text, ((Int, Int), NonEmpty [Cell NumLines Text]))
compoundBalanceReportAsSpreadsheet
AmountFormat
machineFmt Text
"Account" Maybe Text
forall a. Maybe a
Nothing ReportOpts
ropts CompoundPeriodicReport DisplayName MixedAmount
cbr
in [[Cell NumLines Text]] -> CSV
forall border text. [[Cell border text]] -> [[text]]
Spr.rawTableContent ([[Cell NumLines Text]] -> CSV) -> [[Cell NumLines Text]] -> CSV
forall a b. (a -> b) -> a -> b
$
[Cell NumLines Text] -> Cell NumLines Text -> [Cell NumLines Text]
forall border text a.
(Lines border, Monoid text) =>
[a] -> Cell border text -> [Cell border text]
Spr.horizontalSpan (NonEmpty [Cell NumLines Text] -> [Cell NumLines Text]
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty [Cell NumLines Text]
spreadsheet)
(Text -> Cell NumLines Text
forall borders. Lines borders => Text -> Cell borders Text
Spr.headerCell (CompoundPeriodicReport DisplayName MixedAmount -> Text
forall a b. CompoundPeriodicReport a b -> Text
cbrTitle CompoundPeriodicReport DisplayName MixedAmount
cbr)) [Cell NumLines Text]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. a -> [a] -> [a]
:
NonEmpty [Cell NumLines Text] -> [[Cell NumLines Text]]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty [Cell NumLines Text]
spreadsheet
compoundBalanceReportAsHtml :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> Html ()
compoundBalanceReportAsHtml :: ReportOpts
-> CompoundPeriodicReport DisplayName MixedAmount
-> HtmlT Identity ()
compoundBalanceReportAsHtml ReportOpts
ropts CompoundPeriodicReport DisplayName MixedAmount
cbr =
let (Text
title, ((Int, Int)
_fixed, NonEmpty [Cell NumLines Text]
cells)) =
AmountFormat
-> Text
-> Maybe Text
-> ReportOpts
-> CompoundPeriodicReport DisplayName MixedAmount
-> (Text, ((Int, Int), NonEmpty [Cell NumLines Text]))
compoundBalanceReportAsSpreadsheet
AmountFormat
oneLineNoCostFmt Text
"" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
nbsp) ReportOpts
ropts CompoundPeriodicReport DisplayName MixedAmount
cbr
colspanattr :: Attribute
colspanattr = Text -> Attribute
colspan_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ [Cell NumLines Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Cell NumLines Text] -> Int) -> [Cell NumLines Text] -> Int
forall a b. (a -> b) -> a -> b
$ NonEmpty [Cell NumLines Text] -> [Cell NumLines Text]
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty [Cell NumLines Text]
cells
in do
[Attribute] -> HtmlT Identity ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
link_ [Text -> Attribute
rel_ Text
"stylesheet", Text -> Attribute
href_ Text
"hledger.css"]
Text -> HtmlT Identity ()
forall arg result. TermRaw arg result => arg -> result
style_ (Text -> HtmlT Identity ()) -> Text -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Text
stylesheet ([(Text, Text)] -> Text) -> [(Text, Text)] -> Text
forall a b. (a -> b) -> a -> b
$
[(Text, Text)]
tableStyle [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [
(Text
"td:nth-child(1)", Text
"white-space:nowrap"),
(Text
"tr:nth-child(odd) td", Text
"background-color:#eee")
]
HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
table_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ do
HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
tr_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
th_ [Attribute
colspanattr, Text -> Attribute
forall arg result. TermRaw arg result => arg -> result
style_ Text
alignleft] (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
h2_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml Text
title
[[Cell NumLines (HtmlT Identity ())]] -> HtmlT Identity ()
forall border.
Lines border =>
[[Cell border (HtmlT Identity ())]] -> HtmlT Identity ()
printHtml ([[Cell NumLines (HtmlT Identity ())]] -> HtmlT Identity ())
-> [[Cell NumLines (HtmlT Identity ())]] -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ NonEmpty [Cell NumLines (HtmlT Identity ())]
-> [[Cell NumLines (HtmlT Identity ())]]
forall a. NonEmpty a -> [a]
NonEmpty.toList (NonEmpty [Cell NumLines (HtmlT Identity ())]
-> [[Cell NumLines (HtmlT Identity ())]])
-> NonEmpty [Cell NumLines (HtmlT Identity ())]
-> [[Cell NumLines (HtmlT Identity ())]]
forall a b. (a -> b) -> a -> b
$ ([Cell NumLines Text] -> [Cell NumLines (HtmlT Identity ())])
-> NonEmpty [Cell NumLines Text]
-> NonEmpty [Cell NumLines (HtmlT Identity ())]
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Cell NumLines Text -> Cell NumLines (HtmlT Identity ()))
-> [Cell NumLines Text] -> [Cell NumLines (HtmlT Identity ())]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> HtmlT Identity ())
-> Cell NumLines Text -> Cell NumLines (HtmlT Identity ())
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 -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
L.toHtml)) NonEmpty [Cell NumLines Text]
cells
compoundBalanceReportAsSpreadsheet ::
AmountFormat -> T.Text -> Maybe T.Text ->
ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount ->
(T.Text, ((Int, Int), NonEmpty [Spr.Cell Spr.NumLines T.Text]))
compoundBalanceReportAsSpreadsheet :: AmountFormat
-> Text
-> Maybe Text
-> ReportOpts
-> CompoundPeriodicReport DisplayName MixedAmount
-> (Text, ((Int, Int), NonEmpty [Cell NumLines Text]))
compoundBalanceReportAsSpreadsheet AmountFormat
fmt Text
accountLabel Maybe Text
maybeBlank ReportOpts
ropts CompoundPeriodicReport DisplayName MixedAmount
cbr =
let
CompoundPeriodicReport Text
title [DateSpan]
colspans [(Text, PeriodicReport DisplayName MixedAmount, Bool)]
subreports PeriodicReportRow () MixedAmount
totalrow = CompoundPeriodicReport DisplayName MixedAmount
cbr
leadingHeaders :: [Cell NumLines Text]
leadingHeaders =
Text -> Cell NumLines Text
forall borders. Lines borders => Text -> Cell borders Text
Spr.headerCell Text
accountLabel Cell NumLines Text -> [Cell NumLines Text] -> [Cell NumLines Text]
forall a. a -> [a] -> [a]
:
case ReportOpts -> Layout
layout_ ReportOpts
ropts of
Layout
LayoutTidy -> (Text -> Cell NumLines Text) -> [Text] -> [Cell NumLines Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Cell NumLines Text
forall borders. Lines borders => Text -> Cell borders Text
Spr.headerCell [Text]
tidyColumnLabels
Layout
LayoutBare -> [Text -> Cell NumLines Text
forall borders. Lines borders => Text -> Cell borders Text
Spr.headerCell Text
"Commodity"]
Layout
_ -> []
dataHeaders :: [Cell NumLines Text]
dataHeaders =
(Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ReportOpts -> Layout
layout_ ReportOpts
ropts Layout -> Layout -> Bool
forall a. Eq a => a -> a -> Bool
/= Layout
LayoutTidy) [()] -> [Cell NumLines Text] -> [Cell NumLines Text]
forall a b. [a] -> [b] -> [b]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) ([Cell NumLines Text] -> [Cell NumLines Text])
-> [Cell NumLines Text] -> [Cell NumLines Text]
forall a b. (a -> b) -> a -> b
$
(DateSpan -> Cell NumLines Text)
-> [DateSpan] -> [Cell NumLines Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Cell NumLines Text
forall borders. Lines borders => Text -> Cell borders Text
Spr.headerCell (Text -> Cell NumLines Text)
-> (DateSpan -> Text) -> DateSpan -> Cell NumLines Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalanceAccumulation -> [DateSpan] -> DateSpan -> Text
reportPeriodName (ReportOpts -> BalanceAccumulation
balanceaccum_ ReportOpts
ropts) [DateSpan]
colspans)
[DateSpan]
colspans [Cell NumLines Text]
-> [Cell NumLines Text] -> [Cell NumLines Text]
forall a. [a] -> [a] -> [a]
++
(Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ReportOpts -> Bool
multiBalanceHasTotalsColumn ReportOpts
ropts) [()] -> [Cell NumLines Text] -> [Cell NumLines Text]
forall a b. [a] -> [b] -> [b]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Text -> Cell NumLines Text
forall borders. Lines borders => Text -> Cell borders Text
Spr.headerCell Text
"Total"]) [Cell NumLines Text]
-> [Cell NumLines Text] -> [Cell NumLines Text]
forall a. [a] -> [a] -> [a]
++
(Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ReportOpts -> Bool
average_ ReportOpts
ropts) [()] -> [Cell NumLines Text] -> [Cell NumLines Text]
forall a b. [a] -> [b] -> [b]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Text -> Cell NumLines Text
forall borders. Lines borders => Text -> Cell borders Text
Spr.headerCell Text
"Average"])
headerrow :: [Cell NumLines Text]
headerrow = [Cell NumLines Text]
leadingHeaders [Cell NumLines Text]
-> [Cell NumLines Text] -> [Cell NumLines Text]
forall a. [a] -> [a] -> [a]
++ [Cell NumLines Text]
dataHeaders
blankrow :: Maybe [Cell NumLines Text]
blankrow =
(Text -> [Cell NumLines Text])
-> Maybe Text -> Maybe [Cell NumLines Text]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Cell NumLines Text] -> Cell NumLines Text -> [Cell NumLines Text]
forall border text a.
(Lines border, Monoid text) =>
[a] -> Cell border text -> [Cell border text]
Spr.horizontalSpan [Cell NumLines Text]
headerrow (Cell NumLines Text -> [Cell NumLines Text])
-> (Text -> Cell NumLines Text) -> Text -> [Cell NumLines Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Cell NumLines Text
forall border text. Lines border => text -> Cell border text
Spr.defaultCell) Maybe Text
maybeBlank
subreportrows ::
(T.Text, MultiBalanceReport, Bool) -> [[Spr.Cell Spr.NumLines T.Text]]
subreportrows :: (Text, PeriodicReport DisplayName MixedAmount, Bool)
-> [[Cell NumLines Text]]
subreportrows (Text
subreporttitle, PeriodicReport DisplayName MixedAmount
mbr, Bool
_increasestotal) =
let
([Cell NumLines Text]
_, [[Cell NumLines Text]]
bodyrows, [[Cell NumLines Text]]
mtotalsrows) =
AmountFormat
-> ReportOpts
-> PeriodicReport DisplayName MixedAmount
-> ([Cell NumLines Text], [[Cell NumLines Text]],
[[Cell NumLines Text]])
multiBalanceReportAsSpreadsheetParts AmountFormat
fmt ReportOpts
ropts PeriodicReport DisplayName MixedAmount
mbr
in
[Cell NumLines Text] -> Cell NumLines Text -> [Cell NumLines Text]
forall border text a.
(Lines border, Monoid text) =>
[a] -> Cell border text -> [Cell border text]
Spr.horizontalSpan [Cell NumLines Text]
headerrow
((Text -> Cell NumLines Text
forall border text. Lines border => text -> Cell border text
Spr.defaultCell Text
subreporttitle){
Spr.cellStyle = Spr.Body Spr.Total,
Spr.cellClass = Spr.Class "account"
}) [Cell NumLines Text]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. a -> [a] -> [a]
:
[[Cell NumLines Text]]
bodyrows [[Cell NumLines Text]]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. [a] -> [a] -> [a]
++
[[Cell NumLines Text]]
mtotalsrows [[Cell NumLines Text]]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. [a] -> [a] -> [a]
++
Maybe [Cell NumLines Text] -> [[Cell NumLines Text]]
forall a. Maybe a -> [a]
maybeToList Maybe [Cell NumLines Text]
blankrow [[Cell NumLines Text]]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. [a] -> [a] -> [a]
++
[]
totalrows :: [[Cell NumLines Text]]
totalrows =
if ReportOpts -> Bool
no_total_ ReportOpts
ropts Bool -> Bool -> Bool
|| [(Text, PeriodicReport DisplayName MixedAmount, Bool)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, PeriodicReport DisplayName MixedAmount, Bool)]
subreports Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then []
else
AmountFormat
-> ReportOpts
-> [DateSpan]
-> RowClass
-> (DateSpan -> Cell NumLines Text)
-> PeriodicReportRow () MixedAmount
-> [[Cell NumLines WideBuilder]]
forall a.
AmountFormat
-> ReportOpts
-> [DateSpan]
-> RowClass
-> (DateSpan -> Cell NumLines Text)
-> PeriodicReportRow a MixedAmount
-> [[Cell NumLines WideBuilder]]
multiBalanceRowAsCellBuilders AmountFormat
fmt ReportOpts
ropts [DateSpan]
colspans
RowClass
Total DateSpan -> Cell NumLines Text
simpleDateSpanCell PeriodicReportRow () MixedAmount
totalrow
[[Cell NumLines WideBuilder]]
-> ([[Cell NumLines WideBuilder]] -> [[Cell NumLines Text]])
-> [[Cell NumLines Text]]
forall a b. a -> (a -> b) -> b
& ([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 Text]]
-> ([[Cell NumLines Text]] -> [[Cell NumLines Text]])
-> [[Cell NumLines Text]]
forall a b. a -> (a -> b) -> b
& Cell NumLines Text
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall border text.
Cell border text -> [[Cell border text]] -> [[Cell border text]]
Spr.addRowSpanHeader
((Text -> Cell NumLines Text
forall border text. Lines border => text -> Cell border text
Spr.defaultCell Text
"Net:") {Spr.cellClass = Spr.Class "account"})
[[Cell NumLines Text]]
-> ([[Cell NumLines Text]] -> [[Cell NumLines Text]])
-> [[Cell NumLines Text]]
forall a b. a -> (a -> b) -> b
& [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall border text. [[Cell border text]] -> [[Cell NumLines text]]
addTotalBorders
in (Text
title,
((Int
1,Int
1),
[Cell NumLines Text]
headerrow [Cell NumLines Text]
-> [[Cell NumLines Text]] -> NonEmpty [Cell NumLines Text]
forall a. a -> [a] -> NonEmpty a
:| ((Text, PeriodicReport DisplayName MixedAmount, Bool)
-> [[Cell NumLines Text]])
-> [(Text, PeriodicReport DisplayName MixedAmount, Bool)]
-> [[Cell NumLines Text]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, PeriodicReport DisplayName MixedAmount, Bool)
-> [[Cell NumLines Text]]
subreportrows [(Text, PeriodicReport DisplayName MixedAmount, Bool)]
subreports [[Cell NumLines Text]]
-> [[Cell NumLines Text]] -> [[Cell NumLines Text]]
forall a. [a] -> [a] -> [a]
++ [[Cell NumLines Text]]
totalrows))