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