module Hledger.Cli.Balance (
balancemode
,balance
,balanceReportAsText
,balanceReportItemAsText
,periodBalanceReportAsText
,cumulativeBalanceReportAsText
,historicalBalanceReportAsText
,tests_Hledger_Cli_Balance
) where
import Data.List (intercalate)
import Data.Maybe (fromMaybe, isJust)
import System.Console.CmdArgs.Explicit as C
import Text.CSV
import Test.HUnit
import Text.Printf (printf)
import Text.Tabular as T
import Text.Tabular.AsciiWide
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
balancemode = (defCommandMode $ ["balance"] ++ aliases) {
modeHelp = "show accounts and balances" `withAliases` aliases
,modeGroupFlags = C.Group {
groupUnnamed = [
flagNone ["tree"] (\opts -> setboolopt "tree" opts) "show accounts as a tree (default in simple reports)"
,flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show accounts as a list (default in multicolumn mode)"
,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "flat mode: omit N leading account name parts"
,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "singlecolumn mode: use this custom line format"
,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "tree mode: don't squash boring parent accounts"
,flagNone ["historical","H"] (\opts -> setboolopt "historical" opts) "multicolumn mode: show historical ending balances"
,flagNone ["cumulative"] (\opts -> setboolopt "cumulative" opts) "multicolumn mode: show accumulated ending balances"
,flagNone ["average","A"] (\opts -> setboolopt "average" opts) "multicolumn mode: show a row average column"
,flagNone ["row-total","T"] (\opts -> setboolopt "row-total" opts) "multicolumn mode: show a row total column"
,flagNone ["no-total","N"] (\opts -> setboolopt "no-total" opts) "don't show the final total row"
,flagNone ["value","V"] (setboolopt "value") "show amounts as their current market value in their default valuation commodity"
]
++ outputflags
,groupHidden = []
,groupNamed = [generalflagsgroup1]
}
}
where aliases = ["bal"]
balance :: CliOpts -> Journal -> IO ()
balance opts@CliOpts{reportopts_=ropts} j = do
d <- getCurrentDay
case lineFormatFromOpts ropts of
Left err -> error' $ unlines [err]
Right _ -> do
let format = outputFormatFromOpts opts
interval = intervalFromOpts ropts
baltype = balancetype_ ropts
valuedate = fromMaybe d $ queryEndDate False $ queryFromOpts d ropts
case interval of
NoInterval -> do
let report = balanceReport ropts (queryFromOpts d ropts) j
convert | value_ ropts = balanceReportValue j valuedate
| otherwise = id
render = case format of
"csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r
_ -> balanceReportAsText
writeOutput opts $ render ropts $ convert report
_ -> do
let report = multiBalanceReport ropts (queryFromOpts d ropts) j
convert | value_ ropts = multiBalanceReportValue j valuedate
| otherwise = id
render = case format of
"csv" -> \ropts r -> (++ "\n") $ printCSV $ multiBalanceReportAsCsv ropts r
_ -> case baltype of
PeriodBalance -> periodBalanceReportAsText
CumulativeBalance -> cumulativeBalanceReportAsText
HistoricalBalance -> historicalBalanceReportAsText
writeOutput opts $ render ropts $ convert report
balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV
balanceReportAsCsv opts (items, total) =
["account","balance"] :
[[a, showMixedAmountWithoutPrice b] | ((a, _, _), b) <- items]
++
if no_total_ opts
then []
else [["total", showMixedAmountOneLineWithoutPrice total]]
balanceReportAsText :: ReportOpts -> BalanceReport -> String
balanceReportAsText opts ((items, total)) = unlines $ concat lines ++ t
where
fmt = lineFormatFromOpts opts
lines = case fmt of
Right fmt -> map (balanceReportItemAsText opts fmt) items
Left err -> [[err]]
t = if no_total_ opts
then []
else
case fmt of
Right fmt ->
let
acctcolwidth = maximum' [length fullname | ((fullname, _, _), _) <- items]
totallines = map rstrip $ renderBalanceReportItem fmt (replicate (acctcolwidth+1) ' ', 0, total)
overlinewidth | isJust (format_ opts) = maximum' $ map length $ concat lines
| otherwise = defaultTotalFieldWidth
overline = replicate overlinewidth '-'
in overline : totallines
Left _ -> []
tests_balanceReportAsText = [
"balanceReportAsText" ~: do
j <- readJournal'
"2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let opts = defreportopts
balanceReportAsText opts (balanceReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is`
unlines
[" -100 актив:наличные"
," 100 расходы:покупки"
,"--------------------"
," 0"
]
]
balanceReportItemAsText :: ReportOpts -> StringFormat -> BalanceReportItem -> [String]
balanceReportItemAsText opts fmt ((_, accountName, depth), amt) =
renderBalanceReportItem fmt (
maybeAccountNameDrop opts accountName,
depth,
normaliseMixedAmountSquashPricesForDisplay amt
)
renderBalanceReportItem :: StringFormat -> (AccountName, Int, MixedAmount) -> [String]
renderBalanceReportItem fmt (acctname, depth, total) =
lines $
case fmt of
OneLine comps -> concatOneLine $ render1 comps
TopAligned comps -> concatBottomPadded $ render comps
BottomAligned comps -> concatTopPadded $ render comps
where
render1 = map (renderComponent1 (acctname, depth, total))
render = map (renderComponent (acctname, depth, total))
defaultTotalFieldWidth = 20
renderComponent :: (AccountName, Int, MixedAmount) -> StringFormatComponent -> String
renderComponent _ (FormatLiteral s) = s
renderComponent (acctname, depth, total) (FormatField ljust min max field) = case field of
DepthSpacerField -> formatString ljust Nothing max $ replicate d ' '
where d = case min of
Just m -> depth * m
Nothing -> depth
AccountField -> formatString ljust min max acctname
TotalField -> fitStringMulti min max True False $ showMixedAmountWithoutPrice total
_ -> ""
renderComponent1 :: (AccountName, Int, MixedAmount) -> StringFormatComponent -> String
renderComponent1 _ (FormatLiteral s) = s
renderComponent1 (acctname, depth, total) (FormatField ljust min max field) = case field of
AccountField -> formatString ljust min max ((intercalate ", " . lines) (indented acctname))
where
indented = ((replicate (depth*2) ' ')++)
TotalField -> fitStringMulti min max True False $ ((intercalate ", " . map strip . lines) (showMixedAmountWithoutPrice total))
_ -> ""
multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV
multiBalanceReportAsCsv opts (MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
("account" : "short account" : "indent" : map showDateSpan colspans
++ (if row_total_ opts then ["total"] else [])
++ (if average_ opts then ["average"] else [])
) :
[a : a' : show i :
map showMixedAmountOneLineWithoutPrice
(amts
++ (if row_total_ opts then [rowtot] else [])
++ (if average_ opts then [rowavg] else []))
| ((a,a',i), amts, rowtot, rowavg) <- items]
++
if no_total_ opts
then []
else [["totals", "", ""]
++ map showMixedAmountOneLineWithoutPrice (
coltotals
++ (if row_total_ opts then [tot] else [])
++ (if average_ opts then [avg] else [])
)]
periodBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
periodBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
unlines $
([printf "Balance changes in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $
trimborder $ lines $
render id (" "++) showMixedAmountOneLineWithoutPrice $
addtotalrow $
Table
(T.Group NoLine $ map (Header . padRightWide acctswidth) accts)
(T.Group NoLine $ map Header colheadings)
(map rowvals items')
where
trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init)
colheadings = map showDateSpan colspans
++ (if row_total_ opts then [" Total"] else [])
++ (if average_ opts then ["Average"] else [])
items' | empty_ opts = items
| otherwise = items
accts = map renderacct items'
renderacct ((a,a',i),_,_,_)
| tree_ opts = replicate ((i1)*2) ' ' ++ a'
| otherwise = maybeAccountNameDrop opts a
acctswidth = maximum' $ map strWidth accts
rowvals (_,as,rowtot,rowavg) = as
++ (if row_total_ opts then [rowtot] else [])
++ (if average_ opts then [rowavg] else [])
addtotalrow | no_total_ opts = id
| otherwise = (+----+ (row "" $
coltotals
++ (if row_total_ opts then [tot] else [])
++ (if average_ opts then [avg] else [])
))
cumulativeBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
cumulativeBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
unlines $
([printf "Ending balances (cumulative) in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $
trimborder $ lines $
render id (" "++) showMixedAmountOneLineWithoutPrice $
addtotalrow $
Table
(T.Group NoLine $ map (Header . padRightWide acctswidth) accts)
(T.Group NoLine $ map Header colheadings)
(map rowvals items)
where
trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init)
colheadings = map (maybe "" (showDate . prevday) . spanEnd) colspans
++ (if row_total_ opts then [" Total"] else [])
++ (if average_ opts then ["Average"] else [])
accts = map renderacct items
renderacct ((a,a',i),_,_,_)
| tree_ opts = replicate ((i1)*2) ' ' ++ a'
| otherwise = maybeAccountNameDrop opts a
acctswidth = maximum' $ map strWidth accts
rowvals (_,as,rowtot,rowavg) = as
++ (if row_total_ opts then [rowtot] else [])
++ (if average_ opts then [rowavg] else [])
addtotalrow | no_total_ opts = id
| otherwise = (+----+ (row "" $
coltotals
++ (if row_total_ opts then [tot] else [])
++ (if average_ opts then [avg] else [])
))
historicalBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
historicalBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
unlines $
([printf "Ending balances (historical) in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $
trimborder $ lines $
render id (" "++) showMixedAmountOneLineWithoutPrice $
addtotalrow $
Table
(T.Group NoLine $ map (Header . padRightWide acctswidth) accts)
(T.Group NoLine $ map Header colheadings)
(map rowvals items)
where
trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init)
colheadings = map (maybe "" (showDate . prevday) . spanEnd) colspans
++ (if row_total_ opts then [" Total"] else [])
++ (if average_ opts then ["Average"] else [])
accts = map renderacct items
renderacct ((a,a',i),_,_,_)
| tree_ opts = replicate ((i1)*2) ' ' ++ a'
| otherwise = maybeAccountNameDrop opts a
acctswidth = maximum' $ map strWidth accts
rowvals (_,as,rowtot,rowavg) = as
++ (if row_total_ opts then [rowtot] else [])
++ (if average_ opts then [rowavg] else [])
addtotalrow | no_total_ opts = id
| otherwise = (+----+ (row "" $
coltotals
++ (if row_total_ opts then [tot] else [])
++ (if average_ opts then [avg] else [])
))
multiBalanceReportSpan :: MultiBalanceReport -> DateSpan
multiBalanceReportSpan (MultiBalanceReport ([], _, _)) = DateSpan Nothing Nothing
multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans)
tests_Hledger_Cli_Balance = TestList
tests_balanceReportAsText