[Haskell-cafe] xml conduit
Michael Snoyman
michael at snoyman.com
Sat Feb 9 18:13:52 CET 2013
Hi Grant,
As you might expect from immutable data structures, there's no way to
update in place. The approach you'd take to XSLT: traverse the tree, check
each node, and output a new structure. I put together the following as an
example, but I could certainly imagine adding more combinators to the
Cursor module to make something like this more convenient.
{-# LANGUAGE OverloadedStrings #-}
import Prelude hiding (readFile, writeFile)
import Text.XML
import Text.XML.Cursor
main = do
doc@(Document pro (Element name attrs _) epi) <- readFile def "test.xml"
let nodes = fromDocument doc $/ update
writeFile def "output.xml" $ Document pro (Element name attrs nodes) epi
where
update c =
case node c of
NodeElement (Element "f" attrs _)
| parentIsE c && gparentIsD c ->
[ NodeElement $ Element "f" attrs
[ NodeContent "New content"
]
]
NodeElement (Element name attrs _) ->
[NodeElement $ Element name attrs $ c $/ update]
n -> [n]
parentIsE c = not $ null $ parent c >>= element "e"
gparentIsD c = not $ null $ parent c >>= parent >>= element "d"
Michael
On Sat, Feb 9, 2013 at 1:31 AM, grant <thelff at hotmail.com> wrote:
> Hi,
>
> Is there a nice way to update xml. I want to be able to use xml-conduit
> to find a location in the xml and then add/update that node.
>
> eg xpath from //d/e/f and then change the content at 'f' or add a new node
>
> <a>
> ...
> <d>
> <e>
> <f>some data to change
> </f>
> </e>
> </d>
> ...
> </a>
>
>
> Thanks for any help,
> Grant
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20130209/8482958a/attachment.htm>
More information about the Haskell-Cafe
mailing list