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

{- |
   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 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

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

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

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

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

-- ------------------------------------------------------------
-- | 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
== ' ') (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
== ' ')

-- | 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 (\ x :: Char
x -> if Char -> Bool
isSpace Char
x then ' ' 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 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]

-- |
-- 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 "<>\"\'&"

-- |
-- 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 "<&"

-- |
-- 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 "<>\"\'&\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


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

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

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

decimalStringToInt      :: String -> Int
decimalStringToInt :: String -> Int
decimalStringToInt      = Int -> String -> Int
stringToInt 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 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

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

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

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

-- |
-- 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' 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

-- |
-- 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' 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

-- |
-- remove duplicates from list

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

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

-- | 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 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

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