Сгруппировать строки таблицы HTML с HXT в Haskell

Я хочу обработать (очень плохо определенный) 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? Я попробовал оператор &&& без особой удачи.

Вопрос при извлечении умножает html-таблицы на hxt, хотя и полезен, но, на мой взгляд, представляет собой более простую ситуацию.

Источник

2 ответа

Решение

Вот несколько более простая реализация.

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.

Источник

Я провел несколько html-разборов с 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 не совсем подходит для такого выбора индекса. Онлайн XPath-оценщик показывает правильное поведение для //td/font[4]/text(),

Источник
Другие вопросы по тегам