好的,这是我的尝试:代码首先收集兄弟姐妹的父级的所有属性列表,然后对所有不同的属性列表进行合并:
{-# LANGUAGE Arrows #-}
module Main
where
import Data.List
import Text.XML.HXT.Core
example="\
\<root>\
\ <sub>\
\ <p att1=\"0\" att2=\"1\"><i>foo</i></p>\
\ <p att1=\"1\" att2=\"1\"><i>bar</i></p>\
\ <p att1=\"0\" att2=\"0\"><i>baz</i></p>\
\ <p att1=\"0\" att2=\"1\"><i>bazz</i></p>\
\ </sub>\
\</root>"
get_attrs name = getChildren >>> hasName name >>> proc x -> do
a <- listA (((
getAttrName
&&& (getChildren >>> getText)) ) <<< getAttrl ) -< x
returnA -< a
has_attrs atts = proc x -> do
a <- listA (((
getAttrName
&&& (getChildren >>> getText)) ) <<< getAttrl ) -< x
if (a == atts)
then returnA -< x
else none -<< ()
mk_attrs atts = map f atts
where
f (n, v) = sqattr n v
mergeSiblings_one inp name att = catA (map constA inp)
>>> mkelem name
(mk_attrs att)
[getChildren
>>> hasName name >>> has_attrs att >>> getChildren ]
mergeSiblings_core name = proc x -> do
a <- listA (get_attrs name >>. (sort.nub) ) -< x
b <- listA this -< x
c <- listA (getChildren >>> neg (hasName name)) -< x
catA ((map (mergeSiblings_one b name) a) ++ (map constA c) ) -<< ()
is_parent_of name = getChildren >>> hasName name
mergeSiblings name = processTopDownUntil (
is_parent_of name `guards` mergeSiblings_core name
)
stuff = mergeSiblings "p"
main :: IO ()
main
= do
x <- runX (
configSysVars [withTrace 1]
>>> readString [withValidate no
,withPreserveComment yes
,withRemoveWS yes
] example
>>> setTraceLevel 4
>>> stuff >>> traceTree >>> traceSource
)
return ()
示例的输出
<root>
<p att1="0" att2="0">
<i>baz</i>
</p>
<p att1="0" att2="1">
<i>foo</i>
<i>bazz</i>
</p>
<p att1="1" att2="1">
<i>bar</i>
</p>
</root>
很高兴有
上面的版本将合并的子节点放在前面,将不匹配的子节点放在父节点的新子节点列表中:一个不错的变化是:将每个合并的子节点插入第一个旧兄弟节点的旧位置并且不要更改非合并节点的顺序。例如那个
<other>1</other><p><a/></p><other>2</other><p><b/></p>
被转化为
<other>1</other><p><a/><b/></p><other>2</other>
而不是:
<p><a/><b/></p><other>1</other><other>2</other>
免责声明
由于我是 HXT 和箭头的新手 - 如果有更简洁/HXT0 惯用/优雅的答案,我不会感到惊讶。