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

    {- |
       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 :: forall a. Eq a => [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 :: forall a. Eq a => [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 :: forall a. Eq a => [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 a. Eq a => a -> [a] -> 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 a. Eq a => a -> [a] -> 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 b a. (b -> a -> b) -> b -> [a] -> b
    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. HasCallStack => [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
        = [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 a. Eq a => 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 :: forall a. Eq a => [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 a. Eq a => 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 a. Eq a => 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 :: forall a. Eq a => [a] -> [a]
    noDoubles []
        = []
    noDoubles (a
    e : [a]
    s)
        | a
    e a -> [a] -> Bool
    forall a. Eq a => 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 :: 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 =
       (Either a b -> ([a], [b]) -> ([a], [b]))
    -> ([a], [b]) -> [Either a b] -> ([a], [b])
    forall a b. (a -> b -> b) -> 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 :: forall a. 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 :: 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

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