reg: --width/-w option to adjust register overall output width

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.

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
 

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
+  return $ postingsReportAsText opts $ postingsReport ropts (queryFromOpts d ropts) j
-      where opts = defreportopts{empty_=True}
+      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

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
+-- | Parse the format option if provided, possibly returning an error,
--- the default value.
+-- 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

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)
+-- <----------------------------- width (default: 80) ----------------------------->
--- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa  AAAAAAAAAAA AAAAAAAAAAAA
+-- date (10)   description (50%)     account (50%)         amount (12)  balance (12)
--- ^ displayed for first postings^
+-- DDDDDDDDDD  dddddddddddddddddddd  aaaaaaaaaaaaaaaaaaa  AAAAAAAAAAAA  AAAAAAAAAAAA
---   only, otherwise blank
+--
+-- date and description are shown for the first posting of a transaction only.
 -- @
-postingsReportItemAsText :: ReportOpts -> PostingsReportItem -> String
+postingsReportItemAsText :: CliOpts -> PostingsReportItem -> String
-postingsReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr, " ", bal]
+postingsReportItemAsText opts (dd, p, b) =
+  concatTopPadded [date, "  ", desc, "  ", acct, "  ", amt, "  ", bal]
     where
-      datedesc = case dd of Nothing -> replicate datedescwidth ' '
+      totalwidth = case widthFromOpts opts of
-                            Just (da, de) -> printf "%s %s " date desc
+           Left _                       -> defaultWidth -- shouldn't happen
-                                where
+           Right (TotalWidth (Width w)) -> w
-                                  date = showDate da
+           Right (TotalWidth Auto)      -> defaultWidth -- XXX
-                                  desc = printf ("%-"++(show descwidth)++"s") $ elideRight descwidth de :: String
+           Right (FieldWidths _)        -> defaultWidth -- XXX
-          where
+      datewidth = 10
-            descwidth = datedescwidth - datewidth - 2
+      amtwidth = 12
-            datedescwidth = 32
+      balwidth = 12
-            datewidth = 10
+      remaining = totalwidth - (datewidth + 2 + 2 + amtwidth + 2 + balwidth)
-      pstr = showPostingForRegister p
+      (descwidth, acctwidth) | even r    = (r', r')
-      bal = padleft 12 (showMixedAmountWithoutPrice b)
+                             | 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