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 :: 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
"")
)
)
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
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. [a] -> a
last String
uri Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'
then String -> String
forall a. [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 (m :: * -> *) a. Monad m => a -> m a
return String
r
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 (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
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 (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 (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