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, |   aliasesFromOpts, | ||||||
|   journalFilePathFromOpts, |   journalFilePathFromOpts, | ||||||
|   rulesFilePathFromOpts, |   rulesFilePathFromOpts, | ||||||
|  |   outputFilePathAndExtensionFromOpts, | ||||||
|   -- | For register: |   -- | For register: | ||||||
|   OutputWidth(..), |   OutputWidth(..), | ||||||
|   Width(..), |   Width(..), | ||||||
| @ -55,6 +56,7 @@ module Hledger.Cli.Options ( | |||||||
| ) | ) | ||||||
| where | where | ||||||
| 
 | 
 | ||||||
|  | import Control.Applicative ((<$>)) | ||||||
| import qualified Control.Exception as C | import qualified Control.Exception as C | ||||||
| import Control.Monad (when) | import Control.Monad (when) | ||||||
| import Data.List | import Data.List | ||||||
| @ -235,6 +237,7 @@ data CliOpts = CliOpts { | |||||||
|     ,command_         :: String |     ,command_         :: String | ||||||
|     ,file_            :: Maybe FilePath |     ,file_            :: Maybe FilePath | ||||||
|     ,rules_file_      :: Maybe FilePath |     ,rules_file_      :: Maybe FilePath | ||||||
|  |     ,output_          :: Maybe FilePath | ||||||
|     ,alias_           :: [String] |     ,alias_           :: [String] | ||||||
|     ,ignore_assertions_ :: Bool |     ,ignore_assertions_ :: Bool | ||||||
|     ,debug_           :: Int            -- ^ debug level, set by @--debug[=N]@. See also 'Hledger.Utils.debugLevel'. |     ,debug_           :: Int            -- ^ debug level, set by @--debug[=N]@. See also 'Hledger.Utils.debugLevel'. | ||||||
| @ -257,6 +260,7 @@ defcliopts = CliOpts | |||||||
|     def |     def | ||||||
|     def |     def | ||||||
|     def |     def | ||||||
|  |     def | ||||||
| 
 | 
 | ||||||
| -- | Convert possibly encoded option values to regular unicode strings. | -- | Convert possibly encoded option values to regular unicode strings. | ||||||
| decodeRawOpts :: RawOpts -> RawOpts | decodeRawOpts :: RawOpts -> RawOpts | ||||||
| @ -273,6 +277,7 @@ rawOptsToCliOpts rawopts = do | |||||||
|              ,command_         = stringopt "command" rawopts |              ,command_         = stringopt "command" rawopts | ||||||
|              ,file_            = maybestringopt "file" rawopts |              ,file_            = maybestringopt "file" rawopts | ||||||
|              ,rules_file_      = maybestringopt "rules-file" rawopts |              ,rules_file_      = maybestringopt "rules-file" rawopts | ||||||
|  |              ,output_          = maybestringopt "output" rawopts | ||||||
|              ,alias_           = map stripquotes $ listofstringopt "alias" rawopts |              ,alias_           = map stripquotes $ listofstringopt "alias" rawopts | ||||||
|              ,debug_           = intopt "debug" rawopts |              ,debug_           = intopt "debug" rawopts | ||||||
|              ,ignore_assertions_ = boolopt "ignore-assertions" rawopts |              ,ignore_assertions_ = boolopt "ignore-assertions" rawopts | ||||||
| @ -341,6 +346,17 @@ journalFilePathFromOpts opts = do | |||||||
|   d <- getCurrentDirectory |   d <- getCurrentDirectory | ||||||
|   expandPath d $ fromMaybe f $ file_ opts |   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. | -- | Get the (tilde-expanded) rules file path from options, if any. | ||||||
| rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath) | rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath) | ||||||
| rulesFilePathFromOpts opts = do | rulesFilePathFromOpts opts = do | ||||||
|  | |||||||
| @ -15,6 +15,8 @@ module Hledger.Cli.Register ( | |||||||
| import Data.List | import Data.List | ||||||
| import Data.Maybe | import Data.Maybe | ||||||
| import System.Console.CmdArgs.Explicit | import System.Console.CmdArgs.Explicit | ||||||
|  | import System.FilePath | ||||||
|  | import Text.CSV | ||||||
| import Test.HUnit | import Test.HUnit | ||||||
| import Text.Printf | 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 ["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" |      ,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  ["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 = [] |     ,groupHidden = [] | ||||||
|     ,groupNamed = [generalflagsgroup1] |     ,groupNamed = [generalflagsgroup1] | ||||||
| @ -43,7 +46,35 @@ registermode = (defCommandMode $ ["register"] ++ aliases) { | |||||||
| register :: CliOpts -> Journal -> IO () | register :: CliOpts -> Journal -> IO () | ||||||
| register opts@CliOpts{reportopts_=ropts} j = do | register opts@CliOpts{reportopts_=ropts} j = do | ||||||
|   d <- getCurrentDay |   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. | -- | Render a register report as plain text suitable for console output. | ||||||
| postingsReportAsText :: CliOpts -> PostingsReport -> String | postingsReportAsText :: CliOpts -> PostingsReport -> String | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user