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
)
isRelaxAnyURI :: String -> Bool
isRelaxAnyURI s
= s == "" ||
( isURI s && not (isRelativeReference s) &&
( let (URI _ _ path _ frag) = fromMaybe (URI "" Nothing "" "" "") $ parseURI s
in (frag == "" && path /= "")
)
)
compareURI :: String -> String -> Bool
compareURI uri1 uri2
= normalizeURI uri1 == normalizeURI uri2
normalizeURI :: String -> String
normalizeURI ""
= ""
normalizeURI uri
= map toLower ( if last uri == '/'
then init uri
else uri
)
checkByParsing :: SimpleXParser String -> String -> Bool
checkByParsing p s
= either (const False)
(const True)
(runParser p' (withNormNewline ()) "" s)
where
p' = do
r <- p
eof
return r
isNumber :: String -> Bool
isNumber
= checkByParsing parseNumber'
where
parseNumber' :: SimpleXParser 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
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