-- | Text formatting helpers, ported from String as needed.
-- There may be better alternatives out there.

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}

module Hledger.Utils.Text
  (
 -- -- * misc
 -- lowercase,
 -- uppercase,
 -- underline,
 -- stripbrackets,
  textUnbracket,
 -- -- quoting
  quoteIfSpaced,
  textQuoteIfNeeded,
 -- singleQuoteIfNeeded,
 -- -- quotechars,
 -- -- whitespacechars,
  escapeDoubleQuotes,
 -- escapeSingleQuotes,
 -- escapeQuotes,
 -- words',
 -- unwords',
  stripquotes,
 -- isSingleQuoted,
 -- isDoubleQuoted,
 -- -- * single-line layout
 -- elideLeft,
  textElideRight,
 -- formatString,
 -- -- * multi-line layout
  textConcatTopPadded,
 -- concatBottomPadded,
 -- concatOneLine,
 -- vConcatLeftAligned,
 -- vConcatRightAligned,
 -- padtop,
 -- padbottom,
 -- padleft,
 -- padright,
 -- cliptopleft,
 -- fitto,
  fitText,
 -- -- * wide-character-aware layout
  textWidth,
  textTakeWidth,
 -- fitString,
 -- fitStringMulti,
  textPadLeftWide,
  textPadRightWide,
  -- -- * Reading
  readDecimal,
  -- -- * tests
  tests_Text
  )
where

import Data.Char (digitToInt)
import Data.List
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid
#endif
import Data.Text (Text)
import qualified Data.Text as T
-- import Text.Parsec
-- import Text.Printf (printf)

-- import Hledger.Utils.Parse
-- import Hledger.Utils.Regex
import Hledger.Utils.Test
import Text.WideString (charWidth, textWidth)

-- lowercase, uppercase :: String -> String
-- lowercase = map toLower
-- uppercase = map toUpper

-- stripbrackets :: String -> String
-- stripbrackets = dropWhile (`elem` "([") . reverse . dropWhile (`elem` "])") . reverse :: String -> String

-- elideLeft :: Int -> String -> String
-- elideLeft width s =
--     if length s > width then ".." ++ reverse (take (width - 2) $ reverse s) else s

textElideRight :: Int -> Text -> Text
textElideRight :: Int -> Text -> Text
textElideRight Int
width Text
t =
    if Text -> Int
T.length Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
width then Int -> Text -> Text
T.take (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".." else Text
t

-- -- | 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 leftJustified minwidth maxwidth s = intercalate "\n" $ map (printf fmt) $ lines s
--     where
--       justify = if leftJustified then "-" else ""
--       minwidth' = maybe "" show minwidth
--       maxwidth' = maybe "" (("."++).show) maxwidth
--       fmt = "%" ++ justify ++ minwidth' ++ maxwidth' ++ "s"

-- underline :: String -> String
-- underline s = s' ++ replicate (length s) '-' ++ "\n"
--     where s'
--             | last s == '\n' = s
--             | otherwise = s ++ "\n"

-- | Wrap a string in double quotes, and \-prefix any embedded single
-- quotes, if it contains whitespace and is not already single- or
-- double-quoted.
quoteIfSpaced :: T.Text -> T.Text
quoteIfSpaced :: Text -> Text
quoteIfSpaced Text
s | Text -> Bool
isSingleQuoted Text
s Bool -> Bool -> Bool
|| Text -> Bool
isDoubleQuoted Text
s = Text
s
                | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text -> [Char]
T.unpack Text
s)) [Char]
whitespacechars = Text
s
                | Bool
otherwise = Text -> Text
textQuoteIfNeeded Text
s

-- -- | Wrap a string in double quotes, and \-prefix any embedded single
-- -- quotes, if it contains whitespace and is not already single- or
-- -- double-quoted.
-- quoteIfSpaced :: String -> String
-- quoteIfSpaced s | isSingleQuoted s || isDoubleQuoted s = s
--                 | not $ any (`elem` s) whitespacechars = s
--                 | otherwise = "'"++escapeSingleQuotes s++"'"

