-- ------------------------------------------------------------

{- |
   Module     : Text.XML.HXT.DOM.Util
   Copyright  : Copyright (C) 2008 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : stable
   Portability: portable

   Little useful things for strings, lists and other values

-}

-- ------------------------------------------------------------

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

-- ------------------------------------------------------------

-- |
-- remove leading and trailing whitespace with standard Haskell predicate isSpace

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

-- |
-- convert string to uppercase with standard Haskell toUpper function

stringToUpper           :: String -> String
stringToUpper :: String -> String
stringToUpper           = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper

-- |
-- convert string to lowercase with standard Haskell toLower function

stringToLower           :: String -> String
stringToLower :: String -> String
stringToLower           = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower


-- | find all positions where a string occurs within another string

stringAll       :: (Eq a) => [a] -> [a] -> [Int]
stringAll :: [a] -> [a] -> [Int]
stringAll [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 [Int
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

-- | find the position of the first occurence of a string

stringFirst     :: (Eq a) => [a] -> [a] -> Maybe Int
stringFirst :: [a] -> [a] -> Maybe Int
stringFirst [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

-- | find the position of the last occurence of a string

stringLast      :: (Eq a) => [a] -> [a] -> Maybe Int
stringLast :: [a] -> [a] -> Maybe Int
stringLast [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

-- ------------------------------------------------------------
-- | Removes leading \/ trailing whitespaces and leading zeros

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
== Char
' ') (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
x -> Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')

-- | Reduce whitespace sequences to a single whitespace

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

-- | replace all whitespace chars by blanks

normalizeBlanks         :: String -> String
normalizeBlanks :: String -> String
normalizeBlanks         = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\ Char
x -> if Char -> Bool
isSpace Char
x then Char
' ' else Char
x)

-- ------------------------------------------------------------

-- | Escape all disallowed characters in URI
-- references (see <http://www.w3.org/TR/xlink/#link-locators>)

escapeURI :: String -> String
escapeURI :: String -> String
escapeURI 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 Char
c
          = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\31'
            Bool -> Bool -> Bool
||
            Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\DEL', Char
' ', Char
'<', Char
'>', Char
'\"', Char
'{', Char
'}', Char
'|', Char
'\\', Char
'^', Char
'`' ]

      replace :: Char -> String
      replace :: Char -> String
replace Char
c
          | Char -> Bool
notAllowed Char
c
              = Char
'%' 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 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 Char
c
          | Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
escSet
              = String
"&#" 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]
++ String
";"
          | Bool
otherwise
              = [Char
c]

-- |
-- escape XML chars &lt;, &gt;, &quot;,  and ampercent by transforming them into character references
--
-- see also : 'attrEscapeXml'

stringEscapeXml :: String -> String
stringEscapeXml :: String -> String
stringEscapeXml = String -> String -> String
escapeXml String
"<>\"\'&"

-- |
-- escape XML chars &lt;  and ampercent by transforming them into character references, used for escaping text nodes
--
-- see also : 'attrEscapeXml'

textEscapeXml           :: String -> String
textEscapeXml :: String -> String
textEscapeXml           = String -> String -> String
escapeXml String
"<&"

-- |
-- escape XML chars in attribute values, same as stringEscapeXml, but none blank whitespace
-- is also escaped
--
-- see also : 'stringEscapeXml'

attrEscapeXml           :: String -> String
attrEscapeXml :: String -> String
attrEscapeXml           = String -> String -> String
escapeXml String
"<>\"\'&\n\r\t"

stringToInt             :: Int -> String -> Int
stringToInt :: Int -> String -> Int
stringToInt Int
base 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 Int
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 (Char
'-' : String
ds) = ((-a
1), String
ds)
      splitSign (Char
'+' : String
ds) = ( a
1  , String
ds)
      splitSign String
ds         = ( a
1  , String
ds)
      (Int
sign, String
digits1)      = String -> (Int, String)
forall a. Num a => String -> (a, String)
splitSign String
digits
      digToInt :: Char -> [Int]
digToInt Char
c
          | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'
              = [Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0']
          | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z'
              =  [Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10]
          | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z'
              =  [Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10]
          | Bool
otherwise
              = []
      acc :: Int -> Int -> Int
acc Int
i1 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


-- |
-- convert a string of hexadecimal digits into an Int

hexStringToInt          :: String -> Int
hexStringToInt :: String -> Int
hexStringToInt          = Int -> String -> Int
stringToInt Int
16

-- |
-- convert a string of digits into an Int

decimalStringToInt      :: String -> Int
decimalStringToInt :: String -> Int
decimalStringToInt      = Int -> String -> Int
stringToInt Int
10

-- |
-- convert a string into a hexadecimal string applying charToHexString
--
-- see also : 'charToHexString'

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

-- |
-- convert a char (byte) into a 2-digit hexadecimal string
--
-- see also : 'stringToHexString', 'intToHexString'

charToHexString         :: Char -> String
charToHexString :: Char -> String
charToHexString Char
c
    = [ Int -> Char
fourBitsToChar (Int
c' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
16)
      , Int -> Char
fourBitsToChar (Int
c' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
16)
      ]
    where
    c' :: Int
c' = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c

-- |
-- convert a none negative Int into a hexadecimal string
--
-- see also : 'charToHexString'

intToHexString          :: Int -> String
intToHexString :: Int -> String
intToHexString Int
i
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        = String
"0"
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        = Int -> String
intToStr Int
i
    | Bool
otherwise
        = String -> String
forall a. HasCallStack => String -> a
error (String
"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 Int
0  = String
""
    intToStr Int
i' = Int -> String
intToStr (Int
i' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
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` Int
16)]

fourBitsToChar          :: Int -> Char
fourBitsToChar :: Int -> Char
fourBitsToChar Int
i        = String
"0123456789ABCDEF" String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
i

-- ------------------------------------------------------------

-- |
-- take all elements of a list which occur more than once. The result does not contain doubles.
-- (doubles . doubles == doubles)

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' [a]
acc []
          = [a]
acc
      doubles' [a]
acc (a
e : [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

-- |
-- drop all elements from a list which occur more than once.

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' [a]
acc []
          = [a]
acc
      singles' [a]
acc (a
e : [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

-- |
-- remove duplicates from list

noDoubles :: Eq a => [a] -> [a]
noDoubles :: [a] -> [a]
noDoubles []
    = []
noDoubles (a
e : [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 (a
x,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 (\Either a b
x ~([a]
ls,[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 (\a
l -> (a
la -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls,[b]
rs)) (\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 Bool
False a
_ = Maybe a
forall a. Maybe a
Nothing
toMaybe Bool
True  a
x = a -> Maybe a
forall a. a -> Maybe a
Just a
x

-- ------------------------------------------------------------

-- | mothers little helpers for to much curry

uncurry3                        :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 a -> b -> c -> d
f ~(a
a, b
b, 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 a -> b -> c -> d -> e
f ~(a
a, b
b, c
c, d
d)        = a -> b -> c -> d -> e
f a
a b
b c
c d
d

-- ------------------------------------------------------------