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

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

hledger/Hledger/Cli/Options.hs

@@ -1,5 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}
+{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts #-}
-{-# LANGUAGE 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
+  -- XXX check registerWidthsFromOpts opts
-    Left err -> optserror $ "could not parse width option: "++err
-    Right _ -> return ()
   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 =

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) ---------------------------->
+-- <---------------- width (specified, terminal width, or 80) -------------------->
--- date (10)  description (50%)     account (50%)         amount (12)  balance (12)
+-- 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
+      -- calculate widths
-           Left _                       -> defaultWidth -- shouldn't happen
+      (totalwidth,mdescwidth) = registerWidthsFromOpts opts
-           Right (TotalWidth (Width w)) -> w
-           Right (TotalWidth Auto)      -> defaultWidth -- XXX
-           Right (FieldWidths _)        -> defaultWidth -- XXX
       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)
+      (descwidth, acctwidth)
-                             | even remaining  = (r2, r2)
+        | hasinterval = (0, remaining - 2)
-                             | otherwise       = (r2, r2+1)
+        | 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