module Hledger.Utils.String (
takeEnd,
lowercase,
uppercase,
underline,
stripbrackets,
quoteIfNeeded,
singleQuoteIfNeeded,
words',
unwords',
stripAnsi,
strip,
lstrip,
rstrip,
chomp,
chomp1,
singleline,
elideLeft,
elideRight,
formatString,
charWidth,
strWidth,
strWidthAnsi,
takeWidth,
) where
import Data.Char (isSpace, toLower, toUpper)
import Data.List (intercalate)
import qualified Data.Text as T
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.DocLayout (charWidth, realLength)
takeEnd :: Int -> [a] -> [a]
takeEnd Int
n [a]
l = [a] -> [a] -> [a]
forall a a. [a] -> [a] -> [a]
go (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
l) [a]
l
where
go :: [a] -> [a] -> [a]
go (a
_:[a]
xs) (a
_:[a]
ys) = [a] -> [a] -> [a]
go [a]
xs [a]
ys
go [] [a]
r = [a]
r
go [a]
_ [] = []
lowercase, uppercase :: String -> String
lowercase :: String -> String
lowercase = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
uppercase :: String -> String
uppercase = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper
strip :: String -> String
strip :: String -> String
strip = String -> String
lstrip (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
rstrip
lstrip :: String -> String
lstrip :: String -> String
lstrip = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
rstrip :: String -> String
rstrip :: String -> String
rstrip = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
lstrip (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
chomp :: String -> String
chomp :: String -> String
chomp = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\r\n") (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
chomp1 :: String -> String
chomp1 :: String -> String
chomp1 = (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n") (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
chomp
singleline :: String -> String
singleline :: String -> String
singleline = [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
"") ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
strip) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
stripbrackets :: String -> String
stripbrackets :: String -> String
stripbrackets = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"([") (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"])") (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse :: String -> String
elideLeft :: Int -> String -> String
elideLeft :: Int -> String -> String
elideLeft Int
width String
s =
if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
width then String
".." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
takeEnd (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) String
s else String
s
elideRight :: Int -> String -> String
elideRight :: Int -> String -> String
elideRight Int
width String
s =
if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
width then Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".." else String
s
formatString :: Bool -> Maybe Int -> Maybe Int -> String -> String
formatString :: Bool -> Maybe Int -> Maybe Int -> String -> String
formatString Bool
leftJustified Maybe Int
minwidth Maybe Int
maxwidth String
s = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall r. PrintfType r => String -> r
printf String
fmt) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
s
where
justify :: String
justify = if Bool
leftJustified then String
"-" else String
""
minwidth' :: String
minwidth' = String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Int -> String
forall a. Show a => a -> String
show Maybe Int
minwidth
maxwidth' :: String
maxwidth' = String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
"."String -> String -> String
forall a. [a] -> [a] -> [a]
++)(String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> String
forall a. Show a => a -> String
show) Maybe Int
maxwidth
fmt :: String
fmt = String
"%" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
justify String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
minwidth' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
maxwidth' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s"
underline :: String -> String
underline :: String -> String
underline String
s = String
s' String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
'-' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
where s' :: String
s'
| String -> Char
forall a. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' = String
s
| Bool
otherwise = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
quoteIfNeeded :: String -> String
quoteIfNeeded :: String -> String
quoteIfNeeded String
s | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s) (String
quotecharsString -> String -> String
forall a. [a] -> [a] -> [a]
++String
whitespacecharsString -> String -> String
forall a. [a] -> [a] -> [a]
++String
redirectchars) = Char -> String -> String
showChar Char
'"' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
escapeQuotes String
s String
"\""
| Bool
otherwise = String
s
where
escapeQuotes :: String -> String -> String
escapeQuotes [] String
x = String
x
escapeQuotes (Char
'"':String
cs) String
x = String -> String -> String
showString String
"\\\"" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
escapeQuotes String
cs String
x
escapeQuotes (Char
c:String
cs) String
x = Char -> String -> String
showChar Char
c (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
escapeQuotes String
cs String
x
singleQuoteIfNeeded :: String -> String
singleQuoteIfNeeded :: String -> String
singleQuoteIfNeeded String
s | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s) (String
quotecharsString -> String -> String
forall a. [a] -> [a] -> [a]
++String
whitespacechars) = String
"'"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"'"
| Bool
otherwise = String
s
quotechars, whitespacechars, redirectchars :: [Char]
quotechars :: String
quotechars = String
"'\""
whitespacechars :: String
whitespacechars = String
" \t\n\r"
redirectchars :: String
redirectchars = String
"<>"
words' :: String -> [String]
words' :: String -> [String]
words' String
"" = []
words' String
s = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
stripquotes ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Either (ParseErrorBundle String CustomErr) [String] -> [String]
forall t e a.
(Show t, Show (Token t), Show e) =>
Either (ParseErrorBundle t e) a -> a
fromparse (Either (ParseErrorBundle String CustomErr) [String] -> [String])
-> Either (ParseErrorBundle String CustomErr) [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Parsec CustomErr String [String]
-> String -> Either (ParseErrorBundle String CustomErr) [String]
forall e a.
Parsec e String a -> String -> Either (ParseErrorBundle String e) a
parsewithString Parsec CustomErr String [String]
p String
s
where
p :: Parsec CustomErr String [String]
p = (ParsecT CustomErr String Identity String
singleQuotedPattern ParsecT CustomErr String Identity String
-> ParsecT CustomErr String Identity String
-> ParsecT CustomErr String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomErr String Identity String
doubleQuotedPattern ParsecT CustomErr String Identity String
-> ParsecT CustomErr String Identity String
-> ParsecT CustomErr String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomErr String Identity String
patterns) ParsecT CustomErr String Identity String
-> ParsecT CustomErr String Identity ()
-> Parsec CustomErr String [String]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` ParsecT CustomErr String Identity ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
patterns :: ParsecT CustomErr String Identity String
patterns = ParsecT CustomErr String Identity Char
-> ParsecT CustomErr String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ([Token String] -> ParsecT CustomErr String Identity (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf String
[Token String]
whitespacechars)
singleQuotedPattern :: ParsecT CustomErr String Identity String
singleQuotedPattern = ParsecT CustomErr String Identity Char
-> ParsecT CustomErr String Identity Char
-> ParsecT CustomErr String Identity String
-> ParsecT CustomErr String Identity String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token String -> ParsecT CustomErr String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\'') (Token String -> ParsecT CustomErr String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\'') (ParsecT CustomErr String Identity Char
-> ParsecT CustomErr String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomErr String Identity Char
-> ParsecT CustomErr String Identity String)
-> ParsecT CustomErr String Identity Char
-> ParsecT CustomErr String Identity String
forall a b. (a -> b) -> a -> b
$ [Token String] -> ParsecT CustomErr String Identity (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf String
[Token String]
"'")
doubleQuotedPattern :: ParsecT CustomErr String Identity String
doubleQuotedPattern = ParsecT CustomErr String Identity Char
-> ParsecT CustomErr String Identity Char
-> ParsecT CustomErr String Identity String
-> ParsecT CustomErr String Identity String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token String -> ParsecT CustomErr String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'"') (Token String -> ParsecT CustomErr String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'"') (ParsecT CustomErr String Identity Char
-> ParsecT CustomErr String Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomErr String Identity Char
-> ParsecT CustomErr String Identity String)
-> ParsecT CustomErr String Identity Char
-> ParsecT CustomErr String Identity String
forall a b. (a -> b) -> a -> b
$ [Token String] -> ParsecT CustomErr String Identity (Token String)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf String
[Token String]
"\"")
unwords' :: [String] -> String
unwords' :: [String] -> String
unwords' = [String] -> String
unwords ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
quoteIfNeeded
stripquotes :: String -> String
stripquotes :: String -> String
stripquotes String
s = if String -> Bool
isSingleQuoted String
s Bool -> Bool -> Bool
|| String -> Bool
isDoubleQuoted String
s then String -> String
forall a. [a] -> [a]
init (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
tail String
s else String
s
isSingleQuoted :: String -> Bool
isSingleQuoted s :: String
s@(Char
_:Char
_:String
_) = String -> Char
forall a. [a] -> a
head String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''
isSingleQuoted String
_ = Bool
False
isDoubleQuoted :: String -> Bool
isDoubleQuoted s :: String
s@(Char
_:Char
_:String
_) = String -> Char
forall a. [a] -> a
head String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"'
isDoubleQuoted String
_ = Bool
False
takeWidth :: Int -> String -> String
takeWidth :: Int -> String -> String
takeWidth Int
_ String
"" = String
""
takeWidth Int
0 String
_ = String
""
takeWidth Int
w (Char
c:String
cs) | Int
cw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
w = Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Int -> String -> String
takeWidth (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
cw) String
cs
| Bool
otherwise = String
""
where cw :: Int
cw = Char -> Int
charWidth Char
c
strWidthAnsi :: String -> Int
strWidthAnsi :: String -> Int
strWidthAnsi = String -> Int
strWidth (String -> Int) -> (String -> String) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stripAnsi
strWidth :: String -> Int
strWidth :: String -> Int
strWidth = String -> Int
forall a. HasChars a => a -> Int
realLength
stripAnsi :: String -> String
stripAnsi :: String -> String
stripAnsi String
s = (String -> String)
-> (String -> String) -> Either String String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> String
forall a. a
err String -> String
forall a. a -> a
id (Either String String -> String) -> Either String String -> String
forall a b. (a -> b) -> a -> b
$ Regexp -> String -> String -> Either String String
regexReplace Regexp
ansire String
"" String
s
where
err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"stripAnsi: invalid replacement pattern"
ansire :: Regexp
ansire = Text -> Regexp
toRegex' (Text -> Regexp) -> Text -> Regexp
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"\ESC\\[([0-9]+;)*([0-9]+)?[ABCDHJKfmsu]"