diff --git a/extra/hledger-register-csv.hs b/extra/hledger-register-csv.hs deleted file mode 100755 index 568d9a8fc..000000000 --- a/extra/hledger-register-csv.hs +++ /dev/null @@ -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 diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs index ed1dbe063..4ffb37629 100644 --- a/hledger/Hledger/Cli/Options.hs +++ b/hledger/Hledger/Cli/Options.hs @@ -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 diff --git a/hledger/Hledger/Cli/Register.hs b/hledger/Hledger/Cli/Register.hs index c10caea09..31467bb9a 100644 --- a/hledger/Hledger/Cli/Register.hs +++ b/hledger/Hledger/Cli/Register.hs @@ -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