[Haskell-cafe] HXT: desperatedly trying to "concat"
Steffen Schuldenzucker
Steve.Schuldenzucker at web.de
Thu Apr 2 09:26:21 EDT 2009
Hi.
I've got a problem with the Haskell XML Toolkit (hxt). I want to write a little app that performs REST requests from a certain (rather simple) XML format.
A example procedure Call looks like testData defined below.
What I'd like to do is to transform this xml tree into a GET variable string using an XmlArrow. The task sounds easy, and it has to be easy, but I've been sitting here for about a day now, staring at my code.
It looks like this (the transformation should be done by the arrow "mkGetStr"):
-- Rest.hs
-- This is also on HPaste: http://hpaste.org/fastcgi/hpaste.fcgi/view?id=3210#a3210
{-# LANGUAGE NoMonomorphismRestriction #-}
module Rest where
import Text.XML.HXT.Arrow
import Data.List
getParamsA = hasName "param" >>> getChildren >>> isElem
>>> (getName &&& (getChildren >>> getText)) >>> arr2 mkGetPair
mkMethodStr = ("method=" ++)
mkGetPair k v = k ++ "=" ++ v
getMethodA = hasName "method" >>> getChildren >>> getText >>> arr mkMethodStr
mkGetStr = isElem
>>> (getMethodA <+> getParamsA)
>>. intercalate "&"
-- Try it with: runX (testData >>> mkGetStr) >>= print
testData = xread <<< constA (
"<method>my.Method</method>"
++ "<param>"
++ "<foo_arg>Foo</foo_arg>"
++ "<bar_arg>Bar</bar_arg>"
++ "</param>" )
-- End of Rest.hs
What I get out of it is this (in ghci):
*Rest> runX (testData >>> mkGetStr) >>= print
"method=my.Methodfoo_arg=Foo&bar_arg=Bar"
There is an "&" missing right after "method=my.Method"!
Why? I've tried many variants of this and they give me either this or a similar result or multiple results (what I don't want either).
I'd be really happy if someone could save my day and help me with this issue.
Thanks in advance,
Steffen
________________________________________________________________________
Neu bei WEB.DE: Kostenlose maxdome Movie-FLAT!
https://register.maxdome.de/xml/order/LpWebDe?ac=OM.MD.MD008K15726T7073a
More information about the Haskell-Cafe
mailing list