-- | String formatting helpers, starting to get a bit out of control.

module Hledger.Utils.String (
 takeEnd,
 -- * misc
 lowercase,
 uppercase,
 underline,
 stripbrackets,
 -- quoting
 quoteIfNeeded,
 singleQuoteIfNeeded,
 quoteForCommandLine,
 -- quotechars,
 -- whitespacechars,
 words',
 unwords',
 stripAnsi,
 -- * single-line layout
 strip,
 lstrip,
 rstrip,
 chomp,
 chomp1,
 singleline,
 elideLeft,
 elideRight,
 formatString,
 -- * wide-character-aware layout
 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)


-- | Take elements from the end of a list.
takeEnd :: Int -> [a] -> [a]
takeEnd Int
n [a]
l = forall {a} {a}. [a] -> [a] -> [a]
go (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 = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
uppercase :: String -> String
uppercase = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper

-- | Remove leading and trailing whitespace.
strip :: String -> String
strip :: String -> String
strip = String -> String
lstrip forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
rstrip

-- | Remove leading whitespace.
lstrip :: String -> String
lstrip :: String -> String
lstrip = forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace

-- | Remove trailing whitespace.
rstrip :: String -> String
rstrip :: String -> String
rstrip = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
lstrip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

-- | Remove all trailing newlines/carriage returns.
chomp :: String -> String
chomp :: String -> String
chomp = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\r\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

-- | Remove all trailing newline/carriage returns, leaving just one trailing newline.
chomp1 :: String -> String
chomp1 :: String -> String
chomp1 = (forall a. [a] -> [a] -> [a]
++String
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
chomp

-- | Remove consecutive line breaks, replacing them with single space
singleline :: String -> String
singleline :: String -> String
singleline = [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=String
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> [a] -> [b]
map String -> String
strip) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

stripbrackets :: String -> String
stripbrackets :: String -> String
stripbrackets = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"([") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"])") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse :: String -> String

elideLeft :: Int -> String -> String
elideLeft :: Int -> String -> String
elideLeft Int
width String
s =
    if forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s forall a. Ord a => a -> a -> Bool
> Int
width then String
".." forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
takeEnd (Int
width 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 forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s forall a. Ord a => a -> a -> Bool
> Int
width then forall a. Int -> [a] -> [a]
take (Int
width forall a. Num a => a -> a -> a
- Int
2) String
s forall a. [a] -> [a] -> [a]
++ String
".." else String
s

-- | Clip and pad a string to a minimum & maximum width, and/or left/right justify it.
-- Works on multi-line strings too (but will rewrite non-unix line endings).
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 = forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall r. PrintfType r => String -> r
printf String
fmt) 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' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" forall a. Show a => a -> String
show Maybe Int
minwidth
      maxwidth' :: String
maxwidth' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
"."forall a. [a] -> [a] -> [a]
++)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Show a => a -> String
show) Maybe Int
maxwidth
      fmt :: String
fmt = String
"%" forall a. [a] -> [a] -> [a]
++ String
justify forall a. [a] -> [a] -> [a]
++ String
minwidth' forall a. [a] -> [a] -> [a]
++ String
maxwidth' forall a. [a] -> [a] -> [a]
++ String
"s"

underline :: String -> String
underline :: String -> String
underline String
s = String
s' forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
'-' forall a. [a] -> [a] -> [a]
++ String
"\n"
    where s' :: String
s'
            | forall a. [a] -> a
last String
s forall a. Eq a => a -> a -> Bool
== Char
'\n' = String
s
            | Bool
otherwise = String
s forall a. [a] -> [a] -> [a]
++ String
"\n"

-- | Double-quote this string if it contains whitespace, single quotes
-- or double-quotes, escaping the quotes as needed.
quoteIfNeeded :: String -> String
quoteIfNeeded :: String -> String
quoteIfNeeded String
s | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s) (String
quotecharsforall a. [a] -> [a] -> [a]
++String
whitespacecharsforall a. [a] -> [a] -> [a]
++String
redirectchars) = Char -> String -> String
showChar Char
'"' 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
"\\\"" 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        forall a b. (a -> b) -> a -> b
$ String -> String -> String
escapeQuotes String
cs String
x

-- | Single-quote this string if it contains whitespace or double-quotes.
-- Does not work for strings containing single quotes.
singleQuoteIfNeeded :: String -> String
singleQuoteIfNeeded :: String -> String
singleQuoteIfNeeded String
s | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s) (String
quotecharsforall a. [a] -> [a] -> [a]
++String
whitespacechars) = String -> String
singleQuote String
s
                      | Bool
otherwise = String
s

-- | Prepend and append single quotes to a string.
singleQuote :: String -> String
singleQuote :: String -> String
singleQuote String
s = String
"'"forall a. [a] -> [a] -> [a]
++String
sforall a. [a] -> [a] -> [a]
++String
"'"

-- | Try to single- and backslash-quote a string as needed to make it usable
-- as an argument on a (sh/bash) shell command line. At least, well enough 
-- to handle common currency symbols, like $. Probably broken in many ways.
--
-- >>> quoteForCommandLine "a"
-- "a"
-- >>> quoteForCommandLine "\""
-- "'\"'"
-- >>> quoteForCommandLine "$"
-- "'\\$'"
--
quoteForCommandLine :: String -> String
quoteForCommandLine :: String -> String
quoteForCommandLine String
s
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s) (String
quotecharsforall a. [a] -> [a] -> [a]
++String
whitespacecharsforall a. [a] -> [a] -> [a]
++String
shellchars) = String -> String
singleQuote forall a b. (a -> b) -> a -> b
$ String -> String
quoteShellChars String
s
  | Bool
