module Text.XML.HXT.DOM.XmlNode
( module Text.XML.HXT.DOM.XmlNode
, module Data.Tree.NTree.TypeDefs
)
where
import Control.Monad
import Data.Tree.NTree.TypeDefs
import Data.Maybe
import Text.XML.HXT.DOM.Interface
class XmlNode a where
isText :: a -> Bool
isCharRef :: a -> Bool
isEntityRef :: a -> Bool
isCmt :: a -> Bool
isCdata :: a -> Bool
isPi :: a -> Bool
isElem :: a -> Bool
isRoot :: a -> Bool
isDTD :: a -> Bool
isAttr :: a -> Bool
isError :: a -> Bool
mkText :: String -> a
mkCharRef :: Int -> a
mkEntityRef :: String -> a
mkCmt :: String -> a
mkCdata :: String -> a
mkPi :: QName -> XmlTrees -> a
mkError :: Int -> String -> a
getText :: a -> Maybe String
getCharRef :: a -> Maybe Int
getEntityRef :: a -> Maybe String
getCmt :: a -> Maybe String
getCdata :: a -> Maybe String
getPiName :: a -> Maybe QName
getPiContent :: a -> Maybe XmlTrees
getElemName :: a -> Maybe QName
getAttrl :: a -> Maybe XmlTrees
getDTDPart :: a -> Maybe DTDElem
getDTDAttrl :: a -> Maybe Attributes
getAttrName :: a -> Maybe QName
getErrorLevel :: a -> Maybe Int
getErrorMsg :: a -> Maybe String
getName :: a -> Maybe QName
getQualifiedName :: a -> Maybe String
getUniversalName :: a -> Maybe String
getUniversalUri :: a -> Maybe String
getLocalPart :: a -> Maybe String
getNamePrefix :: a -> Maybe String
getNamespaceUri :: a -> Maybe String
changeText :: (String -> String) -> a -> a
changeCmt :: (String -> String) -> a -> a
changeName :: (QName -> QName) -> a -> a
changeElemName :: (QName -> QName) -> a -> a
changeAttrl :: (XmlTrees -> XmlTrees) -> a -> a
changeAttrName :: (QName -> QName) -> a -> a
changePiName :: (QName -> QName) -> a -> a
changeDTDAttrl :: (Attributes -> Attributes) -> a -> a
setText :: String -> a -> a
setCmt :: String -> a -> a
setName :: QName -> a -> a
setElemName :: QName -> a -> a
setElemAttrl :: XmlTrees -> a -> a
setAttrName :: QName -> a -> a
setPiName :: QName -> a -> a
setDTDAttrl :: Attributes -> a -> a
getName n = getElemName n `mplus` getAttrName n `mplus` getPiName n
getQualifiedName n = getName n >>= \ n' -> return (qualifiedName n')
getUniversalName n = getName n >>= \ n' -> return (universalName n')
getUniversalUri n = getName n >>= \ n' -> return (universalUri n')
getLocalPart n = getName n >>= \ n' -> return (localPart n')
getNamePrefix n = getName n >>= \ n' -> return (namePrefix n')
getNamespaceUri n = getName n >>= \ n' -> return (namespaceUri n')
setText t = changeText (const t)
setCmt c = changeCmt (const c)
setName n = changeName (const n)
setElemName n = changeElemName (const n)
setElemAttrl al = changeAttrl (const al)
setAttrName n = changeAttrName (const n)
setPiName n = changePiName (const n)
setDTDAttrl al = changeDTDAttrl (const al)
instance XmlNode XNode where
isText (XText _) = True
isText _ = False
isCharRef (XCharRef _) = True
isCharRef _ = False
isEntityRef (XEntityRef _) = True
isEntityRef _ = False
isCmt (XCmt _) = True
isCmt _ = False
isCdata (XCdata _) = True
isCdata _ = False
isPi (XPi _ _) = True
isPi _ = False
isElem (XTag _ _) = True
isElem _ = False
isRoot t = isElem t
&&
fromMaybe "" (getQualifiedName t) == t_root
isDTD (XDTD _ _) = True
isDTD _ = False
isAttr (XAttr _) = True
isAttr _ = False
isError (XError _ _) = True
isError _ = False
mkText t = XText t
mkCharRef c = XCharRef c
mkEntityRef e = XEntityRef e
mkCmt c = XCmt c
mkCdata d = XCdata d
mkPi n c = XPi n (if null c then [] else [mkAttr (mkName a_value) c])
mkError l msg = XError l msg
getText (XText t) = Just t
getText _ = Nothing
getCharRef (XCharRef c) = Just c
getCharRef _ = Nothing
getEntityRef (XEntityRef e) = Just e
getEntityRef _ = Nothing
getCmt (XCmt c) = Just c
getCmt _ = Nothing
getCdata (XCdata d) = Just d
getCdata _ = Nothing
getPiName (XPi n _) = Just n
getPiName _ = Nothing
getPiContent (XPi _ c) = Just c
getPiContent _ = Nothing
getElemName (XTag n _) = Just n
getElemName _ = Nothing
getAttrl (XTag _ al) = Just al
getAttrl (XPi _ al) = Just al
getAttrl _ = Nothing
getDTDPart (XDTD p _) = Just p
getDTDPart _ = Nothing
getDTDAttrl (XDTD _ al) = Just al
getDTDAttrl _ = Nothing
getAttrName (XAttr n) = Just n
getAttrName _ = Nothing
getErrorLevel (XError l _) = Just l
getErrorLevel _ = Nothing
getErrorMsg (XError _ m) = Just m
getErrorMsg _ = Nothing
changeText cf (XText t) = XText (cf t)
changeText _ _ = error "changeText undefined"
changeCmt cf (XCmt c) = XCmt (cf c)
changeCmt _ _ = error "changeCmt undefined"
changeName cf (XTag n al) = XTag (cf n) al
changeName cf (XAttr n) = XAttr (cf n)
changeName cf (XPi n al) = XPi (cf n) al
changeName _ _ = error "changeName undefined"
changeElemName cf (XTag n al) = XTag (cf n) al
changeElemName _ _ = error "changeElemName undefined"
changeAttrl cf (XTag n al) = XTag n (cf al)
changeAttrl cf (XPi n al) = XPi n (cf al)
changeAttrl _ _ = error "changeAttrl undefined"
changeAttrName cf (XAttr n) = XAttr (cf n)
changeAttrName _ _ = error "changeAttrName undefined"
changePiName cf (XPi n al) = XPi (cf n) al
changePiName _ _ = error "changeAttrName undefined"
changeDTDAttrl cf (XDTD p al) = XDTD p (cf al)
changeDTDAttrl _ _ = error "changeDTDAttrl undefined"
mkElementNode :: QName -> XmlTrees -> XNode
mkElementNode = XTag
mkAttrNode :: QName -> XNode
mkAttrNode = XAttr
mkDTDNode :: DTDElem -> Attributes -> XNode
mkDTDNode = XDTD
instance XmlNode a => XmlNode (NTree a) where
isText = isText . getNode
isCharRef = isCharRef . getNode
isEntityRef = isEntityRef . getNode
isCmt = isCmt . getNode
isCdata = isCdata . getNode
isPi = isPi . getNode
isElem = isElem . getNode
isRoot = isRoot . getNode
isDTD = isDTD . getNode
isAttr = isAttr . getNode
isError = isError . getNode
mkText = mkLeaf . mkText
mkCharRef = mkLeaf . mkCharRef
mkEntityRef = mkLeaf . mkEntityRef
mkCmt = mkLeaf . mkCmt
mkCdata = mkLeaf . mkCdata
mkPi n = mkLeaf . mkPi n
mkError l = mkLeaf . mkError l
getText = getText . getNode
getCharRef = getCharRef . getNode
getEntityRef = getEntityRef . getNode
getCmt = getCmt . getNode
getCdata = getCdata . getNode
getPiName = getPiName . getNode
getPiContent = getPiContent . getNode
getElemName = getElemName . getNode
getAttrl = getAttrl . getNode
getDTDPart = getDTDPart . getNode
getDTDAttrl = getDTDAttrl . getNode
getAttrName = getAttrName . getNode
getErrorLevel = getErrorLevel . getNode
getErrorMsg = getErrorMsg . getNode
changeText cf = changeNode (changeText cf)
changeCmt cf = changeNode (changeCmt cf)
changeName cf = changeNode (changeName cf)
changeElemName cf = changeNode (changeElemName cf)
changeAttrl cf = changeNode (changeAttrl cf)
changeAttrName cf = changeNode (changeAttrName cf)
changePiName cf = changeNode (changePiName cf)
changeDTDAttrl cf = changeNode (changeDTDAttrl cf)
mkElement :: QName -> XmlTrees -> XmlTrees -> XmlTree
mkElement n al = mkTree (mkElementNode n al)
mkRoot :: XmlTrees -> XmlTrees -> XmlTree
mkRoot al = mkTree (mkElementNode (mkName t_root) al)
mkAttr :: QName -> XmlTrees -> XmlTree
mkAttr n = mkTree (mkAttrNode n)
mkDTDElem :: DTDElem -> Attributes -> XmlTrees -> XmlTree
mkDTDElem e al = mkTree (mkDTDNode e al)
addAttr :: XmlTree -> XmlTrees -> XmlTrees
addAttr a al
| isAttr a = add al
| otherwise = al
where
an = (qualifiedName . fromJust . getAttrName) a
add []
= [a]
add (a1:al1)
| isAttr a1
&&
(qualifiedName . fromJust . getAttrName) a1 == an
= a : al1
| otherwise
= a1 : add al1
mergeAttrl :: XmlTrees -> XmlTrees -> XmlTrees
mergeAttrl = foldr addAttr