-
-
Notifications
You must be signed in to change notification settings - Fork 326
/
Copy pathBalance.hs
1284 lines (1106 loc) · 55.7 KB
/
Balance.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{-|
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, cellFromAmount)
import qualified Hledger.Write.Spreadsheet as Ods
-- | Command line options for this command.
balancemode = hledgerCommandMode
$(embedFileRelative "Hledger/Cli/Commands/Balance.txt")
(
-- https://hledger.org/dev/hledger.html#calculation-type :
[flagNone ["sum"] (setboolopt "sum")
"show sum of posting amounts (default)"
,flagNone ["valuechange"] (setboolopt "valuechange")
"show total change of value of period-end historical balances (caused by deposits, withdrawals, market price fluctuations)"
,flagNone ["gain"] (setboolopt "gain")
"show unrealised capital gain/loss (historical balance value minus cost basis)"
-- XXX --budget[=DESCPAT], --forecast[=PERIODEXP], could be more consistent
,flagOpt "" ["budget"] (\s opts -> Right $ setopt "budget" s opts) "DESCPAT"
(unlines
[ "show sum of posting amounts together with budget goals defined by periodic"
, "transactions. With a DESCPAT argument (must be separated by = not space),"
, "use only periodic transactions with matching description"
, "(case insensitive substring match)."
])
,flagNone ["count"] (setboolopt "count") "show the count of postings"
-- https://hledger.org/dev/hledger.html#accumulation-type :
,flagNone ["change"] (setboolopt "change")
"accumulate amounts from column start to column end (in multicolumn reports, default)"
,flagNone ["cumulative"] (setboolopt "cumulative")
"accumulate amounts from report start (specified by e.g. -b/--begin) to column end"
,flagNone ["historical","H"] (setboolopt "historical")
"accumulate amounts from journal start to column end (includes postings before report start date)"
]
-- other options specific to this command:
++ flattreeflags True ++
[flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "omit N leading account name parts (in flat mode)"
,flagNone ["declared"] (setboolopt "declared") "include non-parent declared accounts (best used with -E)"
,flagNone ["average","A"] (setboolopt "average") "show a row average column (in multicolumn reports)"
,flagNone ["row-total","T"] (setboolopt "row-total") "show a row total column (in multicolumn reports)"
,flagNone ["summary-only"] (setboolopt "summary-only") "display only row summaries (e.g. row total, average) (in multicolumn reports)"
,flagNone ["no-total","N"] (setboolopt "no-total") "omit the final total row"
,flagNone ["no-elide"] (setboolopt "no-elide") "don't squash boring parent accounts (in tree mode)"
,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format (in simple reports)"
,flagNone ["sort-amount","S"] (setboolopt "sort-amount") "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."
,flagNone ["percent", "%"] (setboolopt "percent") "express values in percentage of each column's total"
,flagNone ["related","r"] (setboolopt "related") "show the other accounts transacted with, instead"
,flagNone ["invert"] (setboolopt "invert") "display all amounts with reversed sign"
,flagNone ["transpose"] (setboolopt "transpose") "switch rows and columns (use vertical time axis)"
,flagReq ["layout"] (\s opts -> Right $ setopt "layout" s opts) "ARG"
(unlines
["how to lay out multi-commodity amounts and the overall table:"
,"'wide[,WIDTH]': commodities on one line"
,"'tall' : commodities on separate lines"
,"'bare' : commodity symbols in one column"
,"'tidy' : every attribute in its own column"
])
,flagReq ["base-url"] (\s opts -> Right $ setopt "base-url" s opts) "URLPREFIX" "in html output, generate links to hledger-web, with this prefix. (Usually the base url shown by hledger-web; can also be relative.)"
-- output:
,outputFormatFlag ["txt","html","csv","tsv","json","fods"]
,outputFileFlag
]
)
cligeneralflagsgroups1
(hiddenflags ++
[ flagNone ["commodity-column"] (setboolopt "commodity-column")
"show commodity symbols in a separate column, amounts as bare numbers, one row per commodity"
])
([], Just $ argsFlag "[QUERY]")
-- | The balance command, prints a balance report.
balance :: CliOpts -> Journal -> IO ()
balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ ropts of
CalcBudget -> do -- single or multi period budget report
let rspan = fst $ reportSpan j rspec
budgetreport = styleAmounts styles $ budgetReport rspec (balancingopts_ $ inputopts_ opts) rspan j
render = case fmt of
"txt" -> budgetReportAsText ropts
"json" -> (<>"\n") . toJsonText
"csv" -> printCSV . budgetReportAsCsv ropts
"tsv" -> printTSV . budgetReportAsCsv ropts
"html" -> (<>"\n") . htmlAsLazyText .
styledTableHtml . map (map (fmap toHtml)) . budgetReportAsSpreadsheet ropts
"fods" -> printFods IO.localeEncoding .
Map.singleton "Budget Report" . (,) (1,0) . budgetReportAsSpreadsheet ropts
_ -> error' $ unsupportedOutputFormatError fmt
writeOutputLazyText opts $ render budgetreport
_ | multiperiod -> do -- multi period balance report
let report = styleAmounts styles $ multiBalanceReport rspec j
render = case fmt of
"txt" -> multiBalanceReportAsText ropts
"csv" -> printCSV . multiBalanceReportAsCsv ropts
"tsv" -> printTSV . multiBalanceReportAsCsv ropts
"html" -> (<>"\n") . htmlAsLazyText . multiBalanceReportAsHtml ropts
"json" -> (<>"\n") . toJsonText
"fods" -> printFods IO.localeEncoding .
Map.singleton "Multi-period Balance Report" . multiBalanceReportAsSpreadsheet ropts
_ -> const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL:
writeOutputLazyText opts $ render report
_ -> do -- single period simple balance report
let report = styleAmounts styles $ balanceReport rspec j -- simple Ledger-style balance report
render = case fmt of
"txt" -> TB.toLazyText . balanceReportAsText ropts
"csv" -> printCSV . balanceReportAsCsv ropts
"tsv" -> printTSV . balanceReportAsCsv ropts
"html" -> (<>"\n") . htmlAsLazyText .
styledTableHtml . map (map (fmap toHtml)) . balanceReportAsSpreadsheet ropts
"json" -> (<>"\n") . toJsonText
"fods" -> printFods IO.localeEncoding . Map.singleton "Balance Report" . (,) (1,0) . balanceReportAsSpreadsheet ropts
_ -> error' $ unsupportedOutputFormatError fmt -- PARTIAL:
writeOutputLazyText opts $ render report
where
styles = journalCommodityStylesWith HardRounding j
ropts =
let ropts0 = _rsReportOpts rspec in
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 = interval_ ropts /= NoInterval || (layout_ ropts == LayoutTidy && delimited)
delimited = fmt == "csv" || fmt == "tsv"
fmt = outputFormatFromOpts opts
-- Rendering
data RowClass = Value | Total
deriving (Eq, Ord, Enum, Bounded, Show)
amountClass :: RowClass -> Ods.Class
amountClass rc =
Ods.Class $
case rc of Value -> "amount"; Total -> "amount coltotal"
budgetClass :: RowClass -> Ods.Class
budgetClass rc =
Ods.Class $
case rc of Value -> "budget"; Total -> "budget coltotal"
rowTotalClass :: RowClass -> Ods.Class
rowTotalClass rc =
Ods.Class $
case rc of Value -> "amount rowtotal"; Total -> "amount coltotal"
rowAverageClass :: RowClass -> Ods.Class
rowAverageClass rc =
Ods.Class $
case rc of Value -> "amount rowaverage"; Total -> "amount colaverage"
budgetTotalClass :: RowClass -> Ods.Class
budgetTotalClass rc =
Ods.Class $
case rc of Value -> "budget rowtotal"; Total -> "budget coltotal"
budgetAverageClass :: RowClass -> Ods.Class
budgetAverageClass rc =
Ods.Class $
case rc of Value -> "budget rowaverage"; Total -> "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 = ""
totalRowHeadingSpreadsheet = "Total:"
totalRowHeadingBudgetText = ""
totalRowHeadingBudgetCsv = "Total:"
-- Single-column balance reports
-- | Render a single-column balance report as CSV.
balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV
balanceReportAsCsv opts =
rawTableContent . balanceReportAsSpreadsheet opts
-- | Render a single-column balance report as plain text.
balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder
balanceReportAsText opts ((items, total)) = case layout_ opts of
LayoutBare | iscustom -> error' "Custom format not supported with commodity columns" -- PARTIAL:
LayoutBare -> bareLayoutBalanceReportAsText opts ((items, total))
_ -> unlinesB ls <> unlinesB (if no_total_ opts then [] else [overline, totalLines])
where
(ls, sizes) = unzip $ map (balanceReportItemAsText opts) items
-- abuse renderBalanceReportItem to render the total with similar format
(totalLines, _) = renderBalanceReportItem opts ("",0,total)
-- with a custom format, extend the line to the full report width;
-- otherwise show the usual 20-char line for compatibility
iscustom = case format_ opts of
OneLine ((FormatField _ _ _ TotalField):_) -> False
TopAligned ((FormatField _ _ _ TotalField):_) -> False
BottomAligned ((FormatField _ _ _ TotalField):_) -> False
_ -> True
overlinewidth = if iscustom then sum (map maximum' $ transpose sizes) else 20
overline = TB.fromText $ T.replicate overlinewidth "-"
-- | Render a single-column balance report as plain text with a separate commodity column (--layout=bare)
bareLayoutBalanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder
bareLayoutBalanceReportAsText opts (items, total) =
unlinesB .
map
(renderColumns def{tableBorders=singleColumnTableOuterBorder} sizes .
Group singleColumnTableInterColumnBorder . map Header) $
ls ++ concat [[[overline], totalline] | not (no_total_ opts)]
where
render (_, acctname, dep, amt) =
[ Cell TopRight damts
, Cell TopLeft (fmap wbFromText cs)
, Cell TopLeft (replicate (length damts - 1) mempty ++ [wbFromText dispname]) ]
where dopts = oneLineNoCostFmt{displayCommodity=layout_ opts /= LayoutBare, displayCommodityOrder=Just cs, displayColour=color_ opts}
cs = if mixedAmountLooksZero amt then [""] else S.toList $ maCommodities amt
dispname = T.replicate ((dep - 1) * 2) " " <> acctname
damts = showMixedAmountLinesB dopts amt
ls = fmap render items
totalline = render ("", "", 0, total)
sizes = fromMaybe 0 . maximumMay . map cellWidth <$>
transpose ([totalline | not (no_total_ opts)] ++ ls)
overline = Cell TopLeft . pure . wbFromText . flip T.replicate "-" . fromMaybe 0 $ headMay sizes
singleColumnTableOuterBorder = pretty_ opts
singleColumnTableInterColumnBorder = if pretty_ opts then SingleLine else 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 opts (_, accountName, dep, amt) =
renderBalanceReportItem opts (accountName, dep, amt)
-- | Render a balance report item, using the StringFormat specified by --format.
--
renderBalanceReportItem :: ReportOpts -> (AccountName, Int, MixedAmount) -> (TB.Builder, [Int])
renderBalanceReportItem opts (acctname, dep, total) =
case format_ opts of
OneLine comps -> renderRowFromComponents $ renderComponents True True comps
TopAligned comps -> renderRowFromComponents $ renderComponents True False comps
BottomAligned comps -> renderRowFromComponents $ renderComponents False False 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 cs =
( renderRowB def{tableBorders=False, borderSpaces=False} . Group NoLine $ map Header cs
, map cellWidth cs
)
-- Render each of the given StringFormat components for the balance report item,
-- returning each as a Cell.
renderComponents :: Bool -> Bool -> [StringFormatComponent] -> [Cell]
renderComponents topaligned oneline = map (renderComponent topaligned oneline opts (acctname, dep, 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 _ _ _ _ (FormatLiteral s) = textCell TopLeft s
renderComponent topaligned oneline opts (acctname, dep, total) (FormatField ljust mmin mmax field) = case field of
DepthSpacerField -> Cell align [WideBuilder (TB.fromText $ T.replicate d " ") d]
where d = maybe id min mmax $ dep * fromMaybe 1 mmin
AccountField -> textCell align $ formatText ljust mmin mmax acctname
TotalField -> Cell align . pure $ showMixedAmountB dopts total
_ -> Cell align [mempty]
where
align | topaligned && ljust = TopLeft
| topaligned = TopRight
| ljust = BottomLeft
| otherwise = BottomRight
dopts = noCostFmt{displayCommodity = layout_ opts /= LayoutBare
,displayOneLine = oneline
,displayMinWidth = mmin
,displayMaxWidth = mmax
,displayColour = color_ opts
}
headerWithoutBorders :: [Ods.Cell () text] -> [Ods.Cell Ods.NumLines text]
headerWithoutBorders = map (\c -> c {Ods.cellBorder = Ods.noBorder})
simpleDateSpanCell :: DateSpan -> Ods.Cell Ods.NumLines Text
simpleDateSpanCell = Ods.defaultCell . showDateSpan
addTotalBorders :: [[Ods.Cell border text]] -> [[Ods.Cell Ods.NumLines text]]
addTotalBorders =
zipWith
(\border ->
map (\c -> c {
Ods.cellStyle = Ods.Body Ods.Total,
Ods.cellBorder = Ods.noBorder {Ods.borderTop = border}}))
(Ods.DoubleLine : repeat Ods.NoLine)
-- | Render a single-column balance report as FODS.
balanceReportAsSpreadsheet ::
ReportOpts -> BalanceReport -> [[Ods.Cell Ods.NumLines Text]]
balanceReportAsSpreadsheet opts (items, total) =
(if transpose_ opts then Ods.transpose else id) $
headers :
concatMap (rows Value) items ++
if no_total_ opts then []
else addTotalBorders $
rows Total (totalRowHeadingSpreadsheet, totalRowHeadingSpreadsheet, 0, total)
where
cell = Ods.defaultCell
headers =
addHeaderBorders $ map headerCell $
"account" : case layout_ opts of
LayoutBareWide -> allCommodities
LayoutBare -> ["commodity", "balance"]
_ -> ["balance"]
allCommodities =
S.toAscList $ foldMap (\(_,_,_,ma) -> maCommodities ma) items
rows ::
RowClass -> BalanceReportItem ->
[[Ods.Cell Ods.NumLines Text]]
rows rc (name, dispName, dep, ma) =
let accountCell =
setAccountAnchor
(guard (rc==Value) >> balance_base_url_ opts)
(querystring_ opts) name $
cell $ renderBalanceAcct opts nbsp (name, dispName, dep) in
addRowSpanHeader accountCell $
case layout_ opts of
LayoutBareWide ->
let bopts =
machineFmt {
displayCommodity = False,
displayCommodityOrder = Just allCommodities
} in
[map (\bldAmt ->
fmap wbToText $ cellFromAmount bopts (amountClass rc, bldAmt)) $
showMixedAmountLinesPartsB bopts ma]
LayoutBare ->
map (\a -> [cell $ acommodity a, renderAmount rc $ mixedAmount a])
. amounts $ mixedAmountStripCosts ma
_ -> [[renderAmount rc ma]]
renderAmount rc mixedAmt =
wbToText <$> cellFromMixedAmount bopts (amountClass rc, mixedAmt)
where
bopts = machineFmt{displayCommodity=showcomm, displayCommodityOrder = commorder}
(showcomm, commorder)
| layout_ opts == LayoutBare = (False, Just $ S.toList $ maCommodities mixedAmt)
| otherwise = (True, 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 opts@ReportOpts{..} report =
(if transpose_ then transpose else id) $
rawTableContent $ header ++ body ++ totals
where
(header, body, totals) =
multiBalanceReportAsSpreadsheetParts machineFmt opts
(allCommoditiesFromPeriodicReport $ prRows report) 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 ->
[CommoditySymbol] -> MultiBalanceReport ->
([[Ods.Cell Ods.NumLines Text]],
[[Ods.Cell Ods.NumLines Text]],
[[Ods.Cell Ods.NumLines Text]])
multiBalanceReportAsSpreadsheetParts fmt opts@ReportOpts{..}
allCommodities (PeriodicReport colspans items tr) =
(allHeaders, concatMap fullRowAsTexts items, addTotalBorders totalrows)
where
accountCell label =
(Ods.defaultCell label) {Ods.cellClass = Ods.Class "account"}
hCell cls label = (headerCell label) {Ods.cellClass = Ods.Class cls}
allHeaders =
case layout_ of
LayoutBareWide ->
[headerWithoutBorders $
Ods.emptyCell :
concatMap (Ods.horizontalSpan allCommodities) dateHeaders,
headers]
_ -> [headers]
headers =
addHeaderBorders $
hCell "account" "account" :
case layout_ of
LayoutTidy -> map headerCell tidyColumnLabels
LayoutBareWide -> dateHeaders >> map headerCell allCommodities
LayoutBare -> headerCell "commodity" : dateHeaders
_ -> dateHeaders
dateHeaders =
map (headerDateSpanCell balance_base_url_ querystring_) colspans ++
[hCell "rowtotal" "total" | multiBalanceHasTotalsColumn opts] ++
[hCell "rowaverage" "average" | average_]
fullRowAsTexts row =
addRowSpanHeader anchorCell $
rowAsText Value (dateSpanCell balance_base_url_ querystring_ acctName) row
where acctName = prrFullName row
anchorCell =
setAccountAnchor balance_base_url_ querystring_ acctName $
accountCell $ renderPeriodicAcct opts nbsp row
totalrows =
if no_total_
then []
else addRowSpanHeader (accountCell totalRowHeadingSpreadsheet) $
rowAsText Total simpleDateSpanCell tr
rowAsText rc dsCell =
map (map (fmap wbToText)) .
multiBalanceRowAsCellBuilders fmt opts colspans allCommodities rc dsCell
tidyColumnLabels :: [Text]
tidyColumnLabels =
["period", "start_date", "end_date", "commodity", "value"]
-- | Render a multi-column balance report as HTML.
multiBalanceReportAsHtml :: ReportOpts -> MultiBalanceReport -> Html
multiBalanceReportAsHtml ropts mbr =
styledTableHtml . map (map (fmap toHtml)) $
snd $ multiBalanceReportAsSpreadsheet ropts 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 ropts mbr =
let (header,body,total) =
multiBalanceReportAsSpreadsheetParts oneLineNoCostFmt ropts
(allCommoditiesFromPeriodicReport $ prRows mbr) mbr
in (if transpose_ ropts then swap *** Ods.transpose else id) $
((case layout_ ropts of LayoutBareWide -> 2; _ -> 1,
case layout_ ropts of LayoutWide _ -> 1; _ -> 0),
header ++ body ++ total)
-- | Render a multi-column balance report as plain text suitable for console output.
multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> TL.Text
multiBalanceReportAsText ropts@ReportOpts{..} r = TB.toLazyText $
TB.fromText title
<> TB.fromText "\n\n"
<> multiBalanceReportTableAsText ropts (multiBalanceReportAsTable ropts r)
where
title = mtitle <> " in " <> showDateSpan (periodicReportSpan r) <> valuationdesc <> ":"
mtitle = case (balancecalc_, balanceaccum_) of
(CalcValueChange, PerPeriod ) -> "Period-end value changes"
(CalcValueChange, Cumulative ) -> "Cumulative period-end value changes"
(CalcGain, PerPeriod ) -> "Incremental gain"
(CalcGain, Cumulative ) -> "Cumulative gain"
(CalcGain, Historical ) -> "Historical gain"
(_, PerPeriod ) -> "Balance changes"
(_, Cumulative ) -> "Ending balances (cumulative)"
(_, Historical) -> "Ending balances (historical)"
valuationdesc =
(case conversionop_ of
Just ToCost -> ", converted to cost"
_ -> "")
<> (case value_ of
Just (AtThen _mc) -> ", valued at posting date"
Just (AtEnd _mc) | changingValuation -> ""
Just (AtEnd _mc) -> ", valued at period ends"
Just (AtNow _mc) -> ", current value"
Just (AtDate d _mc) -> ", valued at " <> showDate d
Nothing -> "")
changingValuation = case (balancecalc_, balanceaccum_) of
(CalcValueChange, PerPeriod) -> True
(CalcValueChange, Cumulative) -> True
_ -> 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{..} = renderTableByRowsB tableopts renderCh renderRow
where
tableopts = def{tableBorders=multiColumnTableOuterBorder, prettyTable=pretty_}
multiColumnTableOuterBorder = pretty_
renderCh :: [Text] -> [Cell]
renderCh
| layout_ /= LayoutBare || transpose_ = fmap (textCell TopRight)
| otherwise = zipWith ($) (textCell TopLeft : repeat (textCell TopRight))
renderRow :: (Text, [WideBuilder]) -> (Cell, [Cell])
renderRow (rh, row)
| layout_ /= LayoutBare || transpose_ =
(textCell TopLeft rh, fmap (Cell TopRight . pure) row)
| otherwise =
(textCell TopLeft rh, zipWith ($) (Cell TopLeft : repeat (Cell TopRight)) (fmap pure row))
-- | Build a 'Table' from a multi-column balance report.
multiBalanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table T.Text T.Text WideBuilder
multiBalanceReportAsTable opts@ReportOpts{summary_only_, average_, balanceaccum_}
(PeriodicReport spans items tr) =
maybetranspose $
addtotalrow $
Table
(Group multiColumnTableInterRowBorder $ map Header $ concat accts)
(Group multiColumnTableInterColumnBorder $ map Header colheadings)
(concat rows)
where
colheadings = ["Commodity" | layout_ opts == LayoutBare]
++ (if not summary_only_
then case layout_ opts of
LayoutBareWide -> spans >> allCommodities
_ -> map (reportPeriodName balanceaccum_ spans) spans
else [])
++ [" Total" | multiBalanceHasTotalsColumn opts]
++ ["Average" | average_]
allCommodities = allCommoditiesFromPeriodicReport items
(accts, rows) = unzip $ fmap fullRowAsTexts items
where
fullRowAsTexts row = (replicate (length rs) (renderacct row), rs)
where
rs = multiBalanceRowAsText opts allCommodities row
renderacct row' = T.replicate (prrIndent row' * 2) " " <> prrDisplayName row'
addtotalrow
| no_total_ opts = id
| otherwise =
let totalrows = multiBalanceRowAsText opts allCommodities tr
rowhdrs = Group NoLine $ map Header $ totalRowHeadingText : replicate (length totalrows - 1) ""
colhdrs = Header [] -- unused, concatTables will discard
in (flip (concatTables SingleLine) $ Table rowhdrs colhdrs totalrows)
maybetranspose | transpose_ opts = \(Table rh ch vals) -> Table ch rh (transpose vals)
| otherwise = id
multiColumnTableInterRowBorder = NoLine
multiColumnTableInterColumnBorder = if pretty_ opts then SingleLine else NoLine
allCommoditiesFromPeriodicReport ::
[PeriodicReportRow a MixedAmount] -> [CommoditySymbol]
allCommoditiesFromPeriodicReport =
S.toAscList . foldMap (foldMap maCommodities . prrAmounts)
multiBalanceRowAsCellBuilders ::
AmountFormat -> ReportOpts -> [DateSpan] -> [CommoditySymbol] ->
RowClass -> (DateSpan -> Ods.Cell Ods.NumLines Text) ->
PeriodicReportRow a MixedAmount ->
[[Ods.Cell Ods.NumLines WideBuilder]]
multiBalanceRowAsCellBuilders bopts ropts@ReportOpts{..} colspans allCommodities
rc renderDateSpanCell (PeriodicReportRow _acct as rowtot rowavg) =
case layout_ of
LayoutWide width -> [fmap (cellFromMixedAmount bopts{displayMaxWidth=width}) clsamts]
LayoutTall -> paddedTranspose Ods.emptyCell
. map (cellsFromMixedAmount bopts{displayMaxWidth=Nothing})
$ clsamts
LayoutBare -> zipWith (:) (map wbCell cs) -- add symbols
. transpose -- each row becomes a list of Text quantities
. map (cellsFromMixedAmount bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing})
$ clsamts
LayoutBareWide -> [concatMap (cellsFromMixedAmount bopts{displayCommodity=False, displayCommodityOrder=Just allCommodities, displayMinWidth=Nothing})
$ clsamts]
LayoutTidy -> concat
. zipWith (map . addDateColumns) colspans
. map ( zipWith (\c a -> [wbCell c, a]) cs
. cellsFromMixedAmount bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing})
$ classified
-- Do not include totals column or average for tidy output, as this
-- complicates the data representation and can be easily calculated
where
wbCell = Ods.defaultCell . wbFromText
wbDate content = (wbCell content) {Ods.cellType = Ods.TypeDate}
cs = if all mixedAmountLooksZero allamts then [""] else S.toList $ foldMap maCommodities allamts
classified = map ((,) (amountClass rc)) as
allamts = map snd clsamts
clsamts = (if not summary_only_ then classified else []) ++
[(rowTotalClass rc, rowtot) |
multiBalanceHasTotalsColumn ropts && not (null as)] ++
[(rowAverageClass rc, rowavg) | average_ && not (null as)]
addDateColumns spn@(DateSpan s e) remCols =
(wbFromText <$> renderDateSpanCell spn) :
wbDate (maybe "" showEFDate s) :
wbDate (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) :
remCols
paddedTranspose :: a -> [[a]] -> [[a]]
paddedTranspose _ [] = [[]]
paddedTranspose n as1 = take (maximum . map length $ as1) . trans $ as1
where
trans ([] : xss) = (n : map h xss) : trans ([n] : map t xss)
trans ((x : xs) : xss) = (x : map h xss) : trans (m xs : map t xss)
trans [] = []
h (x:_) = x
h [] = n
t (_:xs) = xs
t [] = [n]
m (x:xs) = x:xs
m [] = [n]
multiBalanceHasTotalsColumn :: ReportOpts -> Bool
multiBalanceHasTotalsColumn ropts =
row_total_ ropts && balanceaccum_ ropts `notElem` [Cumulative, Historical]
multiBalanceRowAsText ::
ReportOpts -> [CommoditySymbol] -> PeriodicReportRow a MixedAmount -> [[WideBuilder]]
multiBalanceRowAsText opts allCommodities =
rawTableContent .
multiBalanceRowAsCellBuilders oneLineNoCostFmt{displayColour=color_ opts}
opts [] allCommodities
Value simpleDateSpanCell
multiBalanceRowAsCsvText ::
ReportOpts -> [DateSpan] -> [CommoditySymbol] ->
PeriodicReportRow a MixedAmount -> [[T.Text]]
multiBalanceRowAsCsvText opts colspans allCommodities =
map (map (wbToText . Ods.cellContent)) .
multiBalanceRowAsCellBuilders machineFmt opts colspans allCommodities
Value 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 ropts@ReportOpts{..} budgetr = TB.toLazyText $
TB.fromText title <> TB.fromText "\n\n" <>
multiBalanceReportTableAsText ropts (budgetReportAsTable ropts budgetr)
where
title = "Budget performance in " <> showDateSpan (periodicReportSpan budgetr)
<> (case conversionop_ of
Just ToCost -> ", converted to cost"
_ -> "")
<> (case value_ of
Just (AtThen _mc) -> ", valued at posting date"
Just (AtEnd _mc) -> ", valued at period ends"
Just (AtNow _mc) -> ", current value"
Just (AtDate d _mc) -> ", valued at " <> showDate d
Nothing -> "")
<> ":"
-- | Build a 'Table' from a multi-column balance report.
budgetReportAsTable :: ReportOpts -> BudgetReport -> Table Text Text WideBuilder
budgetReportAsTable ropts@ReportOpts{..} (PeriodicReport spans items totrow) =
maybetransposetable $
addtotalrow $
Table
(Group budgetTableInterRowBorder $ map Header accts)
(Group budgetTableInterColumnBorder $ map Header colheadings)
rows
where
budgetTableInterRowBorder = NoLine
budgetTableInterColumnBorder = if pretty_ then SingleLine else NoLine
maybetransposetable
| transpose_ = \(Table rh ch vals) -> Table ch rh (transpose vals)
| otherwise = id
addtotalrow
| no_total_ = id
| otherwise =
let
rowhdrs = Group NoLine $ map Header $ totalRowHeadingBudgetText : replicate (length totalrows - 1) ""
colhdrs = Header [] -- ignored by concatTables
in
(flip (concatTables SingleLine) $ Table rowhdrs colhdrs totalrows) -- XXX ?
colheadings = ["Commodity" | layout_ == LayoutBare]
++ map (reportPeriodName balanceaccum_ spans) spans
++ [" Total" | row_total_]
++ ["Average" | average_]
(accts, rows, totalrows) =
(accts'
,maybecommcol itemscs $ showcells texts