{-# LANGUAGE DeriveDataTypeable #-}{-# LANGUAGE FlexibleContexts #-}-- | DOM-based XML parsing and rendering.---- In this module, attribute values and content nodes can contain either raw-- text or entities. In most cases, these can be fully resolved at parsing. If-- that is the case for your documents, the "Text.XML" module provides-- simplified datatypes that only contain raw text.moduleText.XML.Unresolved(-- * Non-streaming functionswriteFile,readFile-- * Lazy bytestrings,renderLBS,parseLBS,parseLBS_-- * Text,parseText,parseText_,sinkTextDoc-- * Byte streams,sinkDoc-- * Streaming functions,toEvents,fromEvents,renderBuilder,renderBytes,renderText-- * Exceptions,InvalidEventStream(InvalidEventStream)-- * Settings,P.def-- ** Parse,P.ParseSettings,P.psDecodeEntities-- ** Render,R.RenderSettings,R.rsPretty)whereimportPreludehiding(writeFile,readFile,FilePath)importFilesystem.Path.CurrentOS(FilePath,encodeString)importData.XML.TypesimportControl.Exception(Exception,SomeException)importData.Typeable(Typeable)importBlaze.ByteString.Builder(Builder)importqualifiedText.XML.Stream.RenderasRimportqualifiedText.XML.Stream.ParseasPimportText.XML.Stream.Parse(ParseSettings)importData.ByteString(ByteString)importData.Text(Text)importControl.Applicative((<$>),(<*>))importControl.Monad(when)importqualifiedData.TextasTimportqualifiedData.Text.LazyasTLimportData.Char(isSpace)importqualifiedData.ByteString.LazyasLimportSystem.IO.Unsafe(unsafePerformIO)importqualifiedData.ConduitasCimportqualifiedData.Conduit.ListasCLimportqualifiedData.Conduit.BinaryasCBimportControl.Exception(throw)importControl.Monad.Trans.Class(lift)importControl.Monad.Trans.Resource(MonadUnsafeIO,runExceptionT)importControl.Monad.ST(runST)importData.Conduit.Lazy(lazyConsume)readFile::P.ParseSettings->FilePath->IODocumentreadFilepsfp=C.runResourceT$P.parseFilepsfpC.$$fromEventssinkDoc::C.MonadThrowm=>P.ParseSettings->C.SinkByteStringmDocumentsinkDocps=P.parseBytespsC.=$fromEventswriteFile::R.RenderSettings->FilePath->Document->IO()writeFilersfpdoc=C.runResourceT$renderBytesrsdocC.$$CB.sinkFile(encodeStringfp)renderLBS::R.RenderSettings->Document->L.ByteStringrenderLBSrsdoc=L.fromChunks$unsafePerformIO-- not generally safe, but we know that runResourceT-- will not deallocate any of the resources being used-- by the process$lazyConsume$renderBytesrsdocparseLBS::P.ParseSettings->L.ByteString->EitherSomeExceptionDocumentparseLBSpslbs=runST$runExceptionT$CL.sourceList(L.toChunkslbs)C.$$sinkDocpsparseLBS_::P.ParseSettings->L.ByteString->DocumentparseLBS_pslbs=eitherthrowid$parseLBSpslbsdataInvalidEventStream=InvalidEventStreamStringderiving(Show,Typeable)instanceExceptionInvalidEventStreamrenderBuilder::Monadm=>R.RenderSettings->Document->C.SourcemBuilderrenderBuilderrsdoc=CL.sourceList(toEventsdoc)C.$=R.renderBuilderrsrenderBytes::MonadUnsafeIOm=>R.RenderSettings->Document->C.SourcemByteStringrenderBytesrsdoc=CL.sourceList(toEventsdoc)C.$=R.renderBytesrsrenderText::(C.MonadThrowm,MonadUnsafeIOm)=>R.RenderSettings->Document->C.SourcemTextrenderTextrsdoc=CL.sourceList(toEventsdoc)C.$=R.renderTextrsfromEvents::C.MonadThrowm=>C.SinkEventmDocumentfromEvents=doskipEventBeginDocumentd<-Document<$>goP<*>requiregoE<*>goMskipEventEndDocumenty<-CL.headify==Nothingthenreturndelselift$C.monadThrow$InvalidEventStream$"Trailing matter after epilogue: "++showywhereskipe=dox<-CL.peekwhen(x==Juste)(CL.drop1)manyf=goidwheregofront=dox<-fcasexofNothing->return$front[]Justy->go(front.(:)y)dropReturnx=CL.drop1>>returnxrequiref=dox<-fcasexofJusty->returnyNothing->doy<-CL.headlift$C.monadThrow$InvalidEventStream$"Document must have a single root element, got: "++showygoP=Prologue<$>goM<*>goD<*>goMgoM=manygoM'goM'=dox<-CL.peekcasexofJust(EventInstructioni)->dropReturn$Just$MiscInstructioniJust(EventCommentt)->dropReturn$Just$MiscCommenttJust(EventContent(ContentTextt))|T.allisSpacet->CL.drop1>>goM'_->returnNothinggoD=dox<-CL.peekcasexofJust(EventBeginDoctypenamemeid)->doCL.drop1dropTillDoctypereturn(Just$Doctypenamemeid)_->returnNothingdropTillDoctype=dox<-CL.headcasexof-- Leaving the following line commented so that the intention of-- this function stays clear. I figure in the future xml-types will-- be expanded again to support some form of EventDeclaration---- Just (EventDeclaration _) -> dropTillDoctypeJustEventEndDoctype->return()_->lift$C.monadThrow$InvalidEventStream$"Invalid event during doctype, got: "++showxgoE=dox<-CL.peekcasexofJust(EventBeginElementnas)->Just<$>goE'nas_->returnNothinggoE'nas=doCL.drop1ns<-manygoNy<-CL.headify==Just(EventEndElementn)thenreturn$Elementnas$compressNodesnselselift$C.monadThrow$InvalidEventStream$"Missing end element for "++shown++", got: "++showygoN=dox<-CL.peekcasexofJust(EventBeginElementnas)->(Just.NodeElement)<$>goE'nasJust(EventInstructioni)->dropReturn$Just$NodeInstructioniJust(EventContentc)->dropReturn$Just$NodeContentcJust(EventCommentt)->dropReturn$Just$NodeCommenttJust(EventCDATAt)->dropReturn$Just$NodeContent$ContentTextt_->returnNothingtoEvents::Document->[Event]toEvents(Documentprolrootepi)=(EventBeginDocument:).goPprol.goEroot.goMepi$[EventEndDocument]wheregoP(Prologuebeforedoctypeafter)=goMbefore.maybeidgoDdoctype.goMaftergoM[]=idgoM[x]=(goM'x:)goM(x:xs)=(goM'x:).goMxsgoM'(MiscInstructioni)=EventInstructionigoM'(MiscCommentt)=EventCommenttgoD(Doctypenamemeid)=(:)(EventBeginDoctypenamemeid).(:)EventEndDoctypegoE(Elementnameasns)=(EventBeginElementnameas:).goNns.(EventEndElementname:)goN[]=idgoN[x]=goN'xgoN(x:xs)=goN'x.goNxsgoN'(NodeElemente)=goEegoN'(NodeInstructioni)=(EventInstructioni:)goN'(NodeContentc)=(EventContentc:)goN'(NodeCommentt)=(EventCommentt:)compressNodes::[Node]->[Node]compressNodes[]=[]compressNodes[x]=[x]compressNodes(NodeContent(ContentTextx):NodeContent(ContentTexty):z)=compressNodes$NodeContent(ContentText$x`T.append`y):zcompressNodes(x:xs)=x:compressNodesxsparseText::ParseSettings->TL.Text->EitherSomeExceptionDocumentparseTextpstl=runST$runExceptionT$CL.sourceList(TL.toChunkstl)C.$$sinkTextDocpsparseText_::ParseSettings->TL.Text->DocumentparseText_ps=eitherthrowid.parseTextpssinkTextDoc::C.MonadThrowm=>ParseSettings->C.SinkTextmDocumentsinkTextDocps=P.parseTextpsC.=$fromEvents