忽略流式传输xml-conduit中的子树

时间:2014-06-20 22:26:48

标签: xml haskell xml-conduit

xml-conduit documentation仅列出ConduitM使用整个XML树的示例,例如:

<people>
    <person age="25">Michael</person>
    <person age="2">Eliezer</person>
</people>

我试图解析一棵树,除了上面的<person>标签之外,还有我不感兴趣的深层嵌套子树(他们的确切模式甚至可能是未知的),例如:

<people>
    <person age="25">Michael</person>
    <tagImNotInterestedIn><!-- deeply nested complex subtree --></tagImNotInterestedIn>
    <person age="2">Eliezer</person>
</people>

使用the people.hs example from the docs进行分析时,出现以下异常:

people.hs: XmlException {xmlErrorMessage = "Expected end tag for: Name {nameLocalName = \"people\", nameNamespace = Nothing, namePrefix = Nothing}", xmlBadInput = Just (EventBeginElement (Name {nameLocalName = "tagImNotInterestedIn", nameNamespace = Nothing, namePrefix = Nothing}) [])}

基本上,我正在寻找一种忽略任何标记(包括其所有子标记和属性)的方法,除了我为其指定解析器的特定标记。当使用像HXT这样的基于DOM的解析器时,这显然很容易,但tag docs明确指出除非消耗掉所有子节点,否则它将失败。

我能想到实现这一目标的唯一假设方法是使用Control.Exception中的函数来构建一个带有Maybe a结果的管道(在异常时返回Nothing),然后使用{ {1}}将它与解析器本身结合起来

尽管xml-conduit API需要进行一些更新has been stated,但我认为忽略整个子树必须采用不那么强硬的方法。任何想法将不胜感激!

1 个答案:

答案 0 :(得分:1)

从1.5.0版开始Text.XML.Stream.Parse提供了一个函数takeTree,该功能可能可以用于此目的。

{-# LANGUAGE OverloadedStrings #-}

import           Control.Monad                (void)
import           Control.Monad.Trans.Class    (lift)
import           Control.Monad.Trans.Resource (MonadThrow, runResourceT)
import           Data.ByteString.Lazy         (ByteString)
import           Data.ByteString.Lazy.Char8   (concat)
import           Data.Conduit                 (ConduitT, runConduit, (.|))
import           Data.Conduit.List            (mapM_)
import           Data.Text                    (Text, unpack)
import           Data.XML.Types               (Event)
import           Prelude                      hiding (concat, mapM_)
import           Text.XML.Stream.Parse        (choose, content, def,
                                               ignoreAnyTreeContent,
                                               ignoreAttrs, manyYield, many_,
                                               parseLBS, requireAttr, tag',
                                               tagNoAttr, takeTree)

data Person = Person Int Text deriving Show

parsePerson :: MonadThrow m => ConduitT Event o m (Maybe Person)
parsePerson = tag' "person" (requireAttr "age") $ \age -> do
    name <- content
    return $ Person (read $ unpack age) name

parsePeople :: MonadThrow m => ConduitT Event Person m ()
parsePeople = void $ tagNoAttr "people" $
  many_ (choose([takeTree "person" ignoreAttrs, ignoreAnyTreeContent])) .| manyYield parsePerson

persons :: ByteString
persons = concat [
    "<people>"
  , "<foo/>"
  , "<person age=\"25\">Michael</person>"
  , "<bar/>"
  , "<person age=\"2\">Eliezer</person>"
  , "<tagImNotInterestedIn>x</tagImNotInterestedIn>"
  , "</people>"

main :: IO ()
main = runResourceT $
  runConduit $ parseLBS def persons .| parsePeople .| mapM_ (lift . print)

上面的代码基于xml-conduit sample。仅parsePeople被更改。

λ> main
Person 25 "Michael"
Person 2 "Eliezer"