-- -- | Double-quote this string if it contains whitespace, single quotes
-- -- or double-quotes, escaping the quotes as needed.
textQuoteIfNeeded :: T.Text -> T.Text
textQuoteIfNeeded :: Text -> Text
textQuoteIfNeeded Text
s | (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Text -> [Char]
T.unpack Text
s) ([Char]
quotechars[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
whitespacechars) = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeDoubleQuotes Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
                    | Bool
otherwise = Text
s

-- -- | Single-quote this string if it contains whitespace or double-quotes.
-- -- No good for strings containing single quotes.
-- singleQuoteIfNeeded :: String -> String
-- singleQuoteIfNeeded s | any (`elem` s) whitespacechars = "'"++s++"'"
--                       | otherwise = s

quotechars, whitespacechars :: [Char]
quotechars :: [Char]
quotechars      = [Char]
"'\""
whitespacechars :: [Char]
whitespacechars = [Char]
" \t\n\r"

escapeDoubleQuotes :: T.Text -> T.Text
escapeDoubleQuotes :: Text -> Text
escapeDoubleQuotes = Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"\\\""

-- escapeSingleQuotes :: T.Text -> T.Text
-- escapeSingleQuotes = T.replace "'" "\'"

-- escapeQuotes :: String -> String
-- escapeQuotes = regexReplace "([\"'])" "\\1"

-- -- | 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' "" = []
-- words' s  = map stripquotes $ fromparse $ parsewith p s
--     where
--       p = do ss <- (singleQuotedPattern <|> doubleQuotedPattern <|> pattern) `sepBy` many1 spacenonewline
--              -- eof
--              return ss
--       pattern = many (noneOf whitespacechars)
--       singleQuotedPattern = between (char '\'') (char '\'') (many $ noneOf "'")
--       doubleQuotedPattern = between (char '"') (char '"') (many $ noneOf "\"")

-- -- | Quote-aware version of unwords - single-quote strings which contain whitespace
-- unwords' :: [Text] -> Text
-- unwords' = T.unwords . map quoteIfNeeded

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

isSingleQuoted :: Text -> Bool
isSingleQuoted :: Text -> Bool
isSingleQuoted Text
s =
  Text -> Int
T.length (Int -> Text -> Text
T.take Int
2 Text
s) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
&& Text -> Char
T.head Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
&& Text -> Char
T.last Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''

isDoubleQuoted :: Text -> Bool
isDoubleQuoted :: Text -> Bool
isDoubleQuoted Text
s =
  Text -> Int
T.length (Int -> Text -> Text
T.take Int
2 Text
s) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
&& Text -> Char
T.head Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
&& Text -> Char
T.last Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"'

textUnbracket :: Text -> Text
textUnbracket :: Text -> Text
textUnbracket Text
s
    | (Text -> Char
T.head Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'[' Bool -> Bool -> Bool
&& Text -> Char
T.last Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']') Bool -> Bool -> Bool
|| (Text -> Char
T.head Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
&& Text -> Char
T.last Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')') = Text -> Text
T.init (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.tail Text
s
    | Bool
otherwise = Text
s

-- | Join several multi-line strings as side-by-side rectangular strings of the same height, top-padded.
-- Treats wide characters as double width.
textConcatTopPadded :: [Text] -> Text
textConcatTopPadded :: [Text] -> Text
textConcatTopPadded [Text]
ts = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Text
T.concat ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$ [[Text]] -> [[Text]]
forall a. [[a]] -> [[a]]
transpose [[Text]]
padded
    where
      lss :: [[Text]]
lss = (Text -> [Text]) -> [Text] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Text]
T.lines [Text]
ts :: [[Text]]
      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
$ ([Text] -> Int) -> [[Text]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Text]]
lss
      ypad :: [a] -> [a]
ypad [a]
ls = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. (Num a, Ord a) => a -> a -> a
difforzero Int
h ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls)) a
"" [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ls
      xpad :: [Text] -> [Text]
xpad [Text]
ls = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
textPadLeftWide Int
w) [Text]
ls
        where w :: Int
w | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ls = Int
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
$ (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Int
textWidth [Text]
ls
      padded :: [[Text]]
padded = ([Text] -> [Text]) -> [[Text]] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map ([Text] -> [Text]
xpad ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. IsString a => [a] -> [a]
ypad) [[Text]]
lss :: [[Text]]

-- -- | 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 strs = intercalate "\n" $ map concat $ transpose padded
--     where
--       lss = map lines strs
--       h = maximum $ map length lss
--       ypad ls = ls ++ replicate (difforzero h (length ls)) ""
--       xpad ls = map (padRightWide w) ls where w | null ls = 0
--                                                 | otherwise = maximum $ map strWidth ls
--       padded = map (xpad . ypad) 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 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 -> a -> a
difforzero a
a 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), a
0]

-- -- | Convert a multi-line string to a rectangular string left-padded to the specified width.
-- -- Treats wide characters as double width.
-- padleft :: Int -> String -> String
-- padleft w "" = concat $ replicate w " "
-- padleft w s = intercalate "\n" $ map (printf (printf "%%%ds" w)) $ lines s

-- -- | Convert a multi-line string to a rectangular string right-padded to the specified width.
-- -- Treats wide characters as double width.
-- padright :: Int -> String -> String
-- padright w "" = concat $ replicate w " "
-- padright w s = intercalate "\n" $ map (printf (printf "%%-%ds" w)) $ lines s

-- -- | Clip a multi-line string to the specified width and height from the top left.
-- cliptopleft :: Int -> Int -> String -> String
-- cliptopleft w h = intercalate "\n" . take h . map (take w) . lines

