simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-12-25 19:31:44 +03:00
Code Issues Projects Releases Wiki Activity

register: use full width, column widths, cleanup

Browse Source 
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
This commit is contained in:
Simon Michael 2015-01-19 13:48:37 -08:00
parent 8278c13268
commit 372a2d768b
3 changed files with 93 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -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)

133
hledger/Hledger/Cli/Options.hs
View File

@ -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 =

35
hledger/Hledger/Cli/Register.hs
View File

@ -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