{-# LANGUAGE FlexibleContexts #-}moduleText.XML.Expat.Internal.Namespaced(NName(..),NAttributes,mkNName,mkAnNName,toNamespaced,fromNamespaced,xmlnsUri,xmlns)whereimportText.XML.Expat.Internal.NodeClassimportText.XML.Expat.Internal.QualifiedimportText.XML.Expat.SAXimportControl.DeepSeqimportqualifiedData.MapasMimportqualifiedData.MaybeasDMimportqualifiedData.ListasL-- | A namespace-qualified tag.---- NName has two components, a local part and an optional namespace. The local part is the-- name of the tag. The namespace is the URI identifying collections of declared tags.-- Tags with the same local part but from different namespaces are distinct. Unqualified tags-- are those with no namespace. They are in the default namespace, and all uses of an-- unqualified tag are equivalent.dataNNametext=NName{nnNamespace::Maybetext,nnLocalPart::!text}deriving(Eq,Show)instanceNFDatatext=>NFData(NNametext)wherernf(NNamensloc)=rnf(ns,loc)-- | Type shortcut for attributes with namespaced namestypeNAttributestext=Attributes(NNametext)text-- | Make a new NName from a prefix and localPart.mkNName::text->text->NNametextmkNNameprefixlocalPart=NName(Justprefix)localPart-- | Make a new NName with no prefix.mkAnNName::text->NNametextmkAnNNamelocalPart=NNameNothinglocalParttypeNsPrefixMaptext=M.Map(Maybetext)(Maybetext)typePrefixNsMaptext=M.Map(Maybetext)(Maybetext)xmlUri::(GenericXMLStringtext)=>textxmlUri=gxFromString"http://www.w3.org/XML/1998/namespace"xml::(GenericXMLStringtext)=>textxml=gxFromString"xml"xmlnsUri::(GenericXMLStringtext)=>textxmlnsUri=gxFromString"http://www.w3.org/2000/xmlns/"xmlns::(GenericXMLStringtext)=>textxmlns=gxFromString"xmlns"baseNsBindings::(GenericXMLStringtext,Ordtext)=>NsPrefixMaptextbaseNsBindings=M.fromList[(Nothing,Nothing),(Justxml,JustxmlUri),(Justxmlns,JustxmlnsUri)]basePfBindings::(GenericXMLStringtext,Ordtext)=>PrefixNsMaptextbasePfBindings=M.fromList[(Nothing,Nothing),(JustxmlUri,Justxml),(JustxmlnsUri,Justxmlns)]toNamespaced::(NodeClassnc,GenericXMLStringtext,Ordtext,Showtext)=>nc(QNametext)text->nc(NNametext)texttoNamespaced=nodeWithNamespacesbaseNsBindingsnodeWithNamespaces::(NodeClassnc,GenericXMLStringtext,Ordtext,Showtext)=>NsPrefixMaptext->nc(QNametext)text->nc(NNametext)textnodeWithNamespacesbindings=modifyElementnamespaceifywherenamespaceify(qname,qattrs,qchildren)=(nname,nattrs,nchildren)wherefor=flipmapffor=flipfmap(nsAtts,otherAtts)=L.partition((==Justxmlns).qnPrefix.fst)qattrs(dfAtt,normalAtts)=L.partition((==QNameNothingxmlns).fst)otherAttsnsMap=M.fromList$fornsAtts$\((QName_lp),uri)->(Justlp,Justuri)-- fixme: when snd q is null, use NothingdfMap=M.fromList$fordfAtt$\q->(Nothing,Just$sndq)chldBs=M.unions[dfMap,nsMap,bindings]transbs(QNameprefqual)=casepref`M.lookup`bsofNothing->error$"Namespace prefix referenced but never bound: '"++(show.DM.fromJust)pref++"'"JustmUri->NNamemUriqualnname=transchldBsqname-- attributes with no prefix are in the same namespace as the elementattBs=M.insertNothing(nnNamespacenname)chldBstransAt(qn,v)=(transattBsqn,v)nNsAtts=maptransAtnsAttsnDfAtt=maptransAtdfAttnNormalAtts=maptransAtnormalAttsnattrs=concat[nNsAtts,nDfAtt,nNormalAtts]nchildren=fforqchildren$nodeWithNamespaceschldBsfromNamespaced::(NodeClassnc,GenericXMLStringtext,Ordtext,Functorc)=>nc(NNametext)text->nc(QNametext)textfromNamespaced=nodeWithQualifiers1basePfBindingsnodeWithQualifiers::(NodeClassnc,GenericXMLStringtext,Ordtext,Functorc)=>Int->PrefixNsMaptext->nc(NNametext)text->nc(QNametext)textnodeWithQualifierscntrbindings=modifyElementnamespaceifywherenamespaceify(nname,nattrs,nchildren)=(qname,qattrs,qchildren)wherefor=flipmapffor=flipfmap(nsAtts,otherAtts)=L.partition((==JustxmlnsUri).nnNamespace.fst)nattrs(dfAtt,normalAtts)=L.partition((==NNameNothingxmlns).fst)otherAttsnsMap=M.fromList$fornsAtts$\((NName_lp),uri)->(Justuri,Justlp)dfMap=M.fromList$fordfAtt$\(_,uri)->(Justuri,Justxmlns)chldBs=M.unions[dfMap,nsMap,bindings]trans(i,bs,as)(NNamenspacequal)=casenspace`M.lookup`bsofNothing->letpfx=gxFromString$"ns"++showibsN=M.insertnspace(Justpfx)bsasN=(NName(JustxmlnsUri)pfx,DM.fromJustnspace):asintrans(i+1,bsN,asN)(NNamenspacequal)Justpfx->((i,bs,as),QNamepfxqual)transAtibs(nn,v)=let(ibs',qn)=transibsnnin(ibs',(qn,v))((i',bs',as'),qname)=trans(cntr,chldBs,[])nname((i'',bs'',as''),qNsAtts)=L.mapAccumLtransAt(i',bs',as')nsAtts((i''',bs''',as'''),qDfAtt)=L.mapAccumLtransAt(i'',bs'',as'')dfAtt((i'''',bs'''',as''''),qNormalAtts)=L.mapAccumLtransAt(i''',bs''',as''')normalAtts(_,qas)=L.mapAccumLtransAt(i'''',bs'''',as'''')as''''qattrs=concat[qNsAtts,qDfAtt,qNormalAtts,qas]qchildren=ffornchildren$nodeWithQualifiersi''''bs''''