From 552a15a1bac0c61be22df01c1825572956b8ca69 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 21 Dec 2012 21:56:11 +0000 Subject: [PATCH] reg: --width/-w option to adjust register overall output width --- MANUAL.md | 5 +++ hledger-lib/Hledger/Data/Posting.hs | 15 ------- hledger/Hledger/Cli/Add.hs | 6 ++- hledger/Hledger/Cli/Options.hs | 49 ++++++++++++++++++++--- hledger/Hledger/Cli/Register.hs | 62 +++++++++++++++++++---------- 5 files changed, 92 insertions(+), 45 deletions(-) diff --git a/MANUAL.md b/MANUAL.md index cce42bb7b..3be724a9f 100644 --- a/MANUAL.md +++ b/MANUAL.md @@ -755,6 +755,11 @@ summary postings within each interval: $ hledger register --monthly rent $ hledger register --monthly -E food --depth 4 +The `--width`/`-w` option adjusts the width of the output. By default, +this is 80 characters. To allow more space for descriptions and account +names, use `-w` to increase the width to 120 characters, or `-wN` to set +any desired width (at least 50 recommended). + #### balance The balance command displays accounts and their balances, indented to show the account hierarchy. diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index e0fe1582e..a365185cb 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -38,7 +38,6 @@ module Hledger.Data.Posting ( sumPostings, -- * rendering showPosting, - showPostingForRegister, -- * misc. showComment, tests_Hledger_Data_Posting @@ -95,20 +94,6 @@ showPosting p@Posting{paccount=a,pamount=amt,ptype=t} = showComment :: String -> String showComment s = if null s then "" else " ;" ++ s --- XXX refactor -showPostingForRegister :: Posting -> String -showPostingForRegister (Posting{paccount=a,pamount=amt,ptype=t}) = - concatTopPadded [showaccountname a ++ " ", showamount amt] - where - ledger3ishlayout = False - acctnamewidth = if ledger3ishlayout then 25 else 22 - showaccountname = printf ("%-"++(show acctnamewidth)++"s") . bracket . elideAccountName width - (bracket,width) = case t of - BalancedVirtualPosting -> (\s -> "["++s++"]", acctnamewidth-2) - VirtualPosting -> (\s -> "("++s++")", acctnamewidth-2) - _ -> (id,acctnamewidth) - showamount = padleft 12 . showMixedAmountWithoutPrice - isReal :: Posting -> Bool isReal p = ptype p == RegularPosting diff --git a/hledger/Hledger/Cli/Add.hs b/hledger/Hledger/Cli/Add.hs index a55a12a12..dec3ab242 100644 --- a/hledger/Hledger/Cli/Add.hs +++ b/hledger/Hledger/Cli/Add.hs @@ -223,8 +223,10 @@ registerFromString :: String -> IO String registerFromString s = do d <- getCurrentDay j <- readJournal' s - return $ postingsReportAsText opts $ postingsReport opts (queryFromOpts d opts) j - where opts = defreportopts{empty_=True} + return $ postingsReportAsText opts $ postingsReport ropts (queryFromOpts d ropts) j + where + ropts = defreportopts{empty_=True} + opts = defcliopts{reportopts_=ropts} -- | Return a similarity measure, from 0 to 1, for two strings. -- This is Simon White's letter pairs algorithm from diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs index b64019a86..82d9ce26c 100644 --- a/hledger/Hledger/Cli/Options.hs +++ b/hledger/Hledger/Cli/Options.hs @@ -7,7 +7,7 @@ Command-line options for the hledger program, and option-parsing utilities. module Hledger.Cli.Options where -import Control.Exception as C +import qualified Control.Exception as C import Data.List import Data.List.Split import Data.Maybe @@ -19,7 +19,7 @@ import System.Console.CmdArgs.Text import System.Directory import System.Environment import Test.HUnit -import Text.ParserCombinators.Parsec +import Text.ParserCombinators.Parsec as P import Text.Printf import Hledger @@ -189,7 +189,7 @@ accountsmode = (commandmode ["balance","bal","accounts"]) { ,modeGroupFlags = Group { groupUnnamed = [ flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show full account names, unindented" - ,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components" + ,flagReq ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components" ,flagReq ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format" ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "no eliding at all, stronger than --empty" ,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total" @@ -213,7 +213,9 @@ postingsmode = (commandmode ["register","postings"]) { modeHelp = "(or postings) show matched postings and running total" ,modeArgs = ([], Just commandargsflag) ,modeGroupFlags = Group { - groupUnnamed = [] + groupUnnamed = [ + flagOpt (show defaultWidthWithFlag) ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N" "increase or set the output width (default: 80)" + ] ,groupHidden = [] ,groupNamed = [(generalflagstitle, generalflags1)] } @@ -293,6 +295,7 @@ data CliOpts = CliOpts { ,alias_ :: [String] ,debug_ :: Bool ,no_new_accounts_ :: Bool -- add + ,width_ :: Maybe String -- register ,reportopts_ :: ReportOpts } deriving (Show) @@ -305,6 +308,7 @@ defcliopts = CliOpts def def def + def instance Default CliOpts where def = defcliopts @@ -322,6 +326,7 @@ toCliOpts rawopts = do ,alias_ = map stripquotes $ listofstringopt "alias" rawopts ,debug_ = boolopt "debug" rawopts ,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add + ,width_ = maybestringopt "width" rawopts -- register ,reportopts_ = defreportopts { begin_ = maybesmartdateopt d "begin" rawopts ,end_ = maybesmartdateopt d "end" rawopts @@ -441,10 +446,13 @@ checkCliOpts opts@CliOpts{reportopts_=ropts} = do case formatFromOpts ropts of Left err -> optserror $ "could not parse format option: "++err Right _ -> return () + case widthFromOpts opts of + Left err -> optserror $ "could not parse width option: "++err + Right _ -> return () return opts --- | Parse any format option provided, possibly raising an error, or get --- the default value. +-- | Parse the format option if provided, possibly returning an error, +-- otherwise get the default value. formatFromOpts :: ReportOpts -> Either String [FormatString] formatFromOpts = maybe (Right defaultBalanceFormatString) parseFormatString . format_ @@ -457,6 +465,35 @@ defaultBalanceFormatString = [ , FormatField True Nothing Nothing AccountField ] +data OutputWidth = TotalWidth Width | FieldWidths [Width] deriving Show +data Width = Width Int | Auto deriving Show + +defaultWidth = 80 +defaultWidthWithFlag = 120 + +-- | Parse the width option if provided, possibly returning an error, +-- otherwise get the default value. +widthFromOpts :: CliOpts -> Either String OutputWidth +widthFromOpts CliOpts{width_=Nothing} = Right $ TotalWidth $ Width defaultWidth +widthFromOpts CliOpts{width_=Just ""} = Right $ TotalWidth $ Width defaultWidthWithFlag +widthFromOpts CliOpts{width_=Just s} = parseWidth s + +parseWidth :: String -> Either String OutputWidth +parseWidth s = case (runParser outputwidth () "(unknown)") s of + Left e -> Left $ show e + Right x -> Right x + +outputwidth :: GenParser Char st OutputWidth +outputwidth = + try (do w <- width + ws <- many1 (char ',' >> width) + return $ FieldWidths $ w:ws) + <|> TotalWidth `fmap` width + +width :: GenParser Char st Width +width = (string "auto" >> return Auto) + <|> (Width . read) `fmap` many1 digit + -- | Get the (tilde-expanded, absolute) journal file path from options, an environment variable, or a default. journalFilePathFromOpts :: CliOpts -> IO String journalFilePathFromOpts opts = do diff --git a/hledger/Hledger/Cli/Register.hs b/hledger/Hledger/Cli/Register.hs index 3fde73dca..0f7e97182 100644 --- a/hledger/Hledger/Cli/Register.hs +++ b/hledger/Hledger/Cli/Register.hs @@ -24,12 +24,12 @@ import Hledger.Cli.Options -- | Print a (posting) register report. register :: CliOpts -> Journal -> IO () -register CliOpts{reportopts_=ropts} j = do +register opts@CliOpts{reportopts_=ropts} j = do d <- getCurrentDay - putStr $ postingsReportAsText ropts $ postingsReport ropts (queryFromOpts d ropts) j + putStr $ postingsReportAsText opts $ postingsReport ropts (queryFromOpts d ropts) j -- | Render a register report as plain text suitable for console output. -postingsReportAsText :: ReportOpts -> PostingsReport -> String +postingsReportAsText :: CliOpts -> PostingsReport -> String postingsReportAsText opts = unlines . map (postingsReportItemAsText opts) . snd tests_postingsReportAsText = [ @@ -38,32 +38,50 @@ tests_postingsReportAsText = [ j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" let opts = defreportopts - (postingsReportAsText opts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is` unlines + (postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is` unlines ["2009/01/01 медвежья шкура расходы:покупки 100 100" ," актив:наличные -100 0"] ] --- | Render one register report line item as plain text. Eg: +-- | Render one register report line item as plain text. Layout is like so: -- @ --- date (10) description (20) account (22) amount (11) balance (12) --- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA --- ^ displayed for first postings^ --- only, otherwise blank +-- <----------------------------- width (default: 80) -----------------------------> +-- date (10) description (50%) account (50%) amount (12) balance (12) +-- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaa AAAAAAAAAAAA AAAAAAAAAAAA +-- +-- date and description are shown for the first posting of a transaction only. -- @ -postingsReportItemAsText :: ReportOpts -> PostingsReportItem -> String -postingsReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr, " ", bal] +postingsReportItemAsText :: CliOpts -> PostingsReportItem -> String +postingsReportItemAsText opts (dd, p, b) = + concatTopPadded [date, " ", desc, " ", acct, " ", amt, " ", bal] where - datedesc = case dd of Nothing -> replicate datedescwidth ' ' - Just (da, de) -> printf "%s %s " date desc - where - date = showDate da - desc = printf ("%-"++(show descwidth)++"s") $ elideRight descwidth de :: String - where - descwidth = datedescwidth - datewidth - 2 - datedescwidth = 32 - datewidth = 10 - pstr = showPostingForRegister p - bal = padleft 12 (showMixedAmountWithoutPrice b) + totalwidth = case widthFromOpts opts of + Left _ -> defaultWidth -- shouldn't happen + Right (TotalWidth (Width w)) -> w + Right (TotalWidth Auto) -> defaultWidth -- XXX + Right (FieldWidths _) -> defaultWidth -- XXX + datewidth = 10 + amtwidth = 12 + balwidth = 12 + remaining = totalwidth - (datewidth + 2 + 2 + amtwidth + 2 + balwidth) + (descwidth, acctwidth) | even r = (r', r') + | otherwise = (r', r'+1) + where r = remaining - 2 + r' = r `div` 2 + (date, desc) = case dd of + Just (da, de) -> (printf ("%-"++show datewidth++"s") (showDate da) + ,printf ("%-"++show descwidth++"s") (take descwidth $ elideRight descwidth de :: String) + ) + Nothing -> (replicate datewidth ' ', replicate descwidth ' ') + acct = printf ("%-"++(show acctwidth)++"s") a + where + a = bracket $ elideAccountName awidth $ paccount p + (bracket, awidth) = case ptype p of + BalancedVirtualPosting -> (\s -> "["++s++"]", acctwidth-2) + VirtualPosting -> (\s -> "("++s++")", acctwidth-2) + _ -> (id,acctwidth) + amt = padleft amtwidth $ showMixedAmountWithoutPrice $ pamount p + bal = padleft balwidth $ showMixedAmountWithoutPrice b -- XXX -- showPostingWithBalanceForVty showtxninfo p b = postingsReportItemAsText defreportopts $ mkpostingsReportItem showtxninfo p b