balance, print; more wide char support (#242)

Simple (non-multicolumn) balance reports containing wide characters
should now align correctly (in apps and fonts that show wide chars as
double width). Likewise, the print command.

hledger-lib/Hledger/Data/AccountName.hs

@@ -118,12 +118,12 @@ elideAccountName width s
       names = splitOn ", " $ take (length s - 8) s
       widthpername = (max 0 (width - 8 - 2 * (max 1 (length names) - 1))) `div` length names
     in
-     elideLeftWidth width False $
+     fitString Nothing (Just width) True False $
      (++" (split)") $
      intercalate ", " $
      [accountNameFromComponents $ elideparts widthpername [] $ accountNameComponents s' | s' <- names]
   | otherwise =
-    elideLeftWidth width False $ accountNameFromComponents $ elideparts width [] $ accountNameComponents s
+    fitString Nothing (Just width) True False $ accountNameFromComponents $ elideparts width [] $ accountNameComponents s
       where
         elideparts :: Int -> [String] -> [String] -> [String]
         elideparts width done ss

hledger-lib/Hledger/Utils/String.hs

@@ -29,11 +29,6 @@ module Hledger.Utils.String (
  elideLeft,
  elideRight,
  formatString,
- -- * wide-character-aware single-line layout
- strWidth,
- takeWidth,
- elideLeftWidth,
- elideRightWidth,
  -- * multi-line layout
  concatTopPadded,
  concatBottomPadded,
@@ -45,7 +40,14 @@ module Hledger.Utils.String (
  padleft,
  padright,
  cliptopleft,
- fitto
+ fitto,
+ -- * wide-character-aware layout
+ strWidth,
+ takeWidth,
+ fitString,
+ fitStringMulti,
+ padLeftWide,
+ padRightWide
  ) where
 
 
@@ -169,26 +171,28 @@ unbracket s
     | (head s == '[' && last s == ']') || (head s == '(' && last s == ')') = init $ tail s
     | otherwise = s
 
--- | Join multi-line strings as side-by-side rectangular strings of the same height, top-padded.
+-- | Join several multi-line strings as side-by-side rectangular strings of the same height, top-padded.
+-- Treats wide characters as double width.
 concatTopPadded :: [String] -> String
 concatTopPadded strs = intercalate "\n" $ map concat $ transpose padded
     where
       lss = map lines strs
       h = maximum $ map length lss
       ypad ls = replicate (difforzero h (length ls)) "" ++ ls
-      xpad ls = map (padleft w) ls where w | null ls = 0
+      xpad ls = map (padLeftWide w) ls where w | null ls = 0
-                                           | otherwise = maximum $ map length ls
+                                               | otherwise = maximum $ map strWidth ls
       padded = map (xpad . ypad) lss
 
--- | Join multi-line strings as side-by-side rectangular strings of the same height, bottom-padded.
+-- | Join several multi-line strings as side-by-side rectangular strings of the same height, bottom-padded.
+-- Treats wide characters as double width.
 concatBottomPadded :: [String] -> String
 concatBottomPadded strs = intercalate "\n" $ map concat $ transpose padded
     where
       lss = map lines strs
       h = maximum $ map length lss
       ypad ls = ls ++ replicate (difforzero h (length ls)) ""
-      xpad ls = map (padright w) ls where w | null ls = 0
+      xpad ls = map (padRightWide w) ls where w | null ls = 0
-                                            | otherwise = maximum $ map length ls
+                                                | otherwise = maximum $ map strWidth ls
       padded = map (xpad . ypad) lss
 
 
@@ -237,11 +241,13 @@ difforzero :: (Num a, Ord a) => a -> a -> a
 difforzero a b = maximum [(a - b), 0]
 
 -- | Convert a multi-line string to a rectangular string left-padded to the specified width.
+-- Treats wide characters as double width.
 padleft :: Int -> String -> String
 padleft w "" = concat $ replicate w " "
 padleft w s = intercalate "\n" $ map (printf (printf "%%%ds" w)) $ lines s
 
 -- | Convert a multi-line string to a rectangular string right-padded to the specified width.
+-- Treats wide characters as double width.
 padright :: Int -> String -> String
 padright w "" = concat $ replicate w " "
 padright w s = intercalate "\n" $ map (printf (printf "%%-%ds" w)) $ lines s
@@ -258,27 +264,87 @@ fitto w h s = intercalate "\n" $ take h $ rows ++ repeat blankline
       fit w = take w . (++ repeat ' ')
       blankline = replicate w ' '
 
--- Functions below are aware of double-width characters eg in CJK text.
+-- Functions below treat wide (eg CJK) characters as double-width.
 
--- | Wide-character-aware string clipping to the specified width, with an ellipsis on the right.
+-- | A version of fitString that works on multi-line strings,
--- When the second argument is true, also right-pad with spaces to the specified width if needed.
+-- separate for now to avoid breakage.
-elideLeftWidth :: Int -> Bool -> String -> String
+-- This will rewrite any line endings to unix newlines.
-elideLeftWidth width pad s
+fitStringMulti :: Maybe Int -> Maybe Int -> Bool -> Bool -> String -> String
-  | strWidth s > width = ellipsis ++ reverse (takeWidth (width - length ellipsis) $ reverse s)
+fitStringMulti mminwidth mmaxwidth ellipsify rightside s =
-  | otherwise          = reverse (takeWidth width $ reverse s ++ padding)
+  (intercalate "\n" . map (fitString mminwidth mmaxwidth ellipsify rightside) . lines) s
-  where
-    ellipsis = ".."
-    padding = if pad then repeat ' ' else ""
 
--- | Wide-character-aware string clipping to the specified width, with an ellipsis on the left.
+-- | General-purpose single-line string layout function.
--- When the second argument is true, also left-pad with spaces to the specified width if needed.
+-- It can left- or right-pad a short string to a minimum width.
-elideRightWidth :: Int -> Bool -> String -> String
+-- It can left- or right-clip a long string to a maximum width, optionally inserting an ellipsis.
-elideRightWidth width pad s
+-- It clips and pads on the right if the fourth argument is true, on the left otherwise.
-  | strWidth s > width = takeWidth (width - length ellipsis) s ++ ellipsis
+-- It treats wide characters as double width.
-  | otherwise          = takeWidth width $ s ++ padding
+fitString :: Maybe Int -> Maybe Int -> Bool -> Bool -> String -> String
+fitString mminwidth mmaxwidth ellipsify rightside s = (clip . pad) s
   where
-    ellipsis = ".."
+    clip :: String -> String
-    padding = if pad then repeat ' ' else ""
+    clip s =
+      case mmaxwidth of
+        Just w
+          | strWidth s > w ->
+            case rightside of
+              True  -> takeWidth (w - length ellipsis) s ++ ellipsis
+              False -> ellipsis ++ reverse (takeWidth (w - length ellipsis) $ reverse s)
+          | otherwise -> s
+          where
+            ellipsis = if ellipsify then ".." else ""
+        Nothing -> s
+    pad :: String -> String
+    pad s =
+      case mminwidth of
+        Just w
+          | sw < w ->
+            case rightside of
+              True  -> s ++ replicate (w - sw) ' '
+              False -> replicate (w - sw) ' ' ++ s
+          | otherwise -> s
+        Nothing -> s
+      where sw = strWidth s
+
+-- | Wide-character-aware right-clip a string to the specified width.
+-- When the second argument is true, an ellipsis will be inserted if the string is clipped.
+-- When the third argument is true, a short string will be right-padded with spaces to the specified width.
+-- Works on multi-line strings too (but will rewrite non-unix line endings).
+elideLeftWidth :: Int -> Bool -> Bool -> String -> String
+elideLeftWidth width ellipsify pad s = format s --intercalate "\n" $ map format $ lines s
+  where
+    format s
+      | strWidth s > width = ellipsis ++ reverse (takeWidth (width - length ellipsis) $ reverse s)
+      | otherwise          = reverse (takeWidth width $ reverse s ++ padding)
+      where
+        ellipsis = if ellipsify then ".." else ""
+        padding = if pad then repeat ' ' else ""
+
+-- | Wide-character-aware left-clip a string to the specified width.
+-- When the second argument is true, an ellipsis will be inserted if the string is clipped.
+-- When the third argument is true, a short string will be left-padded with spaces to the specified width.
+elideRightWidth :: Int -> Bool -> Bool -> String -> String
+elideRightWidth width ellipsify pad s = format s --intercalate "\n" $ map format $ lines s
+  where
+    format s
+      | strWidth s > width = takeWidth (width - length ellipsis) s ++ ellipsis
+      | otherwise          = takeWidth width $ s ++ padding
+      where
+        ellipsis = if ellipsify then ".." else ""
+        padding = if pad then repeat ' ' else ""
+
+-- | Left-pad a string to the specified width. (Also clips to this width.)
+-- Treats wide characters as double width.
+-- Works on multi-line strings too (but will rewrite non-unix line endings).
+padLeftWide :: Int -> String -> String
+padLeftWide w "" = replicate w ' '
+padLeftWide w s = intercalate "\n" $ map (elideLeftWidth w False True) $ lines s
+
+-- | Right-pad a string to the specified width. (Also clips to this width.)
+-- Treats wide characters as double width.
+-- Works on multi-line strings too (but will rewrite non-unix line endings).
+padRightWide :: Int -> String -> String
+padRightWide w "" = replicate w ' '
+padRightWide w s = intercalate "\n" $ map (elideRightWidth w False True) $ lines s
 
 -- | Double-width-character-aware string truncation. Take as many
 -- characters as possible from a string without exceeding the

hledger/Hledger/Cli/Balance.hs

@@ -353,7 +353,7 @@ balanceReportAsText opts ((items, total)) = unlines $ concat lines ++ t
                   -- with a custom format, extend the line to the full report width;
                   -- otherwise show the usual 20-char line for compatibility
                   overlinewidth | isJust (format_ opts) = maximum' $ map length $ concat lines
-                                | otherwise             = 20
+                                | otherwise             = defaultTotalFieldWidth
                   overline   = replicate overlinewidth '-'
                 in overline : totallines
                Left _ -> []
@@ -407,6 +407,8 @@ renderBalanceReportItem fmt (acctname, depth, total) =
     render1 = map (renderComponent1 (acctname, depth, total))
     render  = map (renderComponent (acctname, depth, total))
 
+defaultTotalFieldWidth = 20
+
 -- | Render one StringFormat component for a balance report item.
 renderComponent :: (AccountName, Int, MixedAmount) -> StringFormatComponent -> String
 renderComponent _ (FormatLiteral s) = s
@@ -416,7 +418,7 @@ renderComponent (acctname, depth, total) (FormatField ljust min max field) = cas
                                  Just m  -> depth * m
                                  Nothing -> depth
   AccountField     -> formatString ljust min max acctname
-  TotalField       -> formatString ljust min max $ showMixedAmountWithoutPrice total
+  TotalField       -> fitStringMulti min max True False $ showMixedAmountWithoutPrice total
   _                -> ""
 
 -- | Render one StringFormat component for a balance report item.
@@ -431,7 +433,7 @@ renderComponent1 (acctname, depth, total) (FormatField ljust min max field) = ca
                         -- better to indent the account name here rather than use a DepthField component
                         -- so that it complies with width spec. Uses a fixed indent step size.
                         indented = ((replicate (depth*2) ' ')++)
-  TotalField       -> formatString ljust min max $ ((intercalate ", " . map strip . lines) (showMixedAmountWithoutPrice total))
+  TotalField       -> fitStringMulti min max True False $ ((intercalate ", " . map strip . lines) (showMixedAmountWithoutPrice total))
   _                -> ""
 
 -- multi-column balance reports

hledger/Hledger/Cli/Register.hs

@@ -120,21 +120,21 @@ postingsReportItemAsText :: CliOpts -> PostingsReportItem -> String
 postingsReportItemAsText opts (mdate, menddate, mdesc, p, b) =
   -- use elide*Width to be wide-char-aware
   intercalate "\n" $
-    [concat [elideRightWidth datewidth True date
+    [concat [fitString (Just datewidth) (Just datewidth) True True date
             ," "
-            ,elideRightWidth descwidth True desc
+            ,fitString (Just descwidth) (Just descwidth) True True desc
             ,"  "
-            ,elideRightWidth acctwidth True acct
+            ,fitString (Just acctwidth) (Just acctwidth) True True acct
             ,"  "
-            ,elideLeftWidth amtwidth True amtfirstline
+            ,fitString (Just amtwidth) (Just amtwidth) True False amtfirstline
             ,"  "
-            ,elideLeftWidth balwidth True balfirstline
+            ,fitString (Just balwidth) (Just balwidth) True False balfirstline
             ]]
     ++
     [concat [spacer
-            ,elideLeftWidth amtwidth True a
+            ,fitString (Just amtwidth) (Just amtwidth) True False a
             ,"  "
-            ,elideLeftWidth balwidth True b
+            ,fitString (Just balwidth) (Just balwidth) True False b
             ]
      | (a,b) <- zip amtrest balrest
      ]