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

module Hledger.Utils.String (
 takeEnd,
 -- * misc
 lowercase,
 uppercase,
 underline,
 stripbrackets,
 unbracket,
 -- quoting
 quoteIfNeeded,
 singleQuoteIfNeeded,
 -- quotechars,
 -- whitespacechars,
 words',
 unwords',
 stripAnsi,
 -- * single-line layout
 strip,
 lstrip,
 rstrip,
 chomp,
 singleline,
 elideLeft,
 elideRight,
 formatString,
 -- * multi-line layout
 concatTopPadded,
 concatBottomPadded,
 concatOneLine,
 vConcatLeftAligned,
 vConcatRightAligned,
 padtop,
 padbottom,
 padleft,
 padright,
 cliptopleft,
 fitto,
 -- * wide-character-aware layout
 charWidth,
 strWidth,
 takeWidth,
 fitString,
 fitStringMulti,
 padLeftWide,
 padRightWide
 ) where


import Data.Char (isDigit, isSpace, toLower, toUpper)
import Data.List (intercalate, transpose)
import Text.Megaparsec (Parsec, (<|>), (<?>), anySingle, between, many, noneOf,
                        oneOf, parseMaybe, sepBy, takeWhileP, try)
import Text.Megaparsec.Char (char, string)
import Text.Printf (printf)

import Hledger.Utils.Parse