otherwise = String
s

-- | Try to backslash-quote common shell-significant characters in this string.
-- Doesn't handle single quotes, & probably others.
quoteShellChars :: String -> String
quoteShellChars :: String -> String
quoteShellChars = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escapeShellChar
  where
    escapeShellChar :: Char -> String
escapeShellChar Char
c | Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
shellchars = [Char
'\\',Char
c]
    escapeShellChar Char
c = [Char
c]

quotechars, whitespacechars, redirectchars, shellchars :: [Char]
quotechars :: String
quotechars      = String
"'\""
whitespacechars :: String
whitespacechars = String
" \t\n\r"
redirectchars :: String
redirectchars   = String
"<>"
shellchars :: String
shellchars      = String
"<>(){}[]$7?#!~`"

-- | Quote-aware version of words - don't split on spaces which are inside quotes.
-- NB correctly handles "a'b" but not "''a''". Can raise an error if parsing fails.
words' :: String -> [String]
words' :: String -> [String]
words' String
"" = []
words' String
s  = forall a b. (a -> b) -> [a] -> [b]
map String -> String
stripquotes forall a b. (a -> b) -> a -> b
$ forall t e a.
(Show t, Show (Token t), Show e) =>
Either (ParseErrorBundle t e) a -> a
fromparse forall a b. (a -> b) -> a -> b
$ forall e a.
Parsec e String a -> String -> Either (ParseErrorBundle String e) a
parsewithString ParsecT HledgerParseErrorData String Identity [[Token String]]
p String
s
    where
      p :: ParsecT HledgerParseErrorData String Identity [[Token String]]
p = (ParsecT HledgerParseErrorData String Identity [Token String]
singleQuotedPattern forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT HledgerParseErrorData String Identity [Token String]
doubleQuotedPattern forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT HledgerParseErrorData String Identity [Token String]
patterns) forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
          -- eof
      patterns :: ParsecT HledgerParseErrorData String Identity [Token String]
patterns = forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf String
whitespacechars)
      singleQuotedPattern :: ParsecT HledgerParseErrorData String Identity [Token String]
singleQuotedPattern = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\'') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\'') (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf String
"'")
      doubleQuotedPattern :: ParsecT HledgerParseErrorData String Identity [Token String]
doubleQuotedPattern = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"') (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf String
"\"")

-- | Quote-aware version of unwords - single-quote strings which contain whitespace
unwords' :: [String] -> String
unwords' :: [String] -> String
unwords' = [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> String
quoteIfNeeded

-- | Strip one matching pair of single or double quotes on the ends of a string.
stripquotes :: String -> String
stripquotes :: String -> String
stripquotes String
s = if String -> Bool
isSingleQuoted String
s Bool -> Bool -> Bool
|| String -> Bool
isDoubleQuoted String
s then forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail String
s else String
s

isSingleQuoted :: String -> Bool
isSingleQuoted s :: String
s@(Char
_:Char
_:String
_) = forall a. [a] -> a
head String
s forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
&& forall a. [a] -> a
last String
s forall a. Eq a => a -> a -> Bool
== Char
'\''
isSingleQuoted String
_ = Bool
False

isDoubleQuoted :: String -> Bool
isDoubleQuoted s :: String
s@(Char
_:Char
_:String
_) = forall a. [a] -> a
head String
s forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
&& forall a. [a] -> a
last String
s forall a. Eq a => a -> a -> Bool
== Char
'"'
isDoubleQuoted String
_ = Bool
False

-- Functions below treat wide (eg CJK) characters as double-width.

-- | Double-width-character-aware string truncation. Take as many
-- characters as possible from a string without exceeding the
-- specified width. Eg takeWidth 3 "りんご" = "り".
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 forall a. Ord a => a -> a -> Bool
<= Int
w   = Char
cforall a. a -> [a] -> [a]
:Int -> String -> String
takeWidth (Int
wforall a. Num a => a -> a -> a
-Int
cw) String
cs
                   | Bool
otherwise = String
""
  where cw :: Int
cw = Char -> Int
charWidth Char
c

-- | Like strWidth, but also strips ANSI escape sequences before
-- calculating the width.
--
-- This is no longer used in code, as widths are calculated before
-- adding ANSI escape sequences, but is being kept around for now.
strWidthAnsi :: String -> Int
strWidthAnsi :: String -> Int
strWidthAnsi = String -> Int
strWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stripAnsi

-- | Alias for 'realLength'.
strWidth :: String -> Int
strWidth :: String -> Int
strWidth = forall a. HasChars a => a -> Int
realLength

-- | Strip ANSI escape sequences from a string.
--
-- >>> stripAnsi "\ESC[31m-1\ESC[m"
-- "-1"
stripAnsi :: String -> String
stripAnsi :: String -> String
stripAnsi String
s = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a}. a
err forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Regexp -> String -> String -> Either String String
regexReplace Regexp
ansire String
"" String
s
 where
   err :: a
err    = forall a. HasCallStack => String -> a
error String
"stripAnsi: invalid replacement pattern"      -- PARTIAL, shouldn't happen
   ansire :: Regexp
ansire = Text -> Regexp
toRegex' forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"\ESC\\[([0-9]+;)*([0-9]+)?[ABCDHJKfmsu]"  -- PARTIAL, should succeed