module Text.XML.HaXml.Escape(
xmlEscape,
xmlUnEscape,
xmlEscapeContent,
xmlUnEscapeContent,
XmlEscaper,
stdXmlEscaper,
mkXmlEscaper,
) where
import Data.Char
import Text.XML.HaXml.Types
#if __GLASGOW_HASKELL__ >= 604 || __NHC__ >= 118 || defined(__HUGS__)
import qualified Data.Map as Map
type FiniteMap a b = Map.Map a b
listToFM :: Ord a => [(a,b)] -> FiniteMap a b
listToFM :: [(a, b)] -> FiniteMap a b
listToFM = [(a, b)] -> FiniteMap a b
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b
lookupFM :: FiniteMap a b -> a -> Maybe b
lookupFM = (a -> FiniteMap a b -> Maybe b) -> FiniteMap a b -> a -> Maybe b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> FiniteMap a b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup
#elif __GLASGOW_HASKELL__ >= 504 || __NHC__ > 114
import Data.FiniteMap
#else
type FiniteMap a b = [(a,b)]
listToFM :: Eq a => [(a,b)] -> FiniteMap a b
listToFM = id
lookupFM :: Eq a => FiniteMap a b -> a -> Maybe b
lookupFM fm k = lookup k fm
#endif
data XmlEscaper = XmlEscaper {
XmlEscaper -> FiniteMap Char String
toEscape :: FiniteMap Char String,
XmlEscaper -> FiniteMap String Char
fromEscape :: FiniteMap String Char,
XmlEscaper -> Char -> Bool
isEscape :: Char -> Bool
}
xmlEscape :: XmlEscaper -> Element i -> Element i
xmlEscape :: XmlEscaper -> Element i -> Element i
xmlEscape xmlEscaper :: XmlEscaper
xmlEscaper element :: Element i
element =
Element i -> Element i
forall i. Element i -> Element i
compressElement (XmlEscaper -> Element i -> Element i
forall i. XmlEscaper -> Element i -> Element i
escapeElement XmlEscaper
xmlEscaper Element i
element)
xmlEscapeContent :: XmlEscaper -> [Content i] -> [Content i]
xmlEscapeContent :: XmlEscaper -> [Content i] -> [Content i]
xmlEscapeContent xmlEscaper :: XmlEscaper
xmlEscaper cs :: [Content i]
cs =
[Content i] -> [Content i]
forall i. [Content i] -> [Content i]
compressContent (XmlEscaper -> [Content i] -> [Content i]
forall i. XmlEscaper -> [Content i] -> [Content i]
escapeContent XmlEscaper
xmlEscaper [Content i]
cs)
escapeElement :: XmlEscaper -> Element i -> Element i
escapeElement :: XmlEscaper -> Element i -> Element i
escapeElement xmlEscaper :: XmlEscaper
xmlEscaper (Elem name :: QName
name attributes :: [Attribute]
attributes content :: [Content i]
content) =
QName -> [Attribute] -> [Content i] -> Element i
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem QName
name (XmlEscaper -> [Attribute] -> [Attribute]
escapeAttributes XmlEscaper
xmlEscaper [Attribute]
attributes)
(XmlEscaper -> [Content i] -> [Content i]
forall i. XmlEscaper -> [Content i] -> [Content i]
escapeContent XmlEscaper
xmlEscaper [Content i]
content)
escapeAttributes :: XmlEscaper -> [Attribute] -> [Attribute]
escapeAttributes :: XmlEscaper -> [Attribute] -> [Attribute]
escapeAttributes xmlEscaper :: XmlEscaper
xmlEscaper atts :: [Attribute]
atts =
(Attribute -> Attribute) -> [Attribute] -> [Attribute]
forall a b. (a -> b) -> [a] -> [b]
map
(\ (name :: QName
name,av :: AttValue
av) -> (QName
name,XmlEscaper -> AttValue -> AttValue
escapeAttValue XmlEscaper
xmlEscaper AttValue
av))
[Attribute]
atts
escapeAttValue :: XmlEscaper -> AttValue -> AttValue
escapeAttValue :: XmlEscaper -> AttValue -> AttValue
escapeAttValue xmlEscaper :: XmlEscaper
xmlEscaper (AttValue attValList :: [Either String Reference]
attValList) =
[Either String Reference] -> AttValue
AttValue (
[[Either String Reference]] -> [Either String Reference]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (
(Either String Reference -> [Either String Reference])
-> [Either String Reference] -> [[Either String Reference]]
forall a b. (a -> b) -> [a] -> [b]
map
(\ av :: Either String Reference
av -> case Either String Reference
av of
Right _ -> [Either String Reference
av]
Left s :: String
s ->
(Char -> Either String Reference)
-> String -> [Either String Reference]
forall a b. (a -> b) -> [a] -> [b]
map
(\ c :: Char
c -> if XmlEscaper -> Char -> Bool
isEscape XmlEscaper
xmlEscaper Char
c
then
Reference -> Either String Reference
forall a b. b -> Either a b
Right (XmlEscaper -> Char -> Reference
mkEscape XmlEscaper
xmlEscaper Char
c)
else
String -> Either String Reference
forall a b. a -> Either a b
Left [Char
c]
)
String
s
)
[Either String Reference]
attValList
)
)
escapeContent :: XmlEscaper -> [Content i] -> [Content i]
escapeContent :: XmlEscaper -> [Content i] -> [Content i]
escapeContent xmlEscaper :: XmlEscaper
xmlEscaper contents :: [Content i]
contents =
[[Content i]] -> [Content i]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
((Content i -> [Content i]) -> [Content i] -> [[Content i]]
forall a b. (a -> b) -> [a] -> [b]
map
(\ content :: Content i
content -> case Content i
content of
(CString b :: Bool
b str :: String
str i :: i
i) ->
(Char -> Content i) -> String -> [Content i]
forall a b. (a -> b) -> [a] -> [b]
map
(\ c :: Char
c -> if XmlEscaper -> Char -> Bool
isEscape XmlEscaper
xmlEscaper Char
c
then
Reference -> i -> Content i
forall i. Reference -> i -> Content i
CRef (XmlEscaper -> Char -> Reference
mkEscape XmlEscaper
xmlEscaper Char
c) i
i
else
Bool -> String -> i -> Content i
forall i. Bool -> String -> i -> Content i
CString Bool
b [Char
c] i
i
)
String
str
(CElem element :: Element i
element i :: i
i) -> [Element i -> i -> Content i
forall i. Element i -> i -> Content i
CElem (XmlEscaper -> Element i -> Element i
forall i. XmlEscaper -> Element i -> Element i
escapeElement XmlEscaper
xmlEscaper Element i
element) i
i]
_ -> [Content i
content]
)
[Content i]
contents
)
mkEscape :: XmlEscaper -> Char -> Reference
mkEscape :: XmlEscaper -> Char -> Reference
mkEscape (XmlEscaper {toEscape :: XmlEscaper -> FiniteMap Char String
toEscape = FiniteMap Char String
toescape}) ch :: Char
ch =
case FiniteMap Char String -> Char -> Maybe String
forall a b. Ord a => FiniteMap a b -> a -> Maybe b
lookupFM FiniteMap Char String
toescape Char
ch of
Nothing -> CharRef -> Reference
RefChar (Char -> CharRef
ord Char
ch)
Just str :: String
str -> String -> Reference
RefEntity String
str
xmlUnEscape :: XmlEscaper -> Element i -> Element i
xmlUnEscape :: XmlEscaper -> Element i -> Element i
xmlUnEscape xmlEscaper :: XmlEscaper
xmlEscaper element :: Element i
element =
Element i -> Element i
forall i. Element i -> Element i
compressElement (XmlEscaper -> Element i -> Element i
forall i. XmlEscaper -> Element i -> Element i
unEscapeElement XmlEscaper
xmlEscaper Element i
element)
xmlUnEscapeContent :: XmlEscaper -> [Content i] -> [Content i]
xmlUnEscapeContent :: XmlEscaper -> [Content i] -> [Content i]
xmlUnEscapeContent xmlEscaper :: XmlEscaper
xmlEscaper cs :: [Content i]
cs =
[Content i] -> [Content i]
forall i. [Content i] -> [Content i]
compressContent (XmlEscaper -> [Content i] -> [Content i]
forall i. XmlEscaper -> [Content i] -> [Content i]
unEscapeContent XmlEscaper
xmlEscaper [Content i]
cs)
unEscapeElement :: XmlEscaper -> Element i -> Element i
unEscapeElement :: XmlEscaper -> Element i -> Element i
unEscapeElement xmlEscaper :: XmlEscaper
xmlEscaper (Elem name :: QName
name attributes :: [Attribute]
attributes content :: [Content i]
content) =
QName -> [Attribute] -> [Content i] -> Element i
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem QName
name (XmlEscaper -> [Attribute] -> [Attribute]
unEscapeAttributes XmlEscaper
xmlEscaper [Attribute]
attributes)
(XmlEscaper -> [Content i] -> [Content i]
forall i. XmlEscaper -> [Content i] -> [Content i]
unEscapeContent XmlEscaper
xmlEscaper [Content i]
content)
unEscapeAttributes :: XmlEscaper -> [Attribute] -> [Attribute]
unEscapeAttributes :: XmlEscaper -> [Attribute] -> [Attribute]
unEscapeAttributes xmlEscaper :: XmlEscaper
xmlEscaper atts :: [Attribute]
atts =
(Attribute -> Attribute) -> [Attribute] -> [Attribute]
forall a b. (a -> b) -> [a] -> [b]
map
(\ (name :: QName
name,av :: AttValue
av) -> (QName
name,XmlEscaper -> AttValue -> AttValue
unEscapeAttValue XmlEscaper
xmlEscaper AttValue
av))
[Attribute]
atts
unEscapeAttValue :: XmlEscaper -> AttValue -> AttValue
unEscapeAttValue :: XmlEscaper -> AttValue -> AttValue
unEscapeAttValue xmlEscaper :: XmlEscaper
xmlEscaper (AttValue attValList :: [Either String Reference]
attValList) =
[Either String Reference] -> AttValue
AttValue (
(Either String Reference -> Either String Reference)
-> [Either String Reference] -> [Either String Reference]
forall a b. (a -> b) -> [a] -> [b]
map
(\ av :: Either String Reference
av -> case Either String Reference
av of
Left _ -> Either String Reference
av
Right ref :: Reference
ref -> case XmlEscaper -> Reference -> Maybe Char
unEscapeChar XmlEscaper
xmlEscaper Reference
ref of
Just c :: Char
c -> String -> Either String Reference
forall a b. a -> Either a b
Left [Char
c]
Nothing -> Either String Reference
av
)
[Either String Reference]
attValList
)
unEscapeContent :: XmlEscaper -> [Content i] -> [Content i]
unEscapeContent :: XmlEscaper -> [Content i] -> [Content i]
unEscapeContent xmlEscaper :: XmlEscaper
xmlEscaper content :: [Content i]
content =
(Content i -> Content i) -> [Content i] -> [Content i]
forall a b. (a -> b) -> [a] -> [b]
map
(\ cntnt :: Content i
cntnt -> case Content i
cntnt of
CRef ref :: Reference
ref i :: i
i -> case XmlEscaper -> Reference -> Maybe Char
unEscapeChar XmlEscaper
xmlEscaper Reference
ref of
Just c :: Char
c -> Bool -> String -> i -> Content i
forall i. Bool -> String -> i -> Content i
CString Bool
False [Char
c] i
i
Nothing -> Content i
cntnt
CElem element :: Element i
element i :: i
i -> Element i -> i -> Content i
forall i. Element i -> i -> Content i
CElem (XmlEscaper -> Element i -> Element i
forall i. XmlEscaper -> Element i -> Element i
unEscapeElement XmlEscaper
xmlEscaper Element i
element) i
i
_ -> Content i
cntnt
)
[Content i]
content
unEscapeChar :: XmlEscaper -> Reference -> Maybe Char
unEscapeChar :: XmlEscaper -> Reference -> Maybe Char
unEscapeChar xmlEscaper :: XmlEscaper
xmlEscaper ref :: Reference
ref =
case Reference
ref of
RefChar i :: CharRef
i -> Char -> Maybe Char
forall a. a -> Maybe a
Just (CharRef -> Char
chr CharRef
i)
RefEntity name :: String
name -> FiniteMap String Char -> String -> Maybe Char
forall a b. Ord a => FiniteMap a b -> a -> Maybe b
lookupFM (XmlEscaper -> FiniteMap String Char
fromEscape XmlEscaper
xmlEscaper) String
name
compressElement :: Element i -> Element i
compressElement :: Element i -> Element i
compressElement (Elem name :: QName
name attributes :: [Attribute]
attributes content :: [Content i]
content) =
QName -> [Attribute] -> [Content i] -> Element i
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem QName
name ([Attribute] -> [Attribute]
compressAttributes [Attribute]
attributes) ([Content i] -> [Content i]
forall i. [Content i] -> [Content i]
compressContent [Content i]
content)
compressAttributes :: [(QName,AttValue)] -> [(QName,AttValue)]
compressAttributes :: [Attribute] -> [Attribute]
compressAttributes atts :: [Attribute]
atts =
(Attribute -> Attribute) -> [Attribute] -> [Attribute]
forall a b. (a -> b) -> [a] -> [b]
map
(\ (name :: QName
name,av :: AttValue
av) -> (QName
name,AttValue -> AttValue
compressAttValue AttValue
av))
[Attribute]
atts
compressAttValue :: AttValue -> AttValue
compressAttValue :: AttValue -> AttValue
compressAttValue (AttValue l :: [Either String Reference]
l) = [Either String Reference] -> AttValue
AttValue ([Either String Reference] -> [Either String Reference]
compress [Either String Reference]
l)
where
compress :: [Either String Reference] -> [Either String Reference]
compress :: [Either String Reference] -> [Either String Reference]
compress [] = []
compress (Right ref :: Reference
ref : es :: [Either String Reference]
es) = Reference -> Either String Reference
forall a b. b -> Either a b
Right Reference
ref Either String Reference
-> [Either String Reference] -> [Either String Reference]
forall a. a -> [a] -> [a]
: ([Either String Reference] -> [Either String Reference]
compress [Either String Reference]
es)
compress ( (ls :: Either String Reference
ls @ (Left s1 :: String
s1)) : es :: [Either String Reference]
es) =
case [Either String Reference] -> [Either String Reference]
compress [Either String Reference]
es of
(Left s2 :: String
s2 : es2 :: [Either String Reference]
es2) -> String -> Either String Reference
forall a b. a -> Either a b
Left (String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s2) Either String Reference
-> [Either String Reference] -> [Either String Reference]
forall a. a -> [a] -> [a]
: [Either String Reference]
es2
es2 :: [Either String Reference]
es2 -> Either String Reference
ls Either String Reference
-> [Either String Reference] -> [Either String Reference]
forall a. a -> [a] -> [a]
: [Either String Reference]
es2
compressContent :: [Content i] -> [Content i]
compressContent :: [Content i] -> [Content i]
compressContent [] = []
compressContent ((csb :: Content i
csb @ (CString b1 :: Bool
b1 s1 :: String
s1 i1 :: i
i1)) : cs :: [Content i]
cs) =
case [Content i] -> [Content i]
forall i. [Content i] -> [Content i]
compressContent [Content i]
cs of
(CString b2 :: Bool
b2 s2 :: String
s2 _) : cs2 :: [Content i]
cs2
| Bool
b1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b2
-> Bool -> String -> i -> Content i
forall i. Bool -> String -> i -> Content i
CString Bool
b1 (String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s2) i
i1Content i -> [Content i] -> [Content i]
forall a. a -> [a] -> [a]
: [Content i]
cs2
cs2 :: [Content i]
cs2 -> Content i
csb Content i -> [Content i] -> [Content i]
forall a. a -> [a] -> [a]
: [Content i]
cs2
compressContent (CElem element :: Element i
element i :: i
i : cs :: [Content i]
cs) =
Element i -> i -> Content i
forall i. Element i -> i -> Content i
CElem (Element i -> Element i
forall i. Element i -> Element i
compressElement Element i
element) i
i Content i -> [Content i] -> [Content i]
forall a. a -> [a] -> [a]
: [Content i] -> [Content i]
forall i. [Content i] -> [Content i]
compressContent [Content i]
cs
compressContent (c :: Content i
c : cs :: [Content i]
cs) = Content i
c Content i -> [Content i] -> [Content i]
forall a. a -> [a] -> [a]
: [Content i] -> [Content i]
forall i. [Content i] -> [Content i]
compressContent [Content i]
cs
stdXmlEscaper :: XmlEscaper
stdXmlEscaper :: XmlEscaper
stdXmlEscaper = [(Char, String)] -> (Char -> Bool) -> XmlEscaper
mkXmlEscaper
[('\60',"lt"),('\62',"gt"),('\38',"amp"),('\39',"apos"),('\34',"quot")]
(\ ch :: Char
ch ->
let
i :: CharRef
i = Char -> CharRef
ord Char
ch
in
CharRef
i CharRef -> CharRef -> Bool
forall a. Ord a => a -> a -> Bool
< 10 Bool -> Bool -> Bool
|| (10CharRef -> CharRef -> Bool
forall a. Ord a => a -> a -> Bool
<CharRef
i Bool -> Bool -> Bool
&& CharRef
iCharRef -> CharRef -> Bool
forall a. Ord a => a -> a -> Bool
<32) Bool -> Bool -> Bool
|| CharRef
i CharRef -> CharRef -> Bool
forall a. Ord a => a -> a -> Bool
>= 127 Bool -> Bool -> Bool
||
case Char
ch of
'\'' -> Bool
True
'\"' -> Bool
True
'&' -> Bool
True
'<' -> Bool
True
'>' -> Bool
True
_ -> Bool
False
)
mkXmlEscaper :: [(Char,String)] -> (Char -> Bool) -> XmlEscaper
mkXmlEscaper :: [(Char, String)] -> (Char -> Bool) -> XmlEscaper
mkXmlEscaper escapes :: [(Char, String)]
escapes isescape :: Char -> Bool
isescape =
XmlEscaper :: FiniteMap Char String
-> FiniteMap String Char -> (Char -> Bool) -> XmlEscaper
XmlEscaper {
toEscape :: FiniteMap Char String
toEscape = [(Char, String)] -> FiniteMap Char String
forall k a. Ord k => [(k, a)] -> Map k a
listToFM [(Char, String)]
escapes,
fromEscape :: FiniteMap String Char
fromEscape = [(String, Char)] -> FiniteMap String Char
forall k a. Ord k => [(k, a)] -> Map k a
listToFM (((Char, String) -> (String, Char))
-> [(Char, String)] -> [(String, Char)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (c :: Char
c,str :: String
str) -> (String
str,Char
c)) [(Char, String)]
escapes),
isEscape :: Char -> Bool
isEscape = Char -> Bool
isescape
}