From 372a2d768b1aedcf9f87a54d5ba74b6c784e74b9 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 19 Jan 2015 13:48:37 -0800 Subject: [PATCH] register: use full width, column widths, cleanup Refactored and enhanced the --width option used by register (and other commands in future). register now uses the full terminal width by default except on windows. Specifically, the output width is set from: 1. a --width option 2. or a COLUMNS environment variable (NB: not the same as a bash shell var) 3. or on POSIX (non-windows) systems, the current terminal width 4. or the default, 80 characters. Also, register now accepts a description column width as part of --width's argument, comma-separated (--width W,D). This adjusts the relative widths of register's description and account columns, which are normally about half of (W-40): <--------------------------------- width (W) ----------------------------------> date (10) description (D) account (W-41-D) amount (12) balance (12) DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaa AAAAAAAAAAAA AAAAAAAAAAAA Examples: $ hledger reg # use terminal width on posix $ hledger reg -w 100 # width 100, equal description/account widths $ hledger reg -w 100,40 # width 100, wider description $ hledger reg -w $COLUMNS,100 # terminal width and set description width --- Makefile | 2 +- hledger/Hledger/Cli/Options.hs | 133 +++++++++++++++++--------------- hledger/Hledger/Cli/Register.hs | 35 +++++---- 3 files changed, 93 insertions(+), 77 deletions(-) diff --git a/Makefile b/Makefile index ebcc695be..375a2b101 100644 --- a/Makefile +++ b/Makefile @@ -474,7 +474,7 @@ unittest-interpreted: # 16 threads sometimes gives "commitAndReleaseBuffer: resource vanished (Broken pipe)" here but seems harmless functest: bin/hledgerdev tests/addons/hledger-addon @echo functional tests: - @($(SHELLTEST) --execdir tests -- --threads=16 --hide-successes \ + @(COLUMNS=80 $(SHELLTEST) --execdir tests --threads=16 \ && echo $@ PASSED) || echo $@ FAILED # generate dummy add-ons for testing (hledger-addon the rest) diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs index b7a4d5ca5..dd039dd60 100644 --- a/hledger/Hledger/Cli/Options.hs +++ b/hledger/Hledger/Cli/Options.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts #-} {-| Common cmdargs modes and flags, a command-line options type, and @@ -43,12 +42,10 @@ module Hledger.Cli.Options ( rulesFilePathFromOpts, outputFileFromOpts, outputFormatFromOpts, - -- | For register: - OutputWidth(..), - Width(..), defaultWidth, - defaultWidthWithFlag, widthFromOpts, + -- | For register: + registerWidthsFromOpts, maybeAccountNameDrop, -- | For balance: lineFormatFromOpts, @@ -71,6 +68,9 @@ import Safe import System.Console.CmdArgs import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Text +#ifndef mingw32_HOST_OS +import System.Console.Terminfo +#endif import System.Directory import System.Environment import System.Exit (exitSuccess) @@ -255,7 +255,11 @@ data CliOpts = CliOpts { ,ignore_assertions_ :: Bool ,debug_ :: Int -- ^ debug level, set by @--debug[=N]@. See also 'Hledger.Utils.debugLevel'. ,no_new_accounts_ :: Bool -- add - ,width_ :: Maybe String -- register + ,width_ :: Maybe String -- ^ the --width value provided, if any + ,available_width_ :: Int -- ^ estimated usable screen width, based on + -- 1. the COLUMNS env var, if set + -- 2. the width reported by the terminal, if supported + -- 3. the default (80) ,reportopts_ :: ReportOpts } deriving (Show, Data, Typeable) @@ -274,18 +278,33 @@ defcliopts = CliOpts def def def + defaultWidth def -- | Convert possibly encoded option values to regular unicode strings. decodeRawOpts :: RawOpts -> RawOpts decodeRawOpts = map (\(name',val) -> (name', fromSystemString val)) +-- | Default width for hledger console output, when not otherwise specified. +defaultWidth :: Int +defaultWidth = 80 + -- | Parse raw option string values to the desired final data types. -- Any relative smart dates will be converted to fixed dates based on -- today's date. Parsing failures will raise an error. +-- Also records the terminal width, if supported. rawOptsToCliOpts :: RawOpts -> IO CliOpts rawOptsToCliOpts rawopts = do ropts <- rawOptsToReportOpts rawopts + mcolumns <- readMay <$> getEnvSafe "COLUMNS" + mtermwidth <- +#ifdef mingw32_HOST_OS + return Nothing +#else + setupTermFromEnv >>= return . flip getCapability termColumns + -- XXX Throws a SetupTermError if the terminfo database could not be read, should catch +#endif + let availablewidth = head $ catMaybes [mcolumns, mtermwidth, Just defaultWidth] return defcliopts { rawopts_ = rawopts ,command_ = stringopt "command" rawopts @@ -297,7 +316,8 @@ rawOptsToCliOpts rawopts = do ,debug_ = intopt "debug" rawopts ,ignore_assertions_ = boolopt "ignore-assertions" rawopts ,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add - ,width_ = maybestringopt "width" rawopts -- register + ,width_ = maybestringopt "width" rawopts + ,available_width_ = availablewidth ,reportopts_ = ropts } @@ -307,9 +327,7 @@ checkCliOpts opts@CliOpts{reportopts_=ropts} = do case lineFormatFromOpts 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 () + -- XXX check registerWidthsFromOpts opts return opts -- Currently only used by some extras/ scripts: @@ -405,6 +423,47 @@ rulesFilePathFromOpts opts = do d <- getCurrentDirectory maybe (return Nothing) (fmap Just . expandPath d) $ rules_file_ opts +-- | Get the width in characters to use for console output. +-- This comes from the --width option, or the COLUMNS environment +-- variable, or (on posix platforms) the current terminal width, or 80. +-- Will raise a parse error for a malformed --width argument. +widthFromOpts :: CliOpts -> Int +widthFromOpts CliOpts{width_=Nothing, available_width_=w} = w +widthFromOpts CliOpts{width_=Just s} = + case runParser (read `fmap` many1 digit <* eof) () "(unknown)" s of + Left e -> optserror $ "could not parse width option: "++show e + Right w -> w + +-- for register: + +-- | Get the width in characters to use for the register command's console output, +-- and also the description column width if specified (following the main width, comma-separated). +-- The widths will be as follows: +-- @ +-- no --width flag - overall width is the available width (COLUMNS, or posix terminal width, or 80); description width is unspecified (auto) +-- --width W - overall width is W, description width is auto +-- --width W,D - overall width is W, description width is D +-- @ +-- Will raise a parse error for a malformed --width argument. +registerWidthsFromOpts :: CliOpts -> (Int, Maybe Int) +registerWidthsFromOpts CliOpts{width_=Nothing, available_width_=w} = (w, Nothing) +registerWidthsFromOpts CliOpts{width_=Just s} = + case runParser registerwidthp () "(unknown)" s of + Left e -> optserror $ "could not parse width option: "++show e + Right ws -> ws + where + registerwidthp :: Stream [Char] m t => ParsecT [Char] st m (Int, Maybe Int) + registerwidthp = do + totalwidth <- read `fmap` many1 digit + descwidth <- optionMaybe (char ',' >> read `fmap` many1 digit) + eof + return (totalwidth, descwidth) + +-- | Drop leading components of accounts names as specified by --drop, but only in --flat mode. +maybeAccountNameDrop :: ReportOpts -> AccountName -> AccountName +maybeAccountNameDrop opts a | tree_ opts = a + | otherwise = accountNameDrop (drop_ opts) a + -- for balance, currently: -- | Parse the format option if provided, possibly returning an error, @@ -421,56 +480,6 @@ defaultBalanceLineFormat = [ , FormatField True Nothing Nothing AccountField ] --- for register: - --- | Output width configuration (for register). -data OutputWidth = - TotalWidth Width -- ^ specify the overall width - | FieldWidths [Width] -- ^ specify each field's width - deriving Show - --- | A width value. -data Width = - Width Int -- ^ set width to exactly this number of characters - | Auto -- ^ set width automatically from available space - deriving Show - --- | Default width of hledger console output. -defaultWidth :: Int -defaultWidth = 80 - --- | Width of hledger console output when the -w flag is used with no value. -defaultWidthWithFlag :: Int -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 (outputwidthp <* eof) () "(unknown)") s of - Left e -> Left $ show e - Right x -> Right x - -outputwidthp :: Stream [Char] m t => ParsecT [Char] st m OutputWidth -outputwidthp = - try (do w <- widthp - ws <- many1 (char ',' >> widthp) - return $ FieldWidths $ w:ws) - <|> TotalWidth `fmap` widthp - -widthp :: Stream [Char] m t => ParsecT [Char] st m Width -widthp = (string "auto" >> return Auto) - <|> (Width . read) `fmap` many1 digit - --- | Drop leading components of accounts names as specified by --drop, but only in --flat mode. -maybeAccountNameDrop :: ReportOpts -> AccountName -> AccountName -maybeAccountNameDrop opts a | tree_ opts = a - | otherwise = accountNameDrop (drop_ opts) a - -- Other utils -- | Get the sorted unique precise names and display names of hledger @@ -552,7 +561,7 @@ addonExtensions = ] getEnvSafe :: String -> IO String -getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "") +getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "") -- XXX should catch only isDoesNotExistError e getDirectoryContentsSafe :: FilePath -> IO [String] getDirectoryContentsSafe d = diff --git a/hledger/Hledger/Cli/Register.hs b/hledger/Hledger/Cli/Register.hs index c85e643a3..2b23fdf60 100644 --- a/hledger/Hledger/Cli/Register.hs +++ b/hledger/Hledger/Cli/Register.hs @@ -86,12 +86,22 @@ tests_postingsReportAsText = [ -- | Render one register report line item as plain text. Layout is like so: -- @ --- <----------------------------- width (default: 80) ----------------------------> --- date (10) description (50%) account (50%) amount (12) balance (12) +-- <---------------- width (specified, terminal width, or 80) --------------------> +-- date (10) description account amount (12) balance (12) -- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaa AAAAAAAAAAAA AAAAAAAAAAAA +-- @ +-- If description's width is specified, account will use the remaining space. +-- Otherwise, description and account divide up the space equally. +-- +-- With a reporting interval, the layout is like so: +-- @ +-- <---------------- width (specified, terminal width, or 80) --------------------> +-- date (21) account amount (12) balance (12) +-- DDDDDDDDDDDDDDDDDDDDD aaaaaaaaaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAAA AAAAAAAAAAAA +-- @ -- -- date and description are shown for the first posting of a transaction only. --- @ +-- postingsReportItemAsText :: CliOpts -> PostingsReportItem -> String postingsReportItemAsText opts (mdate, menddate, mdesc, p, b) = intercalate "\n" $ @@ -101,11 +111,8 @@ postingsReportItemAsText opts (mdate, menddate, mdesc, p, b) = [printf (spacer ++ "%"++amtw++"s %"++balw++"s") a b | (a,b) <- zip amtrest balrest ] where - totalwidth = case widthFromOpts opts of - Left _ -> defaultWidth -- shouldn't happen - Right (TotalWidth (Width w)) -> w - Right (TotalWidth Auto) -> defaultWidth -- XXX - Right (FieldWidths _) -> defaultWidth -- XXX + -- calculate widths + (totalwidth,mdescwidth) = registerWidthsFromOpts opts amtwidth = 12 balwidth = 12 (datewidth, date) = case (mdate,menddate) of @@ -114,15 +121,15 @@ postingsReportItemAsText opts (mdate, menddate, mdesc, p, b) = (Just d, Nothing) -> (10, showDate d) _ -> (10, "") remaining = totalwidth - (datewidth + 1 + 2 + amtwidth + 2 + balwidth) - (descwidth, acctwidth) | isJust menddate = (0, remaining-2) - | even remaining = (r2, r2) - | otherwise = (r2, r2+1) + (descwidth, acctwidth) + | hasinterval = (0, remaining - 2) + | otherwise = (w, remaining - 2 - w) where - r2 = (remaining-2) `div` 2 + hasinterval = isJust menddate + w = fromMaybe ((remaining - 2) `div` 2) mdescwidth [datew,descw,acctw,amtw,balw] = map show [datewidth,descwidth,acctwidth,amtwidth,balwidth] - - + -- gather content desc = maybe "" (take descwidth . elideRight descwidth) mdesc acct = parenthesise $ elideAccountName awidth $ paccount p where