-- | Take elements from the end of a list.
takeEnd :: Int -> [a] -> [a]
takeEnd n :: Int
n l :: [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 (_:xs :: [a]
xs) (_:ys :: [a]
ys) = [a] -> [a] -> [a]
go [a]
xs [a]
ys
    go []     r :: [a]
r      = [a]
r
    go _      []     = []

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

-- | Remove leading and trailing whitespace.
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

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

-- | Remove trailing whitespace.
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

-- | Remove trailing newlines/carriage returns.
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` "\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

-- | Remove consecutive line breaks, replacing them with single space
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]
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
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
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 width :: Int
width s :: 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
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
- 2) String
s else String
s

elideRight :: Int -> String -> String
elideRight :: Int -> String -> String
elideRight width :: Int
width s :: 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
- 2) String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".." 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 leftJustified :: Bool
leftJustified minwidth :: Maybe Int
minwidth maxwidth :: Maybe Int
maxwidth s :: String
s = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\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 "-" else ""
      minwidth' :: String
minwidth' = String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" 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
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
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]
++ "s"

underline :: String -> String
underline :: String -> String
underline s :: 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) '-' String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n"
    where s' :: String
s'
            | String -> Char
forall a. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' = String
s
            | Bool
otherwise = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\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 s :: 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) = String -> String
forall a. Show a => a -> String
show String
s
                | Bool
otherwise = String
s

-- | Single-quote this string if it contains whitespace or double-quotes.
-- No good for strings containing single quotes.
singleQuoteIfNeeded :: String -> String
singleQuoteIfNeeded :: String -> String
singleQuoteIfNeeded s :: 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
whitespacechars = "'"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++"'"
                      | Bool
otherwise = String
s

quotechars, whitespacechars, redirectchars :: [Char]
quotechars :: String
quotechars      = "'\""
whitespacechars :: String
whitespacechars = " \t\n\r"
redirectchars :: String
redirectchars   = "<>"

-- | 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' "" = []
words' s :: 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 = do [String]
ss <- (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
pattern) 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
             -- eof
             [String] -> Parsec CustomErr String [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
ss
      pattern :: ParsecT CustomErr String Identity String
pattern = 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 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 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 [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 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 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 [Token String]
"\"")

-- | Quote-aware version of unwords - single-quote strings which contain whitespace
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

-- | Strip one matching pair of single or double quotes on the ends of a string.
stripquotes :: String -> String
stripquotes :: String -> String
stripquotes s :: 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@(_:_:_) = String -> Char
forall a. [a] -> a
head String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\'' Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\''
isSingleQuoted _ = Bool
False

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

unbracket :: String -> String
unbracket :: String -> String
unbracket s :: String
s
    | (String -> Char
forall a. [a] -> a
head String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '[' Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ']') Bool -> Bool -> Bool
|| (String -> Char
forall a. [a] -> a
head String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '(' Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ')') = 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
    | Bool
otherwise = String
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 :: [String] -> String
concatTopPadded strs :: [String]
strs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\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
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ [[String]] -> [[String]]
forall a. [[a]] -> [[a]]
transpose [[String]]
padded
    where
      lss :: [[String]]
lss = (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
lines [String]
strs
      h :: Int
h = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ([String] -> Int) -> [[String]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[String]]
lss
      ypad :: [String] -> [String]
ypad ls :: [String]
ls = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. (Num a, Ord a) => a -> a -> a
difforzero Int
h ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls)) "" [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ls
      xpad :: [String] -> [String]
xpad ls :: [String]
ls = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
padLeftWide Int
w) [String]
ls where w :: Int
w | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ls = 0
                                               | Bool
otherwise = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
strWidth [String]
ls
      padded :: [[String]]
padded = ([String] -> [String]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> [String]
xpad ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
ypad) [[String]]
lss

-- | 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 :: [String] -> String
concatBottomPadded strs :: [String]
strs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\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
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ [[String]] -> [[String]]
forall a. [[a]] -> [[a]]
transpose [[String]]
padded
    where
      lss :: [[String]]
lss = (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
lines [String]
strs
      h :: Int
h = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ([String] -> Int) -> [[String]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[String]]
lss
      ypad :: [String] -> [String]
ypad ls :: [String]
ls = [String]
ls [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. (Num a, Ord a) => a -> a -> a
difforzero Int
h ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls)) ""
      xpad :: [String] -> [String]
xpad ls :: [String]
ls = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
padRightWide Int
w) [String]
ls where w :: Int
w | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ls = 0
                                                | Bool
otherwise = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
strWidth [String]
ls
      padded :: [[String]]
padded = ([String] -> [String]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> [String]
xpad ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
ypad) [[String]]
lss


-- | 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 :: [String] -> String
concatOneLine strs :: [String]
strs = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([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 a. [a] -> [[a]] -> [a]
intercalate ", ")([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [String]
lines) [String]
strs

-- | Join strings vertically, left-aligned and right-padded.
vConcatLeftAligned :: [String] -> String
vConcatLeftAligned :: [String] -> String
vConcatLeftAligned ss :: [String]
ss = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\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
showfixedwidth [String]
ss
    where
      showfixedwidth :: String -> String
showfixedwidth = String -> String -> String
forall r. PrintfType r => String -> r
printf (String -> Int -> String
forall r. PrintfType r => String -> r
printf "%%-%ds" Int
width)
      width :: Int
width = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ss

-- | Join strings vertically, right-aligned and left-padded.
vConcatRightAligned :: [String] -> String
vConcatRightAligned :: [String] -> String
vConcatRightAligned ss :: [String]
ss = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\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
showfixedwidth [String]
ss
    where
      showfixedwidth :: String -> String
showfixedwidth = String -> String -> String
forall r. PrintfType r => String -> r
printf (String -> Int -> String
forall r. PrintfType r => String -> r
printf "%%%ds" Int
width)
      width :: Int
width = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ss

-- | Convert a multi-line string to a rectangular string top-padded to the specified height.
padtop :: Int -> String -> String
padtop :: Int -> String -> String
padtop h :: Int
h s :: String
s = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n" [String]
xpadded
    where
      ls :: [String]
ls = String -> [String]
lines String
s
      sh :: Int
sh = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls
      sw :: Int
sw | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ls = 0
         | Bool
otherwise = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls
      ypadded :: [String]
ypadded = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. (Num a, Ord a) => a -> a -> a
difforzero Int
h Int
sh) "" [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ls
      xpadded :: [String]
xpadded = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
padleft Int
sw) [String]
ypadded

-- | Convert a multi-line string to a rectangular string bottom-padded to the specified height.
padbottom :: Int -> String -> String
padbottom :: Int -> String -> String
padbottom h :: Int
h s :: String
s = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n" [String]
xpadded
    where
      ls :: [String]
ls = String -> [String]
lines String
s
      sh :: Int
sh = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls
      sw :: Int
sw | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ls = 0
         | Bool
otherwise = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls
      ypadded :: [String]
ypadded = [String]
ls [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. (Num a, Ord a) => a -> a -> a
difforzero Int
h Int
sh) ""
      xpadded :: [String]
xpadded = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
padleft Int
sw) [String]
ypadded

difforzero :: (Num a, Ord a) => a -> a -> a
difforzero :: a -> a -> a
difforzero a :: a
a b :: a
b = [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [(a
a a -> a -> a
forall a. Num a => a -> a -> a
- 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 :: Int -> String -> String
padleft w :: Int
w "" = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
w " "
padleft w :: Int
w s :: String
s = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\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 -> Int -> String
forall r. PrintfType r => String -> r
printf "%%%ds" Int
w)) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
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 :: Int -> String -> String
padright w :: Int
w "" = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
w " "
padright w :: Int
w s :: String
s = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\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 -> Int -> String
forall r. PrintfType r => String -> r
printf "%%-%ds" Int
w)) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
s

-- | Clip a multi-line string to the specified width and height from the top left.
cliptopleft :: Int -> Int -> String -> String
cliptopleft :: Int -> Int -> String -> String
cliptopleft w :: Int
w h :: Int
h = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n" ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
h ([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 (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
w) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

-- | Clip and pad a multi-line string to fill the specified width and height.
fitto :: Int -> Int -> String -> String
fitto :: Int -> Int -> String -> String
fitto w :: Int
w h :: Int
h s :: String
s = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
h ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
rows [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
forall a. a -> [a]
repeat String
blankline
    where
      rows :: [String]
rows = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
fit Int
w) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
s
      fit :: Int -> String -> String
fit w :: Int
w = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
w (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. a -> [a]
repeat ' ')
      blankline :: String
blankline = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
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 :: Maybe Int -> Maybe Int -> Bool -> Bool -> String -> String
fitString mminwidth :: Maybe Int
mminwidth mmaxwidth :: Maybe Int
mmaxwidth ellipsify :: Bool
ellipsify rightside :: Bool
rightside s :: String
s = (String -> String
clip (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pad) String
s
  where
    clip :: String -> String
    clip :: String -> String
clip s :: String
s =
      case Maybe Int
mmaxwidth of
        Just w :: Int
w
          | String -> Int
strWidth String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
w ->
            case Bool
rightside of
              True  -> Int -> String -> String
takeWidth (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
ellipsis) String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ellipsis
              False -> String
ellipsis String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. [a] -> [a]
reverse (Int -> String -> String
takeWidth (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
ellipsis) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
s)
          | Bool
otherwise -> String
s
          where
            ellipsis :: String
ellipsis = if Bool
ellipsify then ".." else ""
        Nothing -> String
s
    pad :: String -> String
    pad :: String -> String
pad s :: String
s =
      case Maybe Int
mminwidth of
        Just w :: Int
w
          | Int
sw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w ->
            case Bool
rightside of
              True  -> String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sw) ' '
              False -> Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sw) ' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
          | Bool
otherwise -> String
s
        Nothing -> String
s
      where sw :: Int
sw = String -> Int
strWidth String
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 :: Maybe Int -> Maybe Int -> Bool -> Bool -> String -> String
fitStringMulti mminwidth :: Maybe Int
mminwidth mmaxwidth :: Maybe Int
mmaxwidth ellipsify :: Bool
ellipsify rightside :: Bool
rightside s :: String
s =
  (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n" ([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 (Maybe Int -> Maybe Int -> Bool -> Bool -> String -> String
fitString Maybe Int
mminwidth Maybe Int
mmaxwidth Bool
ellipsify Bool
rightside) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) String
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 :: Int -> String -> String
padLeftWide w :: Int
w "" = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
w ' '
padLeftWide w :: Int
w s :: String
s  = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Int -> Maybe Int -> Bool -> Bool -> String -> String
fitString (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w) Maybe Int
forall a. Maybe a
Nothing Bool
False Bool
False) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
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 :: Int -> String -> String
padRightWide w :: Int
w "" = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
w ' '
padRightWide w :: Int
w s :: String
s  = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Int -> Maybe Int -> Bool -> Bool -> String -> String
fitString (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w) Maybe Int
forall a. Maybe a
Nothing Bool
False Bool
True) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
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 "りんご" = "り".
takeWidth :: Int -> String -> String
takeWidth :: Int -> String -> String
takeWidth _ ""     = ""
takeWidth 0 _      = ""
takeWidth w :: Int
w (c :: Char
c:cs :: 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 = ""
  where cw :: Int
cw = Char -> Int
charWidth Char
c

-- from Pandoc (copyright John MacFarlane, GPL)
-- see also http://unicode.org/reports/tr11/#Description

-- | Calculate the render width of a string, considering
-- wide characters (counted as double width), ANSI escape codes
-- (not counted), and line breaks (in a multi-line string, the longest
-- line determines the width).
strWidth :: String -> Int
strWidth :: String -> Int
strWidth = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> (String -> [Int]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) ([Int] -> [Int]) -> (String -> [Int]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Int -> Int) -> Int -> String -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a :: Char
a b :: Int
b -> Char -> Int
charWidth Char
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b) 0) ([String] -> [Int]) -> (String -> [String]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stripAnsi

-- | Strip ANSI escape sequences from a string.
--
-- >>> stripAnsi "\ESC[31m-1\ESC[m"
-- "-1"
stripAnsi :: String -> String
stripAnsi :: String -> String
stripAnsi s :: String
s = case Parsec CustomErr String [String] -> String -> Maybe [String]
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe (ParsecT CustomErr String Identity String
-> Parsec CustomErr String [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomErr String Identity String
 -> Parsec CustomErr String [String])
-> ParsecT CustomErr String Identity String
-> Parsec CustomErr String [String]
forall a b. (a -> b) -> a -> b
$ "" String
-> ParsecT CustomErr String Identity Char
-> ParsecT CustomErr String Identity String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT CustomErr String Identity Char
-> ParsecT CustomErr String Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomErr String Identity Char
ansi 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
<|> Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> String)
-> ParsecT CustomErr String Identity Char
-> ParsecT CustomErr String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr String Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle) String
s of
    Nothing -> String -> String
forall a. HasCallStack => String -> a
error "Bad ansi escape"  -- PARTIAL: should not happen
    Just xs :: [String]
xs -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
xs
  where
    -- This parses lots of invalid ANSI escape codes, but that should be fine
    ansi :: ParsecT CustomErr String Identity Char
ansi = Tokens String -> ParsecT CustomErr String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"\ESC[" ParsecT CustomErr String Identity String
-> ParsecT CustomErr String Identity (Tokens String)
-> ParsecT CustomErr String Identity (Tokens String)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomErr String Identity (Tokens String)
digitSemicolons ParsecT CustomErr String Identity (Tokens String)
-> ParsecT CustomErr String Identity Char
-> ParsecT CustomErr String Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomErr String Identity Char
ParsecT CustomErr String Identity (Token String)
suffix ParsecT CustomErr String Identity Char
-> String -> ParsecT CustomErr String Identity Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "ansi" :: Parsec CustomErr String Char
    digitSemicolons :: ParsecT CustomErr String Identity (Tokens String)
digitSemicolons = Maybe String
-> (Token String -> Bool)
-> ParsecT CustomErr String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (\c :: Token String
c -> Char -> Bool
isDigit Char
Token String
c Bool -> Bool -> Bool
|| Char
Token String
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ';')
    suffix :: ParsecT CustomErr String Identity (Token String)
suffix = [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)
oneOf ['A', 'B', 'C', 'D', 'H', 'J', 'K', 'f', 'm', 's', 'u']

-- | Get the designated render width of a character: 0 for a combining
-- character, 1 for a regular character, 2 for a wide character.
-- (Wide characters are rendered as exactly double width in apps and
-- fonts that support it.) (From Pandoc.)
charWidth :: Char -> Int
charWidth :: Char -> Int
charWidth c :: Char
c =
  case Char
c of
      _ | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<  '\x0300'                    -> 1
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x0300' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x036F'   -> 0  -- combining
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x0370' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x10FC'   -> 1
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x1100' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x115F'   -> 2
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x1160' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x11A2'   -> 1
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x11A3' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x11A7'   -> 2
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x11A8' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x11F9'   -> 1
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x11FA' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x11FF'   -> 2
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x1200' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x2328'   -> 1
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x2329' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x232A'   -> 2
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x232B' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x2E31'   -> 1
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x2E80' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x303E'   -> 2
        | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\x303F'                    -> 1
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x3041' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x3247'   -> 2
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x3248' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x324F'   -> 1 -- ambiguous
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x3250' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x4DBF'   -> 2
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x4DC0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x4DFF'   -> 1
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x4E00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xA4C6'   -> 2
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xA4D0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xA95F'   -> 1
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xA960' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xA97C'   -> 2
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xA980' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xABF9'   -> 1
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xAC00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xD7FB'   -> 2
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xD800' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xDFFF'   -> 1
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xE000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xF8FF'   -> 1 -- ambiguous
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xF900' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xFAFF'   -> 2
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xFB00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xFDFD'   -> 1
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xFE00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xFE0F'   -> 1 -- ambiguous
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xFE10' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xFE19'   -> 2
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xFE20' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xFE26'   -> 1
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xFE30' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xFE6B'   -> 2
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xFE70' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xFEFF'   -> 1
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xFF01' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\xFF60'   -> 2
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\xFF61' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x16A38'  -> 1
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x1B000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x1B001' -> 2
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x1D000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x1F1FF' -> 1
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x1F200' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x1F251' -> 2
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x1F300' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x1F773' -> 1
        | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x20000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x3FFFD' -> 2
        | Bool
otherwise                        -> 1