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 s :: String
s
= String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" Bool -> Bool -> Bool
||
( String -> Bool
isURI String
s Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
isRelativeReference String
s) Bool -> Bool -> Bool
&&
( let (URI _ _ path :: String
path _ frag :: String
frag) = URI -> Maybe URI -> URI
forall a. a -> Maybe a -> a
fromMaybe (String -> Maybe URIAuth -> String -> String -> String -> URI
URI "" Maybe URIAuth
forall a. Maybe a
Nothing "" "" "") (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
== "" Bool -> Bool -> Bool
&& String
path String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "")
)
)
compareURI :: String -> String -> Bool
compareURI :: String -> String -> Bool
compareURI uri1 :: String
uri1 uri2 :: 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 ""
= ""
normalizeURI uri :: 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
== '/'
then String -> String
forall a. [a] -> [a]
init String
uri
else String
uri
)
checkByParsing :: SimpleXParser String -> String -> Bool
checkByParsing :: SimpleXParser String -> String -> Bool
checkByParsing p :: SimpleXParser String
p s :: 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
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 -> SimpleXParser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m 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]
++ "-") ", "
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
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ (a :: String
a, b :: String
b) -> String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ " = " 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 ", "
formatStringListId :: [String] -> String
formatStringListId :: [String] -> String
formatStringListId
= (String -> String) -> String -> [String] -> String
formatStringList String -> String
forall a. a -> a
id ", "
formatStringListArr :: [String] -> String
formatStringListArr :: [String] -> String
formatStringListArr
= (String -> String) -> String -> [String] -> String
formatStringList String -> String
forall a. Show a => a -> String
show " -> "
formatStringList :: (String -> String) -> String -> [String] -> String
formatStringList :: (String -> String) -> String -> [String] -> String
formatStringList _sf :: String -> String
_sf _sp :: String
_sp []
= ""
formatStringList sf :: String -> String
sf spacer :: String
spacer l :: [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 (\e :: String
e -> ((if String
e String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "" then String -> String
sf String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
spacer else "") String -> String -> String
forall a. [a] -> [a] -> [a]
++)) "" [String]
l