{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NamedFieldPuns #-}
module Hledger.Cli.Commands.Balance (
balancemode
,balance
,balanceReportAsText
,balanceReportItemAsText
,multiBalanceReportAsText
,multiBalanceReportAsCsv
,multiBalanceReportAsHtml
,multiBalanceReportHtmlRows
,balanceReportAsTable
,balanceReportTableAsText
,tests_Balance
) where
import Data.List
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import System.Console.CmdArgs.Explicit as C
import Lucid as L
import Text.Printf (printf)
import Text.Tabular as T
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
import Hledger.Read.CsvReader (CSV, printCSV)
balancemode :: Mode RawOpts
balancemode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
$(embedFileRelative "Hledger/Cli/Commands/Balance.txt")
([[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 (default)"
,[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] -> (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)\n "
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["tree"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "tree") "show accounts as a tree; amounts include subaccounts (default in simple reports)"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["flat"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "flat") "show accounts as a list; amounts exclude subaccounts except when account is depth-clipped (default in multicolumn reports)\n "
,[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]
-> 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" "omit N leading account name parts (in flat mode)"
,[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 to display prettier 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 (in flat mode). With multiple columns, sorts by the row total, or by row average if that is displayed."
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["budget"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "budget") "show performance compared to budget goals defined by periodic transactions"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["invert"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "invert") "display all amounts with reversed sign"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["transpose"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "transpose") "transpose rows and columns"
,[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"
]
[Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++ [Flag RawOpts]
outputflags
)
[(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]")
balance :: CliOpts -> Journal -> IO ()
balance :: CliOpts -> Journal -> IO ()
balance opts :: CliOpts
opts@CliOpts{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts,reportopts_ :: CliOpts -> ReportOpts
reportopts_=ropts :: ReportOpts
ropts@ReportOpts{..}} j :: Journal
j = do
Day
d <- IO Day
getCurrentDay
case ReportOpts -> Either CommandDoc StringFormat
lineFormatFromOpts ReportOpts
ropts of
Left err :: CommandDoc
err -> CommandDoc -> IO ()
forall a. CommandDoc -> a
error' (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ [CommandDoc] -> CommandDoc
unlines [CommandDoc
err]
Right _ -> do
let budget :: Bool
budget = CommandDoc -> RawOpts -> Bool
boolopt "budget" RawOpts
rawopts
multiperiod :: Bool
multiperiod = Interval
interval_ Interval -> Interval -> Bool
forall a. Eq a => a -> a -> Bool
/= Interval
NoInterval
format :: CommandDoc
format = CliOpts -> CommandDoc
outputFormatFromOpts CliOpts
opts
if Bool
budget then do
DateSpan
reportspan <- Journal -> ReportOpts -> IO DateSpan
reportSpan Journal
j ReportOpts
ropts
let budgetreport :: BudgetReport
budgetreport = CommandDoc -> BudgetReport -> BudgetReport
forall a. Show a => CommandDoc -> a -> a
dbg1 "budgetreport" (BudgetReport -> BudgetReport) -> BudgetReport -> BudgetReport
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Bool -> DateSpan -> Day -> Journal -> BudgetReport
budgetReport ReportOpts
ropts Bool
assrt DateSpan
reportspan Day
d Journal
j
where
assrt :: Bool
assrt = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ InputOpts -> Bool
ignore_assertions_ (InputOpts -> Bool) -> InputOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> InputOpts
inputopts_ CliOpts
opts
render :: BudgetReport -> CommandDoc
render = case CommandDoc
format of
"csv" -> CommandDoc -> BudgetReport -> CommandDoc
forall a b. a -> b -> a
const (CommandDoc -> BudgetReport -> CommandDoc)
-> CommandDoc -> BudgetReport -> CommandDoc
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
forall a. CommandDoc -> a
error' "Sorry, CSV output is not yet implemented for this kind of report."
"html" -> CommandDoc -> BudgetReport -> CommandDoc
forall a b. a -> b -> a
const (CommandDoc -> BudgetReport -> CommandDoc)
-> CommandDoc -> BudgetReport -> CommandDoc
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc
forall a. CommandDoc -> a
error' "Sorry, HTML output is not yet implemented for this kind of report."
_ -> ReportOpts -> BudgetReport -> CommandDoc
budgetReportAsText ReportOpts
ropts
CliOpts -> CommandDoc -> IO ()
writeOutput CliOpts
opts (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ BudgetReport -> CommandDoc
render BudgetReport
budgetreport
else
if Bool
multiperiod then do
let report :: MultiBalanceReport
report = ReportOpts -> Query -> Journal -> MultiBalanceReport
multiBalanceReport ReportOpts
ropts (Day -> ReportOpts -> Query
queryFromOpts Day
d ReportOpts
ropts) Journal
j
render :: MultiBalanceReport -> CommandDoc
render = case CommandDoc
format of
"csv" -> (CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ "\n") (CommandDoc -> CommandDoc)
-> (MultiBalanceReport -> CommandDoc)
-> MultiBalanceReport
-> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSV -> CommandDoc
printCSV (CSV -> CommandDoc)
-> (MultiBalanceReport -> CSV) -> MultiBalanceReport -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> MultiBalanceReport -> CSV
multiBalanceReportAsCsv ReportOpts
ropts
"html" -> (CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ "\n") (CommandDoc -> CommandDoc)
-> (MultiBalanceReport -> CommandDoc)
-> MultiBalanceReport
-> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CommandDoc
TL.unpack (Text -> CommandDoc)
-> (MultiBalanceReport -> Text) -> MultiBalanceReport -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html () -> Text
forall a. Html a -> Text
L.renderText (Html () -> Text)
-> (MultiBalanceReport -> Html ()) -> MultiBalanceReport -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> MultiBalanceReport -> Html ()
multiBalanceReportAsHtml ReportOpts
ropts
_ -> ReportOpts -> MultiBalanceReport -> CommandDoc
multiBalanceReportAsText ReportOpts
ropts
CliOpts -> CommandDoc -> IO ()
writeOutput CliOpts
opts (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ MultiBalanceReport -> CommandDoc
render MultiBalanceReport
report
else do
let report :: BalanceReport
report
| BalanceType
balancetype_ BalanceType -> [BalanceType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BalanceType
HistoricalBalance, BalanceType
CumulativeChange]
= let ropts' :: ReportOpts
ropts' | ReportOpts -> Bool
flat_ ReportOpts
ropts = ReportOpts
ropts
| Bool
otherwise = ReportOpts
ropts{accountlistmode_ :: AccountListMode
accountlistmode_=AccountListMode
ALTree}
in ReportOpts -> Query -> Journal -> BalanceReport
balanceReportFromMultiBalanceReport ReportOpts
ropts' (Day -> ReportOpts -> Query
queryFromOpts Day
d ReportOpts
ropts) Journal
j
| Bool
otherwise = ReportOpts -> Query -> Journal -> BalanceReport
balanceReport ReportOpts
ropts (Day -> ReportOpts -> Query
queryFromOpts Day
d ReportOpts
ropts) Journal
j
render :: ReportOpts -> BalanceReport -> CommandDoc
render = case CommandDoc
format of
"csv" -> \ropts :: ReportOpts
ropts r :: BalanceReport
r -> (CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ "\n") (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
forall a b. (a -> b) -> a -> b
$ CSV -> CommandDoc
printCSV (CSV -> CommandDoc) -> CSV -> CommandDoc
forall a b. (a -> b) -> a -> b
$ ReportOpts -> BalanceReport -> CSV
balanceReportAsCsv ReportOpts
ropts BalanceReport
r
"html" -> \_ _ -> CommandDoc -> CommandDoc
forall a. CommandDoc -> a
error' "Sorry, HTML output is not yet implemented for this kind of report."
_ -> ReportOpts -> BalanceReport -> CommandDoc
balanceReportAsText
CliOpts -> CommandDoc -> IO ()
writeOutput CliOpts
opts (CommandDoc -> IO ()) -> CommandDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ ReportOpts -> BalanceReport -> CommandDoc
render ReportOpts
ropts BalanceReport
report
balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV
balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV
balanceReportAsCsv opts :: ReportOpts
opts (items :: [BalanceReportItem]
items, total :: MixedAmount
total) =
["account","balance"] [CommandDoc] -> CSV -> CSV
forall a. a -> [a] -> [a]
:
[[Text -> CommandDoc
T.unpack (ReportOpts -> Text -> Text
maybeAccountNameDrop ReportOpts
opts Text
a), MixedAmount -> CommandDoc
showMixedAmountOneLineWithoutPrice MixedAmount
b] | (a :: Text
a, _, _, b :: MixedAmount
b) <- [BalanceReportItem]
items]
CSV -> CSV -> CSV
forall a. [a] -> [a] -> [a]
++
if ReportOpts -> Bool
no_total_ ReportOpts
opts
then []
else [["total", MixedAmount -> CommandDoc
showMixedAmountOneLineWithoutPrice MixedAmount
total]]
balanceReportAsText :: ReportOpts -> BalanceReport -> String
balanceReportAsText :: ReportOpts -> BalanceReport -> CommandDoc
balanceReportAsText opts :: ReportOpts
opts ((items :: [BalanceReportItem]
items, total :: MixedAmount
total)) = [CommandDoc] -> CommandDoc
unlines ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
forall a b. (a -> b) -> a -> b
$ CSV -> [CommandDoc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat CSV
lines [CommandDoc] -> [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a] -> [a]
++ [CommandDoc]
t
where
fmt :: Either CommandDoc StringFormat
fmt = ReportOpts -> Either CommandDoc StringFormat
lineFormatFromOpts ReportOpts
opts
lines :: CSV
lines = case Either CommandDoc StringFormat
fmt of
Right fmt :: StringFormat
fmt -> (BalanceReportItem -> [CommandDoc]) -> [BalanceReportItem] -> CSV
forall a b. (a -> b) -> [a] -> [b]
map (ReportOpts -> StringFormat -> BalanceReportItem -> [CommandDoc]
balanceReportItemAsText ReportOpts
opts StringFormat
fmt) [BalanceReportItem]
items
Left err :: CommandDoc
err -> [[CommandDoc
err]]
t :: [CommandDoc]
t = if ReportOpts -> Bool
no_total_ ReportOpts
opts
then []
else
case Either CommandDoc StringFormat
fmt of
Right fmt :: StringFormat
fmt ->
let
acctcolwidth :: Int
acctcolwidth = [Int] -> Int
forall a. Integral a => [a] -> a
maximum' [Text -> Int
T.length Text
fullname | (fullname :: Text
fullname, _, _, _) <- [BalanceReportItem]
items]
totallines :: [CommandDoc]
totallines = (CommandDoc -> CommandDoc) -> [CommandDoc] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map CommandDoc -> CommandDoc
rstrip ([CommandDoc] -> [CommandDoc]) -> [CommandDoc] -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$ ReportOpts
-> StringFormat -> (Text, Int, MixedAmount) -> [CommandDoc]
renderBalanceReportItem ReportOpts
opts StringFormat
fmt (Int -> Text -> Text
T.replicate (Int
acctcolwidthInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) " ", 0, MixedAmount
total)
overlinewidth :: Int
overlinewidth | Maybe CommandDoc -> Bool
forall a. Maybe a -> Bool
isJust (ReportOpts -> Maybe CommandDoc
format_ ReportOpts
opts) = [Int] -> Int
forall a. Integral a => [a] -> a
maximum' ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (CommandDoc -> Int) -> [CommandDoc] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map CommandDoc -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([CommandDoc] -> [Int]) -> [CommandDoc] -> [Int]
forall a b. (a -> b) -> a -> b
$ CSV -> [CommandDoc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat CSV
lines
| Bool
otherwise = Int
defaultTotalFieldWidth
overline :: CommandDoc
overline = Int -> Char -> CommandDoc
forall a. Int -> a -> [a]
replicate Int
overlinewidth '-'
in CommandDoc
overline CommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
: [CommandDoc]
totallines
Left _ -> []
balanceReportItemAsText :: ReportOpts -> StringFormat -> BalanceReportItem -> [String]
balanceReportItemAsText :: ReportOpts -> StringFormat -> BalanceReportItem -> [CommandDoc]
balanceReportItemAsText opts :: ReportOpts
opts fmt :: StringFormat
fmt (_, accountName :: Text
accountName, depth :: Int
depth, amt :: MixedAmount
amt) =
ReportOpts
-> StringFormat -> (Text, Int, MixedAmount) -> [CommandDoc]
renderBalanceReportItem ReportOpts
opts StringFormat
fmt (
ReportOpts -> Text -> Text
maybeAccountNameDrop ReportOpts
opts Text
accountName,
Int
depth,
MixedAmount -> MixedAmount
normaliseMixedAmountSquashPricesForDisplay MixedAmount
amt
)
renderBalanceReportItem :: ReportOpts -> StringFormat -> (AccountName, Int, MixedAmount) -> [String]
renderBalanceReportItem :: ReportOpts
-> StringFormat -> (Text, Int, MixedAmount) -> [CommandDoc]
renderBalanceReportItem opts :: ReportOpts
opts fmt :: StringFormat
fmt (acctname :: Text
acctname, depth :: Int
depth, total :: MixedAmount
total) =
CommandDoc -> [CommandDoc]
lines (CommandDoc -> [CommandDoc]) -> CommandDoc -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$
case StringFormat
fmt of
OneLine comps :: [StringFormatComponent]
comps -> [CommandDoc] -> CommandDoc
concatOneLine ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
forall a b. (a -> b) -> a -> b
$ [StringFormatComponent] -> [CommandDoc]
render1 [StringFormatComponent]
comps
TopAligned comps :: [StringFormatComponent]
comps -> [CommandDoc] -> CommandDoc
concatBottomPadded ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
forall a b. (a -> b) -> a -> b
$ [StringFormatComponent] -> [CommandDoc]
render [StringFormatComponent]
comps
BottomAligned comps :: [StringFormatComponent]
comps -> [CommandDoc] -> CommandDoc
concatTopPadded ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
forall a b. (a -> b) -> a -> b
$ [StringFormatComponent] -> [CommandDoc]
render [StringFormatComponent]
comps
where
render1 :: [StringFormatComponent] -> [CommandDoc]
render1 = (StringFormatComponent -> CommandDoc)
-> [StringFormatComponent] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map (ReportOpts
-> (Text, Int, MixedAmount) -> StringFormatComponent -> CommandDoc
renderComponent1 ReportOpts
opts (Text
acctname, Int
depth, MixedAmount
total))
render :: [StringFormatComponent] -> [CommandDoc]
render = (StringFormatComponent -> CommandDoc)
-> [StringFormatComponent] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map (ReportOpts
-> (Text, Int, MixedAmount) -> StringFormatComponent -> CommandDoc
renderComponent ReportOpts
opts (Text
acctname, Int
depth, MixedAmount
total))
defaultTotalFieldWidth :: Int
defaultTotalFieldWidth = 20
renderComponent :: ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> String
renderComponent :: ReportOpts
-> (Text, Int, MixedAmount) -> StringFormatComponent -> CommandDoc
renderComponent _ _ (FormatLiteral s :: CommandDoc
s) = CommandDoc
s
renderComponent opts :: ReportOpts
opts (acctname :: Text
acctname, depth :: Int
depth, total :: MixedAmount
total) (FormatField ljust :: Bool
ljust min :: Maybe Int
min max :: Maybe Int
max field :: ReportItemField
field) = case ReportItemField
field of
DepthSpacerField -> Bool -> Maybe Int -> Maybe Int -> CommandDoc -> CommandDoc
formatString Bool
ljust Maybe Int
forall a. Maybe a
Nothing Maybe Int
max (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
forall a b. (a -> b) -> a -> b
$ Int -> Char -> CommandDoc
forall a. Int -> a -> [a]
replicate Int
d ' '
where d :: Int
d = case Maybe Int
min of
Just m :: Int
m -> Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
m
Nothing -> Int
depth
AccountField -> Bool -> Maybe Int -> Maybe Int -> CommandDoc -> CommandDoc
formatString Bool
ljust Maybe Int
min Maybe Int
max (Text -> CommandDoc
T.unpack Text
acctname)
TotalField -> Maybe Int -> Maybe Int -> Bool -> Bool -> CommandDoc -> CommandDoc
fitStringMulti Maybe Int
min Maybe Int
max Bool
True Bool
False (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
forall a b. (a -> b) -> a -> b
$ MixedAmount -> CommandDoc
showamt MixedAmount
total
where
showamt :: MixedAmount -> CommandDoc
showamt | ReportOpts -> Bool
color_ ReportOpts
opts = MixedAmount -> CommandDoc
cshowMixedAmountWithoutPrice
| Bool
otherwise = MixedAmount -> CommandDoc
showMixedAmountWithoutPrice
_ -> ""
renderComponent1 :: ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> String
renderComponent1 :: ReportOpts
-> (Text, Int, MixedAmount) -> StringFormatComponent -> CommandDoc
renderComponent1 _ _ (FormatLiteral s :: CommandDoc
s) = CommandDoc
s
renderComponent1 opts :: ReportOpts
opts (acctname :: Text
acctname, depth :: Int
depth, total :: MixedAmount
total) (FormatField ljust :: Bool
ljust min :: Maybe Int
min max :: Maybe Int
max field :: ReportItemField
field) = case ReportItemField
field of
AccountField -> Bool -> Maybe Int -> Maybe Int -> CommandDoc -> CommandDoc
formatString Bool
ljust Maybe Int
min Maybe Int
max ((CommandDoc -> [CommandDoc] -> CommandDoc
forall a. [a] -> [[a]] -> [a]
intercalate ", " ([CommandDoc] -> CommandDoc)
-> (CommandDoc -> [CommandDoc]) -> CommandDoc -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandDoc -> [CommandDoc]
lines) (CommandDoc -> CommandDoc
indented (Text -> CommandDoc
T.unpack Text
acctname)))
where
indented :: CommandDoc -> CommandDoc
indented = ((Int -> Char -> CommandDoc
forall a. Int -> a -> [a]
replicate (Int
depthInt -> Int -> Int
forall a. Num a => a -> a -> a
*2) ' ')CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++)
TotalField -> Maybe Int -> Maybe Int -> Bool -> Bool -> CommandDoc -> CommandDoc
fitStringMulti Maybe Int
min Maybe Int
max Bool
True Bool
False (CommandDoc -> CommandDoc) -> CommandDoc -> CommandDoc
forall a b. (a -> b) -> a -> b
$ ((CommandDoc -> [CommandDoc] -> CommandDoc
forall a. [a] -> [[a]] -> [a]
intercalate ", " ([CommandDoc] -> CommandDoc)
-> (CommandDoc -> [CommandDoc]) -> CommandDoc -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommandDoc -> CommandDoc) -> [CommandDoc] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map CommandDoc -> CommandDoc
strip ([CommandDoc] -> [CommandDoc])
-> (CommandDoc -> [CommandDoc]) -> CommandDoc -> [CommandDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandDoc -> [CommandDoc]
lines) (MixedAmount -> CommandDoc
showamt MixedAmount
total))
where
showamt :: MixedAmount -> CommandDoc
showamt | ReportOpts -> Bool
color_ ReportOpts
opts = MixedAmount -> CommandDoc
cshowMixedAmountWithoutPrice
| Bool
otherwise = MixedAmount -> CommandDoc
showMixedAmountWithoutPrice
_ -> ""
multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV
multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV
multiBalanceReportAsCsv opts :: ReportOpts
opts@ReportOpts{Bool
average_ :: Bool
average_ :: ReportOpts -> Bool
average_, Bool
row_total_ :: Bool
row_total_ :: ReportOpts -> Bool
row_total_} (MultiBalanceReport (colspans :: [DateSpan]
colspans, items :: [MultiBalanceReportRow]
items, (coltotals :: [MixedAmount]
coltotals,tot :: MixedAmount
tot,avg :: MixedAmount
avg))) =
CSV -> CSV
forall a. [[a]] -> [[a]]
maybetranspose (CSV -> CSV) -> CSV -> CSV
forall a b. (a -> b) -> a -> b
$
("Account" CommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
: (DateSpan -> CommandDoc) -> [DateSpan] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map DateSpan -> CommandDoc
showDateSpan [DateSpan]
colspans
[CommandDoc] -> [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a] -> [a]
++ ["Total" | Bool
row_total_]
[CommandDoc] -> [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a] -> [a]
++ ["Average" | Bool
average_]
) [CommandDoc] -> CSV -> CSV
forall a. a -> [a] -> [a]
:
[Text -> CommandDoc
T.unpack (ReportOpts -> Text -> Text
maybeAccountNameDrop ReportOpts
opts Text
a) CommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
:
(MixedAmount -> CommandDoc) -> [MixedAmount] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map MixedAmount -> CommandDoc
showMixedAmountOneLineWithoutPrice
([MixedAmount]
amts
[MixedAmount] -> [MixedAmount] -> [MixedAmount]
forall a. [a] -> [a] -> [a]
++ [MixedAmount
rowtot | Bool
row_total_]
[MixedAmount] -> [MixedAmount] -> [MixedAmount]
forall a. [a] -> [a] -> [a]
++ [MixedAmount
rowavg | Bool
average_])
| (a :: Text
a, _, _, amts :: [MixedAmount]
amts, rowtot :: MixedAmount
rowtot, rowavg :: MixedAmount
rowavg) <- [MultiBalanceReportRow]
items]
CSV -> CSV -> CSV
forall a. [a] -> [a] -> [a]
++
if ReportOpts -> Bool
no_total_ ReportOpts
opts
then []
else ["Total:" CommandDoc -> [CommandDoc] -> [CommandDoc]
forall a. a -> [a] -> [a]
:
(MixedAmount -> CommandDoc) -> [MixedAmount] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map MixedAmount -> CommandDoc
showMixedAmountOneLineWithoutPrice (
[MixedAmount]
coltotals
[MixedAmount] -> [MixedAmount] -> [MixedAmount]
forall a. [a] -> [a] -> [a]
++ [MixedAmount
tot | Bool
row_total_]
[MixedAmount] -> [MixedAmount] -> [MixedAmount]
forall a. [a] -> [a] -> [a]
++ [MixedAmount
avg | Bool
average_]
)]
where
maybetranspose :: [[a]] -> [[a]]
maybetranspose | ReportOpts -> Bool
transpose_ ReportOpts
opts = [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
transpose
| Bool
otherwise = [[a]] -> [[a]]
forall a. a -> a
id
multiBalanceReportAsHtml :: ReportOpts -> MultiBalanceReport -> Html ()
multiBalanceReportAsHtml :: ReportOpts -> MultiBalanceReport -> Html ()
multiBalanceReportAsHtml ropts :: ReportOpts
ropts mbr :: MultiBalanceReport
mbr =
let
(headingsrow :: Html ()
headingsrow,bodyrows :: [Html ()]
bodyrows,mtotalsrow :: Maybe (Html ())
mtotalsrow) = ReportOpts
-> MultiBalanceReport -> (Html (), [Html ()], Maybe (Html ()))
multiBalanceReportHtmlRows ReportOpts
ropts MultiBalanceReport
mbr
in
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 ()
headingsrow]
[Html ()] -> [Html ()] -> [Html ()]
forall a. [a] -> [a] -> [a]
++ [Html ()]
bodyrows
[Html ()] -> [Html ()] -> [Html ()]
forall a. [a] -> [a] -> [a]
++ Maybe (Html ()) -> [Html ()]
forall a. Maybe a -> [a]
maybeToList Maybe (Html ())
mtotalsrow
multiBalanceReportHtmlRows :: ReportOpts -> MultiBalanceReport -> (Html (), [Html ()], Maybe (Html ()))
multiBalanceReportHtmlRows :: ReportOpts
-> MultiBalanceReport -> (Html (), [Html ()], Maybe (Html ()))
multiBalanceReportHtmlRows ropts :: ReportOpts
ropts mbr :: MultiBalanceReport
mbr =
let
headingsrow :: [CommandDoc]
headingsrow:rest :: CSV
rest | ReportOpts -> Bool
transpose_ ReportOpts
ropts = CommandDoc -> CSV
forall a. CommandDoc -> a
error' "Sorry, --transpose is not supported with HTML output yet"
| Bool
otherwise = ReportOpts -> MultiBalanceReport -> CSV
multiBalanceReportAsCsv ReportOpts
ropts MultiBalanceReport
mbr
(bodyrows :: CSV
bodyrows, mtotalsrow :: Maybe [CommandDoc]
mtotalsrow) | ReportOpts -> Bool
no_total_ ReportOpts
ropts = (CSV
rest, Maybe [CommandDoc]
forall a. Maybe a
Nothing)
| Bool
otherwise = (CSV -> CSV
forall a. [a] -> [a]
init CSV
rest, [CommandDoc] -> Maybe [CommandDoc]
forall a. a -> Maybe a
Just ([CommandDoc] -> Maybe [CommandDoc])
-> [CommandDoc] -> Maybe [CommandDoc]
forall a b. (a -> b) -> a -> b
$ CSV -> [CommandDoc]
forall a. [a] -> a
last CSV
rest)
in
(ReportOpts -> [CommandDoc] -> Html ()
multiBalanceReportHtmlHeadRow ReportOpts
ropts [CommandDoc]
headingsrow
,([CommandDoc] -> Html ()) -> CSV -> [Html ()]
forall a b. (a -> b) -> [a] -> [b]
map (ReportOpts -> [CommandDoc] -> Html ()
multiBalanceReportHtmlBodyRow ReportOpts
ropts) CSV
bodyrows
,ReportOpts -> [CommandDoc] -> Html ()
multiBalanceReportHtmlFootRow ReportOpts
ropts ([CommandDoc] -> Html ()) -> Maybe [CommandDoc] -> Maybe (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [CommandDoc]
mtotalsrow
)
multiBalanceReportHtmlHeadRow :: ReportOpts -> [String] -> Html ()
multiBalanceReportHtmlHeadRow :: ReportOpts -> [CommandDoc] -> Html ()
multiBalanceReportHtmlHeadRow _ [] = Html ()
forall a. Monoid a => a
mempty
multiBalanceReportHtmlHeadRow ropts :: ReportOpts
ropts (acct :: CommandDoc
acct:rest :: [CommandDoc]
rest) =
let
defstyle :: Attribute
defstyle = Text -> Attribute
forall arg result. TermRaw arg result => arg -> result
style_ ""
(amts :: [CommandDoc]
amts,tot :: [CommandDoc]
tot,avg :: [CommandDoc]
avg)
| ReportOpts -> Bool
row_total_ ReportOpts
ropts Bool -> Bool -> Bool
&& ReportOpts -> Bool
average_ ReportOpts
ropts = ([CommandDoc] -> [CommandDoc]
forall a. [a] -> [a]
init ([CommandDoc] -> [CommandDoc]) -> [CommandDoc] -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$ [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a]
init [CommandDoc]
rest, [[CommandDoc] -> CommandDoc
forall a. [a] -> a
last ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
forall a b. (a -> b) -> a -> b
$ [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a]
init [CommandDoc]
rest], [[CommandDoc] -> CommandDoc
forall a. [a] -> a
last [CommandDoc]
rest])
| ReportOpts -> Bool
row_total_ ReportOpts
ropts = ([CommandDoc] -> [CommandDoc]
forall a. [a] -> [a]
init [CommandDoc]
rest, [[CommandDoc] -> CommandDoc
forall a. [a] -> a
last [CommandDoc]
rest], [])
| ReportOpts -> Bool
average_ ReportOpts
ropts = ([CommandDoc] -> [CommandDoc]
forall a. [a] -> [a]
init [CommandDoc]
rest, [], [[CommandDoc] -> CommandDoc
forall a. [a] -> a
last [CommandDoc]
rest])
| Bool
otherwise = ([CommandDoc]
rest, [], [])
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
td_ [Text -> Attribute
class_ "account"] (CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml CommandDoc
acct)
Html () -> [Html ()] -> [Html ()]
forall a. a -> [a] -> [a]
: [[Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
td_ [Text -> Attribute
class_ "", Attribute
defstyle] (CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml CommandDoc
a) | CommandDoc
a <- [CommandDoc]
amts]
[Html ()] -> [Html ()] -> [Html ()]
forall a. [a] -> [a] -> [a]
++ [[Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
td_ [Text -> Attribute
class_ "rowtotal", Attribute
defstyle] (CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml CommandDoc
a) | CommandDoc
a <- [CommandDoc]
tot]
[Html ()] -> [Html ()] -> [Html ()]
forall a. [a] -> [a] -> [a]
++ [[Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
td_ [Text -> Attribute
class_ "rowaverage", Attribute
defstyle] (CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml CommandDoc
a) | CommandDoc
a <- [CommandDoc]
avg]
multiBalanceReportHtmlBodyRow :: ReportOpts -> [String] -> Html ()
multiBalanceReportHtmlBodyRow :: ReportOpts -> [CommandDoc] -> Html ()
multiBalanceReportHtmlBodyRow _ [] = Html ()
forall a. Monoid a => a
mempty
multiBalanceReportHtmlBodyRow ropts :: ReportOpts
ropts (label :: CommandDoc
label:rest :: [CommandDoc]
rest) =
let
defstyle :: Attribute
defstyle = Text -> Attribute
forall arg result. TermRaw arg result => arg -> result
style_ "text-align:right"
(amts :: [CommandDoc]
amts,tot :: [CommandDoc]
tot,avg :: [CommandDoc]
avg)
| ReportOpts -> Bool
row_total_ ReportOpts
ropts Bool -> Bool -> Bool
&& ReportOpts -> Bool
average_ ReportOpts
ropts = ([CommandDoc] -> [CommandDoc]
forall a. [a] -> [a]
init ([CommandDoc] -> [CommandDoc]) -> [CommandDoc] -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$ [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a]
init [CommandDoc]
rest, [[CommandDoc] -> CommandDoc
forall a. [a] -> a
last ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
forall a b. (a -> b) -> a -> b
$ [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a]
init [CommandDoc]
rest], [[CommandDoc] -> CommandDoc
forall a. [a] -> a
last [CommandDoc]
rest])
| ReportOpts -> Bool
row_total_ ReportOpts
ropts = ([CommandDoc] -> [CommandDoc]
forall a. [a] -> [a]
init [CommandDoc]
rest, [[CommandDoc] -> CommandDoc
forall a. [a] -> a
last [CommandDoc]
rest], [])
| ReportOpts -> Bool
average_ ReportOpts
ropts = ([CommandDoc] -> [CommandDoc]
forall a. [a] -> [a]
init [CommandDoc]
rest, [], [[CommandDoc] -> CommandDoc
forall a. [a] -> a
last [CommandDoc]
rest])
| Bool
otherwise = ([CommandDoc]
rest, [], [])
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
td_ [Text -> Attribute
class_ "account", Text -> Attribute
forall arg result. TermRaw arg result => arg -> result
style_ "text-align:left"] (CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml CommandDoc
label)
Html () -> [Html ()] -> [Html ()]
forall a. a -> [a] -> [a]
: [[Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
td_ [Text -> Attribute
class_ "amount", Attribute
defstyle] (CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml CommandDoc
a) | CommandDoc
a <- [CommandDoc]
amts]
[Html ()] -> [Html ()] -> [Html ()]
forall a. [a] -> [a] -> [a]
++ [[Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
td_ [Text -> Attribute
class_ "amount rowtotal", Attribute
defstyle] (CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml CommandDoc
a) | CommandDoc
a <- [CommandDoc]
tot]
[Html ()] -> [Html ()] -> [Html ()]
forall a. [a] -> [a] -> [a]
++ [[Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
td_ [Text -> Attribute
class_ "amount rowaverage", Attribute
defstyle] (CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml CommandDoc
a) | CommandDoc
a <- [CommandDoc]
avg]
multiBalanceReportHtmlFootRow :: ReportOpts -> [String] -> Html ()
_ropts :: ReportOpts
_ropts [] = Html ()
forall a. Monoid a => a
mempty
multiBalanceReportHtmlFootRow ropts :: ReportOpts
ropts (acct :: CommandDoc
acct:rest :: [CommandDoc]
rest) =
let
defstyle :: Attribute
defstyle = Text -> Attribute
forall arg result. TermRaw arg result => arg -> result
style_ "text-align:right"
(amts :: [CommandDoc]
amts,tot :: [CommandDoc]
tot,avg :: [CommandDoc]
avg)
| ReportOpts -> Bool
row_total_ ReportOpts
ropts Bool -> Bool -> Bool
&& ReportOpts -> Bool
average_ ReportOpts
ropts = ([CommandDoc] -> [CommandDoc]
forall a. [a] -> [a]
init ([CommandDoc] -> [CommandDoc]) -> [CommandDoc] -> [CommandDoc]
forall a b. (a -> b) -> a -> b
$ [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a]
init [CommandDoc]
rest, [[CommandDoc] -> CommandDoc
forall a. [a] -> a
last ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
forall a b. (a -> b) -> a -> b
$ [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a]
init [CommandDoc]
rest], [[CommandDoc] -> CommandDoc
forall a. [a] -> a
last [CommandDoc]
rest])
| ReportOpts -> Bool
row_total_ ReportOpts
ropts = ([CommandDoc] -> [CommandDoc]
forall a. [a] -> [a]
init [CommandDoc]
rest, [[CommandDoc] -> CommandDoc
forall a. [a] -> a
last [CommandDoc]
rest], [])
| ReportOpts -> Bool
average_ ReportOpts
ropts = ([CommandDoc] -> [CommandDoc]
forall a. [a] -> [a]
init [CommandDoc]
rest, [], [[CommandDoc] -> CommandDoc
forall a. [a] -> a
last [CommandDoc]
rest])
| Bool
otherwise = ([CommandDoc]
rest, [], [])
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_ [Text -> Attribute
forall arg result. TermRaw arg result => arg -> result
style_ "text-align:left"] (CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml CommandDoc
acct)
Html () -> [Html ()] -> [Html ()]
forall a. a -> [a] -> [a]
: [[Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
th_ [Text -> Attribute
class_ "amount coltotal", Attribute
defstyle] (CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml CommandDoc
a) | CommandDoc
a <- [CommandDoc]
amts]
[Html ()] -> [Html ()] -> [Html ()]
forall a. [a] -> [a] -> [a]
++ [[Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
th_ [Text -> Attribute
class_ "amount coltotal", Attribute
defstyle] (CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml CommandDoc
a) | CommandDoc
a <- [CommandDoc]
tot]
[Html ()] -> [Html ()] -> [Html ()]
forall a. [a] -> [a] -> [a]
++ [[Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
th_ [Text -> Attribute
class_ "amount colaverage", Attribute
defstyle] (CommandDoc -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml CommandDoc
a) | CommandDoc
a <- [CommandDoc]
avg]
multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> CommandDoc
multiBalanceReportAsText ropts :: ReportOpts
ropts@ReportOpts{..} r :: MultiBalanceReport
r =
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 -> CommandDoc)
-> Table CommandDoc CommandDoc MixedAmount -> CommandDoc
forall a b. (a -> b) -> a -> b
$ ReportOpts
-> MultiBalanceReport -> Table CommandDoc CommandDoc MixedAmount
balanceReportAsTable ReportOpts
ropts MultiBalanceReport
r)
where
multiperiod :: Bool
multiperiod = Interval
interval_ Interval -> Interval -> Bool
forall a. Eq a => a -> a -> Bool
/= Interval
NoInterval
title :: CommandDoc
title = CommandDoc -> CommandDoc -> CommandDoc -> CommandDoc -> CommandDoc
forall r. PrintfType r => CommandDoc -> r
printf "%s in %s%s:"
(case BalanceType
balancetype_ of
PeriodChange -> "Balance changes"
CumulativeChange -> "Ending balances (cumulative)"
HistoricalBalance -> "Ending balances (historical)")
(DateSpan -> CommandDoc
showDateSpan (DateSpan -> CommandDoc) -> DateSpan -> CommandDoc
forall a b. (a -> b) -> a -> b
$ MultiBalanceReport -> DateSpan
multiBalanceReportSpan MultiBalanceReport
r)
(case Maybe ValuationType
value_ of
Just (AtCost _mc :: Maybe Text
_mc) -> ", valued at cost"
Just (AtEnd _mc :: Maybe Text
_mc) -> ", valued at period ends"
Just (AtNow _mc :: Maybe Text
_mc) -> ", current value"
Just (AtDefault _mc :: Maybe Text
_mc) | Bool
multiperiod -> ", valued at period ends"
Just (AtDefault _mc :: Maybe Text
_mc) -> ", current value"
Just (AtDate d :: Day
d _mc :: Maybe Text
_mc) -> ", valued at "CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++Day -> CommandDoc
showDate Day
d
Nothing -> "")
balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount
balanceReportAsTable :: ReportOpts
-> MultiBalanceReport -> Table CommandDoc CommandDoc MixedAmount
balanceReportAsTable opts :: ReportOpts
opts@ReportOpts{Bool
average_ :: Bool
average_ :: ReportOpts -> Bool
average_, Bool
row_total_ :: Bool
row_total_ :: ReportOpts -> Bool
row_total_, BalanceType
balancetype_ :: BalanceType
balancetype_ :: ReportOpts -> BalanceType
balancetype_} (MultiBalanceReport (colspans :: [DateSpan]
colspans, items :: [MultiBalanceReportRow]
items, (coltotals :: [MixedAmount]
coltotals,tot :: MixedAmount
tot,avg :: MixedAmount
avg))) =
Table CommandDoc CommandDoc MixedAmount
-> Table CommandDoc CommandDoc MixedAmount
forall rh a. Table rh rh a -> Table rh rh a
maybetranspose (Table CommandDoc CommandDoc MixedAmount
-> Table CommandDoc CommandDoc MixedAmount)
-> Table CommandDoc CommandDoc MixedAmount
-> Table CommandDoc CommandDoc MixedAmount
forall a b. (a -> b) -> a -> b
$
Table CommandDoc CommandDoc MixedAmount
-> Table CommandDoc CommandDoc MixedAmount
forall ch.
Table CommandDoc ch MixedAmount -> Table CommandDoc ch MixedAmount
addtotalrow (Table CommandDoc CommandDoc MixedAmount
-> Table CommandDoc CommandDoc MixedAmount)
-> Table CommandDoc CommandDoc MixedAmount
-> Table CommandDoc CommandDoc MixedAmount
forall a b. (a -> b) -> a -> b
$
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
NoLine ([Header CommandDoc] -> Header CommandDoc)
-> [Header CommandDoc] -> Header CommandDoc
forall a b. (a -> b) -> a -> b
$ (CommandDoc -> Header CommandDoc)
-> [CommandDoc] -> [Header CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header [CommandDoc]
accts)
(Properties -> [Header CommandDoc] -> Header CommandDoc
forall h. Properties -> [Header h] -> Header h
T.Group Properties
NoLine ([Header CommandDoc] -> Header CommandDoc)
-> [Header CommandDoc] -> Header CommandDoc
forall a b. (a -> b) -> a -> b
$ (CommandDoc -> Header CommandDoc)
-> [CommandDoc] -> [Header CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map CommandDoc -> Header CommandDoc
forall h. h -> Header h
Header [CommandDoc]
colheadings)
((MultiBalanceReportRow -> [MixedAmount])
-> [MultiBalanceReportRow] -> [[MixedAmount]]
forall a b. (a -> b) -> [a] -> [b]
map MultiBalanceReportRow -> [MixedAmount]
forall a b c a. (a, b, c, [a], a, a) -> [a]
rowvals [MultiBalanceReportRow]
items)
where
totalscolumn :: Bool
totalscolumn = Bool
row_total_ Bool -> Bool -> Bool
&& Bool -> Bool
not (BalanceType
balancetype_ BalanceType -> [BalanceType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BalanceType
CumulativeChange, BalanceType
HistoricalBalance])
mkDate :: DateSpan -> CommandDoc
mkDate = case BalanceType
balancetype_ of
PeriodChange -> DateSpan -> CommandDoc
showDateSpanMonthAbbrev
_ -> CommandDoc -> (Day -> CommandDoc) -> Maybe Day -> CommandDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (Day -> CommandDoc
showDate (Day -> CommandDoc) -> (Day -> Day) -> Day -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Day
prevday) (Maybe Day -> CommandDoc)
-> (DateSpan -> Maybe Day) -> DateSpan -> CommandDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateSpan -> Maybe Day
spanEnd
colheadings :: [CommandDoc]
colheadings = (DateSpan -> CommandDoc) -> [DateSpan] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map DateSpan -> CommandDoc
mkDate [DateSpan]
colspans
[CommandDoc] -> [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a] -> [a]
++ [" Total" | Bool
totalscolumn]
[CommandDoc] -> [CommandDoc] -> [CommandDoc]
forall a. [a] -> [a] -> [a]
++ ["Average" | Bool
average_]
accts :: [CommandDoc]
accts = (MultiBalanceReportRow -> CommandDoc)
-> [MultiBalanceReportRow] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map MultiBalanceReportRow -> CommandDoc
forall d e f. (Text, Text, Int, d, e, f) -> CommandDoc
renderacct [MultiBalanceReportRow]
items
renderacct :: (Text, Text, Int, d, e, f) -> CommandDoc
renderacct (a :: Text
a,a' :: Text
a',i :: Int
i,_,_,_)
| ReportOpts -> Bool
tree_ ReportOpts
opts = Int -> Char -> CommandDoc
forall a. Int -> a -> [a]
replicate ((Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*2) ' ' CommandDoc -> CommandDoc -> CommandDoc
forall a. [a] -> [a] -> [a]
++ Text -> CommandDoc
T.unpack Text
a'
| Bool
otherwise = Text -> CommandDoc
T.unpack (Text -> CommandDoc) -> Text -> CommandDoc
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Text -> Text
maybeAccountNameDrop ReportOpts
opts Text
a
rowvals :: (a, b, c, [a], a, a) -> [a]
rowvals (_,_,_,as :: [a]
as,rowtot :: a
rowtot,rowavg :: a
rowavg) = [a]
as
[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
rowtot | Bool
totalscolumn]
[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
rowavg | Bool
average_]
addtotalrow :: Table CommandDoc ch MixedAmount -> Table CommandDoc ch MixedAmount
addtotalrow | ReportOpts -> Bool
no_total_ ReportOpts
opts = Table CommandDoc ch MixedAmount -> Table CommandDoc ch MixedAmount
forall a. a -> a
id
| Bool
otherwise = (Table CommandDoc ch MixedAmount
-> SemiTable CommandDoc MixedAmount
-> Table CommandDoc ch 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 "" ([MixedAmount] -> SemiTable CommandDoc MixedAmount)
-> [MixedAmount] -> SemiTable CommandDoc MixedAmount
forall a b. (a -> b) -> a -> b
$
[MixedAmount]
coltotals
[MixedAmount] -> [MixedAmount] -> [MixedAmount]
forall a. [a] -> [a] -> [a]
++ [MixedAmount
tot | Bool
totalscolumn Bool -> Bool -> Bool
&& Bool -> Bool
not ([MixedAmount] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MixedAmount]
coltotals)]
[MixedAmount] -> [MixedAmount] -> [MixedAmount]
forall a. [a] -> [a] -> [a]
++ [MixedAmount
avg | Bool
average_ Bool -> Bool -> Bool
&& Bool -> Bool
not ([MixedAmount] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MixedAmount]
coltotals)]
))
maybetranspose :: Table rh rh a -> Table rh rh a
maybetranspose | ReportOpts -> Bool
transpose_ ReportOpts
opts = \(Table rh :: Header rh
rh ch :: Header rh
ch vals :: [[a]]
vals) -> Header rh -> Header rh -> [[a]] -> Table rh rh a
forall rh ch a. Header rh -> Header ch -> [[a]] -> Table rh ch a
Table Header rh
ch Header rh
rh ([[a]] -> [[a]]
forall a. [[a]] -> [[a]]
transpose [[a]]
vals)
| Bool
otherwise = Table rh rh a -> Table rh rh a
forall a. a -> a
id
balanceReportTableAsText :: ReportOpts -> Table String String MixedAmount -> String
balanceReportTableAsText :: ReportOpts -> Table CommandDoc CommandDoc MixedAmount -> CommandDoc
balanceReportTableAsText ropts :: ReportOpts
ropts = ReportOpts
-> (MixedAmount -> CommandDoc)
-> Table CommandDoc CommandDoc MixedAmount
-> CommandDoc
forall a.
ReportOpts
-> (a -> CommandDoc) -> Table CommandDoc CommandDoc a -> CommandDoc
tableAsText ReportOpts
ropts MixedAmount -> CommandDoc
showamt
where
showamt :: MixedAmount -> CommandDoc
showamt | ReportOpts -> Bool
color_ ReportOpts
ropts = MixedAmount -> CommandDoc
cshowMixedAmountOneLineWithoutPrice
| Bool
otherwise = MixedAmount -> CommandDoc
showMixedAmountOneLineWithoutPrice
tests_Balance :: TestTree
tests_Balance = CommandDoc -> [TestTree] -> TestTree
tests "Balance" [
CommandDoc -> [TestTree] -> TestTree
tests "balanceReportAsText" [
CommandDoc -> IO () -> TestTree
test "unicode in balance layout" (IO () -> TestTree) -> IO () -> TestTree
forall a b. (a -> b) -> a -> b
$ do
Journal
j <- Text -> IO Journal
readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let opts :: ReportOpts
opts = ReportOpts
defreportopts
ReportOpts -> BalanceReport -> CommandDoc
balanceReportAsText ReportOpts
opts (ReportOpts -> Query -> Journal -> BalanceReport
balanceReport ReportOpts
opts (Day -> ReportOpts -> Query
queryFromOpts (CommandDoc -> Day
parsedate "2008/11/26") ReportOpts
opts) Journal
j)
CommandDoc -> CommandDoc -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?=
[CommandDoc] -> CommandDoc
unlines
[" -100 актив:наличные"
," 100 расходы:покупки"
,"--------------------"
," 0"
]
]
]