在哈斯克爾

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

回答

相關問題