lib: Remove unused String utility functions.

This commit is contained in:
Stephen Morgan 2021-04-22 16:48:26 +10:00 committed by Simon Michael
parent 0b419adba2
commit e80bb37b1c

View File

@ -7,7 +7,6 @@ module Hledger.Utils.String (
uppercase, uppercase,
underline, underline,
stripbrackets, stripbrackets,
unbracket,
-- quoting -- quoting
quoteIfNeeded, quoteIfNeeded,
singleQuoteIfNeeded, singleQuoteIfNeeded,
@ -26,43 +25,23 @@ module Hledger.Utils.String (
elideLeft, elideLeft,
elideRight, elideRight,
formatString, formatString,
-- * multi-line layout
concatTopPadded,
concatBottomPadded,
concatOneLine,
vConcatLeftAligned,
vConcatRightAligned,
padtop,
padbottom,
padleft,
padright,
cliptopleft,
fitto,
-- * wide-character-aware layout -- * wide-character-aware layout
charWidth, charWidth,
strWidth, strWidth,
strWidthAnsi, strWidthAnsi,
takeWidth, takeWidth,
fitString,
fitStringMulti,
padLeftWide,
padRightWide
) where ) where
import Data.Char (isSpace, toLower, toUpper) import Data.Char (isSpace, toLower, toUpper)
import Data.Default (def)
import Data.List (intercalate) import Data.List (intercalate)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Text.Megaparsec ((<|>), between, many, noneOf, sepBy) import Text.Megaparsec ((<|>), between, many, noneOf, sepBy)
import Text.Megaparsec.Char (char) import Text.Megaparsec.Char (char)
import Text.Printf (printf) import Text.Printf (printf)
import Hledger.Utils.Parse import Hledger.Utils.Parse
import Hledger.Utils.Regex (toRegex', regexReplace) import Hledger.Utils.Regex (toRegex', regexReplace)
import Text.Tabular.AsciiWide
(Align(..), Header(..), Properties(..), TableOpts(..), textCell, renderRow)
import Text.WideString (charWidth, strWidth) import Text.WideString (charWidth, strWidth)
@ -176,150 +155,8 @@ isSingleQuoted _ = False
isDoubleQuoted s@(_:_:_) = head s == '"' && last s == '"' isDoubleQuoted s@(_:_:_) = head s == '"' && last s == '"'
isDoubleQuoted _ = False 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. -- 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 -- | Double-width-character-aware string truncation. Take as many
-- characters as possible from a string without exceeding the -- characters as possible from a string without exceeding the
-- specified width. Eg takeWidth 3 "りんご" = "り". -- specified width. Eg takeWidth 3 "りんご" = "り".