-- -- | Clip and pad a multi-line string to fill the specified width and height.
-- fitto :: Int -> Int -> String -> String
-- fitto w h s = intercalate "\n" $ take h $ rows ++ repeat blankline
--     where
--       rows = map (fit w) $ lines s
--       fit w = take w . (++ repeat ' ')
--       blankline = replicate w ' '

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

-- | General-purpose wide-char-aware single-line text 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.
fitText :: Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText :: Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText Maybe Int
mminwidth Maybe Int
mmaxwidth Bool
ellipsify Bool
rightside = Text -> Text
clip (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
pad
  where
    clip :: Text -> Text
    clip :: Text -> Text
clip Text
s =
      case Maybe Int
mmaxwidth of
        Just Int
w
          | Text -> Int
textWidth Text
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
w ->
            case Bool
rightside of
              Bool
True  -> Int -> Text -> Text
textTakeWidth (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
ellipsis) Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ellipsis
              Bool
False -> Text
ellipsis Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.reverse (Int -> Text -> Text
textTakeWidth (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
ellipsis) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.reverse Text
s)
          | Bool
otherwise -> Text
s
          where
            ellipsis :: Text
ellipsis = if Bool
ellipsify then Text
".." else Text
""
        Maybe Int
Nothing -> Text
s
    pad :: Text -> Text
    pad :: Text -> Text
pad Text
s =
      case Maybe Int
mminwidth of
        Just Int
w
          | Int
sw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w ->
            case Bool
rightside of
              Bool
True  -> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sw) Text
" "
              Bool
False -> Int -> Text -> Text
T.replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sw) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
          | Bool
otherwise -> Text
s
        Maybe Int
Nothing -> Text
s
      where sw :: Int
sw = Text -> Int
textWidth Text
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 text to the specified width.
-- Treats wide characters as double width.
-- Works on multi-line texts too (but will rewrite non-unix line endings).
textPadLeftWide :: Int -> Text -> Text
textPadLeftWide :: Int -> Text -> Text
textPadLeftWide Int
w Text
"" = Int -> Text -> Text
T.replicate Int
w Text
" "
textPadLeftWide Int
w Text
s  = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w) Maybe Int
forall a. Maybe a
Nothing Bool
False Bool
False) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
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).
textPadRightWide :: Int -> Text -> Text
textPadRightWide :: Int -> Text -> Text
textPadRightWide Int
w Text
"" = Int -> Text -> Text
T.replicate Int
w Text
" "
textPadRightWide Int
w Text
s  = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w) Maybe Int
forall a. Maybe a
Nothing Bool
False Bool
True) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
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 textTakeWidth 3 "りんご" = "り".
textTakeWidth :: Int -> Text -> Text
textTakeWidth :: Int -> Text -> Text
textTakeWidth Int
_ Text
""     = Text
""
textTakeWidth Int
0 Text
_      = Text
""
textTakeWidth Int
w Text
t | Bool -> Bool
not (Text -> Bool
T.null Text
t),
                let c :: Char
c = Text -> Char
T.head Text
t,
                let cw :: Int
cw = Char -> Int
charWidth Char
c,
                Int
cw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
w
                = Char -> Text -> Text
T.cons Char
c (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
textTakeWidth (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
cw) (Text -> Text
T.tail Text
t)
              | Bool
otherwise = Text
""


-- | Read a decimal number from a Text. Assumes the input consists only of digit
-- characters.
readDecimal :: Text -> Integer
readDecimal :: Text -> Integer
readDecimal = (Integer -> Char -> Integer) -> Integer -> [Char] -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Integer -> Char -> Integer
step Integer
0 ([Char] -> Integer) -> (Text -> [Char]) -> Text -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
  where step :: Integer -> Char -> Integer
step Integer
a Char
c = Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Int
digitToInt Char
c)


tests_Text :: TestTree
tests_Text = [Char] -> [TestTree] -> TestTree
tests [Char]
"Text" [
   [Char] -> Assertion -> TestTree
test [Char]
"quoteIfSpaced" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
     Text -> Text
quoteIfSpaced Text
"a'a" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"a'a"
     Text -> Text
quoteIfSpaced Text
"a\"a" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"a\"a"
     Text -> Text
quoteIfSpaced Text
"a a" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"\"a a\""
     Text -> Text
quoteIfSpaced Text
"mimi's cafe" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"\"mimi's cafe\""
     Text -> Text
quoteIfSpaced Text
"\"alex\" cafe" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"\"\\\"alex\\\" cafe\""
     Text -> Text
quoteIfSpaced Text
"le'shan's cafe" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"\"le'shan's cafe\""
     Text -> Text
quoteIfSpaced Text
"\"be'any's\" cafe" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
"\"\\\"be'any's\\\" cafe\""
  ]