mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
balance, print: add -o and CSV output here too
Not very elegant yet, but works.
This commit is contained in:
parent
2dc44cb131
commit
b6774f47a3
@ -73,10 +73,18 @@ ppShow = show
|
||||
lowercase = map toLower
|
||||
uppercase = map toUpper
|
||||
|
||||
-- | Remove leading and trailing whitespace.
|
||||
strip = lstrip . rstrip
|
||||
lstrip = dropWhile (`elem` " \t") :: String -> String
|
||||
|
||||
-- | Remove leading whitespace.
|
||||
lstrip = dropWhile (`elem` " \t") :: String -> String -- XXX isSpace ?
|
||||
|
||||
-- | Remove trailing whitespace.
|
||||
rstrip = reverse . lstrip . reverse
|
||||
|
||||
-- | Remove trailing newlines/carriage returns.
|
||||
chomp = reverse . dropWhile (`elem` "\r\n") . reverse
|
||||
|
||||
stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse :: String -> String
|
||||
|
||||
elideLeft width s =
|
||||
|
@ -16,7 +16,3 @@ numbered = zip [1..]
|
||||
dayToJsTimestamp :: Day -> Integer
|
||||
dayToJsTimestamp d = read (formatTime defaultTimeLocale "%s" t) * 1000 -- XXX read
|
||||
where t = UTCTime d (secondsToDiffTime 0)
|
||||
|
||||
chomp :: String -> String
|
||||
chomp = reverse . dropWhile (`elem` "\r\n") . reverse
|
||||
|
||||
|
@ -247,6 +247,8 @@ import Data.Maybe
|
||||
-- import System.Console.CmdArgs
|
||||
import System.Console.CmdArgs.Explicit as C
|
||||
-- import System.Console.CmdArgs.Text
|
||||
import System.FilePath
|
||||
import Text.CSV
|
||||
import Test.HUnit
|
||||
import Text.Printf (printf)
|
||||
import Text.Tabular as T
|
||||
@ -272,6 +274,7 @@ balancemode = (defCommandMode $ ["balance"] ++ aliases) { -- also accept but don
|
||||
,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total"
|
||||
,flagNone ["cumulative"] (\opts -> setboolopt "cumulative" opts) "multicolumn mode: show accumulated ending balances"
|
||||
,flagNone ["historical","H"] (\opts -> setboolopt "historical" opts) "multicolumn mode: show historical ending balances"
|
||||
,flagReq ["output","o"] (\s opts -> Right $ setopt "output" s opts) "[FILE][.FMT]" "write output to FILE (- or nothing means stdout). With a recognised FMT suffix, write that format (txt, csv)."
|
||||
]
|
||||
,groupHidden = []
|
||||
,groupNamed = [generalflagsgroup1]
|
||||
@ -281,20 +284,41 @@ balancemode = (defCommandMode $ ["balance"] ++ aliases) { -- also accept but don
|
||||
|
||||
-- | The balance command, prints a balance report.
|
||||
balance :: CliOpts -> Journal -> IO ()
|
||||
balance CliOpts{reportopts_=ropts} j = do
|
||||
balance opts@CliOpts{reportopts_=ropts} j = do
|
||||
d <- getCurrentDay
|
||||
let output =
|
||||
case lineFormatFromOpts ropts of
|
||||
Left err -> [err]
|
||||
Right _ ->
|
||||
case (intervalFromOpts ropts, balancetype_ ropts) of
|
||||
(NoInterval,_) -> balanceReportAsText ropts $ balanceReport ropts (queryFromOpts d ropts) j
|
||||
(_,PeriodBalance) -> periodBalanceReportAsText ropts $ multiBalanceReport ropts (queryFromOpts d ropts) j
|
||||
(_,CumulativeBalance) -> cumulativeBalanceReportAsText ropts $ multiBalanceReport ropts (queryFromOpts d ropts) j
|
||||
(_,HistoricalBalance) -> historicalBalanceReportAsText ropts $ multiBalanceReport ropts (queryFromOpts d ropts) j
|
||||
putStr $ unlines output
|
||||
Left err -> putStr $ unlines [err]
|
||||
Right _ -> do
|
||||
(path, ext) <- outputFilePathAndExtensionFromOpts opts
|
||||
let filename = fst $ splitExtension $ snd $ splitFileName path
|
||||
case intervalFromOpts ropts of
|
||||
|
||||
-- | Render an old-style single-column balance report as plain text.
|
||||
NoInterval -> do
|
||||
let render | ext=="csv" = \_ r -> printCSV (balanceReportAsCsv ropts r) ++ "\n"
|
||||
| otherwise = \ropts r -> unlines $ balanceReportAsText ropts r
|
||||
write | filename `elem` ["","-"] && ext `elem` ["","csv","txt"] = putStr
|
||||
| otherwise = writeFile path
|
||||
write $ render ropts $ balanceReport ropts (queryFromOpts d ropts) j
|
||||
|
||||
_ ->
|
||||
if ext=="csv"
|
||||
then error' "Sorry, CSV output with a report period is not supported yet"
|
||||
else do
|
||||
let render = case balancetype_ ropts of
|
||||
PeriodBalance -> periodBalanceReportAsText
|
||||
CumulativeBalance -> cumulativeBalanceReportAsText
|
||||
HistoricalBalance -> historicalBalanceReportAsText
|
||||
write | filename `elem` ["","-"] && ext `elem` ["","txt"] = putStr . unlines
|
||||
| otherwise = writeFile path . unlines
|
||||
write $ render ropts $ multiBalanceReport ropts (queryFromOpts d ropts) j
|
||||
|
||||
-- | Render a single-column balance report as CSV.
|
||||
balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV
|
||||
balanceReportAsCsv _ (items,_) =
|
||||
["account","balance"] :
|
||||
[[a, showMixedAmountWithoutPrice b] | ((a, _, _), b) <- items]
|
||||
|
||||
-- | Render a single-column balance report as plain text.
|
||||
balanceReportAsText :: ReportOpts -> BalanceReport -> [String]
|
||||
balanceReportAsText opts ((items, total)) = concat lines ++ t
|
||||
where
|
||||
@ -367,11 +391,6 @@ formatField opts accountName depth total ljust min max field = case field of
|
||||
TotalField -> formatValue ljust min max $ showAmountWithoutPrice total
|
||||
_ -> ""
|
||||
|
||||
-- | Figure out the overall date span of a multicolumn balance report.
|
||||
multiBalanceReportSpan :: MultiBalanceReport -> DateSpan
|
||||
multiBalanceReportSpan (MultiBalanceReport ([], _, _)) = DateSpan Nothing Nothing
|
||||
multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans)
|
||||
|
||||
-- | Render a multi-column period balance report as plain text suitable for console output.
|
||||
periodBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> [String]
|
||||
periodBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, coltotals)) =
|
||||
@ -441,6 +460,11 @@ historicalBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, colto
|
||||
addtotalrow | no_total_ opts = id
|
||||
| otherwise = (+----+ row "" coltotals)
|
||||
|
||||
-- | Figure out the overall date span of a multicolumn balance report.
|
||||
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
|
||||
|
@ -13,7 +13,9 @@ where
|
||||
|
||||
import Data.List
|
||||
import System.Console.CmdArgs.Explicit
|
||||
import System.FilePath
|
||||
import Test.HUnit
|
||||
import Text.CSV
|
||||
|
||||
import Hledger
|
||||
import Prelude hiding (putStr)
|
||||
@ -24,7 +26,9 @@ import Hledger.Cli.Options
|
||||
printmode = (defCommandMode $ ["print"] ++ aliases) {
|
||||
modeHelp = "show transaction entries" `withAliases` aliases
|
||||
,modeGroupFlags = Group {
|
||||
groupUnnamed = []
|
||||
groupUnnamed = [
|
||||
flagReq ["output","o"] (\s opts -> Right $ setopt "output" s opts) "[FILE][.FMT]" "write output to FILE (- or nothing means stdout). With a recognised FMT suffix, write that format (txt, csv)."
|
||||
]
|
||||
,groupHidden = []
|
||||
,groupNamed = [generalflagsgroup1]
|
||||
}
|
||||
@ -33,13 +37,20 @@ printmode = (defCommandMode $ ["print"] ++ aliases) {
|
||||
|
||||
-- | Print journal transactions in standard format.
|
||||
print' :: CliOpts -> Journal -> IO ()
|
||||
print' CliOpts{reportopts_=ropts} j = do
|
||||
print' opts@CliOpts{reportopts_=ropts} j = do
|
||||
d <- getCurrentDay
|
||||
let q = queryFromOpts d ropts
|
||||
putStr $ entriesReportAsText ropts q $ entriesReport ropts q j
|
||||
(path, ext) <- outputFilePathAndExtensionFromOpts opts
|
||||
let filename = fst $ splitExtension $ snd $ splitFileName path
|
||||
write | filename `elem` ["","-"] && ext `elem` ["","csv","txt"] = putStr
|
||||
| otherwise = writeFile path
|
||||
(render,ropts') | ext=="csv" = ((++"\n") . printCSV . entriesReportAsCsv, ropts{flat_=True})
|
||||
| otherwise = (entriesReportAsText, ropts)
|
||||
|
||||
entriesReportAsText :: ReportOpts -> Query -> EntriesReport -> String
|
||||
entriesReportAsText _ _ items = concatMap showTransactionUnelided items
|
||||
write $ render $ entriesReport ropts' q j
|
||||
|
||||
entriesReportAsText :: EntriesReport -> String
|
||||
entriesReportAsText items = concatMap showTransactionUnelided items
|
||||
|
||||
-- XXX
|
||||
-- tests_showTransactions = [
|
||||
@ -82,5 +93,39 @@ entriesReportAsText _ _ items = concatMap showTransactionUnelided items
|
||||
-- ]
|
||||
-- ]
|
||||
|
||||
entriesReportAsCsv :: EntriesReport -> CSV
|
||||
entriesReportAsCsv items =
|
||||
concat $
|
||||
([["nth","date","date2","status","code","description","comment","account","amount","commodity","credit","debit","status","posting-comment"]]:).snd $
|
||||
mapAccumL (\n e -> (n + 1, transactionToCSV n e)) 0 items
|
||||
|
||||
transactionToCSV :: Integer -> Transaction -> CSV
|
||||
transactionToCSV n t =
|
||||
map (\p -> show n:date:date2:status:code:description:comment:p)
|
||||
(concatMap postingToCSV $ tpostings t)
|
||||
where
|
||||
description = tdescription t
|
||||
date = showDate (tdate t)
|
||||
date2 = maybe "" showDate (tdate2 t)
|
||||
status = if tstatus t then "*" else ""
|
||||
code = tcode t
|
||||
comment = chomp $ strip $ tcomment t
|
||||
|
||||
postingToCSV :: Posting -> CSV
|
||||
postingToCSV p =
|
||||
map (\(a@(Amount {aquantity=q,acommodity=c})) ->
|
||||
let a_ = a{acommodity=""} in
|
||||
let amount = showAmount a_ in
|
||||
let commodity = c in
|
||||
let credit = if q < 0 then showAmount $ negate a_ else "" in
|
||||
let debit = if q > 0 then showAmount a_ else "" in
|
||||
account:amount:commodity:credit:debit:status:comment:[])
|
||||
amounts
|
||||
where
|
||||
Mixed amounts = pamount p
|
||||
status = if pstatus p then "*" else ""
|
||||
account = showAccountName Nothing (ptype p) (paccount p)
|
||||
comment = chomp $ strip $ pcomment p
|
||||
|
||||
tests_Hledger_Cli_Print = TestList []
|
||||
-- tests_showTransactions
|
||||
|
Loading…
Reference in New Issue
Block a user