{-# LANGUAGE OverloadedStrings, BangPatterns #-}moduleText.Roundtrip.Xml.Printer(XmlPrinter,runXmlPrinter,runXmlPrinterByteString,runXmlPrinterLazyByteString,runXmlPrinterText,runXmlPrinterLazyText,runXmlPrinterString)whereimportControl.Monad(mplus,liftM2)importData.XML.TypesimportControl.Monad.StateimportControl.Exception(SomeException)importSystem.IO.Unsafe(unsafePerformIO)importqualifiedData.TextasTimportqualifiedData.Text.LazyasTLimportqualifiedData.EnumeratorasEimportqualifiedData.Enumerator.ListasELimportqualifiedData.Enumerator.BinaryasEBimportqualifiedData.Enumerator.TextasETimportqualifiedText.XML.Enumerator.RenderasEXimportqualifiedData.ByteStringasBSimportqualifiedData.ByteString.LazyasBSLimportControl.Isomorphism.PartialimportText.RoundtripimportText.Roundtrip.PrinterdataPxState=PxStateJustName[Attribute]|PxStateNothingderiving(Show)newtypeXmlPrintera=XmlPrinter{unXmlPrinter::Printer(StatePxState)[Event]a}instanceIsoFunctorXmlPrinterwhereiso<$>(XmlPrinterp)=XmlPrinter$iso`printerApply`pinstanceProductFunctorXmlPrinterwhereXmlPrinterp<*>XmlPrinterq=XmlPrinter(p`printerConcat`q)instanceAlternativeXmlPrinterwhereXmlPrinterp<||>XmlPrinterq=XmlPrinter(p`printerAlternative`q)empty=XmlPrinterprinterEmptyinstanceSyntaxXmlPrinterwherepurex=XmlPrinter(printerPurex)-- Rendering a list of events into a string/text/bytestring is done via-- enumerators. This is not optimal because the resulting list is too strict.-- However, currently no other functions exists for such a conversion.runXmlPrinterGen::Monadm=>XmlPrintera->a->(m(EitherSomeException[c])->EitherSomeException[c])->E.EnumerateeEventcm[c]->Maybe[c]runXmlPrinterGenpxrunrender=caserunXmlPrinterpxofNothing->NothingJustl->caserun$E.run$E.enumList20lE.$$E.joinI$(renderE.$$EL.consume)ofLeft_->NothingRightt->JusttrunXmlPrinterByteString::XmlPrintera->a->MaybeBS.ByteStringrunXmlPrinterByteStringpx=dol<-runXmlPrinterGenpxunsafePerformIOEX.renderBytesreturn$BS.concatlrunXmlPrinterLazyByteString::XmlPrintera->a->MaybeBSL.ByteStringrunXmlPrinterLazyByteStringpx=dol<-runXmlPrinterGenpxunsafePerformIOEX.renderBytesreturn$BSL.fromChunkslrunXmlPrinterText::XmlPrintera->a->MaybeT.TextrunXmlPrinterTextpx=dol<-runXmlPrinterGenpxunsafePerformIOEX.renderTextreturn$T.concatlrunXmlPrinterLazyText::XmlPrintera->a->MaybeTL.TextrunXmlPrinterLazyTextpx=dol<-runXmlPrinterGenpxunsafePerformIOEX.renderTextreturn$TL.fromChunkslrunXmlPrinterString::XmlPrintera->a->MaybeStringrunXmlPrinterStringpx=dotl<-runXmlPrinterLazyTextpxcaseTL.unpacktlof('<':'?':'x':'m':'l':z)->Just(eatz)str->Juststrwhereeatl=casedropWhile(/='?')lof'>':xs->xs[]->[]_:xs->eatxsrunXmlPrinter::XmlPrintera->a->Maybe[Event]runXmlPrinter(XmlPrinter(Printerp))x=evalState(px)PxStateNothinginstanceXmlSyntaxXmlPrinterwherexmlBeginDoc=xmlPrinterBeginDocxmlEndDoc=xmlPrinterEndDocxmlBeginElem=xmlPrinterBeginElemxmlEndElem=xmlPrinterEndElemxmlAttrValue=xmlPrinterAttrValuexmlTextNotEmpty=xmlPrinterTextNotEmptymkXmlPrinter::(a->StatePxState(Maybe[Event]))->XmlPrinteramkXmlPrinter=XmlPrinter.PrinterxmlPrinterBeginDoc::XmlPrinter()xmlPrinterBeginDoc=mkXmlPrinter$\()->return(Just[EventBeginDocument])xmlPrinterEndDoc::XmlPrinter()xmlPrinterEndDoc=mkXmlPrinter$\()->return(Just[EventEndDocument])xmlPrinterBeginElem::Name->XmlPrinter()xmlPrinterBeginElemname=mkXmlPrinter$\()->dol<-possiblyCloseOpeningTag[]state<-getletnewState=casestateofPxStateNothing->PxStateJustname[]_->error$"expected state Nothing, but got "++(showstate)putnewStatereturnlxmlPrinterEndElem::Name->XmlPrinter()xmlPrinterEndElemname=mkXmlPrinter$\()->possiblyCloseOpeningTag[EventEndElementname]xmlPrinterAttrValue::Name->XmlPrinterT.TextxmlPrinterAttrValueaName=mkXmlPrinter$\value->dostate<-getletnewState=casestateofPxStateJustelNameattrs->PxStateJustelName((aName,[ContentTextvalue]):attrs)PxStateNothing->error"xmlAttribute: state is Nothing"putnewStatereturn$Just[]xmlPrinterTextNotEmpty::XmlPrinterT.TextxmlPrinterTextNotEmpty=mkXmlPrinter$\value->ifT.nullvaluethenreturn$Just[]elsepossiblyCloseOpeningTag[EventContent(ContentTextvalue)]possiblyCloseOpeningTag::[Event]->StatePxState(Maybe[Event])possiblyCloseOpeningTagl=dostate<-getcasestateofPxStateJustnameattrs->doputPxStateNothingreturn$Just(EventBeginElementname(reverseattrs):l)PxStateNothing->return$Justl