{-# 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.String (charWidth)
import Hledger.Utils.Test
textElideRight :: Int -> Text -> Text
textElideRight :: Int -> Text -> Text
textElideRight width :: Int
width t :: 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
- 2) Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ".." else Text
t
quoteIfSpaced :: T.Text -> T.Text
quoteIfSpaced :: Text -> Text
quoteIfSpaced s :: 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 s :: 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
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeDoubleQuotes Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\""
| Bool
otherwise = Text
s
quotechars, whitespacechars :: [Char]
quotechars :: [Char]
quotechars = "'\""
whitespacechars :: [Char]
whitespacechars = " \t\n\r"
escapeDoubleQuotes :: T.Text -> T.Text
escapeDoubleQuotes :: Text -> Text
escapeDoubleQuotes = Text -> Text -> Text -> Text
T.replace "\"" "\\\""
stripquotes :: Text -> Text
stripquotes :: Text -> Text
stripquotes s :: 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 s :: Text
s =
Text -> Int
T.length (Int -> Text -> Text
T.take 2 Text
s) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2 Bool -> Bool -> Bool
&& Text -> Char
T.head Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\'' Bool -> Bool -> Bool
&& Text -> Char
T.last Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\''
isDoubleQuoted :: Text -> Bool
isDoubleQuoted :: Text -> Bool
isDoubleQuoted s :: Text
s =
Text -> Int
T.length (Int -> Text -> Text
T.take 2 Text
s) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2 Bool -> Bool -> Bool
&& Text -> Char
T.head Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '"' Bool -> Bool -> Bool
&& Text -> Char
T.last Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '"'
textUnbracket :: Text -> Text
textUnbracket :: Text -> Text
textUnbracket s :: Text
s
| (Text -> Char
T.head Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '[' Bool -> Bool -> Bool
&& Text -> Char
T.last Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ']') Bool -> Bool -> Bool
|| (Text -> Char
T.head Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '(' Bool -> Bool -> Bool
&& Text -> Char
T.last Text
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ')') = 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 ts :: [Text]
ts = Text -> [Text] -> Text
T.intercalate "\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 ls :: [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]
forall a. [a] -> [a] -> [a]
++ [a]
ls
xpad :: [Text] -> [Text]
xpad ls :: [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 = 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
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]
fitText :: Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText :: Maybe Int -> Maybe Int -> Bool -> Bool -> Text -> Text
fitText mminwidth :: Maybe Int
mminwidth mmaxwidth :: Maybe Int
mmaxwidth ellipsify :: Bool
ellipsify rightside :: 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 s :: Text
s =
case Maybe Int
mmaxwidth of
Just w :: Int
w
| Text -> Int
textWidth Text
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
w ->
case Bool
rightside of
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
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 ".." else ""
Nothing -> Text
s
pad :: Text -> Text
pad :: Text -> Text
pad s :: Text
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 -> 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) " "
False -> Int -> Text -> Text
T.replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sw) " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
| Bool
otherwise -> Text
s
Nothing -> Text
s
where sw :: Int
sw = Text -> Int
textWidth Text
s
textPadLeftWide :: Int -> Text -> Text
textPadLeftWide :: Int -> Text -> Text
textPadLeftWide w :: Int
w "" = Int -> Text -> Text
T.replicate Int
w " "
textPadLeftWide w :: Int
w s :: Text
s = Text -> [Text] -> Text
T.intercalate "\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 w :: Int
w "" = Int -> Text -> Text
T.replicate Int
w " "
textPadRightWide w :: Int
w s :: Text
s = Text -> [Text] -> Text
T.intercalate "\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 _ "" = ""
textTakeWidth 0 _ = ""
textTakeWidth w :: Int
w t :: 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 = ""
textWidth :: Text -> Int
textWidth :: Text -> Int
textWidth "" = 0
textWidth s :: Text
s = [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 ((Char -> Int -> Int) -> Int -> Text -> Int
forall a. (Char -> a -> a) -> a -> Text -> a
T.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) ([Text] -> [Int]) -> [Text] -> [Int]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
s
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 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 a :: Integer
a c :: Char
c = Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 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 "Text" [
[Char] -> Assertion -> TestTree
test "quoteIfSpaced" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
Text -> Text
quoteIfSpaced "a'a" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "a'a"
Text -> Text
quoteIfSpaced "a\"a" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "a\"a"
Text -> Text
quoteIfSpaced "a a" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "\"a a\""
Text -> Text
quoteIfSpaced "mimi's cafe" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "\"mimi's cafe\""
Text -> Text
quoteIfSpaced "\"alex\" cafe" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "\"\\\"alex\\\" cafe\""
Text -> Text
quoteIfSpaced "le'shan's cafe" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "\"le'shan's cafe\""
Text -> Text
quoteIfSpaced "\"be'any's\" cafe" Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= "\"\\\"be'any's\\\" cafe\""
]