-- | 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,
  wrap,
  textChomp,
 -- -- quoting
  quoteIfSpaced,
  textQuoteIfNeeded,
 -- singleQuoteIfNeeded,
 -- -- quotechars,
 -- -- whitespacechars,
  escapeDoubleQuotes,
 -- escapeSingleQuotes,
 -- escapeQuotes,
 -- words',
 -- unwords',
  stripquotes,
 -- isSingleQuoted,
 -- isDoubleQuoted,
 -- -- * single-line layout
 -- elideLeft,
  textElideRight,
  formatText,
 -- -- * multi-line layout
  textConcatTopPadded,
  textConcatBottomPadded,
 -- concatOneLine,
 -- vConcatLeftAligned,
 -- vConcatRightAligned,
 -- padtop,
 -- padbottom,
 -- padleft,
 -- padright,
 -- cliptopleft,
 -- fitto,
  fitText,
  linesPrepend,
  linesPrepend2,
  unlinesB,
 -- -- * wide-character-aware layout
  WideBuilder(..),
  wbToText,
  wbUnpack,
  textWidth,
  textTakeWidth,
 -- fitString,
 -- fitStringMulti,
  textPadLeftWide,
  textPadRightWide,
  -- -- * Reading
  readDecimal,
  -- -- * tests
  tests_Text
  )
where

import Data.Char (digitToInt)
import Data.Default (def)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB

import Hledger.Utils.Test ((@?=), test, tests)
import Text.Tabular (Header(..), Properties(..))
import Text.Tabular.AsciiWide (Align(..), TableOpts(..), textCell, renderRow)
import Text.WideString (WideBuilder(..), wbToText, wbUnpack, 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

-- | Wrap a Text with the surrounding Text.
wrap :: Text -> Text -> Text -> Text
wrap :: Text -> Text -> Text -> Text
wrap Text
start Text
end Text
x = Text
start Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
end

-- | Remove trailing newlines/carriage returns.
textChomp :: Text -> Text
textChomp :: Text -> Text
textChomp = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\r', Char
'\n'])

-- | 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).
formatText :: Bool -> Maybe Int -> Maybe Int -> Text -> Text
formatText :: Bool -> Maybe Int -> Maybe Int -> Text -> Text
formatText Bool
leftJustified Maybe Int
minwidth Maybe Int
maxwidth Text
t =
    Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
pad (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
clip) ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
t then [Text
""] else Text -> [Text]
T.lines Text
t
  where
    pad :: Text -> Text
pad  = (Text -> Text)
-> (Int -> Text -> Text) -> Maybe Int -> Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> Text
forall a. a -> a
id Int -> Text -> Text
justify Maybe Int
minwidth
    clip :: Text -> Text
clip = (Text -> Text)
-> (Int -> Text -> Text) -> Maybe Int -> Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> Text
forall a. a -> a
id Int -> Text -> Text
T.take Maybe Int
maxwidth
    justify :: Int -> Text -> Text
justify Int
n = if Bool
leftJustified then Int -> Char -> Text -> Text
T.justifyLeft Int
n Char
' ' else Int -> Char -> Text -> Text
T.justifyRight Int
n Char
' '

-- 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
c -> (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c) 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
c -> (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c) 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 -> Text
TL.toStrict (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableOpts -> Header Cell -> Text
renderRow TableOpts
forall a. Default a => a
def{tableBorders :: Bool
tableBorders=Bool
False, borderSpaces :: Bool
borderSpaces=Bool
False}
                    (Header Cell -> Text) -> ([Text] -> Header Cell) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Properties -> [Header Cell] -> Header Cell
forall h. Properties -> [Header h] -> Header h
Group Properties
NoLine ([Header Cell] -> Header Cell)
-> ([Text] -> [Header Cell]) -> [Text] -> Header Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Header Cell) -> [Text] -> [Header Cell]
forall a b. (a -> b) -> [a] -> [b]
map (Cell -> Header Cell
forall h. h -> Header h
Header (Cell -> Header Cell) -> (Text -> Cell) -> Text -> Header Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Align -> Text -> Cell
textCell Align
BottomLeft)

-- | Join several multi-line strings as side-by-side rectangular strings of the same height, bottom-padded.
-- Treats wide characters as double width.
textConcatBottomPadded :: [Text] -> Text
textConcatBottomPadded :: [Text] -> Text
textConcatBottomPadded = Text -> Text
TL.toStrict (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableOpts -> Header Cell -> Text
renderRow TableOpts
forall a. Default a => a
def{tableBorders :: Bool
tableBorders=Bool
False, borderSpaces :: Bool
borderSpaces=Bool
False}
                       (Header Cell -> Text) -> ([Text] -> Header Cell) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Properties -> [Header Cell] -> Header Cell
forall h. Properties -> [Header h] -> Header h
Group Properties
NoLine ([Header Cell] -> Header Cell)
-> ([Text] -> [Header Cell]) -> [Text] -> Header Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Header Cell) -> [Text] -> [Header Cell]
forall a b. (a -> b) -> [a] -> [b]
map (Cell -> Header Cell
forall h. h -> Header h
Header (Cell -> Header Cell) -> (Text -> Cell) -> Text -> Header Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Align -> Text -> Cell
textCell Align
TopLeft)

-- -- | 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

-- -- | 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
""

-- | Add a prefix to each line of a string.
linesPrepend :: Text -> Text -> Text
linesPrepend :: Text -> Text -> Text
linesPrepend Text
prefix = [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
prefixText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

-- | Add a prefix to the first line of a string, 
-- and a different prefix to the remaining lines.
linesPrepend2 :: Text -> Text -> Text -> Text
linesPrepend2 :: Text -> Text -> Text -> Text
linesPrepend2 Text
prefix1 Text
prefix2 Text
s = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ case Text -> [Text]
T.lines Text
s of
    []   -> []
    Text
l:[Text]
ls -> (Text
prefix1Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
l) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
prefix2Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
ls

-- | Join a list of Text Builders with a newline after each item.
unlinesB :: [TB.Builder] -> TB.Builder
unlinesB :: [Builder] -> Builder
unlinesB = (Builder -> Builder) -> [Builder] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TB.singleton Char
'\n')

-- | 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 -> Text -> Integer
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' Integer -> Char -> Integer
step Integer
0
  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\""
  ]