From 42e2da4bb6cd19c38fcc37ee74abbbdab89db2ac Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 28 Sep 2015 18:33:18 -1000 Subject: [PATCH] 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 | 4 +- hledger-lib/Hledger/Utils/String.hs | 126 ++++++++++++++++++------ hledger/Hledger/Cli/Balance.hs | 8 +- hledger/Hledger/Cli/Register.hs | 14 +-- 4 files changed, 110 insertions(+), 42 deletions(-) diff --git a/hledger-lib/Hledger/Data/AccountName.hs b/hledger-lib/Hledger/Data/AccountName.hs index 108a69867..01178edac 100644 --- 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 diff --git a/hledger-lib/Hledger/Utils/String.hs b/hledger-lib/Hledger/Utils/String.hs index 003b8fbba..ff443701d 100644 --- 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 diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index a67b3c81a..175726a2f 100644 --- 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 diff --git a/hledger/Hledger/Cli/Register.hs b/hledger/Hledger/Cli/Register.hs index ba21bcaed..e30e0a3a9 100644 --- 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 ]