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 | lowercase = map toLower | ||||||
| uppercase = map toUpper | uppercase = map toUpper | ||||||
| 
 | 
 | ||||||
|  | -- | Remove leading and trailing whitespace. | ||||||
| strip = lstrip . rstrip | 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 | 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 | stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse :: String -> String | ||||||
| 
 | 
 | ||||||
| elideLeft width s = | elideLeft width s = | ||||||
|  | |||||||
| @ -16,7 +16,3 @@ numbered = zip [1..] | |||||||
| dayToJsTimestamp :: Day -> Integer | dayToJsTimestamp :: Day -> Integer | ||||||
| dayToJsTimestamp d = read (formatTime defaultTimeLocale "%s" t) * 1000 -- XXX read | dayToJsTimestamp d = read (formatTime defaultTimeLocale "%s" t) * 1000 -- XXX read | ||||||
|                      where t = UTCTime d (secondsToDiffTime 0) |                      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 | ||||||
| import System.Console.CmdArgs.Explicit as C | import System.Console.CmdArgs.Explicit as C | ||||||
| -- import System.Console.CmdArgs.Text | -- import System.Console.CmdArgs.Text | ||||||
|  | import System.FilePath | ||||||
|  | import Text.CSV | ||||||
| import Test.HUnit | import Test.HUnit | ||||||
| import Text.Printf (printf) | import Text.Printf (printf) | ||||||
| import Text.Tabular as T | 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 ["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 ["cumulative"] (\opts -> setboolopt "cumulative" opts) "multicolumn mode: show accumulated ending balances" | ||||||
|      ,flagNone ["historical","H"] (\opts -> setboolopt "historical" opts) "multicolumn mode: show historical 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 = [] |     ,groupHidden = [] | ||||||
|     ,groupNamed = [generalflagsgroup1] |     ,groupNamed = [generalflagsgroup1] | ||||||
| @ -281,20 +284,41 @@ balancemode = (defCommandMode $ ["balance"] ++ aliases) { -- also accept but don | |||||||
| 
 | 
 | ||||||
| -- | The balance command, prints a balance report. | -- | The balance command, prints a balance report. | ||||||
| balance :: CliOpts -> Journal -> IO () | balance :: CliOpts -> Journal -> IO () | ||||||
| balance CliOpts{reportopts_=ropts} j = do | balance opts@CliOpts{reportopts_=ropts} j = do | ||||||
|   d <- getCurrentDay |   d <- getCurrentDay | ||||||
|   let output = |   case lineFormatFromOpts ropts of | ||||||
|        case lineFormatFromOpts ropts of |     Left err -> putStr $ unlines [err] | ||||||
|          Left err -> [err] |     Right _ -> do | ||||||
|          Right _ -> |       (path, ext) <- outputFilePathAndExtensionFromOpts opts | ||||||
|           case (intervalFromOpts ropts, balancetype_ ropts) of |       let filename = fst $ splitExtension $ snd $ splitFileName path | ||||||
|             (NoInterval,_)        -> balanceReportAsText           ropts  $ balanceReport ropts (queryFromOpts d ropts) j |       case intervalFromOpts ropts of | ||||||
|             (_,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 |  | ||||||
| 
 | 
 | ||||||
| -- | 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 :: ReportOpts -> BalanceReport -> [String] | ||||||
| balanceReportAsText opts ((items, total)) = concat lines ++ t | balanceReportAsText opts ((items, total)) = concat lines ++ t | ||||||
|   where |   where | ||||||
| @ -367,11 +391,6 @@ formatField opts accountName depth total ljust min max field = case field of | |||||||
|         TotalField       -> formatValue ljust min max $ showAmountWithoutPrice total |         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. | -- | Render a multi-column period balance report as plain text suitable for console output. | ||||||
| periodBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> [String] | periodBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> [String] | ||||||
| periodBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, coltotals)) = | periodBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, coltotals)) = | ||||||
| @ -441,6 +460,11 @@ historicalBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, colto | |||||||
|     addtotalrow | no_total_ opts = id |     addtotalrow | no_total_ opts = id | ||||||
|                 | otherwise      = (+----+ row "" coltotals) |                 | 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_Hledger_Cli_Balance = TestList | ||||||
|   tests_balanceReportAsText |   tests_balanceReportAsText | ||||||
|  | |||||||
| @ -13,7 +13,9 @@ where | |||||||
| 
 | 
 | ||||||
| import Data.List | import Data.List | ||||||
| import System.Console.CmdArgs.Explicit | import System.Console.CmdArgs.Explicit | ||||||
|  | import System.FilePath | ||||||
| import Test.HUnit | import Test.HUnit | ||||||
|  | import Text.CSV | ||||||
| 
 | 
 | ||||||
| import Hledger | import Hledger | ||||||
| import Prelude hiding (putStr) | import Prelude hiding (putStr) | ||||||
| @ -24,7 +26,9 @@ import Hledger.Cli.Options | |||||||
| printmode = (defCommandMode $ ["print"] ++ aliases) { | printmode = (defCommandMode $ ["print"] ++ aliases) { | ||||||
|   modeHelp = "show transaction entries" `withAliases` aliases |   modeHelp = "show transaction entries" `withAliases` aliases | ||||||
|  ,modeGroupFlags = Group { |  ,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 = [] |     ,groupHidden = [] | ||||||
|     ,groupNamed = [generalflagsgroup1] |     ,groupNamed = [generalflagsgroup1] | ||||||
|     } |     } | ||||||
| @ -33,13 +37,20 @@ printmode = (defCommandMode $ ["print"] ++ aliases) { | |||||||
| 
 | 
 | ||||||
| -- | Print journal transactions in standard format. | -- | Print journal transactions in standard format. | ||||||
| print' :: CliOpts -> Journal -> IO () | print' :: CliOpts -> Journal -> IO () | ||||||
| print' CliOpts{reportopts_=ropts} j = do | print' opts@CliOpts{reportopts_=ropts} j = do | ||||||
|   d <- getCurrentDay |   d <- getCurrentDay | ||||||
|   let q = queryFromOpts d ropts |   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 |   write $ render $ entriesReport ropts' q j | ||||||
| entriesReportAsText _ _ items = concatMap showTransactionUnelided items | 
 | ||||||
|  | entriesReportAsText :: EntriesReport -> String | ||||||
|  | entriesReportAsText items = concatMap showTransactionUnelided items | ||||||
| 
 | 
 | ||||||
| -- XXX | -- XXX | ||||||
| -- tests_showTransactions = [ | -- 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_Hledger_Cli_Print = TestList [] | ||||||
|   -- tests_showTransactions |   -- tests_showTransactions | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user