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.
2015-09-28 18:33:18 -10:00 · 2015-09-28 18:33:18 -10:00 · 42e2da4bb6
commit 42e2da4bb6
parent 5b5e5eeaf4
4 changed files with 110 additions and 42 deletions
--- a/hledger-lib/Hledger/Data/AccountName.hs
+++ b/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
--- a/hledger-lib/Hledger/Utils/String.hs
+++ b/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
-                                           | otherwise = maximum $ map length ls
+      xpad ls = map (padLeftWide w) ls where w | null ls = 0
+                                               | 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
-                                            | otherwise = maximum $ map length ls
+      xpad ls = map (padRightWide w) ls where w | null ls = 0
+                                                | 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.
-- When the second argument is true, also right-pad with spaces to the specified width if needed.
-elideLeftWidth :: Int -> Bool -> String -> String
-elideLeftWidth width pad s
-  | strWidth s > width = ellipsis ++ reverse (takeWidth (width - length ellipsis) $ reverse s)
-  | otherwise          = reverse (takeWidth width $ reverse s ++ padding)
-  where
-    ellipsis = ".."
-    padding = if pad then repeat ' ' else ""
+-- | A version of fitString that works on multi-line strings,
+-- separate for now to avoid breakage.
+-- This will rewrite any line endings to unix newlines.
+fitStringMulti :: Maybe Int -> Maybe Int -> Bool -> Bool -> String -> String
+fitStringMulti mminwidth mmaxwidth ellipsify rightside s =
+  (intercalate "\n" . map (fitString mminwidth mmaxwidth ellipsify rightside) . lines) s

-- | Wide-character-aware string clipping to the specified width, with an ellipsis on the left.
-- When the second argument is true, also left-pad with spaces to the specified width if needed.
-elideRightWidth :: Int -> Bool -> String -> String
-elideRightWidth width pad s
-  | strWidth s > width = takeWidth (width - length ellipsis) s ++ ellipsis
-  | otherwise          = takeWidth width $ s ++ padding
+-- | General-purpose single-line string layout function.
+-- It can left- or right-pad a short string to a minimum width.
+-- It can left- or right-clip a long string to a maximum width, optionally inserting an ellipsis.
+-- It clips and pads on the right if the fourth argument is true, on the left otherwise.
+-- It treats wide characters as double width.
+fitString :: Maybe Int -> Maybe Int -> Bool -> Bool -> String -> String
+fitString mminwidth mmaxwidth ellipsify rightside s = (clip . pad) s
  where
-    ellipsis = ".."
-    padding = if pad then repeat ' ' else ""
+    clip :: String -> String
+    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
--- a/hledger/Hledger/Cli/Balance.hs
+++ b/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
--- a/hledger/Hledger/Cli/Register.hs
+++ b/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
     ]