register: add -o/--output option, merge CSV functionality (cf #206)
This commit is contained in:
		
							parent
							
								
									301f506486
								
							
						
					
					
						commit
						d234663b6d
					
				| @ -1,59 +0,0 @@ | ||||
| #!/usr/bin/env runhaskell | ||||
| {-| | ||||
| hledger-register-csv [OPTIONS] [ARGS] | ||||
| 
 | ||||
| Show a register report as CSV. | ||||
| -} | ||||
| 
 | ||||
| module Main | ||||
| where | ||||
| 
 | ||||
| import Hledger.Cli | ||||
| import Text.CSV | ||||
| 
 | ||||
| 
 | ||||
| argsmode :: Mode RawOpts | ||||
| argsmode = (defCommandMode ["register-csv"]) { | ||||
|   modeHelp = "show matched postings and running total as CSV" | ||||
|  ,modeGroupFlags = Group { | ||||
|      groupUnnamed = [ -- copied from Register.hs: | ||||
|       flagNone ["historical","H"] (\opts -> setboolopt "historical" opts) "include prior postings in the running total" | ||||
|      ,flagNone ["average","A"] (\opts -> setboolopt "average" opts) "show a running average instead of the running total (implies --empty)" | ||||
|      ,flagNone ["related","r"] (\opts -> setboolopt "related" opts) "show postings' siblings instead" | ||||
|      ] | ||||
|     ,groupNamed = [ | ||||
|          ("Input",inputflags) | ||||
|         ,("Reporting",reportflags) | ||||
|         ,("Misc",helpflags) | ||||
|         ] | ||||
|     ,groupHidden = [] | ||||
|     } | ||||
|  } | ||||
| 
 | ||||
| main :: IO () | ||||
| main = do | ||||
|   opts <- getCliOpts argsmode | ||||
|   withJournalDo opts $ | ||||
|     \CliOpts{reportopts_=ropts} j -> do | ||||
|       d <- getCurrentDay | ||||
|       putStrLn $ printCSV $ postingsReportAsCsv $ postingsReport ropts (queryFromOpts d ropts) j | ||||
|      | ||||
| postingsReportAsCsv :: PostingsReport -> CSV | ||||
| postingsReportAsCsv (_,is) = | ||||
|   ["date","description","account","amount","running total or balance"] | ||||
|   : | ||||
|   map postingsReportItemAsCsvRecord is | ||||
| 
 | ||||
| postingsReportItemAsCsvRecord :: PostingsReportItem -> Record | ||||
| postingsReportItemAsCsvRecord (_, _, _, p, b) = [date,desc,acct,amt,bal] | ||||
|   where | ||||
|     date = showDate $ postingDate p | ||||
|     desc = maybe "" tdescription $ ptransaction p | ||||
|     acct = bracket $ paccount p | ||||
|       where | ||||
|         bracket = case ptype p of | ||||
|                              BalancedVirtualPosting -> (\s -> "["++s++"]") | ||||
|                              VirtualPosting -> (\s -> "("++s++")") | ||||
|                              _ -> id | ||||
|     amt = showMixedAmountOneLineWithoutPrice $ pamount p | ||||
|     bal = showMixedAmountOneLineWithoutPrice b | ||||
| @ -37,6 +37,7 @@ module Hledger.Cli.Options ( | ||||
|   aliasesFromOpts, | ||||
|   journalFilePathFromOpts, | ||||
|   rulesFilePathFromOpts, | ||||
|   outputFilePathAndExtensionFromOpts, | ||||
|   -- | For register: | ||||
|   OutputWidth(..), | ||||
|   Width(..), | ||||
| @ -55,6 +56,7 @@ module Hledger.Cli.Options ( | ||||
| ) | ||||
| where | ||||
| 
 | ||||
| import Control.Applicative ((<$>)) | ||||
| import qualified Control.Exception as C | ||||
| import Control.Monad (when) | ||||
| import Data.List | ||||
| @ -235,6 +237,7 @@ data CliOpts = CliOpts { | ||||
|     ,command_         :: String | ||||
|     ,file_            :: Maybe FilePath | ||||
|     ,rules_file_      :: Maybe FilePath | ||||
|     ,output_          :: Maybe FilePath | ||||
|     ,alias_           :: [String] | ||||
|     ,ignore_assertions_ :: Bool | ||||
|     ,debug_           :: Int            -- ^ debug level, set by @--debug[=N]@. See also 'Hledger.Utils.debugLevel'. | ||||
| @ -257,6 +260,7 @@ defcliopts = CliOpts | ||||
|     def | ||||
|     def | ||||
|     def | ||||
|     def | ||||
| 
 | ||||
| -- | Convert possibly encoded option values to regular unicode strings. | ||||
| decodeRawOpts :: RawOpts -> RawOpts | ||||
| @ -273,6 +277,7 @@ rawOptsToCliOpts rawopts = do | ||||
|              ,command_         = stringopt "command" rawopts | ||||
|              ,file_            = maybestringopt "file" rawopts | ||||
|              ,rules_file_      = maybestringopt "rules-file" rawopts | ||||
|              ,output_          = maybestringopt "output" rawopts | ||||
|              ,alias_           = map stripquotes $ listofstringopt "alias" rawopts | ||||
|              ,debug_           = intopt "debug" rawopts | ||||
|              ,ignore_assertions_ = boolopt "ignore-assertions" rawopts | ||||
| @ -341,6 +346,17 @@ journalFilePathFromOpts opts = do | ||||
|   d <- getCurrentDirectory | ||||
|   expandPath d $ fromMaybe f $ file_ opts | ||||
| 
 | ||||
| 
 | ||||
| -- | Get the (tilde-expanded, absolute) output file path and file | ||||
| -- extension (without the dot) from options, or the defaults ("-",""). | ||||
| outputFilePathAndExtensionFromOpts :: CliOpts -> IO (String, String) | ||||
| outputFilePathAndExtensionFromOpts opts = do | ||||
|   d <- getCurrentDirectory | ||||
|   p <- expandPath d <$> fromMaybe "-" $ output_ opts | ||||
|   let (_,ext) = splitExtension p | ||||
|       ext' = dropWhile (=='.') ext | ||||
|   return (p,ext') | ||||
| 
 | ||||
| -- | Get the (tilde-expanded) rules file path from options, if any. | ||||
| rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath) | ||||
| rulesFilePathFromOpts opts = do | ||||
|  | ||||
| @ -15,6 +15,8 @@ module Hledger.Cli.Register ( | ||||
| import Data.List | ||||
| import Data.Maybe | ||||
| import System.Console.CmdArgs.Explicit | ||||
| import System.FilePath | ||||
| import Text.CSV | ||||
| import Test.HUnit | ||||
| import Text.Printf | ||||
| 
 | ||||
| @ -32,6 +34,7 @@ registermode = (defCommandMode $ ["register"] ++ aliases) { | ||||
|      ,flagNone ["average","A"] (\opts -> setboolopt "average" opts) "show a running average instead of the running total (implies --empty)" | ||||
|      ,flagNone ["related","r"] (\opts -> setboolopt "related" opts) "show postings' siblings instead" | ||||
|      ,flagReq  ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N" "set output width (default: 80)" | ||||
|      ,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] | ||||
| @ -43,7 +46,35 @@ registermode = (defCommandMode $ ["register"] ++ aliases) { | ||||
| register :: CliOpts -> Journal -> IO () | ||||
| register opts@CliOpts{reportopts_=ropts} j = do | ||||
|   d <- getCurrentDay | ||||
|   putStr $ postingsReportAsText opts $ postingsReport ropts (queryFromOpts d ropts) j | ||||
|   let r = postingsReport ropts (queryFromOpts d ropts) j | ||||
| 
 | ||||
|   (path, ext) <- outputFilePathAndExtensionFromOpts opts | ||||
|   let filename = fst $ splitExtension $ snd $ splitFileName path | ||||
|       write  | filename `elem` ["","-"] && ext `elem` ["","csv","txt"] = putStr | ||||
|              | otherwise                                               = writeFile path | ||||
|       render | ext=="csv" = \_ r -> (printCSV . postingsReportAsCsv) r | ||||
|              | otherwise  = postingsReportAsText | ||||
|   write $ render opts r | ||||
| 
 | ||||
| postingsReportAsCsv :: PostingsReport -> CSV | ||||
| postingsReportAsCsv (_,is) = | ||||
|   ["date","description","account","amount","running total or balance"] | ||||
|   : | ||||
|   map postingsReportItemAsCsvRecord is | ||||
| 
 | ||||
| postingsReportItemAsCsvRecord :: PostingsReportItem -> Record | ||||
| postingsReportItemAsCsvRecord (_, _, _, p, b) = [date,desc,acct,amt,bal] | ||||
|   where | ||||
|     date = showDate $ postingDate p | ||||
|     desc = maybe "" tdescription $ ptransaction p | ||||
|     acct = bracket $ paccount p | ||||
|       where | ||||
|         bracket = case ptype p of | ||||
|                              BalancedVirtualPosting -> (\s -> "["++s++"]") | ||||
|                              VirtualPosting -> (\s -> "("++s++")") | ||||
|                              _ -> id | ||||
|     amt = showMixedAmountOneLineWithoutPrice $ pamount p | ||||
|     bal = showMixedAmountOneLineWithoutPrice b | ||||
| 
 | ||||
| -- | Render a register report as plain text suitable for console output. | ||||
| postingsReportAsText :: CliOpts -> PostingsReport -> String | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user