在 Haskell 中，如何从 XML 文档中提取字符串？

Question

如果我有这样的 XML 文档：

<root>
  <elem name="Greeting">
    Hello
  </elem>
  <elem name="Name">
    Name
  </elem>
</root>

还有一些像这样的 Haskell 类型/数据定义：

 type Name = String
 type Value = String
 data LocalizedString = LS Name Value

我想写一个带有以下签名的 Haskell 函数：

 getLocalizedStrings :: String -> [LocalizedString]

其中第一个参数是XML文本，返回值为：

 [LS "Greeting" "Hello", LS "Name" "Name"]

我该怎么做？

如果 HaXml 是最好的工具，我将如何使用 HaXml 来实现上述目标？

谢谢！

Answer 1

我从来没有真正费心弄清楚如何使用HaXML 从 XML 文档中提取位； HXT 满足了我的所有需求。

{-# LANGUAGE Arrows #-}
import Data.Maybe
import Text.XML.HXT.Arrow

type Name = String
type Value = String
data LocalizedString = LS Name Value

getLocalizedStrings :: String -> Maybe [LocalizedString]
getLocalizedStrings = (.) listToMaybe . runLA $ xread >>> getRoot

atTag :: ArrowXml a => String -> a XmlTree XmlTree
atTag tag = deep $ isElem >>> hasName tag

getRoot :: ArrowXml a => a XmlTree [LocalizedString]
getRoot = atTag "root" >>> listA getElem

getElem :: ArrowXml a => a XmlTree LocalizedString
getElem = atTag "elem" >>> proc x -> do
    name <- getAttrValue "name" -< x
    value <- getChildren >>> getText -< x
    returnA -< LS name value

您可能想要更多的错误检查（即不要像我一样懒洋洋地使用atTag；实际上验证<root> 是root，<elem> 是直接后代，等等）但这有效你的例子就好了。

---

现在，如果您需要介绍Arrows，很遗憾我不知道有什么好的。我自己学会了“扔进海里学游泳”的方式。

需要记住的一点是 proc/-< 语法只是基本箭头操作（arr、>>> 等）的糖，就像 do/ <- 只是基本 monad 操作的糖（return、>>= 等）。以下是等价的：

getAttrValue "name" &&& (getChildren >>> getText) >>^ uncurry LS

proc x -> do
    name <- getAttrValue "name" -< x
    value <- getChildren >>> getText -< x
    returnA -< LS name value

Answer 2

使用其中一个 XML 包。

最受欢迎的是，按顺序，

1. haxml
2. hxt
3. xml-light
4. 六边形

Answer 3

FWIW，HXT 看起来有点矫枉过正，一个简单的 TagSoup 就可以了 :)

Answer 4

这是我使用 TagSoup 的第二次尝试（在收到其他人的一些好的意见后）：

module Xml where

import Data.Char
import Text.HTML.TagSoup

type SName = String
type SValue = String

data LocalizedString = LS SName SValue
     deriving Show

getLocalizedStrings :: String -> [LocalizedString]
getLocalizedStrings = create . filterTags . parseTags
  where 
    filterTags :: [Tag] -> [Tag]
    filterTags = filter (\x -> isTagOpenName "elem" x || isTagText x)

    create :: [Tag] -> [LocalizedString]
    create (TagOpen "elem" [("name", name)] : TagText text : rest) = 
      LS name (trimWhiteSpace text) : create rest
    create (_:rest) = create rest
    create [] = []               

trimWhiteSpace :: String -> String
trimWhiteSpace = dropWhile isSpace . reverse . dropWhile isSpace . reverse

main = do
  xml <- readFile "xml.xml"  -- xml.xml contains the xml in the original question.
  putStrLn . show . getLocalizedStrings $ xml

第一次尝试展示了一种从字符串中修剪空白的幼稚（和错误）方法。