diff --git a/hledger-lib/Hledger/Utils/String.hs b/hledger-lib/Hledger/Utils/String.hs index d8d2faf1b..b447a6d3c 100644 --- a/hledger-lib/Hledger/Utils/String.hs +++ b/hledger-lib/Hledger/Utils/String.hs @@ -7,7 +7,6 @@ module Hledger.Utils.String ( uppercase, underline, stripbrackets, - unbracket, -- quoting quoteIfNeeded, singleQuoteIfNeeded, @@ -26,43 +25,23 @@ module Hledger.Utils.String ( elideLeft, elideRight, formatString, - -- * multi-line layout - concatTopPadded, - concatBottomPadded, - concatOneLine, - vConcatLeftAligned, - vConcatRightAligned, - padtop, - padbottom, - padleft, - padright, - cliptopleft, - fitto, -- * wide-character-aware layout charWidth, strWidth, strWidthAnsi, takeWidth, - fitString, - fitStringMulti, - padLeftWide, - padRightWide ) where import Data.Char (isSpace, toLower, toUpper) -import Data.Default (def) import Data.List (intercalate) import qualified Data.Text as T -import qualified Data.Text.Lazy as TL import Text.Megaparsec ((<|>), between, many, noneOf, sepBy) import Text.Megaparsec.Char (char) import Text.Printf (printf) import Hledger.Utils.Parse import Hledger.Utils.Regex (toRegex', regexReplace) -import Text.Tabular.AsciiWide - (Align(..), Header(..), Properties(..), TableOpts(..), textCell, renderRow) import Text.WideString (charWidth, strWidth) @@ -176,150 +155,8 @@ isSingleQuoted _ = False isDoubleQuoted s@(_:_:_) = head s == '"' && last s == '"' isDoubleQuoted _ = False -unbracket :: String -> String -unbracket s - | (head s == '[' && last s == ']') || (head s == '(' && last s == ')') = init $ tail s - | otherwise = s - --- | 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 = TL.unpack . renderRow def{tableBorders=False, borderSpaces=False} - . Group NoLine . map (Header . textCell BottomLeft . T.pack) - --- | 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 = TL.unpack . renderRow def{tableBorders=False, borderSpaces=False} - . Group NoLine . map (Header . textCell TopLeft . T.pack) - --- | Join multi-line strings horizontally, after compressing each of --- them to a single line with a comma and space between each original line. -concatOneLine :: [String] -> String -concatOneLine strs = concat $ map ((intercalate ", ").lines) strs - --- | Join strings vertically, left-aligned and right-padded. -vConcatLeftAligned :: [String] -> String -vConcatLeftAligned ss = intercalate "\n" $ map showfixedwidth ss - where - showfixedwidth = printf (printf "%%-%ds" width) - width = maximum $ map length ss - --- | Join strings vertically, right-aligned and left-padded. -vConcatRightAligned :: [String] -> String -vConcatRightAligned ss = intercalate "\n" $ map showfixedwidth ss - where - showfixedwidth = printf (printf "%%%ds" width) - width = maximum $ map length ss - --- | Convert a multi-line string to a rectangular string top-padded to the specified height. -padtop :: Int -> String -> String -padtop h s = intercalate "\n" xpadded - where - ls = lines s - sh = length ls - sw | null ls = 0 - | otherwise = maximum $ map length ls - ypadded = replicate (difforzero h sh) "" ++ ls - xpadded = map (padleft sw) ypadded - --- | Convert a multi-line string to a rectangular string bottom-padded to the specified height. -padbottom :: Int -> String -> String -padbottom h s = intercalate "\n" xpadded - where - ls = lines s - sh = length ls - sw | null ls = 0 - | otherwise = maximum $ map length ls - ypadded = ls ++ replicate (difforzero h sh) "" - xpadded = map (padleft sw) ypadded - -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 - --- | Clip a multi-line string to the specified width and height from the top left. -cliptopleft :: Int -> Int -> String -> String -cliptopleft w h = intercalate "\n" . take h . map (take w) . lines - --- | Clip and pad a multi-line string to fill the specified width and height. -fitto :: Int -> Int -> String -> String -fitto w h s = intercalate "\n" $ take h $ rows ++ repeat blankline - where - rows = map (fit w) $ lines s - fit w = take w . (++ repeat ' ') - blankline = replicate w ' ' - -- Functions below treat wide (eg CJK) characters as double-width. --- | General-purpose wide-char-aware 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 (the third argument). --- It clips and pads on the right when the fourth argument is true, otherwise on the left. --- 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 - 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 - --- | 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 - --- | Left-pad a string to the specified 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 (fitString (Just w) Nothing False False) $ lines s --- XXX not yet replaceable by --- padLeftWide w = fitStringMulti (Just w) Nothing False False - --- | Right-pad a string to the specified 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 (fitString (Just w) Nothing False True) $ lines s --- XXX not yet replaceable by --- padRightWide w = fitStringMulti (Just w) Nothing False True - -- | Double-width-character-aware string truncation. Take as many -- characters as possible from a string without exceeding the -- specified width. Eg takeWidth 3 "りんご" = "り".