---------------------------------------------------------------------- |-- Module : Text.XML.Expat.Cursor---- This module ported from Text.XML.Light.Cursor---- XML cursors for working XML content withing the context of-- an XML document. This implementation is based on the general-- tree zipper written by Krasimir Angelov and Iavor S. Diatchki.--moduleText.XML.Expat.Cursor(Tag(..),getTag,fromTag,Cursor(..),Path-- * Conversions,fromTree,fromForest,toForest,toTree-- * Moving around,parent,root,getChild,firstChild,lastChild,left,right,nextDF-- ** Searching,findChild,findLeft,findRight,findRec-- * Node classification,isRoot,isFirst,isLast,isLeaf,isChild,hasChildren,getNodeIndex-- * Updates,setContent,modifyContent,modifyContentList,modifyContentM-- ** Inserting content,insertLeft,insertRight,insertManyLeft,insertManyRight,insertFirstChild,insertLastChild,insertManyFirstChild,insertManyLastChild,insertGoLeft,insertGoRight-- ** Removing content,removeLeft,removeRight,removeGoLeft,removeGoRight,removeGoUp)whereimportText.XML.Expat.TreeimportData.Maybe(isNothing)importControl.Monad(mplus)dataTagtagtext=Tag{tagName::tag,tagAttribs::Attributestagtext}deriving(Show){-
setTag :: Tag -> Element -> Element
setTag t e = fromTag t (elContent e)
-}fromTag::Tagtagtext->[Nodetagtext]->NodetagtextfromTagtcs=Element{eName=tagNamet,eAttributes=tagAttribst,eChildren=cs}typePathtagtext=[([Nodetagtext],Tagtagtext,[Nodetagtext])]-- | The position of a piece of content in an XML document.dataCursortagtext=Cur{current::Nodetagtext-- ^ The currently selected content.,lefts::[Nodetagtext]-- ^ Siblings on the left, closest first.,rights::[Nodetagtext]-- ^ Siblings on the right, closest first.,parents::Pathtagtext-- ^ The contexts of the parent elements of this location.}deriving(Show)-- Moving around ----------------------------------------------------------------- | The parent of the given location.parent::Cursortagtext->Maybe(Cursortagtext)parentloc=caseparentslocof(pls,v,prs):ps->JustCur{current=(fromTagv(combChildren(leftsloc)(currentloc)(rightsloc))),lefts=pls,rights=prs,parents=ps}[]->Nothing-- | The top-most parent of the given location.root::Cursortagtext->Cursortagtextrootloc=maybelocroot(parentloc)-- | The left sibling of the given location.left::Cursortagtext->Maybe(Cursortagtext)leftloc=caseleftslocoft:ts->Justloc{current=t,lefts=ts,rights=currentloc:rightsloc}[]->Nothing-- | The right sibling of the given location.right::Cursortagtext->Maybe(Cursortagtext)rightloc=caserightslocoft:ts->Justloc{current=t,lefts=currentloc:leftsloc,rights=ts}[]->Nothing-- | The first child of the given location.firstChild::Cursortagtext->Maybe(Cursortagtext)firstChildloc=do(t:ts,ps)<-downParentslocreturnCur{current=t,lefts=[],rights=ts,parents=ps}-- | The last child of the given location.lastChild::Cursortagtext->Maybe(Cursortagtext)lastChildloc=do(ts,ps)<-downParentsloccasereversetsofl:ls->returnCur{current=l,lefts=ls,rights=[],parents=ps}[]->Nothing-- | Find the next left sibling that satisfies a predicate.findLeft::(Cursortagtext->Bool)->Cursortagtext->Maybe(Cursortagtext)findLeftploc=doloc1<-leftlocifploc1thenreturnloc1elsefindLeftploc1-- | Find the next right sibling that satisfies a predicate.findRight::(Cursortagtext->Bool)->Cursortagtext->Maybe(Cursortagtext)findRightploc=doloc1<-rightlocifploc1thenreturnloc1elsefindRightploc1-- | The first child that satisfies a predicate.findChild::(Cursortagtext->Bool)->Cursortagtext->Maybe(Cursortagtext)findChildploc=doloc1<-firstChildlocifploc1thenreturnloc1elsefindRightploc1-- | The next position in a left-to-right depth-first traversal of a document:-- either the first child, right sibling, or the right sibling of a parent that-- has one.nextDF::Cursortagtext->Maybe(Cursortagtext)nextDFc=firstChildc`mplus`upcwhereupx=rightx`mplus`(up=<<parentx)-- | Perform a depth first search for a descendant that satisfies the-- given predicate.findRec::(Cursortagtext->Bool)->Cursortagtext->Maybe(Cursortagtext)findRecpc=ifpcthenJustcelsefindRecp=<<nextDFc-- | The child with the given index (starting from 0).getChild::Int->Cursortagtext->Maybe(Cursortagtext)getChildnloc=do(ts,ps)<-downParentsloc(ls,t,rs)<-splitChildrentsnreturnCur{current=t,lefts=ls,rights=rs,parents=ps}-- | private: computes the parent for "down" operations.downParents::Cursortagtext->Maybe([Nodetagtext],Pathtagtext)downParentsloc=casecurrentlocofElementnac->Just(c,(leftsloc,Tagna,rightsloc):parentsloc)_->NothinggetTag::Nodetagtext->TagtagtextgetTage=Tag{tagName=eNamee,tagAttribs=eAttributese}-- Conversions ------------------------------------------------------------------- | A cursor for the given content.fromTree::Nodetagtext->CursortagtextfromTreet=Cur{current=t,lefts=[],rights=[],parents=[]}-- | The location of the first tree in a forest.fromForest::[Nodetagtext]->Maybe(Cursortagtext)fromForest(t:ts)=JustCur{current=t,lefts=[],rights=ts,parents=[]}fromForest[]=Nothing-- | Computes the tree containing this location.toTree::Cursortagtext->NodetagtexttoTreeloc=current(rootloc)-- | Computes the forest containing this location.toForest::Cursortagtext->[Nodetagtext]toForestloc=letr=rootlocincombChildren(leftsr)(currentr)(rightsr)-- Queries ----------------------------------------------------------------------- | Are we at the top of the document?isRoot::Cursortagtext->BoolisRootloc=null(parentsloc)-- | Are we at the left end of the the document?isFirst::Cursortagtext->BoolisFirstloc=null(leftsloc)-- | Are we at the right end of the document?isLast::Cursortagtext->BoolisLastloc=null(rightsloc)-- | Are we at the bottom of the document?isLeaf::Cursortagtext->BoolisLeafloc=isNothing(downParentsloc)-- | Do we have a parent?isChild::Cursortagtext->BoolisChildloc=not(isRootloc)-- | Get the node index inside the sequence of childrengetNodeIndex::Cursortagtext->IntgetNodeIndexloc=length(leftsloc)-- | Do we have children?hasChildren::Cursortagtext->BoolhasChildrenloc=not(isLeafloc)-- Updates ----------------------------------------------------------------------- | Change the current content.setContent::Nodetagtext->Cursortagtext->CursortagtextsetContenttloc=loc{current=t}-- | Modify the current content.modifyContent::(Nodetagtext->Nodetagtext)->Cursortagtext->CursortagtextmodifyContentfloc=setContent(f(currentloc))loc-- | Modify the current content.modifyContentList::(Nodetagtext->[Nodetagtext])->Cursortagtext->Maybe(Cursortagtext)modifyContentListfloc=removeGoRight$insertManyRight(f$currentloc)loc-- | Modify the current content, allowing for an effect.modifyContentM::Monadm=>(Nodetagtext->m(Nodetagtext))->Cursortagtext->m(Cursortagtext)modifyContentMfloc=dox<-f(currentloc)return(setContentxloc)-- | Insert content to the left of the current position.insertLeft::Nodetagtext->Cursortagtext->CursortagtextinsertLefttloc=loc{lefts=t:leftsloc}-- | Insert content to the right of the current position.insertRight::Nodetagtext->Cursortagtext->CursortagtextinsertRighttloc=loc{rights=t:rightsloc}-- | Insert content to the left of the current position.insertManyLeft::[Nodetagtext]->Cursortagtext->CursortagtextinsertManyLefttloc=loc{lefts=reverset++leftsloc}-- | Insert content to the right of the current position.insertManyRight::[Nodetagtext]->Cursortagtext->CursortagtextinsertManyRighttloc=loc{rights=t++rightsloc}-- | Insert content as the first child of the current position.mapChildren::([Nodetagtext]->[Nodetagtext])->Cursortagtext->Maybe(Cursortagtext)mapChildrenfloc=lete=currentlocincaseeofText_->NothingElement__c->Just$loc{current=e{eChildren=fc}}-- | Insert content as the first child of the current position.insertFirstChild::Nodetagtext->Cursortagtext->Maybe(Cursortagtext)insertFirstChildt=mapChildren(t:)-- | Insert content as the first child of the current position.insertLastChild::Nodetagtext->Cursortagtext->Maybe(Cursortagtext)insertLastChildt=mapChildren(++[t])-- | Insert content as the first child of the current position.insertManyFirstChild::[Nodetagtext]->Cursortagtext->Maybe(Cursortagtext)insertManyFirstChildt=mapChildren(t++)-- | Insert content as the first child of the current position.insertManyLastChild::[Nodetagtext]->Cursortagtext->Maybe(Cursortagtext)insertManyLastChildt=mapChildren(++t)-- | Remove the content on the left of the current position, if any.removeLeft::Cursortagtext->Maybe(Nodetagtext,Cursortagtext)removeLeftloc=caseleftslocofl:ls->return(l,loc{lefts=ls})[]->Nothing-- | Remove the content on the right of the current position, if any.removeRight::Cursortagtext->Maybe(Nodetagtext,Cursortagtext)removeRightloc=caserightslocofl:ls->return(l,loc{rights=ls})[]->Nothing-- | Insert content to the left of the current position.-- The new content becomes the current position.insertGoLeft::Nodetagtext->Cursortagtext->CursortagtextinsertGoLefttloc=loc{current=t,rights=currentloc:rightsloc}-- | Insert content to the right of the current position.-- The new content becomes the current position.insertGoRight::Nodetagtext->Cursortagtext->CursortagtextinsertGoRighttloc=loc{current=t,lefts=currentloc:leftsloc}-- | Remove the current element.-- The new position is the one on the left.removeGoLeft::Cursortagtext->Maybe(Cursortagtext)removeGoLeftloc=caseleftslocofl:ls->Justloc{current=l,lefts=ls}[]->Nothing-- | Remove the current element.-- The new position is the one on the right.removeGoRight::Cursortagtext->Maybe(Cursortagtext)removeGoRightloc=caserightslocofl:ls->Justloc{current=l,rights=ls}[]->Nothing-- | Remove the current element.-- The new position is the parent of the old position.removeGoUp::Cursortagtext->Maybe(Cursortagtext)removeGoUploc=caseparentslocof(pls,v,prs):ps->JustCur{current=fromTagv(reverse(leftsloc)++rightsloc),lefts=pls,rights=prs,parents=ps}[]->Nothing-- | private: Gets the given element of a list.-- Also returns the preceding elements (reversed) and the following elements.splitChildren::[a]->Int->Maybe([a],a,[a])splitChildren_n|n<0=NothingsplitChildrencspos=loop[]csposwhereloopacc(x:xs)0=Just(acc,x,xs)loopacc(x:xs)n=loop(x:acc)xs$!n-1loop___=Nothing-- | private: combChildren ls x ys = reverse ls ++ [x] ++ yscombChildren::[a]->a->[a]->[a]combChildrenlstrs=foldl(flip(:))(t:rs)ls