<tr>s 在 Html table 中使用 Arrows 和 HXT 在 Haskell 中记录

Records from <tr>s in an Html table using Arrows and HXT in Haskell

希望使用 HXT 从格式良好的 HTMl table 中的 table 中提取记录。我已经查看了几个关于 SO 和 HXT 文档的示例,例如:

我的问题是:

I want to identify a table uniquely by a known id, and then for each tr within that table, create a record object and return this as a list of records.

这是我的 HTML

<!DOCTYPE html>
<head>
  <title>FakeHTML</title>
</head>
<body>
  <table id="fakeout-dont-get-me">
    <thead><tr><td>Null</td></tr></thead>
    <tbody><tr><td>Junk!</td></tr></tbody>
  </table>
  <table id="Greatest-Table">
    <thead>
      <tr><td>Name</td><td>Favorite Rock</td></tr>
    </thead>
    <tbody>
      <tr id="rock1">
        <td>Fred</td>
        <td>Igneous</td>
      </tr>
      <tr id="rock2">
        <td>Bill</td>
        <td>Sedimentary</td>
      </tr>
    </tbody>
  </table>
</body>
</html>

这是我正在尝试的代码,以及 2 种不同的解析方法。首先,进口...

{-# LANGUAGE Arrows, OverloadedStrings, DeriveDataTypeable, FlexibleContexts  #-}
import Text.XML.HXT.Core
import Text.HandsomeSoup
import Text.XML.HXT.XPath.XPathEval
import Data.Tree.NTree.TypeDefs
import Text.XML.HXT.XPath.Arrows

我想要的是 Rockrecs 列表,例如来自...

recs = [("rock1", "Name", "Fred", "Favorite Rock", "Igneous"),
        ("rock2", "Name", "Bill", "Favorite Rock", "Sedimentary")]

data Rockrec = Rockrec { rockID:: String,
                         rockName :: String,
                         rockFav :: String} deriving Show

rocks = [(\(a,_,b,_,c) -> Rockrec a b c ) r | r <- recs]
-- [Rockrec {rockID = "rock1", rockName = "Fred", rockFav = "Igneous"},
--  Rockrec {rockID = "rock2", rockName = "Bill", rockFav = "Sedimentary"}]

这是我的第一种方法,它在 return 一堆 [XMLTree] 之后在 运行LA 上使用绑定。也就是说,我首先进行解析只是为了得到正确的 table,然后我在第一次抓取之后处理树行。

尝试 1

getTab = do
  dt <- Prelude.readFile "fake.html"
  let html = parseHtml dt
  tab <- runX $ html //> hasAttrValue "id" (== "Greatest-Table")
  return tab
  -- hmm, now this gets tricky...

-- table <- getTab

node tag = multi (hasName tag)

-- a la 
getIt  :: ArrowXml cat => cat (Data.Tree.NTree.TypeDefs.NTree XNode) (String, String)
getIt = (node "tr" >>>
         (getAttrValue "id" &&& (node "td" //> getText)))

这有点管用。我需要按摩一下,但可以达到 运行...

-- table >>= runLA getIt
-- [("","Name"),("","Favorite Rock"),("rock1","Fred"),("rock1","Igneous"),("rock2","Bill"),("rock2","Sedimentary")]

这是受 https://wiki.haskell.org/HXT/Practical/Simple1 启发的第二种方法。在这里,我想我依赖于 {-# LANGUAGE Arrows -} 中的某些东西(巧合地打破了我对上面 rec 的列表理解),以使用 proc 函数在更具可读性的 do 块中执行此操作。也就是说,我什至无法编译它的最小版本:

尝试 2

 getR :: ArrowXml cat => cat XmlTree Rockrec
 getR = (hasAttrValue "id" (== "Greatest-Table")) >>>
   proc x -> do
     rockId <- getText -< x
     rockName <- getText -< x
     rockFav <- getText -< x
     returnA -< Rockrec rockId rockName rockFav

编辑

类型问题,回复下面来自 Alec 的评论

λ> getR [table]

<interactive>:56:1-12: error:
    • Couldn't match type ‘NTree XNode’ with ‘[[XmlTree]]’
      Expected type: [[XmlTree]] -> Rockrec
        Actual type: XmlTree -> Rockrec
    • The function ‘getR’ is applied to one argument,
      its type is ‘cat0 XmlTree Rockrec’,
      it is specialized to ‘XmlTree -> Rockrec’
      In the expression: getR [table]
      In an equation for ‘it’: it = getR [table]
λ> getR table

<interactive>:57:1-10: error:
    • Couldn't match type ‘NTree XNode’ with ‘[XmlTree]’
      Expected type: [XmlTree] -> Rockrec
        Actual type: XmlTree -> Rockrec
    • The function ‘getR’ is applied to one argument,
      its type is ‘cat0 XmlTree Rockrec’,
      it is specialized to ‘XmlTree -> Rockrec’
      In the expression: getR table
      In an equation for ‘it’: it = getR table

编辑结束

即使我不选择元素,我也无法将上面的内容获取到运行。我也有点困惑我应该如何做一些事情,比如把第一个 td 放在 rockName 中,第二个 td 放在 rockFav 中,如何在这些上包含一个迭代器(假设我有很多 td 字段,而不是只有 2 个。)

感谢任何关于如何更轻松地做到这一点的进一步一般提示。

来自 HXT/Practical/Google1 我想我可以拼凑出一个解决方案。

{-# LANGUAGE Arrows #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Hanzo where
import Text.HandsomeSoup
import Text.XML.HXT.Cor

atTag tag =
  deep (isElem >>> hasName tag)
text =
  deep isText >>> getText

data Rock = Rock String String String deriving Show    
rocks =
  atTag "tbody" //> atTag "tr"
  >>> proc x -> do
        rowID <- x >- getAttrValue "id"
        name <- x >- atTag "td" >. (!! 0) >>> text
        kind <- x >- atTag "td" >. (!! 1) >>> text
        returnA -< Rock rowID name kind

main = do
  dt <- readFile "html.html"
  result <- runX $ parseHtml dt
                   //> hasAttrValue "id" (== "Greatest-Table")
                   >>> rocks
  print result

关键要点如下:

  • 您的箭头适用于 元素,但不适用于单个元素。这是 ArrowList 约束。因此,调用 getText 三次会产生令人惊讶的行为,因为 getText 表示您在通过 proc x -> do {...} 流式传输 <table> 元素的过程中可能获得的所有不同的文本值。

  • 我们可以做的是专注于我们想要的流:<tbody> 中的 <tr> 流。对于每个 table 行,我们获取 ID 属性值和前两个 <td> 的文本。

  • 这似乎不是最优雅的解决方案,但我们可以对流进行索引的一种方法是使用 (>.) :: ArrowList cat => cat a b -> ([b] -> c) -> cat a c 组合器对其进行过滤。

  • 最后一个技巧,我在实际 wiki 示例中注意到的一个技巧:我们可以使用 deepisElem/isText 只关注我们想要的节点。 XML树很吵!