-- |The difference between this XML parsers and all other XML parsers-- is that this one can parse an XML document that is only partially-- received, returning the parts that have arrived so far.moduleNetwork.XMPP.XMLParse(XMLElem(..),xmlPath,getAttr,getCdata,xmlToString,attrsToString,getRest,xmppStreamStart,shallowTag,deepTag,deepTags,Text.ParserCombinators.Parsec.parse,Text.ParserCombinators.Parsec.Parser,xmlPath')whereimportText.ParserCombinators.ParsecimportList-- |A data structure representing an XML element.dataXMLElem=XMLString[(String,String)][XMLElem]-- ^Tags have a name, a list of attributes, and a list of-- child elements.|CDataString-- ^Character data just contains a string.deriving(Show,Eq)-- |Follow a \"path\" of named subtags in an XML tree. For every-- element in the given list, find the subtag with that name and-- proceed recursively.xmlPath::[String]->XMLElem->MaybeXMLElemxmlPath[]el=returnelxmlPath(name:names)(XML__els)=doel<-find(\stanza->casestanzaof(XMLn__)->name==n_->False)elsxmlPathnamesel-- |Get the value of an attribute in the given tag.getAttr::String->XMLElem->MaybeStringgetAttrattr(XML_attrs_)=lookupattrattrs-- |Get the character data subelement of the given tag.getCdata::XMLElem->MaybeStringgetCdata(XML__els)=caseelsof[CDatas]->Justs_->Nothing-- |Convert the tag back to XML. If the first parameter is true,-- close the tag.xmlToString::Bool->XMLElem->StringxmlToString_(CDatas)=replaceToEntitiessxmlToStringclose(XMLnameattrssubels)="<"++name++attrsToStringattrs++ifclosethen">"++(concat$map(xmlToStringTrue)subels)++"</"++name++">"else">"------------------------------------------------- |Replace special characters to XML entities.replaceToEntities::String->StringreplaceToEntities[]=[]replaceToEntities(char:chars)=letstr=casecharof'&'->"&amp;"'<'->"&lt;"'>'->"&gt;"'"'->"&quot;"'\''->"&apos;"_->char:[]instr++(replaceToEntitieschars)-----------------------------------------------attrsToString::[(String,String)]->StringattrsToString[]=""attrsToString((name,value):attrs)=" "++name++"='"++value++"'"++attrsToStringattrsgetRest::Parsera->Parser(a,String)getRestf=dox<-tryfp<-getInputreturn(x,p)xmppStreamStart::ParserXMLElemxmppStreamStart=domany$tryprocessingInstructionstreamTag<-shallowTagreturnstreamTagshallowTag::ParserXMLElemshallowTag=dotag<-tagStartchar'>'returntagdeepTags::Parser[XMLElem]deepTags=many$trydeepTagdeepTag::ParserXMLElemdeepTag=do(XMLnameattrs_)<-tagStartsubels<-(try$dochar'/'char'>'return[])<|>dochar'>'els<-many$(trydeepTag)<|>cdatachar'<'char'/'stringnamechar'>'returnelsreturn$XMLnameattrssubelstagStart::ParserXMLElemtagStart=dochar'<'name<-many1tokenCharmanyspaceattrs<-many$doattr<-attributemanyspacereturnattrreturn$XMLnameattrs[]attribute::Parser(String,String)attribute=doname<-many1tokenCharchar'='quote<-char'\''<|>char'"'value<-many$satisfy(/=quote)charquotereturn(name,value)------------------------------------------------- cdata :: Parser XMLElem-- cdata =-- do-- text <- many1 plainCdata-- return $ CData text-- where plainCdata = satisfy (\c -> c/='<')cdata::ParserXMLElemcdata=dotext<-many1$plainCdata<|>predefinedEntityreturn$CDatatextwhereplainCdata=satisfy(\c->c/='<'&&c/='&')predefinedEntity=dochar'&'entity<-try(string"amp")<|>try(string"lt")<|>try(string"gt")<|>try(string"quot")<|>string"apos"char';'return$caseentityof"amp"->'&'"lt"->'<'"gt"->'>'"quot"->'"'"apos"->'\''-----------------------------------------------tokenChar::ParserChartokenChar=letter<|>char':'<|>char'-'processingInstruction::Parser()processingInstruction=dochar'<'char'?'many$satisfy(/='?')char'?'char'>'return()------------------------------------------------- |Default xmlPath doesn't find subtag2 if we have-- tag1/subtag1 and tag1/subtag2 in xml stanza.xmlPath'::[String]->[XMLElem]->MaybeXMLElemxmlPath'[][]=NothingxmlPath'[]els=Just$headelsxmlPath'(name:names)elems=letelems'=mapfilter_elemelemsfilter_elem(XML__els)=filter(\stanza->casestanzaof(XMLn__)->name==n_->False)elsinxmlPath'names(concatelems')