在哈斯克尔

HXT组HTML表行我想处理（定义很差）HTML，它在对的行分组的信息，像这样：在哈斯克尔

<html> 
<body> 
<table> 
<tr> 
    <td> 
     <font > 
     <a href="a">ABC</a></font> 
    </td> 
</tr> 
<tr> 
    <td height="50"> 
     <font>When:</font><font>19-1-2013</font> 
      <b><font>&nbsp; </font></b> 
     <font>Where:</font><font>Here</font> 
     <font>Who:</font><font>Me</font> 
    </td> 
</tr> 
<tr> 
    <td> 
     <font > 
      <a href="b">EFG</a> 
     </font> 
    </td> 
</tr> 
<tr> 
    <td height="50"> 
     <font>When:</font><font>19-2-2013</font> 
     <b><font>&nbsp; </font></b> 
     <font>Where:</font><font>There</font> 
     <font>Who:</font><font>You</font> 
    </td> 
</tr> 
<tr> 
    <td> 
     <font > 
      <a href="c">HIJ</a> 
     </font> 
    </td> 
</tr> 
<tr> 
    <td height="50"> 
     <font>When:</font><font>19-3-2013</font><b> 
     <font>&nbsp; </font></b> 
     <font>Where:</font><font>Far away</font> 
     <font>Who:</font><font>Him</font> 
    </td> 
</tr> 
</table> 
</body> 
</html>

对此，几经反复，我来到这个代码来实现我想要什么：

import Data.List 
import Control.Arrow.ArrowNavigatableTree 
import Text.XML.HXT.Core 
import Text.HandsomeSoup 

group2 [] = [] 
group2 (x0:x1:xs) = [x0,x1]:(group2 xs) 

countRows html = html >>> deep (hasName "tr") >. length 

parsePage sz html = let 
    n x = deep (hasName "tr") >. ((-> a !! x) . group2) >>> unlistA 
    m = deep (hasName "td") >>> css "a" /> getText 
    o = deep (hasName "td") >>> hasAttr "height" >>> (css "font" >. (take 1 . drop 4)) >>> unlistA /> getText 
    p x = (((n x) >>> m) &&& ((n x) >>> o)) 
    in html >>> catA [p x | x <- [0..sz]] 

main = do 
    dt <- readFile "test.html" 
    let html = parseHtml dt 
    count <- (runX . countRows) html 
    let cnt = ((head count) `div` 2) - 1 
    prcssd <- (runX . (parsePage cnt)) html 
    print prcssd

，其结果是： [（ “ABC”， “在这里”），（ “EFG”， “有”），（ “HIJ” “远”）]

但是，我不认为这是一个非常好的答案，不得不先计算行数。使用HXT进行分组有更好的方法吗？我已经尝试运营商运气不好。

extract multiples html tables with hxt这个问题虽然有用，但我认为这个问题比较简单。

来源

2013-02-19 jcristovao

这是一个稍微简单的实现。

import Text.XML.HXT.Core 
import Text.HandsomeSoup 

group2 :: [a] -> [(a, a)] 
group2 [] = [] 
group2 (x0:x1:xs) = (x0, x1) : group2 xs 

parsePage :: ArrowXml a => a XmlTree (String, String) 
parsePage = let 
    trPairs = deep (hasName "tr") >>. group2 
    insideLink = deep (hasName "a") /> getText 
    insideFont = deep (hasName "font") >>. (take 1 . drop 4) /> getText 

    in trPairs >>> (insideLink *** insideFont) 


main = do 
    dt <- readFile "test.html" 
    let html = parseHtml dt 
    prcssd <- runX $ html >>> parsePage 
    print prcssd

的>>.运算符可以用来代替>.，这样你就不需要调用unlistA之后。

我将group2函数更改为返回对的列表，因为它更好地映射了我们试图实现的内容，并且更容易处理。

类型的trPairs是

trPairs :: ArrowXml a => a XmlNode (XmlNode, XmlNode)

即它是一个箭头，取入节点和输出节点对（即，配对<tr>节点）。现在我们可以使用来自Control.Arrow的***运算符将变换应用于该对的任一元素，第一个为insideLink，第二个为insideFont。这样我们就可以通过一次遍历HTML树来收集和分组我们需要的所有东西。

来源

2013-02-20 11:08:16 shang

就是这样。我已经成对地将它们分组了，但是对我来说没有发生这样的事情，一个疙瘩是最合适的解决方案，因此允许我使用（***）。谢谢！然后，我也想从'属性'行抓取多个字段，因此我只需修改你的函数：'insideFont =（deep（hasName“font”）>>。（\ x→[x !! 1 ]）/> getText）&&&（deep（hasName“font”）>>。（\ x→[x !! 4]）/> getText）'。这当然不是问题所在，当然，我只是把它包含在其他人可能会觉得有用的情况下。 – jcristovao 2013-02-20 15:00:29

