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

{- |
   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              = reverse . dropWhile isSpace . reverse . dropWhile isSpace

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

stringToUpper           :: String -> String
stringToUpper           = map toUpper

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

stringToLower           :: String -> String
stringToLower           = map toLower


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

stringAll       :: (Eq a) => [a] -> [a] -> [Int]
stringAll x     = map fst . filter ((x `isPrefixOf`) . snd) . zip [0..] . tails

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

stringFirst     :: (Eq a) => [a] -> [a] -> Maybe Int
stringFirst x   = listToMaybe . stringAll x

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

stringLast      :: (Eq a) => [a] -> [a] -> Maybe Int
stringLast x    = listToMaybe . reverse . stringAll x

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

normalizeNumber         :: String -> String
normalizeNumber
    = reverse . dropWhile (== ' ') . reverse .
      dropWhile (\x -> x == '0' || x == ' ')

-- | Reduce whitespace sequences to a single whitespace

normalizeWhitespace     :: String -> String
normalizeWhitespace     = unwords . words

-- | replace all whitespace chars by blanks

normalizeBlanks         :: String -> String
normalizeBlanks         = map (\ x -> if isSpace x then ' ' else x)

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

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

escapeURI :: String -> String
escapeURI ref
    = concatMap replace ref
      where
      notAllowed        :: Char -> Bool
      notAllowed c
          = c < '\31'
            ||
            c `elem` ['\DEL', ' ', '<', '>', '\"', '{', '}', '|', '\\', '^', '`' ]

      replace :: Char -> String
      replace c
          | notAllowed c
              = '%' : charToHexString c
          | otherwise
              = [c]

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

escapeXml               :: String -> String -> String
escapeXml escSet
    = concatMap esc
      where
      esc c
          | c `elem` escSet
              = "&#" ++ show (fromEnum c) ++ ";"
          | otherwise
              = [c]

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

stringEscapeXml :: String -> String
stringEscapeXml = 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           = escapeXml "<&"

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

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

stringToInt             :: Int -> String -> Int
stringToInt base digits
    = sign * (foldl acc 0 $ concatMap digToInt digits1)
      where
      splitSign ('-' : ds) = ((-1), ds)
      splitSign ('+' : ds) = ( 1  , ds)
      splitSign ds         = ( 1  , ds)
      (sign, digits1)      = splitSign digits
      digToInt c
          | c >= '0' && c <= '9'
              = [ord c - ord '0']
          | c >= 'A' && c <= 'Z'
              =  [ord c - ord 'A' + 10]
          | c >= 'a' && c <= 'z'
              =  [ord c - ord 'a' + 10]
          | otherwise
              = []
      acc i1 i0
          = i1 * base + i0


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

hexStringToInt          :: String -> Int
hexStringToInt          = stringToInt 16

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

decimalStringToInt      :: String -> Int
decimalStringToInt      = stringToInt 10

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

stringToHexString       :: String -> String
stringToHexString       = concatMap charToHexString

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

charToHexString         :: Char -> String
charToHexString c
    = [ fourBitsToChar (c' `div` 16)
      , fourBitsToChar (c' `mod` 16)
      ]
    where
    c' = fromEnum c

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

intToHexString          :: Int -> String
intToHexString i
    | i == 0
        = "0"
    | i > 0
        = intToStr i
    | otherwise
        = error ("intToHexString: negative argument " ++ show i)
    where
    intToStr 0  = ""
    intToStr i' = intToStr (i' `div` 16) ++ [fourBitsToChar (i' `mod` 16)]

fourBitsToChar          :: Int -> Char
fourBitsToChar i        = "0123456789ABCDEF" !! 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
    = doubles' []
      where
      doubles' acc []
          = acc
      doubles' acc (e : s)
          | e `elem` s
            &&
            e `notElem` acc
              = doubles' (e:acc) s
          | otherwise
              = doubles' acc s

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

singles :: Eq a => [a] -> [a]
singles
    = singles' []
      where
      singles' acc []
          = acc
      singles' acc (e : s)
          | e `elem` s
            ||
            e `elem` acc
              = singles' acc s
          | otherwise
              = singles' (e : acc) s

-- |
-- remove duplicates from list

noDoubles :: Eq a => [a] -> [a]
noDoubles []
    = []
noDoubles (e : s)
    | e `elem` s = noDoubles s
    | otherwise  = e : noDoubles s

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

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

partitionEither :: [Either a b] -> ([a], [b])
partitionEither =
   foldr (\x ~(ls,rs) -> either (\l -> (l:ls,rs)) (\r -> (ls,r:rs)) x) ([],[])

toMaybe :: Bool -> a -> Maybe a
toMaybe False _ = Nothing
toMaybe True  x = Just x

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

-- | mothers little helpers for to much curry

uncurry3                        :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 f ~(a, b, c)           = f a b c

uncurry4                        :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 f ~(a, b, c, d)        = f a b c d

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