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

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

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

       Helper functions for RelaxNG validation

    -}

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

    module Text.XML.HXT.RelaxNG.Utils
        ( isRelaxAnyURI
        , compareURI
        , normalizeURI
        , isNumber
        , isNmtoken
        , isName
        , formatStringList
        , formatStringListPatt
        , formatStringListId
        , formatStringListQuot
        , formatStringListPairs
        , formatStringListArr
        )
    where

    import Text.ParserCombinators.Parsec

    import Text.XML.HXT.Parser.XmlTokenParser
        ( skipS0
        , nmtoken
        , name
        )

    import Network.URI
        ( isURI
        , isRelativeReference
        , parseURI
        , URI(..)
        )

    import Data.Maybe
        ( fromMaybe
        )

    import Data.Char
        ( toLower
        )

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

    -- | Tests whether a URI matches the Relax NG anyURI symbol

    isRelaxAnyURI :: String -> Bool
    isRelaxAnyURI s
        = s == "" ||
          ( isURI s && not (isRelativeReference s) &&
            ( let (URI _ _ path _ frag) = fromMaybe (URI "" Nothing "" "" "") $ parseURI s
              in (frag == "" && path /= "")
            )
          )

    -- | Tests whether two URIs are equal after 'normalizeURI' is performed

    compareURI :: String -> String -> Bool
    compareURI uri1 uri2
        = normalizeURI uri1 == normalizeURI uri2

    -- |  Converts all letters to the corresponding lower-case letter
    -- and removes a trailing \"\/\"

    normalizeURI :: String -> String
    normalizeURI ""
        = ""
    normalizeURI uri
        = map toLower ( if last uri == '/'
                        then init uri
                        else uri
                      )

    checkByParsing  :: Parser String -> String -> Bool
    checkByParsing p s
        = either (const False) (const True) (parse p' "" s)
          where
          p' = do
               r <- p
               eof
               return r

    -- | Tests whether a string matches a number [-](0-9)*
    isNumber :: String -> Bool
    isNumber
        = checkByParsing parseNumber'
        where
        parseNumber' :: Parser String
        parseNumber'
            = do
              skipS0
              m <- option "" (string "-")
              n <- many1 digit
              skipS0
              return $ m ++ n

    isNmtoken       :: String -> Bool
    isNmtoken    = checkByParsing nmtoken

    isName  :: String -> Bool
    isName  = checkByParsing name

    {- |

    Formats a list of strings into a single string.
    The first parameter formats the elements, the 2. is inserted
    between two elements.

    example:

    > formatStringList show ", " ["foo", "bar", "baz"] -> "foo", "bar", "baz"

    -}

    formatStringListPatt :: [String] -> String
    formatStringListPatt
        = formatStringList (++ "-") ", "

    formatStringListPairs :: [(String,String)] -> String
    formatStringListPairs
        = formatStringList id ", "
          . map (\ (a, b) -> a ++ " = " ++ show b)

    formatStringListQuot :: [String] -> String
    formatStringListQuot
        = formatStringList show ", "

    formatStringListId :: [String] -> String
    formatStringListId
        = formatStringList id ", "

    formatStringListArr :: [String] -> String
    formatStringListArr
        = formatStringList show " -> "

    formatStringList :: (String -> String) -> String -> [String] -> String
    formatStringList _sf _sp []
        = ""
    formatStringList sf spacer l
        = reverse $ drop (length spacer) $ reverse $
          foldr (\e -> ((if e /= "" then sf e ++ spacer else "") ++)) "" l

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