{-# LANGUAGE OverloadedStrings, RecordWildCards, LambdaCase #-}
module Hledger.Cli.CompoundBalanceCommand (
CompoundBalanceCommandSpec(..)
,compoundBalanceCommandMode
,compoundBalanceCommand
) where
import Data.List (foldl')
import Data.Maybe
import qualified Data.Text as TS
import qualified Data.Text.Lazy as TL
import Data.Time.Calendar
import System.Console.CmdArgs.Explicit as C
import Hledger.Read.CsvReader (CSV, printCSV)
import Lucid as L hiding (value_)
import Text.Tabular as T
import Hledger
import Hledger.Cli.Commands.Balance
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils (unsupportedOutputFormatError, writeOutput)
data CompoundBalanceCommandSpec = CompoundBalanceCommandSpec {
CompoundBalanceCommandSpec -> CommandDoc
cbcdoc :: CommandDoc,
CompoundBalanceCommandSpec -> CommandDoc
cbctitle :: String,
CompoundBalanceCommandSpec -> [CBCSubreportSpec]
cbcqueries :: [CBCSubreportSpec],
CompoundBalanceCommandSpec -> BalanceType
cbctype :: BalanceType
}
compoundBalanceCommandMode :: CompoundBalanceCommandSpec -> Mode RawOpts
compoundBalanceCommandMode :: CompoundBalanceCommandSpec -> Mode RawOpts
compoundBalanceCommandMode CompoundBalanceCommandSpec{..} =
CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
CommandDoc
cbcdoc
([[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["change"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "change")
("show balance change in each period" CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ BalanceType -> CommandDoc
defType BalanceType
PeriodChange)
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["cumulative"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "cumulative")
("show balance change accumulated across periods (in multicolumn reports)"
CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ BalanceType -> CommandDoc
defType BalanceType
CumulativeChange
)
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["historical","H"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "historical")
("show historical ending balance in each period (includes postings before report start date)"
CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ BalanceType -> CommandDoc
defType BalanceType
HistoricalBalance
)
]
[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]
++
[[CommandDoc]
-> Update RawOpts -> CommandDoc -> CommandDoc -> Flag RawOpts
forall a.
[CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
flagReq ["drop"] (\s :: CommandDoc
s opts :: RawOpts
opts -> RawOpts -> Either CommandDoc RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either CommandDoc RawOpts)
-> RawOpts -> Either CommandDoc RawOpts
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc -> RawOpts -> RawOpts
setopt "drop" CommandDoc
s RawOpts
opts) "N" "flat mode: omit N leading account name parts"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["average","A"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "average") "show a row average column (in multicolumn reports)"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["row-total","T"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "row-total") "show a row total column (in multicolumn reports)"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["no-total","N"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "no-total") "omit the final total row"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["no-elide"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "no-elide") "don't squash boring parent accounts (in tree mode)"
,[CommandDoc]
-> Update RawOpts -> CommandDoc -> CommandDoc -> Flag RawOpts
forall a.
[CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
flagReq ["format"] (\s :: CommandDoc
s opts :: RawOpts
opts -> RawOpts -> Either CommandDoc RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either CommandDoc RawOpts)
-> RawOpts -> Either CommandDoc RawOpts
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc -> RawOpts -> RawOpts
setopt "format" CommandDoc
s RawOpts
opts) "FORMATSTR" "use this custom line format (in simple reports)"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["pretty-tables"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "pretty-tables") "use unicode when displaying tables"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["sort-amount","S"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "sort-amount") "sort by amount instead of account code/name"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["percent", "%"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "percent") "express values in percentage of each column's total"
,[CommandDoc] -> Flag RawOpts
outputFormatFlag ["txt","html","csv","json"]
,Flag RawOpts
outputFileFlag
])
[(CommandDoc, [Flag RawOpts])
generalflagsgroup1]
[Flag RawOpts]
hiddenflags
([], 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
$ CommandDoc -> Arg RawOpts
argsFlag "[QUERY]")
where
defType :: BalanceType -> String
defType :: BalanceType -> CommandDoc
defType bt :: BalanceType
bt | BalanceType
bt BalanceType -> BalanceType -> Bool
forall a. Eq a => a -> a -> Bool
== BalanceType
cbctype = " (default)"
| Bool
otherwise = ""
compoundBalanceCommand :: CompoundBalanceCommandSpec -> (CliOpts -> Journal -> IO ())
compoundBalanceCommand :: CompoundBalanceCommandSpec -> CliOpts -> Journal -> IO ()
compoundBalanceCommand CompoundBalanceCommandSpec{..} opts :: CliOpts
opts@CliOpts{reportopts_ :: CliOpts -> ReportOpts
reportopts_=ropts :: ReportOpts
ropts@ReportOpts{..}, rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts} j :: Journal
j = do
Day
today <- IO Day
getCurrentDay
let
mBalanceTypeOverride :: Maybe BalanceType
mBalanceTypeOverride =
(CommandDoc -> Maybe BalanceType) -> RawOpts -> Maybe BalanceType
forall a. (CommandDoc -> Maybe a) -> RawOpts -> Maybe a
choiceopt CommandDoc -> Maybe BalanceType
parse RawOpts
rawopts where
parse :: CommandDoc -> Maybe BalanceType
parse = \case
"historical" -> BalanceType -> Maybe BalanceType
forall a. a -> Maybe a
Just BalanceType
HistoricalBalance
"cumulative" -> BalanceType -> Maybe BalanceType
forall a. a -> Maybe a
Just BalanceType
CumulativeChange
"change" -> BalanceType -> Maybe BalanceType
forall a. a -> Maybe a
Just BalanceType
PeriodChange
_ -> Maybe BalanceType
forall a. Maybe a
Nothing
balancetype :: BalanceType
balancetype = BalanceType -> Maybe BalanceType -> BalanceType
forall a. a -> Maybe a -> a
fromMaybe BalanceType
cbctype Maybe BalanceType
mBalanceTypeOverride
ropts' :: ReportOpts
ropts' = ReportOpts
ropts{balancetype_ :: BalanceType
balancetype_=BalanceType
balancetype}
title :: CommandDoc
title =
CommandDoc
cbctitle
CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ " "
CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ CommandDoc
titledatestr
CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ CommandDoc
-> (CommandDoc -> CommandDoc) -> Maybe CommandDoc -> CommandDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (' 'Char -> CommandDoc -> CommandDoc
forall a. a -> [a] -> [a]
:) Maybe CommandDoc
mtitleclarification
CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ CommandDoc
valuationdesc
where
titledatestr :: CommandDoc
titledatestr = case BalanceType
balancetype of
HistoricalBalance -> [Day] -> CommandDoc
showEndDates [Day]
enddates
_ -> DateSpan -> CommandDoc
showDateSpan DateSpan
requestedspan
where
enddates :: [Day]
enddates = (Day -> Day) -> [Day] -> [Day]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Day -> Day
addDays (-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 = Bool -> Query -> DateSpan
queryDateSpan Bool
date2_ (Day -> ReportOpts -> Query
queryFromOpts Day
today ReportOpts
ropts')
DateSpan -> DateSpan -> DateSpan
`spanDefaultsFrom` Bool -> Journal -> DateSpan
journalDateSpan Bool
date2_ Journal
j
mtitleclarification :: Maybe CommandDoc
mtitleclarification = ((BalanceType -> CommandDoc)
-> Maybe BalanceType -> Maybe CommandDoc)
-> Maybe BalanceType
-> (BalanceType -> CommandDoc)
-> Maybe CommandDoc
forall a b c. (a -> b -> c) -> b -> a -> c
flip (BalanceType -> CommandDoc)
-> Maybe BalanceType -> Maybe CommandDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe BalanceType
mBalanceTypeOverride ((BalanceType -> CommandDoc) -> Maybe CommandDoc)
-> (BalanceType -> CommandDoc) -> Maybe CommandDoc
forall a b. (a -> b) -> a -> b
$ \t :: BalanceType
t ->
case BalanceType
t of
PeriodChange -> "(Balance Changes)"
CumulativeChange -> "(Cumulative Ending Balances)"
HistoricalBalance -> "(Historical Ending Balances)"
valuationdesc :: CommandDoc
valuationdesc = case Maybe ValuationType
value_ of
Just (AtCost _mc :: Maybe CommoditySymbol
_mc) -> ", valued at cost"
Just (AtThen _mc :: Maybe CommoditySymbol
_mc) -> CommandDoc -> CommandDoc
forall a. CommandDoc -> a
error' CommandDoc
unsupportedValueThenError
Just (AtEnd _mc :: Maybe CommoditySymbol
_mc) -> ", valued at period ends"
Just (AtNow _mc :: Maybe CommoditySymbol
_mc) -> ", current value"
Just (AtDefault _mc :: Maybe CommoditySymbol
_mc) | Bool
multiperiod -> ", valued at period ends"
Just (AtDefault _mc :: Maybe CommoditySymbol
_mc) -> ", current value"
Just (AtDate today :: Day
today _mc :: Maybe CommoditySymbol
_mc) -> ", valued at "CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++Day -> CommandDoc
showDate Day
today
Nothing -> ""
where multiperiod :: Bool
multiperiod = Interval
interval_ Interval -> Interval -> Bool
forall a. Eq a => a -> a -> Bool
/= Interval
NoInterval
cbr' :: CompoundPeriodicReport DisplayName MixedAmount
cbr' = Day
-> ReportOpts
-> Journal
-> [CBCSubreportSpec]
-> CompoundPeriodicReport DisplayName MixedAmount
compoundBalanceReport Day
today ReportOpts
ropts' Journal
j [CBCSubreportSpec]
cbcqueries
cbr :: CompoundPeriodicReport DisplayName MixedAmount
cbr = CompoundPeriodicReport DisplayName MixedAmount
cbr'{cbrTitle :: CommandDoc
cbrTitle=CommandDoc
title}
CliOpts -> CommandDoc -> IO ()
writeOutput CliOpts
opts (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ case CliOpts -> CommandDoc
outputFormatFromOpts CliOpts
opts of
"txt" -> ReportOpts
-> CompoundPeriodicReport DisplayName MixedAmount -> CommandDoc
compoundBalanceReportAsText ReportOpts
ropts' CompoundPeriodicReport DisplayName MixedAmount
cbr
"csv" -> CSV -> CommandDoc
printCSV (ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> CSV
compoundBalanceReportAsCsv ReportOpts
ropts CompoundPeriodicReport DisplayName MixedAmount
cbr) CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ "\n"
"html" -> (CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++"\n") (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Text -> CommandDoc
TL.unpack (Text -> CommandDoc) -> Text -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Html () -> Text
forall a. Html a -> Text
L.renderText (Html () -> Text) -> Html () -> Text
forall a b. (a -> b) -> a -> b
$ ReportOpts
-> CompoundPeriodicReport DisplayName MixedAmount -> Html ()
compoundBalanceReportAsHtml ReportOpts
ropts CompoundPeriodicReport DisplayName MixedAmount
cbr
"json" -> (CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++"\n") (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Text -> CommandDoc
TL.unpack (Text -> CommandDoc) -> Text -> CommandDoc
forall a b. (a -> b) -> a -> b
$ CompoundPeriodicReport DisplayName MixedAmount -> Text
forall a. ToJSON a => a -> Text
toJsonText CompoundPeriodicReport DisplayName MixedAmount
cbr
x :: CommandDoc
x -> CommandDoc -> CommandDoc
forall a. CommandDoc -> a
error' (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
unsupportedOutputFormatError CommandDoc
x
showEndDates :: [Day] -> String
showEndDates :: [Day] -> CommandDoc
showEndDates es :: [Day]
es = case [Day]
es of
(e :: Day
e:_:_) -> Day -> CommandDoc
showdate Day
e CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ ".." CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ Day -> CommandDoc
showdate ([Day] -> Day
forall a. [a] -> a
last [Day]
es)
[e :: Day
e] -> Day -> CommandDoc
showdate Day
e
[] -> ""
where
showdate :: Day -> CommandDoc
showdate = Day -> CommandDoc
forall a. Show a => a -> CommandDoc
show
compoundBalanceReportAsText :: ReportOpts -> CompoundBalanceReport -> String
compoundBalanceReportAsText :: ReportOpts
-> CompoundPeriodicReport DisplayName MixedAmount -> CommandDoc
compoundBalanceReportAsText ropts :: ReportOpts
ropts
(CompoundPeriodicReport title :: CommandDoc
title _colspans :: [DateSpan]
_colspans subreports :: [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)]
subreports (PeriodicReportRow _ coltotals :: [MixedAmount]
coltotals grandtotal :: MixedAmount
grandtotal grandavg :: MixedAmount
grandavg)) =
CommandDoc
title CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ "\n\n" CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++
ReportOpts -> Table CommandDoc CommandDoc MixedAmount -> CommandDoc
balanceReportTableAsText ReportOpts
ropts Table CommandDoc CommandDoc MixedAmount
bigtable'
where
bigtable :: Table CommandDoc CommandDoc MixedAmount
bigtable =
case ((CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)
-> Table CommandDoc CommandDoc MixedAmount)
-> [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)]
-> [Table CommandDoc CommandDoc MixedAmount]
forall a b. (a -> b) -> [a] -> [b]
map (ReportOpts
-> (CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)
-> Table CommandDoc CommandDoc MixedAmount
forall c.
ReportOpts
-> (CommandDoc, PeriodicReport DisplayName MixedAmount, c)
-> Table CommandDoc CommandDoc MixedAmount
subreportAsTable ReportOpts
ropts) [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)]
subreports of
[] -> Table CommandDoc CommandDoc MixedAmount
forall rh ch a. Table rh ch a
T.empty
r :: Table CommandDoc CommandDoc MixedAmount
r:rs :: [Table CommandDoc CommandDoc MixedAmount]
rs -> (Table CommandDoc CommandDoc MixedAmount
-> Table CommandDoc CommandDoc MixedAmount
-> Table CommandDoc CommandDoc MixedAmount)
-> Table CommandDoc CommandDoc MixedAmount
-> [Table CommandDoc CommandDoc MixedAmount]
-> Table CommandDoc CommandDoc MixedAmount
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Table CommandDoc CommandDoc MixedAmount
-> Table CommandDoc CommandDoc MixedAmount
-> Table CommandDoc CommandDoc MixedAmount
forall rh ch a ch. Table rh ch a -> Table rh ch a -> Table rh ch a
concatTables Table CommandDoc CommandDoc MixedAmount
r [Table CommandDoc CommandDoc MixedAmount]
rs
bigtable' :: Table CommandDoc CommandDoc MixedAmount
bigtable'
| ReportOpts -> Bool
no_total_ ReportOpts
ropts Bool -> Bool -> Bool
|| [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)]
subreports Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 =
Table CommandDoc CommandDoc MixedAmount
bigtable
| Bool
otherwise =
Table CommandDoc CommandDoc MixedAmount
bigtable
Table CommandDoc CommandDoc MixedAmount
-> SemiTable CommandDoc MixedAmount
-> Table CommandDoc CommandDoc MixedAmount
forall rh ch a. Table rh ch a -> SemiTable rh a -> Table rh ch a
+====+
CommandDoc -> [MixedAmount] -> SemiTable CommandDoc MixedAmount
forall rh a. rh -> [a] -> SemiTable rh a
row "Net:" (
[MixedAmount]
coltotals
[MixedAmount] -> [MixedAmount] -> [MixedAmount]
forall a. [a] -> [a] -> [a]
++ (if ReportOpts -> Bool
row_total_ ReportOpts
ropts then [MixedAmount
grandtotal] else [])
[MixedAmount] -> [MixedAmount] -> [MixedAmount]
forall a. [a] -> [a] -> [a]
++ (if ReportOpts -> Bool
average_ ReportOpts
ropts then [MixedAmount
grandavg] else [])
)
subreportAsTable :: ReportOpts
-> (CommandDoc, PeriodicReport DisplayName MixedAmount, c)
-> Table CommandDoc CommandDoc MixedAmount
subreportAsTable ropts :: ReportOpts
ropts (title :: CommandDoc
title, r :: PeriodicReport DisplayName MixedAmount
r, _) = Table CommandDoc CommandDoc MixedAmount
t
where
Table lefthdrs :: Header CommandDoc
lefthdrs tophdrs :: Header CommandDoc
tophdrs cells :: [[MixedAmount]]
cells = ReportOpts
-> PeriodicReport DisplayName MixedAmount
-> Table CommandDoc CommandDoc MixedAmount
balanceReportAsTable ReportOpts
ropts PeriodicReport DisplayName MixedAmount
r
t :: Table CommandDoc CommandDoc MixedAmount
t = Header CommandDoc
-> Header CommandDoc
-> [[MixedAmount]]
-> Table CommandDoc CommandDoc MixedAmount
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table (Properties -> [Header CommandDoc] -> Header CommandDoc
forall h. Properties -> [Header h] -> Header h
T.Group Properties
SingleLine [CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header CommandDoc
title, Header CommandDoc
lefthdrs]) Header CommandDoc
tophdrs ([][MixedAmount] -> [[MixedAmount]] -> [[MixedAmount]]
forall a. a -> [a] -> [a]
:[[MixedAmount]]
cells)
concatTables :: Table rh ch a -> Table rh ch a -> Table rh ch a
concatTables (Table hLeft :: Header rh
hLeft hTop :: Header ch
hTop dat :: [[a]]
dat) (Table hLeft' :: Header rh
hLeft' _ dat' :: [[a]]
dat') =
Header rh -> Header ch -> [[a]] -> Table rh ch a
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table (Properties -> [Header rh] -> Header rh
forall h. Properties -> [Header h] -> Header h
T.Group Properties
DoubleLine [Header rh
hLeft, Header rh
hLeft']) Header ch
hTop ([[a]]
dat [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
dat')
compoundBalanceReportAsCsv :: ReportOpts -> CompoundBalanceReport -> CSV
compoundBalanceReportAsCsv :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> CSV
compoundBalanceReportAsCsv ropts :: ReportOpts
ropts (CompoundPeriodicReport title :: CommandDoc
title colspans :: [DateSpan]
colspans subreports :: [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)]
subreports (PeriodicReportRow _ coltotals :: [MixedAmount]
coltotals grandtotal :: MixedAmount
grandtotal grandavg :: MixedAmount
grandavg)) =
CSV -> CSV
addtotals (CSV -> CSV) -> CSV -> CSV
forall a b. (a -> b) -> a -> b
$
CommandDoc -> [CommandDoc]
forall a. IsString a => a -> [a]
padRow CommandDoc
title [CommandDoc] -> CSV -> CSV
forall a. a -> [a] -> [a]
:
("Account" CommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
:
(DateSpan -> CommandDoc) -> [DateSpan] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map DateSpan -> CommandDoc
showDateSpanMonthAbbrev [DateSpan]
colspans
[CommandDoc] -> [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a] -> [a]
++ (if ReportOpts -> Bool
row_total_ ReportOpts
ropts then ["Total"] else [])
[CommandDoc] -> [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a] -> [a]
++ (if ReportOpts -> Bool
average_ ReportOpts
ropts then ["Average"] else [])
) [CommandDoc] -> CSV -> CSV
forall a. a -> [a] -> [a]
:
((CommandDoc, PeriodicReport DisplayName MixedAmount, Bool) -> CSV)
-> [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)]
-> CSV
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ReportOpts
-> (CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)
-> CSV
forall c.
ReportOpts
-> (CommandDoc, PeriodicReport DisplayName MixedAmount, c) -> CSV
subreportAsCsv ReportOpts
ropts) [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)]
subreports
where
subreportAsCsv :: ReportOpts
-> (CommandDoc, PeriodicReport DisplayName MixedAmount, c) -> CSV
subreportAsCsv ropts :: ReportOpts
ropts (subreporttitle :: CommandDoc
subreporttitle, multibalreport :: PeriodicReport DisplayName MixedAmount
multibalreport, _) =
CommandDoc -> [CommandDoc]
forall a. IsString a => a -> [a]
padRow CommandDoc
subreporttitle [CommandDoc] -> CSV -> CSV
forall a. a -> [a] -> [a]
:
CSV -> CSV
forall a. [a] -> [a]
tail (ReportOpts -> PeriodicReport DisplayName MixedAmount -> CSV
multiBalanceReportAsCsv ReportOpts
ropts PeriodicReport DisplayName MixedAmount
multibalreport)
padRow :: a -> [a]
padRow s :: a
s = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
numcols ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a
s a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a]
forall a. a -> [a]
repeat ""
where
numcols :: Int
numcols
| [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)]
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)]
subreports = 1
| Bool
otherwise =
(1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
(if ReportOpts -> Bool
row_total_ ReportOpts
ropts then (1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) else Int -> Int
forall a. a -> a
id) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
(if ReportOpts -> Bool
average_ ReportOpts
ropts then (1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) else Int -> Int
forall a. a -> a
id) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
[Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$
((CommandDoc, PeriodicReport DisplayName MixedAmount, Bool) -> Int)
-> [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)]
-> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([DateSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([DateSpan] -> Int)
-> ((CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)
-> [DateSpan])
-> (CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeriodicReport DisplayName MixedAmount -> [DateSpan]
forall a b. PeriodicReport a b -> [DateSpan]
prDates (PeriodicReport DisplayName MixedAmount -> [DateSpan])
-> ((CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)
-> PeriodicReport DisplayName MixedAmount)
-> (CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)
-> [DateSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)
-> PeriodicReport DisplayName MixedAmount
forall a b c. (a, b, c) -> b
second3) [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)]
subreports
addtotals :: CSV -> CSV
addtotals
| ReportOpts -> Bool
no_total_ ReportOpts
ropts Bool -> Bool -> Bool
|| [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)]
subreports Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = CSV -> CSV
forall a. a -> a
id
| Bool
otherwise = (CSV -> CSV -> CSV
forall a. [a] -> [a] -> [a]
++
["Net:" CommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
:
(MixedAmount -> CommandDoc) -> [MixedAmount] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> MixedAmount -> CommandDoc
showMixedAmountOneLineWithoutPrice Bool
False) (
[MixedAmount]
coltotals
[MixedAmount] -> [MixedAmount] -> [MixedAmount]
forall a. [a] -> [a] -> [a]
++ (if ReportOpts -> Bool
row_total_ ReportOpts
ropts then [MixedAmount
grandtotal] else [])
[MixedAmount] -> [MixedAmount] -> [MixedAmount]
forall a. [a] -> [a] -> [a]
++ (if ReportOpts -> Bool
average_ ReportOpts
ropts then [MixedAmount
grandavg] else [])
)
])
compoundBalanceReportAsHtml :: ReportOpts -> CompoundBalanceReport -> Html ()
compoundBalanceReportAsHtml :: ReportOpts
-> CompoundPeriodicReport DisplayName MixedAmount -> Html ()
compoundBalanceReportAsHtml ropts :: ReportOpts
ropts cbr :: CompoundPeriodicReport DisplayName MixedAmount
cbr =
let
CompoundPeriodicReport title :: CommandDoc
title colspans :: [DateSpan]
colspans subreports :: [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)]
subreports (PeriodicReportRow _ coltotals :: [MixedAmount]
coltotals grandtotal :: MixedAmount
grandtotal grandavg :: MixedAmount
grandavg) = CompoundPeriodicReport DisplayName MixedAmount
cbr
colspanattr :: Attribute
colspanattr = CommoditySymbol -> Attribute
colspan_ (CommoditySymbol -> Attribute) -> CommoditySymbol -> Attribute
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommoditySymbol
TS.pack (CommandDoc -> CommoditySymbol) -> CommandDoc -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ Int -> CommandDoc
forall a. Show a => a -> CommandDoc
show (Int -> CommandDoc) -> Int -> CommandDoc
forall a b. (a -> b) -> a -> b
$
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [DateSpan] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DateSpan]
colspans Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if ReportOpts -> Bool
row_total_ ReportOpts
ropts then 1 else 0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if ReportOpts -> Bool
average_ ReportOpts
ropts then 1 else 0)
leftattr :: Attribute
leftattr = CommoditySymbol -> Attribute
forall arg result. TermRaw arg result => arg -> result
style_ "text-align:left"
blankrow :: Html ()
blankrow = Html () -> Html ()
forall arg result. Term arg result => arg -> result
tr_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
td_ [Attribute
colspanattr] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtmlRaw (" "::String)
titlerows :: [Html ()]
titlerows =
[Html () -> Html ()
forall arg result. Term arg result => arg -> result
tr_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
th_ [Attribute
colspanattr, Attribute
leftattr] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ Html () -> Html ()
forall arg result. Term arg result => arg -> result
h2_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml CommandDoc
title]
[Html ()] -> [Html ()] -> [Html ()]
forall a. [a] -> [a] -> [a]
++ [[CommandDoc] -> Html ()
thRow ([CommandDoc] -> Html ()) -> [CommandDoc] -> Html ()
forall a b. (a -> b) -> a -> b
$
"" CommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
:
(DateSpan -> CommandDoc) -> [DateSpan] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map DateSpan -> CommandDoc
showDateSpanMonthAbbrev [DateSpan]
colspans
[CommandDoc] -> [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a] -> [a]
++ (if ReportOpts -> Bool
row_total_ ReportOpts
ropts then ["Total"] else [])
[CommandDoc] -> [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a] -> [a]
++ (if ReportOpts -> Bool
average_ ReportOpts
ropts then ["Average"] else [])
]
thRow :: [String] -> Html ()
thRow :: [CommandDoc] -> Html ()
thRow = Html () -> Html ()
forall arg result. Term arg result => arg -> result
tr_ (Html () -> Html ())
-> ([CommandDoc] -> Html ()) -> [CommandDoc] -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ())
-> ([CommandDoc] -> [Html ()]) -> [CommandDoc] -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommandDoc -> Html ()) -> [CommandDoc] -> [Html ()]
forall a b. (a -> b) -> [a] -> [b]
map (Html () -> Html ()
forall arg result. Term arg result => arg -> result
th_ (Html () -> Html ())
-> (CommandDoc -> Html ()) -> CommandDoc -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml)
subreportrows :: (String, MultiBalanceReport, Bool) -> [Html ()]
subreportrows :: (CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)
-> [Html ()]
subreportrows (subreporttitle :: CommandDoc
subreporttitle, mbr :: PeriodicReport DisplayName MixedAmount
mbr, _increasestotal :: Bool
_increasestotal) =
let
(_,bodyrows :: [Html ()]
bodyrows,mtotalsrow :: Maybe (Html ())
mtotalsrow) = ReportOpts
-> PeriodicReport DisplayName MixedAmount
-> (Html (), [Html ()], Maybe (Html ()))
multiBalanceReportHtmlRows ReportOpts
ropts PeriodicReport DisplayName MixedAmount
mbr
in
[Html () -> Html ()
forall arg result. Term arg result => arg -> result
tr_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
th_ [Attribute
colspanattr, Attribute
leftattr] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml CommandDoc
subreporttitle]
[Html ()] -> [Html ()] -> [Html ()]
forall a. [a] -> [a] -> [a]
++ [Html ()]
bodyrows
[Html ()] -> [Html ()] -> [Html ()]
forall a. [a] -> [a] -> [a]
++ [Html ()] -> (Html () -> [Html ()]) -> Maybe (Html ()) -> [Html ()]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Html () -> [Html ()] -> [Html ()]
forall a. a -> [a] -> [a]
:[]) Maybe (Html ())
mtotalsrow
[Html ()] -> [Html ()] -> [Html ()]
forall a. [a] -> [a] -> [a]
++ [Html ()
blankrow]
totalrows :: [Html ()]
totalrows | ReportOpts -> Bool
no_total_ ReportOpts
ropts Bool -> Bool -> Bool
|| [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)]
subreports Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = []
| Bool
otherwise =
let defstyle :: Attribute
defstyle = CommoditySymbol -> Attribute
forall arg result. TermRaw arg result => arg -> result
style_ "text-align:right"
in
[Html () -> Html ()
forall arg result. Term arg result => arg -> result
tr_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$
[Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
th_ [CommoditySymbol -> Attribute
class_ "", CommoditySymbol -> Attribute
forall arg result. TermRaw arg result => arg -> result
style_ "text-align:left"] "Net:"
Html () -> [Html ()] -> [Html ()]
forall a. a -> [a] -> [a]
: [[Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
th_ [CommoditySymbol -> Attribute
class_ "amount coltotal", Attribute
defstyle] (CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml (CommandDoc -> Html ()) -> CommandDoc -> Html ()
forall a b. (a -> b) -> a -> b
$ Bool -> MixedAmount -> CommandDoc
showMixedAmountOneLineWithoutPrice Bool
False MixedAmount
a) | MixedAmount
a <- [MixedAmount]
coltotals]
[Html ()] -> [Html ()] -> [Html ()]
forall a. [a] -> [a] -> [a]
++ (if ReportOpts -> Bool
row_total_ ReportOpts
ropts then [[Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
th_ [CommoditySymbol -> Attribute
class_ "amount coltotal", Attribute
defstyle] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml (CommandDoc -> Html ()) -> CommandDoc -> Html ()
forall a b. (a -> b) -> a -> b
$ Bool -> MixedAmount -> CommandDoc
showMixedAmountOneLineWithoutPrice Bool
False MixedAmount
grandtotal] else [])
[Html ()] -> [Html ()] -> [Html ()]
forall a. [a] -> [a] -> [a]
++ (if ReportOpts -> Bool
average_ ReportOpts
ropts then [[Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
th_ [CommoditySymbol -> Attribute
class_ "amount colaverage", Attribute
defstyle] (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml (CommandDoc -> Html ()) -> CommandDoc -> Html ()
forall a b. (a -> b) -> a -> b
$ Bool -> MixedAmount -> CommandDoc
showMixedAmountOneLineWithoutPrice Bool
False MixedAmount
grandavg] else [])
]
in do
CommoditySymbol -> Html ()
forall arg result. TermRaw arg result => arg -> result
style_ ([CommoditySymbol] -> CommoditySymbol
TS.unlines [""
,"td { padding:0 0.5em; }"
,"td:nth-child(1) { white-space:nowrap; }"
,"tr:nth-child(even) td { background-color:#eee; }"
])
[Attribute] -> Html ()
forall (m :: * -> *). Applicative m => [Attribute] -> HtmlT m ()
link_ [CommoditySymbol -> Attribute
rel_ "stylesheet", CommoditySymbol -> Attribute
href_ "hledger.css"]
Html () -> Html ()
forall arg result. Term arg result => arg -> result
table_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Html ()] -> Html ()
forall a. Monoid a => [a] -> a
mconcat ([Html ()] -> Html ()) -> [Html ()] -> Html ()
forall a b. (a -> b) -> a -> b
$
[Html ()]
titlerows
[Html ()] -> [Html ()] -> [Html ()]
forall a. [a] -> [a] -> [a]
++ [Html ()
blankrow]
[Html ()] -> [Html ()] -> [Html ()]
forall a. [a] -> [a] -> [a]
++ ((CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)
-> [Html ()])
-> [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)]
-> [Html ()]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)
-> [Html ()]
subreportrows [(CommandDoc, PeriodicReport DisplayName MixedAmount, Bool)]
subreports
[Html ()] -> [Html ()] -> [Html ()]
forall a. [a] -> [a] -> [a]
++ [Html ()]
totalrows