{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Hledger.Utils.Text
(
textUnbracket,
quoteIfSpaced,
textQuoteIfNeeded,
escapeDoubleQuotes,
stripquotes,
textElideRight,
textConcatTopPadded,
fitText,
textWidth,
textTakeWidth,
textPadLeftWide,
textPadRightWide,
readDecimal,
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 Hledger.Utils.Test
import Text.WideString (charWidth, textWidth)
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
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
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
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
"\\\""
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
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]]
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]
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
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
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
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
""
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\""
]