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

    {- |
       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.XmlCharParser
        ( SimpleXParser
        , withNormNewline
        )

    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 :: String -> Bool
    isRelaxAnyURI String
    s
        = String
    s String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "" Bool -> Bool -> Bool
    ||
          ( String -> Bool
    isURI String
    s Bool -> Bool -> Bool
    && Bool -> Bool
    not (String -> Bool
    isRelativeReference String
    s) Bool -> Bool -> Bool
    &&
            ( let (URI String
    _ Maybe URIAuth
    _ String
    path String
    _ String
    frag) = URI -> Maybe URI -> URI
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Maybe URIAuth -> String -> String -> String -> URI
    URI String
    "" Maybe URIAuth
    forall a. Maybe a
    Nothing String
    "" String
    "" String
    "") (Maybe URI -> URI) -> Maybe URI -> URI
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe URI
    parseURI String
    s
              in (String
    frag String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "" Bool -> Bool -> Bool
    && String
    path String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    "")
            )
          )

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

    compareURI :: String -> String -> Bool
    compareURI :: String -> String -> Bool
    compareURI String
    uri1 String
    uri2
        = String -> String
    normalizeURI String
    uri1 String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> String
    normalizeURI String
    uri2

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

    normalizeURI :: String -> String
    normalizeURI :: String -> String
    normalizeURI String
    ""
        = String
    ""
    normalizeURI String
    uri
        = (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower ( if String -> Char
    forall a. HasCallStack => [a] -> a
    last String
    uri Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '/'
                        then String -> String
    forall a. HasCallStack => [a] -> [a]
    init String
    uri
                        else String
    uri
                      )

    checkByParsing  :: SimpleXParser String -> String -> Bool
    checkByParsing :: SimpleXParser String -> String -> Bool
    checkByParsing SimpleXParser String
    p String
    s
        = (ParseError -> Bool)
    -> (String -> Bool) -> Either ParseError String -> Bool
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Bool -> ParseError -> Bool
    forall a b. a -> b -> a
    const Bool
    False)
                 (Bool -> String -> Bool
    forall a b. a -> b -> a
    const Bool
    True)
                 (SimpleXParser String
    -> XPState () -> String -> String -> Either ParseError String
    forall tok st a.
    GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
    runParser SimpleXParser String
    p' (() -> XPState ()
    forall a. a -> XPState a
    withNormNewline ()) String
    "" String
    s)
          where
          p' :: SimpleXParser String
    p' = do
               String
    r <- SimpleXParser String
    p
               ParsecT String (XPState ()) Identity ()
    forall s (m :: * -> *) t u.
    (Stream s m t, Show t) =>
    ParsecT s u m ()
    eof
               String -> SimpleXParser String
    forall a. a -> ParsecT String (XPState ()) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    r

    -- | Tests whether a string matches a number [-](0-9)*
    isNumber :: String -> Bool
    isNumber :: String -> Bool
    isNumber
        = SimpleXParser String -> String -> Bool
    checkByParsing SimpleXParser String
    parseNumber'
        where
        parseNumber' :: SimpleXParser String
        parseNumber' :: SimpleXParser String
    parseNumber'
            = do
              ParsecT String (XPState ()) Identity ()
    forall s. XParser s ()
    skipS0
              String
    m <- String -> SimpleXParser String -> SimpleXParser String
    forall s (m :: * -> *) t a u.
    Stream s m t =>
    a -> ParsecT s u m a -> ParsecT s u m a
    option String
    "" (String -> SimpleXParser String
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m String
    string String
    "-")
              String
    n <- ParsecT String (XPState ()) Identity Char -> SimpleXParser String
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m [a]
    many1 ParsecT String (XPState ()) Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    digit
              ParsecT String (XPState ()) Identity ()
    forall s. XParser s ()
    skipS0
              String -> SimpleXParser String
    forall a. a -> ParsecT String (XPState ()) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> SimpleXParser String) -> String -> SimpleXParser String
    forall a b. (a -> b) -> a -> b
    $ String
    m String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    n

    isNmtoken       :: String -> Bool
    isNmtoken :: String -> Bool
    isNmtoken    = SimpleXParser String -> String -> Bool
    checkByParsing SimpleXParser String
    forall s. XParser s String
    nmtoken

    isName  :: String -> Bool
    isName :: String -> Bool
    isName  = SimpleXParser String -> String -> Bool
    checkByParsing SimpleXParser String
    forall s. XParser s String
    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 :: [String] -> String
    formatStringListPatt
        = (String -> String) -> String -> [String] -> String
    formatStringList (String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "-") String
    ", "

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

    formatStringListQuot :: [String] -> String
    formatStringListQuot :: [String] -> String
    formatStringListQuot
        = (String -> String) -> String -> [String] -> String
    formatStringList String -> String
    forall a. Show a => a -> String
    show String
    ", "

    formatStringListId :: [String] -> String
    formatStringListId :: [String] -> String
    formatStringListId
        = (String -> String) -> String -> [String] -> String
    formatStringList String -> String
    forall a. a -> a
    id String
    ", "

    formatStringListArr :: [String] -> String
    formatStringListArr :: [String] -> String
    formatStringListArr
        = (String -> String) -> String -> [String] -> String
    formatStringList String -> String
    forall a. Show a => a -> String
    show String
    " -> "

    formatStringList :: (String -> String) -> String -> [String] -> String
    formatStringList :: (String -> String) -> String -> [String] -> String
    formatStringList String -> String
    _sf String
    _sp []
        = String
    ""
    formatStringList String -> String
    sf String
    spacer [String]
    l
        = String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    spacer) (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $
          (String -> String -> String) -> String -> [String] -> String
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\String
    e -> ((if String
    e String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    "" then String -> String
    sf String
    e String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    spacer else String
    "") String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++)) String
    "" [String]
    l

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