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

{- |
   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              = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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           = 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           = 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 :: forall a. Eq a => [a] -> [a] -> [Int]
stringAll [a]
x     = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (([a]
x forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
tails

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

stringFirst     :: (Eq a) => [a] -> [a] -> Maybe Int
stringFirst :: forall a. Eq a => [a] -> [a] -> Maybe Int
stringFirst [a]
x   = forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Eq a => [a] -> [a] -> Maybe Int
stringLast [a]
x    = forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> [Int]
stringAll [a]
x

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

normalizeNumber         :: String -> String
normalizeNumber :: String -> String
normalizeNumber
    = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\Char
x -> Char
x forall a. Eq a => a -> a -> Bool
== Char
'0' Bool -> Bool -> Bool
|| Char
x 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 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         = 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
    = 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 forall a. Ord a => a -> a -> Bool
< Char
'\31'
            Bool -> Bool -> Bool
||
            Char
c 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
'%' 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
    = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
esc
      where
      esc :: Char -> String
esc Char
c
          | Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
escSet
              = String
"&#" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Enum a => a -> Int
fromEnum Char
c) 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 forall a. Num a => a -> a -> a
* (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Int -> Int -> Int
acc Int
0 forall a b. (a -> b) -> a -> b
$ 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)      = forall {a}. Num a => String -> (a, String)
splitSign String
digits
      digToInt :: Char -> [Int]
digToInt Char
c
          | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9'
              = [Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0']
          | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'Z'
              =  [Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' forall a. Num a => a -> a -> a
+ Int
10]
          | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'z'
              =  [Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' forall a. Num a => a -> a -> a
+ Int
10]
          | Bool
otherwise
              = []
      acc :: Int -> Int -> Int
acc Int
i1 Int
i0
          = Int
i1 forall a. Num a => a -> a -> a
* Int
base 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       = 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' forall a. Integral a => a -> a -> a
`div` Int
16)
      , Int -> Char
fourBitsToChar (Int
c' forall a. Integral a => a -> a -> a
`mod` Int
16)
      ]
    where
    c' :: Int
c' = 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 forall a. Eq a => a -> a -> Bool
== Int
0
        = String
"0"
    | Int
i forall a. Ord a => a -> a -> Bool
> Int
0
        = Int -> String
intToStr Int
i
    | Bool
otherwise
        = forall a. HasCallStack => String -> a
error (String
"intToHexString: negative argument " forall a. [a] -> [a] -> [a]
++ 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' forall a. Integral a => a -> a -> a
`div` Int
16) forall a. [a] -> [a] -> [a]
++ [Int -> Char
fourBitsToChar (Int
i' forall a. Integral a => a -> a -> a
`mod` Int
16)]

fourBitsToChar          :: Int -> Char
fourBitsToChar :: Int -> Char
fourBitsToChar Int
i        = String
"0123456789ABCDEF" 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 :: forall a. Eq a => [a] -> [a]
doubles
    = 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
s
            Bool -> Bool -> Bool
&&
            a
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
acc
              = [a] -> [a] -> [a]
doubles' (a
eforall 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 :: forall a. Eq a => [a] -> [a]
singles
    = 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
s
            Bool -> Bool -> Bool
||
            a
e 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 forall a. a -> [a] -> [a]
: [a]
acc) [a]
s

-- |
-- remove duplicates from list

noDoubles :: Eq a => [a] -> [a]
noDoubles :: forall a. Eq a => [a] -> [a]
noDoubles []
    = []
noDoubles (a
e : [a]
s)
    | a
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
s = forall a. Eq a => [a] -> [a]
noDoubles [a]
s
    | Bool
otherwise  = a
e forall a. a -> [a] -> [a]
: forall a. Eq a => [a] -> [a]
noDoubles [a]
s

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

swap :: (a,b) -> (b,a)
swap :: forall a b. (a, b) -> (b, a)
swap (a
x,b
y) = (b
y,a
x)

partitionEither :: [Either a b] -> ([a], [b])
partitionEither :: forall a b. [Either a b] -> ([a], [b])
partitionEither =
   forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Either a b
x ~([a]
ls,[b]
rs) -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\a
l -> (a
lforall a. a -> [a] -> [a]
:[a]
ls,[b]
rs)) (\b
r -> ([a]
ls,b
rforall a. a -> [a] -> [a]
:[b]
rs)) Either a b
x) ([],[])

toMaybe :: Bool -> a -> Maybe a
toMaybe :: forall a. Bool -> a -> Maybe a
toMaybe Bool
False a
_ = forall a. Maybe a
Nothing
toMaybe Bool
True  a
x = 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 :: forall a b c d. (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 :: forall a b c d e. (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

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