几周前我做了一些hxt解析，并认为xpath非常方便。不幸的是，我没有为你的问题想出一个完美的解决方案，但它可能是一个新尝试的开始。

import Text.XML.HXT.Core 
import Text.XML.HXT.XPath.Arrows 

type XmlTreeValue a = a XmlTree String 
type ParsedXmlTree a = a XmlTree XmlTree 
type IOXmlTree = IOSArrow XmlTree XmlTree 

-- parses a given .html file 
parseHtml :: FilePath -> IOStateArrow s b XmlTree 
parseHtml path = readDocument [withParseHTML yes, withWarnings no] path 

-- "" for stdout 
saveHtml :: IOXmlTree 
saveHtml = writeDocument [withIndent yes] "" 

extract :: IOXmlTree 
extract = processChildren (process `when` isElem) 

-- main processing functon 
processHtml :: FilePath -> IO() 
processHtml src = 
    runX (parseHtml src >>> extract >>> saveHtml) 
    >> return() 

-- process the html structure 
process :: ArrowXml cat => ParsedXmlTree cat 
process = 
    -- create tag <structure> for the expression given next 
    selem "structure" 
    -- navigate to <html><body><table><tr>... 
    [(getXPathTrees "/html/body/table/tr") 
     -- then combine the results 
     >>> (getTheName <+> getWhere)] 

-- selects text at path <td><font><a...> </a></font></td> and creates <name>-Tag 
-- (// means that all <td>-tags are analysed, 
-- but I'm not quite sure why this is relevant here) 
getTheName :: ArrowXml cat => ParsedXmlTree cat 
getTheName = selem "name" [getXPathTrees "//td/font/a/text()"] 

-- selects text at path <td><font><a...> </a></font></td> 
-- (where the forth font-tag is taken) and creates <where>-Tag 
getWhere :: ArrowXml cat => ParsedXmlTree cat 
getWhere = selem "where" [getXPathTrees "//td/font[4]/text()"]

结果看起来是这样的：

*Main> processHtml "test.html" 
<?xml version="1.0" encoding="UTF-8"?> 
<structure> 
<name>ABC</name> 
<where/> 
<name/> 
<where>Here</where> 
<name>EFG</name> 
<where/> 
<name/> 
<where>There</where> 
<name>HIJ</name> 
<where/> 
<name/> 
<where>Far away</where> 
</structure>

就像我说的，还不太完善，但希望是一个开始。编辑：也许这看起来更像你的方法。尽管如此，我们首先选择所有适合并过滤结果的元素，而不是放弃不关心的元素。我认为对于这样一个问题没有通用的方法是非常有趣的。因为，不知何故，字体[4]选择不适用于我的另一种方法 - 但也许我不是一个好的xpath用户。

processHtml :: FilePath -> IO [(String,String)] 
processHtml src = do 
    names <- runX (parseHtml src >>> process1) 
    fontTags <- runX (parseHtml src >>> process2) 
    let wheres = filterAfterWhere fontTags 
    let result = zip names wheres 
    return result 
where filterAfterWhere [] = [] 
     filterAfterWhere xs = case dropWhile (/= "Where:") xs of 
           []  -> [] 
           [x] -> [x] 
           _:y:ys -> y : filterAfterWhere ys 

process1 :: ArrowXml cat => XmlTreeValue cat 
process1 = textNodeToText getTheName 

process2 :: ArrowXml cat => XmlTreeValue cat 
process2 = textNodeToText getWhere 

getTheName :: ArrowXml cat => ParsedXmlTree cat 
getTheName = getXPathTrees "//td/font/a/text()" 

getWhere :: ArrowXml cat => ParsedXmlTree cat 
getWhere = getXPathTrees "//td/font/text()" 

-- neet function to select a value within a XmlTree as String 
textNodeToText :: ArrowXml cat => ParsedXmlTree cat -> XmlTreeValue cat 
textNodeToText selector = selector `when` isElem >>> getText

这样，你让你在你的问题得到了下述结果：

*Main> processHtml "test.html" 
[("ABC","Here"),("EFG","There"),("HIJ","Far away")]

EDIT2：

有趣的事实：它好像HXT-的XPath库并不完全适合工作这样的索引选择。 An online XPath-evaluator显示//td/font[4]/text()的正确行为。

来源

2013-02-19 18:58:28 ichistmeinname

我其实并不知道XPath扩展，tks！我似乎没有使用[]谓词的问题...即使位置（）支持。不支持的是“后续”和“之前”的轴，这将是非常有用的。我也尝试在Text.HandsomeSoup包上使用CSS2选择器来获得类似的效果，但它们大部分都未实现。你的第二个解决方案虽然正确，但并不是我想要的：它意味着HTML树的双重横向，正如@shang注意到的，这是我个人比较喜欢的解决方案。我仍然赞成你，因为你的解决方案比我的更优雅 – jcristovao 2013-02-20 14:52:43

回答

相关问题