module Text.XML.HXT.DOM.Util
( stringTrim
, stringToLower
, stringToUpper
, stringAll
, stringFirst
, stringLast
, normalizeNumber
, normalizeWhitespace
, normalizeBlanks
, escapeURI
, textEscapeXml
, stringEscapeXml
, attrEscapeXml
, stringToInt
, stringToHexString
, charToHexString
, intToHexString
, hexStringToInt
, decimalStringToInt
, doubles
, singles
, noDoubles
, swap
, partitionEither
, toMaybe
, uncurry3
, uncurry4
)
where
import Data.Char
import Data.List
import Data.Maybe
stringTrim :: String -> String
stringTrim :: String -> String
stringTrim = 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 -> Bool
isSpace (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 -> Bool
isSpace
stringToUpper :: String -> String
stringToUpper :: String -> String
stringToUpper = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper
stringToLower :: String -> String
stringToLower :: String -> String
stringToLower = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
stringAll :: (Eq a) => [a] -> [a] -> [Int]
stringAll :: [a] -> [a] -> [Int]
stringAll x :: [a]
x = ((Int, [a]) -> Int) -> [(Int, [a])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [a]) -> Int
forall a b. (a, b) -> a
fst ([(Int, [a])] -> [Int]) -> ([a] -> [(Int, [a])]) -> [a] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, [a]) -> Bool) -> [(Int, [a])] -> [(Int, [a])]
forall a. (a -> Bool) -> [a] -> [a]
filter (([a]
x [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) ([a] -> Bool) -> ((Int, [a]) -> [a]) -> (Int, [a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [a]) -> [a]
forall a b. (a, b) -> b
snd) ([(Int, [a])] -> [(Int, [a])])
-> ([a] -> [(Int, [a])]) -> [a] -> [(Int, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [[a]] -> [(Int, [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] ([[a]] -> [(Int, [a])]) -> ([a] -> [[a]]) -> [a] -> [(Int, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. [a] -> [[a]]
tails
stringFirst :: (Eq a) => [a] -> [a] -> Maybe Int
stringFirst :: [a] -> [a] -> Maybe Int
stringFirst x :: [a]
x = [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe ([Int] -> Maybe Int) -> ([a] -> [Int]) -> [a] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a] -> [Int]
forall a. Eq a => [a] -> [a] -> [Int]
stringAll [a]
x
stringLast :: (Eq a) => [a] -> [a] -> Maybe Int
stringLast :: [a] -> [a] -> Maybe Int
stringLast x :: [a]
x = [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe ([Int] -> Maybe Int) -> ([a] -> [Int]) -> [a] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> ([a] -> [Int]) -> [a] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a] -> [Int]
forall a. Eq a => [a] -> [a] -> [Int]
stringAll [a]
x
normalizeNumber :: String -> String
normalizeNumber :: String -> String
normalizeNumber
= 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 -> Char -> 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
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 (\x :: Char
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '0' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ')
normalizeWhitespace :: String -> String
normalizeWhitespace :: String -> String
normalizeWhitespace = [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
normalizeBlanks :: String -> String
normalizeBlanks :: String -> String
normalizeBlanks = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\ x :: Char
x -> if Char -> Bool
isSpace Char
x then ' ' else Char
x)
escapeURI :: String -> String
escapeURI :: String -> String
escapeURI ref :: String
ref
= (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
replace String
ref
where
notAllowed :: Char -> Bool
notAllowed :: Char -> Bool
notAllowed c :: Char
c
= Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< '\31'
Bool -> Bool -> Bool
||
Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ['\DEL', ' ', '<', '>', '\"', '{', '}', '|', '\\', '^', '`' ]
replace :: Char -> String
replace :: Char -> String
replace c :: Char
c
| Char -> Bool
notAllowed Char
c
= '%' Char -> String -> String
forall a. a -> [a] -> [a]
: Char -> String
charToHexString Char
c
| Bool
otherwise
= [Char
c]
escapeXml :: String -> String -> String
escapeXml :: String -> String -> String
escapeXml escSet :: String
escSet
= (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
esc
where
esc :: Char -> String
esc c :: Char
c
| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
escSet
= "&#" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ";"
| Bool
otherwise
= [Char
c]
stringEscapeXml :: String -> String
stringEscapeXml :: String -> String
stringEscapeXml = String -> String -> String
escapeXml "<>\"\'&"
textEscapeXml :: String -> String
textEscapeXml :: String -> String
textEscapeXml = String -> String -> String
escapeXml "<&"
attrEscapeXml :: String -> String
attrEscapeXml :: String -> String
attrEscapeXml = String -> String -> String
escapeXml "<>\"\'&\n\r\t"
stringToInt :: Int -> String -> Int
stringToInt :: Int -> String -> Int
stringToInt base :: Int
base digits :: String
digits
= Int
sign Int -> Int -> Int
forall a. Num a => a -> a -> a
* ((Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Int -> Int -> Int
acc 0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> [Int]) -> String -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Int]
digToInt String
digits1)
where
splitSign :: String -> (a, String)
splitSign ('-' : ds :: String
ds) = ((-1), String
ds)
splitSign ('+' : ds :: String
ds) = ( 1 , String
ds)
splitSign ds :: String
ds = ( 1 , String
ds)
(sign :: Int
sign, digits1 :: String
digits1) = String -> (Int, String)
forall a. Num a => String -> (a, String)
splitSign String
digits
digToInt :: Char -> [Int]
digToInt c :: Char
c
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '9'
= [Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord '0']
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= 'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= 'Z'
= [Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord 'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 10]
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= 'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= 'z'
= [Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord 'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 10]
| Bool
otherwise
= []
acc :: Int -> Int -> Int
acc i1 :: Int
i1 i0 :: Int
i0
= Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i0
hexStringToInt :: String -> Int
hexStringToInt :: String -> Int
hexStringToInt = Int -> String -> Int
stringToInt 16
decimalStringToInt :: String -> Int
decimalStringToInt :: String -> Int
decimalStringToInt = Int -> String -> Int
stringToInt 10
stringToHexString :: String -> String
stringToHexString :: String -> String
stringToHexString = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
charToHexString
charToHexString :: Char -> String
charToHexString :: Char -> String
charToHexString c :: Char
c
= [ Int -> Char
fourBitsToChar (Int
c' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 16)
, Int -> Char
fourBitsToChar (Int
c' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 16)
]
where
c' :: Int
c' = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c
intToHexString :: Int -> String
intToHexString :: Int -> String
intToHexString i :: Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
= "0"
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
= Int -> String
intToStr Int
i
| Bool
otherwise
= String -> String
forall a. HasCallStack => String -> a
error ("intToHexString: negative argument " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i)
where
intToStr :: Int -> String
intToStr 0 = ""
intToStr i' :: Int
i' = Int -> String
intToStr (Int
i' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 16) String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Int -> Char
fourBitsToChar (Int
i' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 16)]
fourBitsToChar :: Int -> Char
fourBitsToChar :: Int -> Char
fourBitsToChar i :: Int
i = "0123456789ABCDEF" String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
i
doubles :: Eq a => [a] -> [a]
doubles :: [a] -> [a]
doubles
= [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
doubles' []
where
doubles' :: [a] -> [a] -> [a]
doubles' acc :: [a]
acc []
= [a]
acc
doubles' acc :: [a]
acc (e :: a
e : s :: [a]
s)
| a
e a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
s
Bool -> Bool -> Bool
&&
a
e a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
acc
= [a] -> [a] -> [a]
doubles' (a
ea -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc) [a]
s
| Bool
otherwise
= [a] -> [a] -> [a]
doubles' [a]
acc [a]
s
singles :: Eq a => [a] -> [a]
singles :: [a] -> [a]
singles
= [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
singles' []
where
singles' :: [a] -> [a] -> [a]
singles' acc :: [a]
acc []
= [a]
acc
singles' acc :: [a]
acc (e :: a
e : s :: [a]
s)
| a
e a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
s
Bool -> Bool -> Bool
||
a
e a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
acc
= [a] -> [a] -> [a]
singles' [a]
acc [a]
s
| Bool
otherwise
= [a] -> [a] -> [a]
singles' (a
e a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc) [a]
s
noDoubles :: Eq a => [a] -> [a]
noDoubles :: [a] -> [a]
noDoubles []
= []
noDoubles (e :: a
e : s :: [a]
s)
| a
e a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
s = [a] -> [a]
forall a. Eq a => [a] -> [a]
noDoubles [a]
s
| Bool
otherwise = a
e a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
forall a. Eq a => [a] -> [a]
noDoubles [a]
s
swap :: (a,b) -> (b,a)
swap :: (a, b) -> (b, a)
swap (x :: a
x,y :: b
y) = (b
y,a
x)
partitionEither :: [Either a b] -> ([a], [b])
partitionEither :: [Either a b] -> ([a], [b])
partitionEither =
(Either a b -> ([a], [b]) -> ([a], [b]))
-> ([a], [b]) -> [Either a b] -> ([a], [b])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\x :: Either a b
x ~(ls :: [a]
ls,rs :: [b]
rs) -> (a -> ([a], [b])) -> (b -> ([a], [b])) -> Either a b -> ([a], [b])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\l :: a
l -> (a
la -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls,[b]
rs)) (\r :: b
r -> ([a]
ls,b
rb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
rs)) Either a b
x) ([],[])
toMaybe :: Bool -> a -> Maybe a
toMaybe :: Bool -> a -> Maybe a
toMaybe False _ = Maybe a
forall a. Maybe a
Nothing
toMaybe True x :: a
x = a -> Maybe a
forall a. a -> Maybe a
Just a
x
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 f :: a -> b -> c -> d
f ~(a :: a
a, b :: b
b, c :: c
c) = a -> b -> c -> d
f a
a b
b c
c
uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 f :: a -> b -> c -> d -> e
f ~(a :: a
a, b :: b
b, c :: c
c, d :: d
d) = a -> b -> c -> d -> e
f a
a b
b c
c d
d